#lang plai (define-type RCFAE [num (n number?)] [add (lhs RCFAE?)(rhs RCFAE?)] [mult (lhs RCFAE?)(rhs RCFAE?)] [id (name symbol?)] [fun (param symbol?)(body RCFAE?)] [app (fun-expr RCFAE?)(arg-expr RCFAE?)] [if0 (test RCFAE?)(true RCFAE?)(false RCFAE?)] [rec (bound-id symbol?)(named-expr RCFAE?)(body RCFAE?)]) ;; parse: sexp -> RCFAE (define (parse sexp) (cond ((number? sexp)(num sexp)) ((symbol? sexp)(id sexp)) ((list? sexp) (case (first sexp) ((+)(add (parse (second sexp)) (parse (third sexp)))) ((*)(mult (parse (second sexp)) (parse (third sexp)))) ((fun)(fun (caadr sexp) (parse (third sexp)))) ((with)(app (fun (caadr sexp) (parse (third sexp))) (parse (cadadr sexp)))) ((rec)(rec (caadr sexp) (parse (cadadr sexp)) (parse (third sexp)))) ((if0)(if0 (parse (second sexp)) (parse (third sexp)) (parse (fourth sexp)))) (else (app (parse(first sexp)) (parse (second sexp)))) )) )) (define-type RCFAE-Value [numV (n number?)] [closureV (param symbol?) (body RCFAE?) (env Env?)]) ;; boxed-RCFAE-Value? sexp -> boolean (define (boxed-RCFAE-Value? v) (and (box? v) (RCFAE-Value? (unbox v)))) (define-type Env [mtSub] [aSub (name symbol?)(value RCFAE-Value?)(env Env?)] [aRecSub (name symbol?)(value boxed-RCFAE-Value?)(env Env?)]) ;; lookup:symbol Env -> RCFAE-Value (define (lookup name env) (type-case Env env [mtSub ()(error 'lookup "no binding for identifier")] [aSub (bound-name bound-value rest-env) (if (symbol=? bound-name name) bound-value (lookup name rest-env))] [aRecSub (bound-name boxed-bound-value rest-env) (if (symbol=? bound-name name) (unbox boxed-bound-value) (lookup name rest-env))])) ;; num+: numV numV -> numV (define (num+ n1 n2) (numV (+(numV-n n1)(numV-n n2)))) ;; num*: numV numV -> numV (define (num* n1 n2) (numV (*(numV-n n1)(numV-n n2)))) ;; num-zero?: numV -> boolean (define (num-zero? n) (zero? (numV-n n))) ;; cyclically-bind-and-interp: symbol RCFAE Env -> Env (define (cyclically-bind-and-interp bound-id named-expr env) (let* ([value-holder (box (numV 1729))] [new-env (aRecSub bound-id value-holder env)] [named-expr-val (interp named-expr new-env)]) (begin (set-box! value-holder named-expr-val) new-env))) ;; interp: RCFAE Env -> RCFAE-Value (define (interp expr env) (type-case RCFAE expr [num (n)(numV n)] [add (l r)(num+ (interp l env)(interp r env))] [mult (l r)(num* (interp l env)(interp r env))] [id (v)(lookup v env)] [if0 (v t f) (if (num-zero? (interp v env)) (interp t env) (interp f env))] [fun (bound-id bound-body) (closureV bound-id bound-body env)] [app (fun-expr arg-expr) (let ([fun-val (interp fun-expr env)]) (interp (closureV-body fun-val) (aSub (closureV-param fun-val) (interp arg-expr env) (closureV-env fun-val))))] [rec (bound-id named-expr bound-body) (interp bound-body (cyclically-bind-and-interp bound-id named-expr env))]))