Advertisement
Guest User

Untitled

a guest
Apr 16th, 2019
100
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Racket 15.52 KB | None | 0 0
  1. #lang eopl
  2. (require racket/string); string-trim
  3.  
  4.  
  5. (define lexical-spec
  6. '((white-sp (whitespace) skip)
  7.   (comment ("#" (arbno (not #\newline))) skip)
  8.   (identifier ((arbno "@") letter (arbno (or letter digit "_" "?" "=" ))) symbol)
  9.   (number (digit (arbno digit)) number)
  10.   (number ("-" digit (arbno digit)) number)
  11.   (text ("\"" (or letter whitespace)
  12.               (arbno (or letter digit whitespace ":" "?" "=" "'")) "\"") string)
  13.   )
  14. )
  15.  
  16. (define grammar-spec
  17.   '( ;;Representa un programa de ruby    
  18.      (ruby-program ("ruby" exp-batch "end") a-program)
  19.      ;; Parte 2: Ruby con objetos
  20.      ;; cambiar a: (ruby-program ("ruby" (arbno class-decl) exp-batch "end") a-program)
  21.      
  22.      ;;Exp-batch: Representa una cerradura de expresiones
  23.      (exp-batch (expression (arbno expression)) a-batch)
  24.  
  25.      ;;Expresión:
  26.      (expression (simple-exp) a-simple-exp)
  27.      ;Declare-exp: al menos uno o más identificadores (deben inicializarse en 'nil)
  28.      (expression ("declare" identifier (arbno "," identifier) ";") declare-exp)
  29.      ;Puts-exp: al menos un valor compuesto para imprimir
  30.      (expression ("puts" (separated-list comp-value ",") ";") puts-exp)
  31.  
  32.      (expression ("if" comp-value (arbno "then") exp-batch
  33.                        (arbno "elsif" comp-value (arbno "then") exp-batch)
  34.                        (arbno "else" exp-batch) "end") if-exp)
  35.      
  36.      (expression ("unless" comp-value (arbno "then")
  37.                            exp-batch
  38.                            (arbno "else" exp-batch) "end") unless-exp)
  39.  
  40.      (expression ("while" comp-value (arbno "do") exp-batch "end") while-exp)
  41.      (expression ("until" comp-value (arbno "do") exp-batch "end") until-exp)
  42.  
  43.      (expression ("for" identifier "in" comp-value (arbno "do") exp-batch "end") for-exp)
  44.  
  45.      (expression ("def" identifier "(" (separated-list identifier ",") ")"
  46.                   exp-batch                  
  47.                   "end") function-exp)
  48.      (expression ("return" comp-value ";") return-exp)
  49.  
  50.      ;;Expresión simple
  51.      (simple-exp (simple-value complement ";") val-exp)
  52.      
  53.      ;;Complemento
  54.      (complement ("=" comp-value calls) assign)
  55.      (complement (assign-op comp-value calls) assign-and)
  56.      (complement (calls) comp-calls)
  57.  
  58.      ;;Calls
  59.      ;; 0 o muchas llamadas
  60.      (calls ((arbno call)) some-calls)
  61.  
  62.      ;;Call
  63.      (call (arguments) arguments-call)
  64.      ;; (call ("." identifier arguments) a-method-call) ;; Parte 2: Ruby con Objetos
  65.  
  66.      ;;Argumentos
  67.      ;; llamar una función puede tener 0 argumentos o muchos
  68.      (arguments ("(" (separated-list comp-value ",") ")") some-arguments)
  69.      ;; almenos 1 argumento para llamar acceder a un elemento en un arreglo
  70.      ;; máximo 2, ejemplo: a=[1,2,3]; a[1] #output 2; a[1,2] #output [2,3];
  71.      ;;                    a[1,2,3] #output Error
  72.      (arguments ("[" comp-value (arbno "," comp-value) "]") arr-arguments)
  73.  
  74.      ;;Valores compuestos
  75.      (comp-value (value) a-value)
  76.      (comp-value (un-op comp-value) unop-value)
  77.      
  78.      (value (simple-value) a-s-val)
  79.      (value ("(" comp-value val-compl ")") compl-val)
  80.  
  81.      ;;Complemento para valores
  82.      ;; llamadas a un valor:
  83.      ;; Ejemplo: sirve para ("hola"+(mundo())) donde mundo() retorna "mundo"
  84.      (val-compl (calls) val-call)
  85.      ;; operacion inorden con otro valor
  86.      (val-compl (bin-op comp-value) binop-val)
  87.  
  88.      ;; Valores simples
  89.      (simple-value (identifier) id-val)
  90.      (simple-value (number) int-val)
  91.      (simple-value (text) str-val) ;; recordar hacer string-trim cuando se evalue
  92.      (simple-value ("true") true-val)
  93.      (simple-value ("false") false-val)
  94.      (simple-value ("nil") nil-val)
  95.      ;; arreglo con 0 o muchos valores
  96.      (simple-value ("["(separated-list comp-value ",")"]") arr-val)
  97.      
  98.      ;;Operacion Inorden
  99.      (bin-op ("+") add)
  100.      (bin-op ("-") diff)
  101.      (bin-op ("*") mult)
  102.      (bin-op ("/") div)
  103.      (bin-op ("%") mod)
  104.      (bin-op ("**") pow)
  105.      (bin-op (">") great)
  106.      (bin-op (">=") great-eq)
  107.      (bin-op ("<") less)
  108.      (bin-op ("<=") less-eq)
  109.      (bin-op ("==") equal)
  110.      (bin-op ("!=") not-equal)
  111.      (bin-op ("and") and-op)
  112.      (bin-op ("&&") and-op)
  113.      (bin-op ("or") or-op)
  114.      (bin-op ("||") or-op)
  115.      ;;Rangos:
  116.      ;; Solo admite 2 argumentos, no se puede operar más de 1 vez
  117.      ;;Inclusivo: va hasta el limite superior
  118.      (bin-op ("..") in-range)
  119.      ;;Exclusivo: va hasta un step antes del limite superior
  120.      (bin-op ("...") ex-range)
  121.      ;; Ejemplo: (1..5) => (1 2 3 4 5)
  122.      ;; Ejemplo: (1...5) => (1 2 3 4)
  123.      ;; Ejemplo: ((1..5) .. 6) => Error
  124.      (bin-op ("step") st-range)
  125.      ;; Ejemplo: ((1..5) step 2) => (1 3 5)
  126.      ;; Ejemplo: ((1..5) step -1) => Error
  127.      ;; Ejemplo: ((-1..-5) step -2) => (-1 -3 -5)
  128.      ;; Ejemplo: ((1..-5) step 2) => Error
  129.      
  130.      ;;Operación asignación
  131.      (assign-op ("+=") add-eq)
  132.      (assign-op ("-=") diff-eq)
  133.      (assign-op ("*=") mult-eq)
  134.      (assign-op ("/=") div-eq)
  135.      (assign-op ("**=") pow-eq)
  136.  
  137.      ;;Operación unitaria
  138.      (un-op ("not") not-op)
  139.      (un-op ("!") not-op)
  140.  
  141.      ;;##############################################
  142.      ;; Parte 2: Ruby con objetos
  143.      ;(class-decl ("class" identifier
  144.      ;                     (arbno "<" identifier)
  145.      ;                     "attr" (separated-list ":" identifier ",") ";"
  146.      ;                     (arbno method-decl) "end") a-class-decl)
  147.  
  148.      ;(method-decl ("def" identifier "(" (separated-list identifier ",") ")"
  149.      ;             exp-batch                  
  150.      ;             "end") a-method-decl)
  151.  
  152.   )
  153. )
  154.  
  155. ;Construidos automáticamente:
  156.  
  157.  
  158. (sllgen:make-define-datatypes lexical-spec grammar-spec)
  159.  
  160. (define show-the-datatypes
  161.   (lambda () (sllgen:list-define-datatypes lexical-spec grammar-spec)))
  162.  
  163. ;*******************************************************************************************
  164. ;Parser, Scanner, Interfaz
  165.  
  166. ;El FrontEnd (Análisis léxico (scanner) y sintáctico (parser) integrados)
  167.  
  168. (define scan&parse
  169.   (sllgen:make-string-parser lexical-spec grammar-spec))
  170.  
  171. ;El Analizador Léxico (Scanner)
  172.  
  173. (define scan
  174.   (sllgen:make-string-scanner lexical-spec grammar-spec))
  175.  
  176. ;El Interpretador (FrontEnd + Evaluación + señal para lectura )
  177.  
  178. (define interpretador
  179.   (sllgen:make-rep-loop  "--> "
  180.     (lambda (pgm) (eval-program pgm))
  181.     (sllgen:make-stream-parser
  182.       lexical-spec
  183.       grammar-spec)))
  184.  
  185. ;*******************************************************************************************
  186. ;*******************************************************************************************
  187. ;Procedimientos
  188. (define-datatype procval procval?
  189.   (closure
  190.    (ids (list-of symbol?))
  191.    (body exp-batch?)
  192.    (env environment?)
  193.    ))
  194.  
  195. ;apply-procedure: evalua el cuerpo de un procedimientos en el ambiente extendido correspondiente
  196. (define apply-procedure
  197.   (lambda (proc args env)
  198.     (cases procval proc
  199.       (closure (ids body env)
  200.                ; |Evaluar el cuerpo de una función
  201. ;;quitar '
  202.                '(eval-exp-batch body (extend-env ids args env))
  203.                )
  204.       )
  205.     )
  206.   )
  207. ;*******************************************************************************************
  208.  
  209. (define (eval-program pgm)
  210.   (cases ruby-program pgm
  211.     (a-program (a-batch) (eval-exp-batch a-batch (empty-env)))
  212.     )
  213.   )
  214.  
  215. (define (eval-exp-batch batch env)
  216.   (cases exp-batch batch
  217.     (a-batch (exp exps) (eval-expressions exp exps env))
  218.     )
  219.   )
  220. ; eval-a-batch: exp exps env
  221. (define (eval-expressions exp exps env)
  222.   (let loop ((acc (eval-expression exp env))
  223.                              (exps exps))
  224.                     (if (null? exps)
  225.                         acc
  226.                         (loop (eval-expression (car exps)
  227.                                                env)
  228.                               (cdr exps)))))
  229.  
  230. (define (eval-expression exp env)
  231.   (cases expression exp
  232.     (puts-exp (vals)
  233.               ;TO-DO;
  234.               ; map: evaluar valores en la lista | for-each: imprimir valores evaluados
  235.               (eopl:pretty-print vals))
  236.     (else "TO DO")
  237.     ;simple-exp
  238.     ;declare-exp
  239.     ;if-exp
  240.     ;unless-exp
  241.     ;while-exp
  242.     ;until-exp
  243.     ;for-exp
  244.     ;function-exp
  245.     ;return-exp
  246.     )
  247.   )
  248.  
  249. ; eval-comp-value c-value env => (cases comp-value c-value (a-value ...) (unop-value ...))
  250. ;   evalúa un valor compuesto,
  251. ;     1) si es a-value llamaría eval-value,
  252. ;     2) si es unop-value: evaluaría la un-op y aplicaría sobre el llamado recursivo de eval-comp-value
  253. (define (eval-comp-value c-value env)
  254.   (cases comp-value c-value
  255.     (a-value (value) (eval-value value env))
  256.     (unop-value (un-op comp-value) (eval-comp-value (eval-value un-op env) env))))
  257.  
  258.  
  259. ; eval-value a-value env => (cases value a-value (simple-val ...) (compl-val ...))
  260. ;   evalúa un valor, tiene 2 casos:
  261. ;     1) un valor simple que se evaluaría con eval-simple-value
  262. ;     2) un valor con complemento, se llama eval-val-compl con c-val evaluado y
  263. ;        a-val-compl (c-val es un comp-value, a-val-compl es un val-compl)
  264.  
  265. ; eval-val-compl a-val a-val-compl env => (cases val-compl a-val-compl (val-call ...) (binop-val ...))
  266. ;  evalúa un complemento sobre un c-val, tiene 2 casos:
  267. ;    1) val-call(some-calls) entonces se tienen que aplicar los argumentos
  268. ;    2) binop-val(binop c-val) entonces se aplica una bin-op entre a.val y la evaluacion
  269. ;       de c-val (c-val es un comp-value)
  270.  
  271. ; eval-simple-value s-val env (cases simple-value s-val (id-val ...) (num-val ...) (true-val ...))
  272. ;   evalúa un valor simple, comprende los casos desde id-val hasta arr-val
  273. ;   para el caso de id-val se debe hacer apply-env
  274. (define (eval-simple-value s-val env)
  275.    (cases simple-value s-val
  276.     (id-val (identifier) (apply-env env identifier))
  277.     (int-val (number) number)
  278.     (str-val (text) text)
  279.     (true-val () 'true)
  280.     (false-val () 'false)
  281.     (nil-val () 'nil)
  282.     (arr-val (comp-values)(eval-comp-value (car comp-value) env))))
  283.  
  284. ;*******************************************************************************************
  285. ;Referencias
  286. (define-datatype reference reference?
  287.   (a-ref (position integer?)
  288.          (vec vector?)))
  289.  
  290. (define deref
  291.   (lambda (ref)
  292.     (primitive-deref ref)))
  293.  
  294. (define primitive-deref
  295.   (lambda (ref)
  296.     (cases reference ref
  297.       (a-ref (pos vec)
  298.              (vector-ref vec pos)))))
  299.  
  300. (define setref!
  301.   (lambda (ref val)
  302.     (primitive-setref! ref val)))
  303.  
  304. (define primitive-setref!
  305.   (lambda (ref val)
  306.     (cases reference ref
  307.       (a-ref (pos vec)
  308.              (vector-set! vec pos val)))))
  309.  
  310. ;*******************************************************************************************
  311. ;*******************************************************************************************
  312. ;Ambientes
  313.  
  314. ;definición del tipo de dato ambiente
  315. (define-datatype environment environment?
  316.   (empty-env-record)
  317.   (extended-env-record
  318.    (syms (list-of symbol?))
  319.    (vec vector?)
  320.    (env environment?)))
  321.  
  322. (define scheme-value? (lambda (v) #t))
  323.  
  324. ;empty-env:      -> enviroment
  325. ;función que crea un ambiente vacío
  326. (define empty-env  
  327.   (lambda ()
  328.     (empty-env-record)))       ;llamado al constructor de ambiente vacío
  329.  
  330.  
  331. ;extend-env: <list-of symbols> <list-of numbers> enviroment -> enviroment
  332. ;función que crea un ambiente extendido
  333. (define extend-env
  334.   (lambda (syms vals env)
  335.     (extended-env-record syms (list->vector vals) env)))
  336.  
  337. ;extend-env-recursively: <list-of symbols> <list-of <list-of symbols>> <list-of expressions> environment -> environment
  338. ;función que crea un ambiente extendido para procedimientos recursivos
  339. (define extend-env-recursively
  340.   (lambda (proc-names idss bodies old-env)
  341.     (let ((len (length proc-names)))
  342.       (let ((vec (make-vector len)))
  343.         (let ((env (extended-env-record proc-names vec old-env)))
  344.           (for-each
  345.             (lambda (pos ids body)
  346.               (vector-set! vec pos (closure ids body env)))
  347.             (iota len) idss bodies)
  348.           env)))))
  349.  
  350. ; |Ambiente recursivo para un solo procedimiento
  351.  
  352. (define (a-recursive-env a-proc-name ids body env)
  353.   (let ((vec (make-vector 1)))
  354.     (let ((env (extended-env-record (list a-proc-name) vec env)))
  355.           (vector-set! vec 0 (closure ids body env))
  356.           env)
  357.     )
  358.   )
  359.  
  360. ;iota: number -> list
  361. ;función que retorna una lista de los números desde 0 hasta end
  362. (define iota
  363.   (lambda (end)
  364.     (let loop ((next 0))
  365.       (if (>= next end) '()
  366.         (cons next (loop (+ 1 next)))))))
  367.  
  368. ;función que busca un símbolo en un ambiente
  369. (define apply-env
  370.   (lambda (env sym)
  371.     (deref (apply-env-ref env sym))))
  372.  
  373. (define apply-env-ref
  374.   (lambda (env sym)
  375.     (cases environment env
  376.       (empty-env-record ()
  377.                         (eopl:error 'Error "undefined local variable or method ~s" sym))
  378.       (extended-env-record (syms vals env)
  379.                            (let ((pos (rib-find-position sym syms)))
  380.                              (if (number? pos)
  381.                                  (a-ref pos vals)
  382.                                  (apply-env-ref env sym)))))))
  383.  
  384. ;*******************************************************************************************
  385. ;*******************************************************************************************
  386. ;Ambiente inicial
  387.  
  388. (define (init-env) (empty-env))
  389. ;*******************************************************************************************
  390. ;*******************************************************************************************
  391. ;Funciones Auxiliares
  392.  
  393. ; funciones auxiliares para encontrar la posición de un símbolo
  394. ; en la lista de símbolos de un ambiente
  395.  
  396. (define rib-find-position
  397.   (lambda (sym los)
  398.     (list-find-position sym los)))
  399.  
  400. (define list-find-position
  401.   (lambda (sym los)
  402.     (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
  403.  
  404. (define list-index
  405.   (lambda (pred ls)
  406.     (cond
  407.       ((null? ls) #f)
  408.       ((pred (car ls)) 0)
  409.       (else (let ((list-index-r (list-index pred (cdr ls))))
  410.               (if (number? list-index-r)
  411.                 (+ list-index-r 1)
  412.                 #f))))))
  413.  
  414. ;*******************************************************************************************
  415. ;*******************************************************************************************
  416. ;;;Rangos
  417. (define-datatype range range?
  418.   (inclusive (start number?) (end number?) (step number?))
  419.   (exclusive (start number?) (end number?) (step number?))
  420.   )
  421.  
  422. (define (eval-range a-range)
  423.   (cases range a-range
  424.     (inclusive (start end step) (iota-range start end step))
  425.     (exclusive (start end step) (iota-range start (- end 1) step))
  426.     )
  427.   )
  428.  
  429. ;;Función que retorna una lista dado un inicio, un final, y un incremento
  430. (define iota-range
  431.   (lambda (start end step)
  432.     (cond [(or
  433.             (and (< start end) (> 0 step))
  434.             (and (> start end) (< 0 step)))
  435.            (eopl:error 'Step "bad step")]
  436.           [else
  437.            (let loop ((next start))
  438.              (if (= 0 (abs (- next end)))
  439.                  (list next)
  440.                  (cons next (loop (+ next step)))))]
  441.           )
  442.     ))
  443.  
  444. ; #Ejemplos:
  445. ; > (eval-range (inclusive 1 10 1))
  446. ; (1 2 3 4 5 6 7 8 9 10)
  447. ; > (eval-range (exclusive 1 10 1))
  448. ; (1 2 3 4 5 6 7 8 9)
  449. ; > (eval-range (inclusive 1 -10 1))
  450. ; . . Step: bad step
  451. ; > (eval-range (inclusive -1 10 -1))
  452. ; . . Step: bad step
  453.  
  454.  
  455. ;*******************************************************************************************
  456. ;*******************************************************************************************
  457. (interpretador)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement