daily pastebin goal
21%
SHARE
TWEET

Untitled

a guest Feb 21st, 2019 67 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #lang eopl
  2. ;******************************************************************************************
  3. ;;;;; Interpretador para lenguaje con condicionales, ligadura local, procedimientos y
  4. ;;;;; procedimientos recursivos
  5.  
  6. ;; La definición BNF para las expresiones del lenguaje:
  7. ;;
  8. ;;  <program>       ::= <expression>
  9. ;;                      <a-program (exp)>
  10. ;;  <expression>    ::= <number>
  11. ;;                      <lit-exp (datum)>
  12. ;;                  ::= <identifier>
  13. ;;                      <var-exp (id)>
  14. ;;                  ::= <primitive> ({<expression>}*(,))
  15. ;;                      <primapp-exp (prim rands)>
  16. ;;                  ::= if <expresion> then <expresion> else <expression>
  17. ;;                      <if-exp (exp1 exp2 exp23)>
  18. ;;                  ::= let {identifier = <expression>}* in <expression>
  19. ;;                      <let-exp (ids rands body)>
  20. ;;                  ::= proc({<identificador>}*) <expression>
  21. ;;                      <proc-exp (ids body)>
  22. ;;                  ::= (<expression> {<expression>}*)
  23. ;;                      <app-exp proc rands>
  24. ;;                  ::= letrec  {identifier ({identifier}*(,)) = <expression>}* in <expression>
  25. ;;                     <letrec-exp proc-names idss bodies bodyletrec>
  26. ;;  <primitive>     ::= + | - | * | add1 | sub1
  27.  
  28. ;******************************************************************************************
  29.  
  30. ;******************************************************************************************
  31. ;Especificación Léxica
  32.  
  33. (define scanner-spec-simple-interpreter
  34. '((white-sp
  35.    (whitespace) skip)
  36.   (comment
  37.    ("%" (arbno (not #\newline))) skip)
  38.   (identifier
  39.    (letter (arbno (or letter digit "?"))) symbol)
  40.   (number
  41.    (digit (arbno digit)) number)
  42.   (number
  43.    ("-" digit (arbno digit)) number)))
  44.  
  45. ;Especificación Sintáctica (gramática)
  46.  
  47. (define grammar-simple-interpreter
  48.   '((program (expression) a-program)
  49.     (expression (number) lit-exp)
  50.     (expression (identifier) var-exp)
  51.     (expression
  52.      (primitive "(" (separated-list expression ",")")")
  53.      primapp-exp)
  54.     (expression ("if" expression "then" expression "else" expression)
  55.                 if-exp)
  56.     (expression ("let" (arbno identifier "=" expression) "in" expression)
  57.                 let-exp)
  58.     (expression ("proc" "(" (arbno identifier) ")" expression)
  59.                 proc-exp)
  60.     (expression ( "(" expression (arbno expression) ")")
  61.                 app-exp)
  62.    
  63.     ; características adicionales
  64.     (expression ("letrec" (arbno identifier "(" (separated-list identifier ",") ")" "=" expression)  "in" expression)
  65.                 letrec-exp)
  66.     ;;;;;;
  67.  
  68.     (primitive ("+") add-prim)
  69.     (primitive ("-") substract-prim)
  70.     (primitive ("*") mult-prim)
  71.     (primitive ("add1") incr-prim)
  72.     (primitive ("sub1") decr-prim)))
  73.  
  74.  
  75. ;Tipos de datos para la sintaxis abstracta de la gramática
  76.  
  77. ;Construidos manualmente:
  78.  
  79. ;(define-datatype program program?
  80. ;  (a-program
  81. ;   (exp expression?)))
  82. ;
  83. ;(define-datatype expression expression?
  84. ;  (lit-exp
  85. ;   (datum number?))
  86. ;  (var-exp
  87. ;   (id symbol?))
  88. ;  (primapp-exp
  89. ;   (prim primitive?)
  90. ;   (rands (list-of expression?)))
  91. ;  (if-exp
  92. ;   (test-exp expression?)
  93. ;   (true-exp expression?)
  94. ;   (false-exp expression?))
  95. ;  (let-exp
  96. ;   (ids (list-of symbol?))
  97. ;   (rans (list-of expression?))
  98. ;   (body expression?))
  99. ;  (proc-exp
  100. ;   (ids (list-of symbol?))
  101. ;   (body expression?))
  102. ;  (app-exp
  103. ;   (proc expression?)
  104. ;   (args (list-of expression?)))
  105. ;  (letrec-exp
  106. ;   (proc-names (list-of symbol?))
  107. ;   (idss (list-of (list-of symbol?)))
  108. ;   (bodies (list-of expression?))
  109. ;   (body-letrec expression?)))
  110.  
  111. ;
  112. ;(define-datatype primitive primitive?
  113. ;  (add-prim)
  114. ;  (substract-prim)
  115. ;  (mult-prim)
  116. ;  (incr-prim)
  117. ;  (decr-prim))
  118.  
  119. ;Construidos automáticamente:
  120.  
  121. (sllgen:make-define-datatypes scanner-spec-simple-interpreter grammar-simple-interpreter)
  122.  
  123. (define show-the-datatypes
  124.   (lambda () (sllgen:list-define-datatypes scanner-spec-simple-interpreter grammar-simple-interpreter)))
  125.  
  126. ;*******************************************************************************************
  127. ;Parser, Scanner, Interfaz
  128.  
  129. ;El FrontEnd (Análisis léxico (scanner) y sintáctico (parser) integrados)
  130.  
  131. (define scan&parse
  132.   (sllgen:make-string-parser scanner-spec-simple-interpreter grammar-simple-interpreter))
  133.  
  134. ;El Analizador Léxico (Scanner)
  135.  
  136. (define just-scan
  137.   (sllgen:make-string-scanner scanner-spec-simple-interpreter grammar-simple-interpreter))
  138.  
  139. ;El Interpretador (FrontEnd + Evaluación + señal para lectura )
  140.  
  141. (define interpretador
  142.   (sllgen:make-rep-loop  "--> "
  143.     (lambda (pgm) (eval-program  pgm))
  144.     (sllgen:make-stream-parser
  145.       scanner-spec-simple-interpreter
  146.       grammar-simple-interpreter)))
  147.  
  148. ;*******************************************************************************************
  149. ;El Interprete
  150.  
  151. ;eval-program: <programa> -> numero
  152. ; función que evalúa un programa teniendo en cuenta un ambiente dado (se inicializa dentro del programa)
  153.  
  154. (define eval-program
  155.   (lambda (pgm)
  156.     (cases program pgm
  157.       (a-program (body)
  158.                  (eval-expression body (init-env))))))
  159.  
  160. ; Ambiente inicial
  161. ;(define init-env
  162. ;  (lambda ()
  163. ;    (extend-env
  164. ;     '(x y z)
  165. ;     '(4 2 5)
  166. ;     (empty-env))))
  167. (define init-env
  168.   (lambda ()
  169.     (extend-env
  170.      '(x y z f)
  171.      (list 4 2 5 (closure '(y) (primapp-exp (mult-prim) (cons (var-exp 'y) (cons (primapp-exp (decr-prim) (cons (var-exp 'y) '())) '())))
  172.                       (empty-env)))
  173.      (empty-env))))
  174.  
  175. ;eval-expression: <expression> <enviroment> -> numero
  176. ; evalua la expresión en el ambiente de entrada
  177. (define eval-expression
  178.   (lambda (exp env)
  179.     (cases expression exp
  180.       (lit-exp (datum) datum)
  181.       (var-exp (id) (apply-env env id))
  182.       (primapp-exp (prim rands)
  183.                    (let ((args (eval-rands rands env)))
  184.                      (apply-primitive prim args)))
  185.       (if-exp (test-exp true-exp false-exp)
  186.               (if (true-value? (eval-expression test-exp env))
  187.                   (eval-expression true-exp env)
  188.                   (eval-expression false-exp env)))
  189.       (let-exp (ids rands body)
  190.                (let ((args (eval-rands rands env)))
  191.                  (eval-expression body
  192.                                   (extend-env ids args env))))
  193.       (proc-exp (ids body)
  194.                 (closure ids body env))
  195.       (app-exp (rator rands)
  196.                (let ((proc (eval-expression rator env))
  197.                      (args (eval-rands rands env)))
  198.                  (if (procval? proc)
  199.                      (apply-procedure proc args)
  200.                      (eopl:error 'eval-expression
  201.                                  "Attempt to apply non-procedure ~s" proc))))
  202.       (letrec-exp (proc-names idss bodies letrec-body)
  203.                   (eval-expression letrec-body
  204.                                    (extend-env-recursively proc-names idss bodies env))))))
  205.  
  206. ; funciones auxiliares para aplicar eval-expression a cada elemento de una
  207. ; lista de operandos (expresiones)
  208. (define eval-rands
  209.   (lambda (rands env)
  210.     (map (lambda (x) (eval-rand x env)) rands)))
  211.  
  212. (define eval-rand
  213.   (lambda (rand env)
  214.     (eval-expression rand env)))
  215.  
  216. ;apply-primitive: <primitiva> <list-of-expression> -> numero
  217. (define apply-primitive
  218.   (lambda (prim args)
  219.     (cases primitive prim
  220.       (add-prim () (+ (car args) (cadr args)))
  221.       (substract-prim () (- (car args) (cadr args)))
  222.       (mult-prim () (* (car args) (cadr args)))
  223.       (incr-prim () (+ (car args) 1))
  224.       (decr-prim () (- (car args) 1)))))
  225.  
  226. ;true-value?: determina si un valor dado corresponde a un valor booleano falso o verdadero
  227. (define true-value?
  228.   (lambda (x)
  229.     (not (zero? x))))
  230.  
  231. ;*******************************************************************************************
  232. ;Procedimientos
  233. (define-datatype procval procval?
  234.   (closure
  235.    (ids (list-of symbol?))
  236.    (body expression?)
  237.    (env environment?)))
  238.  
  239. ;apply-procedure: evalua el cuerpo de un procedimientos en el ambiente extendido correspondiente
  240. (define apply-procedure
  241.   (lambda (proc args)
  242.     (cases procval proc
  243.       (closure (ids body env)
  244.                (eval-expression body (extend-env ids args env))))))
  245.  
  246. ;*******************************************************************************************
  247. ;Ambientes
  248.  
  249. ;definición del tipo de dato ambiente
  250. (define-datatype environment environment?
  251.   (empty-env-record)
  252.   (extended-env-record (syms (list-of symbol?))
  253.                        (vals (list-of scheme-value?))
  254.                        (env environment?))
  255.   (recursively-extended-env-record (proc-names (list-of symbol?))
  256.                                    (idss (list-of (list-of symbol?)))
  257.                                    (bodies (list-of expression?))
  258.                                    (env environment?)))
  259.  
  260. (define scheme-value? (lambda (v) #t))
  261.  
  262. ;empty-env:      -> enviroment
  263. ;función que crea un ambiente vacío
  264. (define empty-env  
  265.   (lambda ()
  266.     (empty-env-record)))       ;llamado al constructor de ambiente vacío
  267.  
  268.  
  269. ;extend-env: <list-of symbols> <list-of numbers> enviroment -> enviroment
  270. ;función que crea un ambiente extendido
  271. (define extend-env
  272.   (lambda (syms vals env)
  273.     (extended-env-record syms vals env)))
  274.  
  275. ;extend-env-recursively: <list-of symbols> <list-of <list-of symbols>> <list-of expressions> environment -> environment
  276. ;función que crea un ambiente extendido para procedimientos recursivos
  277. (define extend-env-recursively
  278.   (lambda (proc-names idss bodies old-env)
  279.     (recursively-extended-env-record
  280.      proc-names idss bodies old-env)))
  281.  
  282.  
  283. ;función que busca un símbolo en un ambiente
  284. (define apply-env
  285.   (lambda (env sym)
  286.     (cases environment env
  287.       (empty-env-record ()
  288.                         (eopl:error 'empty-env "No binding for ~s" sym))
  289.       (extended-env-record (syms vals old-env)
  290.                            (let ((pos (list-find-position sym syms)))
  291.                              (if (number? pos)
  292.                                  (list-ref vals pos)
  293.                                  (apply-env old-env sym))))
  294.       (recursively-extended-env-record (proc-names idss bodies old-env)
  295.                                        (let ((pos (list-find-position sym proc-names)))
  296.                                          (if (number? pos)
  297.                                              (closure (list-ref idss pos)
  298.                                                       (list-ref bodies pos)
  299.                                                       env)
  300.                                              (apply-env old-env sym)))))))
  301.  
  302.  
  303. ;****************************************************************************************
  304. ;Funciones Auxiliares
  305.  
  306. ; funciones auxiliares para encontrar la posición de un símbolo
  307. ; en la lista de símbolos de unambiente
  308.  
  309. (define list-find-position
  310.   (lambda (sym los)
  311.     (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
  312.  
  313. (define list-index
  314.   (lambda (pred ls)
  315.     (cond
  316.       ((null? ls) #f)
  317.       ((pred (car ls)) 0)
  318.       (else (let ((list-index-r (list-index pred (cdr ls))))
  319.               (if (number? list-index-r)
  320.                 (+ list-index-r 1)
  321.                 #f))))))
  322.  
  323. ;******************************************************************************************
  324. ;Pruebas
  325.  
  326. (show-the-datatypes)
  327. just-scan
  328. scan&parse
  329. (just-scan "add1(x)")
  330. (just-scan "add1(   x   )%cccc")
  331. (just-scan "add1(  +(5, x)   )%cccc")
  332. (just-scan "add1(  +(5, %ccccc x) ")
  333. (scan&parse "add1(x)")
  334. (scan&parse "add1(   x   )%cccc")
  335. (scan&parse "add1(  +(5, x)   )%cccc")
  336. (scan&parse "add1(  +(5, %cccc
  337. x)) ")
  338. (scan&parse "if -(x,4) then +(y,11) else *(y,10)")
  339. (scan&parse "let
  340. x = -(y,1)
  341. in
  342. let
  343. x = +(x,2)
  344. in
  345. add1(x)")
  346.  
  347. (define caso1 (primapp-exp (incr-prim) (list (lit-exp 5))))
  348. (define exp-numero (lit-exp 8))
  349. (define exp-ident (var-exp 'c))
  350. (define exp-app (primapp-exp (add-prim) (list exp-numero exp-ident)))
  351. (define programa (a-program exp-app))
  352. (define una-expresion-dificil (primapp-exp (mult-prim)
  353.                                            (list (primapp-exp (incr-prim)
  354.                                                               (list (var-exp 'v)
  355.                                                                     (var-exp 'y)))
  356.                                                  (var-exp 'x)
  357.                                                  (lit-exp 200))))
  358. (define un-programa-dificil
  359.     (a-program una-expresion-dificil))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top