#lang plai #|-------------------------------------------------------------------------------------------------- - - - Gramáticas necesarias - - - --------------------------------------------------------------------------------------------------|# ;; Gramática para representar los árboles de sintaxis abstracta de BRCFWAE. Estos árboles representan: ;; · Identificadores. ;; · Números. ;; · Operaciones binarias. ;; · Condicional, if0. ;; · Asignaciones locales, with. ;; · Asignaciones locales recursivas, rec. ;; · Funciones anónimas de primera clase, fun. ;; · Aplicación de funciones. ;; · Cajas y sus operaciones. (define-type BRCFWAE [idS (i symbol?)] [binopS (op procedure?) (lh BRCFWAE?) (rh BRCFWAE?)] [numS (n number?)] [if0S (test-expr BRCFWAE?) (then-expr BRCFWAE?) (else-expr BRCFWAE?)] [withS (id symbol?) (value BRCFWAE?) (body BRCFWAE?)] [recS (id symbol?) (value BRCFWAE?) (body BRCFWAE?)] [funS (param symbol?) (body BRCFWAE?)] [appS (fun-expr BRCFWAE?) (arg BRCFWAE?)] [newboxS (value BRCFWAE?)] [setboxS (box BRCFWAE?) (value BRCFWAE?)] [openboxS (box BRCFWAE?)] [seqnS (action1 BRCFWAE?) (action2 BRCFWAE?)]) ;; Gramática para representar la versión sin azúcar sintáctica de BRCFWAE. Estos árboles representan: ;; · Identificadores. ;; · Números. ;; · Operaciones binarias. ;; · Condicional, if0. ;; · Asignaciones locales recursivas, rec. ;; · Funciones anónimas de primera clase, fun. ;; · Aplicación de funciones. ;; · Cajas y sus operaciones. (define-type BRCFAE [id (i symbol?)] [num (n number?)] [binop (op procedure?) (lh BRCFAE?) (rh BRCFAE?)] [if0 (test-expr BRCFAE?) (then-expr BRCFAE?) (else-expr BRCFAE?)] [rec (id symbol?) (value BRCFAE?) (body BRCFAE?)] [fun (param symbol?) (body BRCFAE?)] [app (fun-expr BRCFAE?) (arg BRCFAE?)] [newbox (value BRCFAE?)] [setbox (box BRCFAE?) (value BRCFAE?)] [openbox (box BRCFAE?)] [seqn (action1 BRCFAE?) (action2 BRCFAE?)]) ;; Gramática para representar los ambientes de avaluación. Los ambientes son representador por listas ;; en forma de pila, de esta forma un ambiente puede estar vacío o almacenar identificadores con su ;; la dirección en memoria del valor y el siguiente ambiente. Esta versión incluye ambientes ;; recursivos. ;; ;; Un ambiente recursivo, almacena el cuerpo de la función recursiva en una caja. Aprovechamos los ;; aspecto imperativos del lenguaje para preservar el estado de la función en la caja, cada que ;; abrimos la caja, obtenemos la misma función. (define-type Enviroment [mtSub] [aSub (id symbol?) (location number?) (env Enviroment?)]) ;; Gramática para representar el store. El store es parecido al ambiente, aquí almacenarmos la ;; locación y el valor asociado. (define-type Store [mtSto] [aSto (location number?) (value BRCFAE-Value?) (store Store?)]) ;; Gramática para representar los valores devueltos por el intérprete. El intérprete puede devolver: ;; · Números. ;; · Funciones, que más bien son cerraduras. Una cerradura almacena: ;; - Los parámetros de la función. ;; - El cuerpo de la función. ;; - El ambiente donde fue definida. ;; · Cajas (define-type BRCFAE-Value [numV (n number?)] [closureV (param symbol?) (body BRCFAE?) (env Enviroment?)] [boxV (location number?)]) (define-type Value*Store [v*s (value BRCFAE-Value?) (store Store?)]) #|-------------------------------------------------------------------------------------------------- - - - Análisis sintácitco - - - --------------------------------------------------------------------------------------------------|# ;; Función que recibe una expresión en sintaxis concreta y regresa el árbol de sintaxis abstracta ;; correspondiente. ;; parse: sexp -> BRCFWAE (define (parse sexp) (match sexp ; Si es un símbolo: 'foo [(? symbol?) (idS sexp)] ; Si es un número: 1729 [(? number?) (numS sexp)] ; Si es un condicional if0: {if0 {+ 10 -10} 2 3} [(list 'if0 test-expr then-expr else-expr) (if0S (parse test-expr) (parse then-expr) (parse else-expr))] ; Si es un with: {with {a 2} {+ a a}} [(list 'with (list id value) body) (withS id (parse value) (parse body))] ; Si es un rec: {rec {fac {fun {n} {if0 n 1 {* n {fac {- n 1}}}}}} {fac 5}} [(list 'rec (list id value) body) (recS id (parse value) (parse body))] ; Si es una función: {fun {x} x} [(list 'fun (list param) body) (funS param (parse body))] ; Si es una nueva caja: {newbox 3} [(list 'newbox value) (newboxS (parse value))] ; Si se asigna valor a una caja: {setbox caja 3} [(list 'setbox box value) (setboxS (parse box) (parse value))] ; Si se abre una caja: {openbox caja} [(list 'openbox box) (openboxS (parse box))] ; Para ejecutar dos acciones: {seqn {setbox caja 2} {openbox caja}} [(list 'seqn action1 action2) (seqnS (parse action1) (parse action2))] [(cons x xs) (case x ; Si es una operación binaria: {+ 1 {* 2 3}} [(+ - * /) (binopS (elige x) (parse (car xs)) (parse (cadr xs)))] ; Si es una aplicación de función: {{fun {x} x} 2} [else (appS (parse x) (parse (car xs)))])])) ;; Función que hace ilustra la relación entre el lenguaje objetivo y el anfitrión. ;; elige: sexp -> procedure (define (elige sexp) (match sexp ['+ +] ['- -] ['* *] ['/ /])) ;; Función que recibe una expresión en sintaxis abstracta y regresa una versión desendulzada de ;; ésta. Simplemente convierte with en una aplicación de funciones. ;; desugar: BRCFWAE -> BRCFAE (define (desugar sexp) (match sexp [(idS i) (id i)] [(numS n) (num n)] [(binopS op lh rh) (binop op (desugar lh) (desugar rh))] [(if0S test-expr then-expr else-expr) (if0 (desugar test-expr) (desugar then-expr) (desugar else-expr))] [(withS id value body) (app (fun id (desugar body)) (desugar value))] [(recS id value body) (rec id (desugar value) (desugar body))] [(funS param body) (fun param (desugar body))] [(appS fun-expr arg) (app (desugar fun-expr) (desugar arg))] [(newboxS value) (newbox (desugar value))] [(setboxS box value) (setbox (desugar box) (desugar value))] [(openboxS box) (openbox (desugar box))] [(seqnS action1 action2) (seqn (desugar action1) (desugar action2))])) #|-------------------------------------------------------------------------------------------------- - - - Análisis semántico - - - --------------------------------------------------------------------------------------------------|# (define current-location (box -1)) (define (nextlocation) (begin (set-box! current-location (+ 1 (unbox current-location))) (unbox current-location))) ;; Función que recibe una expresión en sintaxis abstracta y regresa su evaluación. Para evaluar usa ;; un ambiente y un store. ;; interp: BRCFAE Enviroment Store -> BRCFAE-Value (define (interp expr env store) (match expr [(id i) (v*s (store-lookup (env-lookup i env) store) store)] [(num n) (v*s (numV n) store)] [(binop op lh rh) (let* ([izq (interp lh env store)] [izq-val (v*s-value izq)] [izq-store (v*s-store izq)] [der (interp rh env izq-store)] [der-val (v*s-value der)] [der-store (v*s-store der)] [resultado (op (numV-n izq-val) (numV-n der-val))]) (v*s (numV resultado) der-store))] [(if0 test-expr then-expr else-expr) (let* ([condicion (interp test-expr env store)] [cond-value (v*s-value condicion)] [cond-store (v*s-store condicion)]) (if (zero? (numV-n cond-value)) (interp then-expr env cond-store) (interp else-expr env cond-store)))] [(rec id value body) (let* ([location (nextlocation)] [new-env (aSub id location env)] [result (interp value new-env store)] [result-value (v*s-value result)] [result-store (v*s-store result)] [new-store (aSto location result-value result-store)]) (interp body new-env new-store))] [(fun param body) (v*s (closureV param body env) store)] [(app fun-expr arg) (let* ([fun-res (interp fun-expr env store)] [fun-val (v*s-value fun-res)] [fun-store (v*s-store fun-res)] [arg-res (interp arg env fun-store)] [arg-val (v*s-value arg-res)] [arg-store (v*s-store arg-res)] [location (nextlocation)]) (interp (closureV-body fun-val) (aSub (closureV-param fun-val) location (closureV-env fun-val)) (aSto location arg-val arg-store)))] [(newbox box) (let* ([location (nextlocation)] [result (interp box env store)] [box-value (v*s-value result)] [box-store (v*s-store result)]) (v*s (boxV location) (aSto location box-value box-store)))] [(setbox box value) (let* ([boxv (interp box env store)] [boxv-value (v*s-value boxv)] [boxv-store (v*s-store boxv)] [val (interp value env boxv-store)] [val-value (v*s-value val)] [val-store (v*s-store val)]) (v*s val-value (aSto (boxV-location boxv-value) val-value val-store)))] [(openbox box) (let* ([boxv (interp box env store)] [box-value (v*s-value boxv)] [box-store (v*s-store boxv)]) (v*s (store-lookup (boxV-location box-value) box-store) box-store))] [(seqn a1 a2) (let* ([a1v (interp a1 env store)] [a1-store (v*s-store a1v)]) (interp a2 env a1-store))])) ;; Función que busca un valor en el ambiente indicado. ;; env-lookup: symbol Enviroment -> number (define (env-lookup id env) (match env [(mtSub) (error 'lookup "Identificador libre")] [(aSub sub-id location rest-env) (if (symbol=? id sub-id) location (env-lookup id rest-env))])) (define (store-lookup index store) (match store [(mtSto) (error 'lookup "Valor no almacenado")] [(aSto location value rest-store) (if (= location index) value (store-lookup index rest-store))]))