Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #lang eopl
- (require racket/string); string-trim
- (define lexical-spec
- '((white-sp (whitespace) skip)
- (comment ("#" (arbno (not #\newline))) skip)
- (identifier ((arbno "@") letter (arbno (or letter digit "_" "?" "=" ))) symbol)
- (number (digit (arbno digit)) number)
- (number ("-" digit (arbno digit)) number)
- (text ("\"" (or letter whitespace)
- (arbno (or letter digit whitespace ":" "?" "=" "'")) "\"") string)
- )
- )
- (define grammar-spec
- '( ;;Representa un programa de ruby
- (ruby-program ("ruby" exp-batch "end") a-program)
- ;; Parte 2: Ruby con objetos
- ;; cambiar a: (ruby-program ("ruby" (arbno class-decl) exp-batch "end") a-program)
- ;;Exp-batch: Representa una cerradura de expresiones
- (exp-batch (expression (arbno expression)) a-batch)
- ;;Expresión:
- (expression (simple-exp) a-simple-exp)
- ;Declare-exp: al menos uno o más identificadores (deben inicializarse en 'nil)
- (expression ("declare" identifier (arbno "," identifier) ";") declare-exp)
- ;Puts-exp: al menos un valor compuesto para imprimir
- (expression ("puts" (separated-list comp-value ",") ";") puts-exp)
- (expression ("if" comp-value (arbno "then") exp-batch
- (arbno "elsif" comp-value (arbno "then") exp-batch)
- (arbno "else" exp-batch) "end") if-exp)
- (expression ("unless" comp-value (arbno "then")
- exp-batch
- (arbno "else" exp-batch) "end") unless-exp)
- (expression ("while" comp-value (arbno "do") exp-batch "end") while-exp)
- (expression ("until" comp-value (arbno "do") exp-batch "end") until-exp)
- (expression ("for" identifier "in" comp-value (arbno "do") exp-batch "end") for-exp)
- (expression ("def" identifier "(" (separated-list identifier ",") ")"
- exp-batch
- "end") function-exp)
- (expression ("return" comp-value ";") return-exp)
- ;;Expresión simple
- (simple-exp (simple-value complement ";") val-exp)
- ;;Complemento
- (complement ("=" comp-value calls) assign)
- (complement (assign-op comp-value calls) assign-and)
- (complement (calls) comp-calls)
- ;;Calls
- ;; 0 o muchas llamadas
- (calls ((arbno call)) some-calls)
- ;;Call
- (call (arguments) arguments-call)
- ;; (call ("." identifier arguments) a-method-call) ;; Parte 2: Ruby con Objetos
- ;;Argumentos
- ;; llamar una función puede tener 0 argumentos o muchos
- (arguments ("(" (separated-list comp-value ",") ")") some-arguments)
- ;; almenos 1 argumento para llamar acceder a un elemento en un arreglo
- ;; máximo 2, ejemplo: a=[1,2,3]; a[1] #output 2; a[1,2] #output [2,3];
- ;; a[1,2,3] #output Error
- (arguments ("[" comp-value (arbno "," comp-value) "]") arr-arguments)
- ;;Valores compuestos
- (comp-value (value) a-value)
- (comp-value (un-op comp-value) unop-value)
- (value (simple-value) a-s-val)
- (value ("(" comp-value val-compl ")") compl-val)
- ;;Complemento para valores
- ;; llamadas a un valor:
- ;; Ejemplo: sirve para ("hola"+(mundo())) donde mundo() retorna "mundo"
- (val-compl (calls) val-call)
- ;; operacion inorden con otro valor
- (val-compl (bin-op comp-value) binop-val)
- ;; Valores simples
- (simple-value (identifier) id-val)
- (simple-value (number) int-val)
- (simple-value (text) str-val) ;; recordar hacer string-trim cuando se evalue
- (simple-value ("true") true-val)
- (simple-value ("false") false-val)
- (simple-value ("nil") nil-val)
- ;; arreglo con 0 o muchos valores
- (simple-value ("["(separated-list comp-value ",")"]") arr-val)
- ;;Operacion Inorden
- (bin-op ("+") add)
- (bin-op ("-") diff)
- (bin-op ("*") mult)
- (bin-op ("/") div)
- (bin-op ("%") mod)
- (bin-op ("**") pow)
- (bin-op (">") great)
- (bin-op (">=") great-eq)
- (bin-op ("<") less)
- (bin-op ("<=") less-eq)
- (bin-op ("==") equal)
- (bin-op ("!=") not-equal)
- (bin-op ("and") and-op)
- (bin-op ("&&") and-op)
- (bin-op ("or") or-op)
- (bin-op ("||") or-op)
- ;;Rangos:
- ;; Solo admite 2 argumentos, no se puede operar más de 1 vez
- ;;Inclusivo: va hasta el limite superior
- (bin-op ("..") in-range)
- ;;Exclusivo: va hasta un step antes del limite superior
- (bin-op ("...") ex-range)
- ;; Ejemplo: (1..5) => (1 2 3 4 5)
- ;; Ejemplo: (1...5) => (1 2 3 4)
- ;; Ejemplo: ((1..5) .. 6) => Error
- (bin-op ("step") st-range)
- ;; Ejemplo: ((1..5) step 2) => (1 3 5)
- ;; Ejemplo: ((1..5) step -1) => Error
- ;; Ejemplo: ((-1..-5) step -2) => (-1 -3 -5)
- ;; Ejemplo: ((1..-5) step 2) => Error
- ;;Operación asignación
- (assign-op ("+=") add-eq)
- (assign-op ("-=") diff-eq)
- (assign-op ("*=") mult-eq)
- (assign-op ("/=") div-eq)
- (assign-op ("**=") pow-eq)
- ;;Operación unitaria
- (un-op ("not") not-op)
- (un-op ("!") not-op)
- ;;##############################################
- ;; Parte 2: Ruby con objetos
- ;(class-decl ("class" identifier
- ; (arbno "<" identifier)
- ; "attr" (separated-list ":" identifier ",") ";"
- ; (arbno method-decl) "end") a-class-decl)
- ;(method-decl ("def" identifier "(" (separated-list identifier ",") ")"
- ; exp-batch
- ; "end") a-method-decl)
- )
- )
- ;Construidos automáticamente:
- (sllgen:make-define-datatypes lexical-spec grammar-spec)
- (define show-the-datatypes
- (lambda () (sllgen:list-define-datatypes lexical-spec grammar-spec)))
- ;*******************************************************************************************
- ;Parser, Scanner, Interfaz
- ;El FrontEnd (Análisis léxico (scanner) y sintáctico (parser) integrados)
- (define scan&parse
- (sllgen:make-string-parser lexical-spec grammar-spec))
- ;El Analizador Léxico (Scanner)
- (define scan
- (sllgen:make-string-scanner lexical-spec grammar-spec))
- ;El Interpretador (FrontEnd + Evaluación + señal para lectura )
- (define interpretador
- (sllgen:make-rep-loop "--> "
- (lambda (pgm) (eval-program pgm))
- (sllgen:make-stream-parser
- lexical-spec
- grammar-spec)))
- ;*******************************************************************************************
- ;*******************************************************************************************
- ;Procedimientos
- (define-datatype procval procval?
- (closure
- (ids (list-of symbol?))
- (body exp-batch?)
- (env environment?)
- ))
- ;apply-procedure: evalua el cuerpo de un procedimientos en el ambiente extendido correspondiente
- (define apply-procedure
- (lambda (proc args env)
- (cases procval proc
- (closure (ids body env)
- ; |Evaluar el cuerpo de una función
- ;;quitar '
- '(eval-exp-batch body (extend-env ids args env))
- )
- )
- )
- )
- ;*******************************************************************************************
- (define (eval-program pgm)
- (cases ruby-program pgm
- (a-program (a-batch) (eval-exp-batch a-batch (empty-env)))
- )
- )
- (define (eval-exp-batch batch env)
- (cases exp-batch batch
- (a-batch (exp exps) (eval-expressions exp exps env))
- )
- )
- ; eval-a-batch: exp exps env
- (define (eval-expressions exp exps env)
- (let loop ((acc (eval-expression exp env))
- (exps exps))
- (if (null? exps)
- acc
- (loop (eval-expression (car exps)
- env)
- (cdr exps)))))
- (define (eval-expression exp env)
- (cases expression exp
- (puts-exp (vals)
- ;TO-DO;
- ; map: evaluar valores en la lista | for-each: imprimir valores evaluados
- (eopl:pretty-print vals))
- (else "TO DO")
- ;simple-exp
- ;declare-exp
- ;if-exp
- ;unless-exp
- ;while-exp
- ;until-exp
- ;for-exp
- ;function-exp
- ;return-exp
- )
- )
- ; eval-comp-value c-value env => (cases comp-value c-value (a-value ...) (unop-value ...))
- ; evalúa un valor compuesto,
- ; 1) si es a-value llamaría eval-value,
- ; 2) si es unop-value: evaluaría la un-op y aplicaría sobre el llamado recursivo de eval-comp-value
- (define (eval-comp-value c-value env)
- (cases comp-value c-value
- (a-value (value) (eval-value value env))
- (unop-value (un-op comp-value) (eval-comp-value (eval-value un-op env) env))))
- ; eval-value a-value env => (cases value a-value (simple-val ...) (compl-val ...))
- ; evalúa un valor, tiene 2 casos:
- ; 1) un valor simple que se evaluaría con eval-simple-value
- ; 2) un valor con complemento, se llama eval-val-compl con c-val evaluado y
- ; a-val-compl (c-val es un comp-value, a-val-compl es un val-compl)
- ; eval-val-compl a-val a-val-compl env => (cases val-compl a-val-compl (val-call ...) (binop-val ...))
- ; evalúa un complemento sobre un c-val, tiene 2 casos:
- ; 1) val-call(some-calls) entonces se tienen que aplicar los argumentos
- ; 2) binop-val(binop c-val) entonces se aplica una bin-op entre a.val y la evaluacion
- ; de c-val (c-val es un comp-value)
- ; eval-simple-value s-val env (cases simple-value s-val (id-val ...) (num-val ...) (true-val ...))
- ; evalúa un valor simple, comprende los casos desde id-val hasta arr-val
- ; para el caso de id-val se debe hacer apply-env
- (define (eval-simple-value s-val env)
- (cases simple-value s-val
- (id-val (identifier) (apply-env env identifier))
- (int-val (number) number)
- (str-val (text) text)
- (true-val () 'true)
- (false-val () 'false)
- (nil-val () 'nil)
- (arr-val (comp-values)(eval-comp-value (car comp-value) env))))
- ;*******************************************************************************************
- ;Referencias
- (define-datatype reference reference?
- (a-ref (position integer?)
- (vec vector?)))
- (define deref
- (lambda (ref)
- (primitive-deref ref)))
- (define primitive-deref
- (lambda (ref)
- (cases reference ref
- (a-ref (pos vec)
- (vector-ref vec pos)))))
- (define setref!
- (lambda (ref val)
- (primitive-setref! ref val)))
- (define primitive-setref!
- (lambda (ref val)
- (cases reference ref
- (a-ref (pos vec)
- (vector-set! vec pos val)))))
- ;*******************************************************************************************
- ;*******************************************************************************************
- ;Ambientes
- ;definición del tipo de dato ambiente
- (define-datatype environment environment?
- (empty-env-record)
- (extended-env-record
- (syms (list-of symbol?))
- (vec vector?)
- (env environment?)))
- (define scheme-value? (lambda (v) #t))
- ;empty-env: -> enviroment
- ;función que crea un ambiente vacío
- (define empty-env
- (lambda ()
- (empty-env-record))) ;llamado al constructor de ambiente vacío
- ;extend-env: <list-of symbols> <list-of numbers> enviroment -> enviroment
- ;función que crea un ambiente extendido
- (define extend-env
- (lambda (syms vals env)
- (extended-env-record syms (list->vector vals) env)))
- ;extend-env-recursively: <list-of symbols> <list-of <list-of symbols>> <list-of expressions> environment -> environment
- ;función que crea un ambiente extendido para procedimientos recursivos
- (define extend-env-recursively
- (lambda (proc-names idss bodies old-env)
- (let ((len (length proc-names)))
- (let ((vec (make-vector len)))
- (let ((env (extended-env-record proc-names vec old-env)))
- (for-each
- (lambda (pos ids body)
- (vector-set! vec pos (closure ids body env)))
- (iota len) idss bodies)
- env)))))
- ; |Ambiente recursivo para un solo procedimiento
- (define (a-recursive-env a-proc-name ids body env)
- (let ((vec (make-vector 1)))
- (let ((env (extended-env-record (list a-proc-name) vec env)))
- (vector-set! vec 0 (closure ids body env))
- env)
- )
- )
- ;iota: number -> list
- ;función que retorna una lista de los números desde 0 hasta end
- (define iota
- (lambda (end)
- (let loop ((next 0))
- (if (>= next end) '()
- (cons next (loop (+ 1 next)))))))
- ;función que busca un símbolo en un ambiente
- (define apply-env
- (lambda (env sym)
- (deref (apply-env-ref env sym))))
- (define apply-env-ref
- (lambda (env sym)
- (cases environment env
- (empty-env-record ()
- (eopl:error 'Error "undefined local variable or method ~s" sym))
- (extended-env-record (syms vals env)
- (let ((pos (rib-find-position sym syms)))
- (if (number? pos)
- (a-ref pos vals)
- (apply-env-ref env sym)))))))
- ;*******************************************************************************************
- ;*******************************************************************************************
- ;Ambiente inicial
- (define (init-env) (empty-env))
- ;*******************************************************************************************
- ;*******************************************************************************************
- ;Funciones Auxiliares
- ; funciones auxiliares para encontrar la posición de un símbolo
- ; en la lista de símbolos de un ambiente
- (define rib-find-position
- (lambda (sym los)
- (list-find-position sym los)))
- (define list-find-position
- (lambda (sym los)
- (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
- (define list-index
- (lambda (pred ls)
- (cond
- ((null? ls) #f)
- ((pred (car ls)) 0)
- (else (let ((list-index-r (list-index pred (cdr ls))))
- (if (number? list-index-r)
- (+ list-index-r 1)
- #f))))))
- ;*******************************************************************************************
- ;*******************************************************************************************
- ;;;Rangos
- (define-datatype range range?
- (inclusive (start number?) (end number?) (step number?))
- (exclusive (start number?) (end number?) (step number?))
- )
- (define (eval-range a-range)
- (cases range a-range
- (inclusive (start end step) (iota-range start end step))
- (exclusive (start end step) (iota-range start (- end 1) step))
- )
- )
- ;;Función que retorna una lista dado un inicio, un final, y un incremento
- (define iota-range
- (lambda (start end step)
- (cond [(or
- (and (< start end) (> 0 step))
- (and (> start end) (< 0 step)))
- (eopl:error 'Step "bad step")]
- [else
- (let loop ((next start))
- (if (= 0 (abs (- next end)))
- (list next)
- (cons next (loop (+ next step)))))]
- )
- ))
- ; #Ejemplos:
- ; > (eval-range (inclusive 1 10 1))
- ; (1 2 3 4 5 6 7 8 9 10)
- ; > (eval-range (exclusive 1 10 1))
- ; (1 2 3 4 5 6 7 8 9)
- ; > (eval-range (inclusive 1 -10 1))
- ; . . Step: bad step
- ; > (eval-range (inclusive -1 10 -1))
- ; . . Step: bad step
- ;*******************************************************************************************
- ;*******************************************************************************************
- (interpretador)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement