• Inicio
• Tareas
• Laboratorio
• Bibliografía

Código: faev2.rkt

Descarga aquí

#lang plai


(define-type FWAE
   [idS (i symbol?)]
   [numS (n number?)]
   [binopS (f procedure?) (izq FWAE?) (der FWAE?)]
   [withS (id symbol?) (val FWAE?) (body FWAE?)]
   [funS (param symbol?) (body FWAE?)]
   [appS (fun FWAE?) (arg FWAE?)])

(define-type FAE
   [id (i symbol?)]
   [num (n number?)]
   [binop (f procedure?) (izq FAE?) (der FAE?)]
   [fun (param symbol?) (body FAE?)]
   [app (fun FAE?) (arg FAE?)])

(define (parse sexp)
   (match sexp
      [(? symbol?) (idS sexp)]
      [(? number?) (numS sexp)]
      [(list 'with (list id val) body) (withS id (parse val) (parse body))]
      [(list 'fun (list param) body) (funS param (parse body))]
      [(list op l r) (binopS (elige op) (parse l) (parse r))]
      [else (appS (parse (car sexp)) (parse (cadr sexp)))]))

(define (elige sexp)
   (match sexp
      ['+ +]
      ['- -]
      ['* *]
      ['/ /]))

(define (desugar sexp)
   (match sexp
      [(idS i) (id i)]
      [(numS n) (num n)]
      [(binopS f izq der) (binop f (desugar izq) (desugar der))]
      [(withS id val body) (app (fun id (desugar body)) (desugar val))]
      [(funS param body) (fun param (desugar body))]
      [(appS fun arg) (app (desugar fun) (desugar arg))]))

(define (subst expr sub-id val)
   (match expr
      [(id i) (if (symbol=? i sub-id) val expr)]
      [(num n) expr]
      [(binop f izq der) (binop f (subst izq sub-id val) (subst der sub-id val))]
      [(fun param body)
         (if (symbol=? param sub-id)
             (fun param body)
             (fun param (subst body sub-id val)))]
      [(app fun arg)
         (app (subst fun sub-id val) (subst arg sub-id val))]))

(define (interp sexp)
   (match sexp
      [(id i) (error 'interp "Identificador libre")]
      [(num n) sexp]
      [(binop f izq der) (num (f (num-n (interp izq)) (num-n (interp der))))]
      [(fun param body) sexp]
      [(app fun args) (interp (subst (fun-body fun) (fun-param fun) args))]))