#lang plai (define-type FAE [num (n number?)] [add (lhs FAE?) (rhs FAE?)] [sub (lhs FAE?) (rhs FAE?)] [id (name symbol?)] [fun (param symbol?) (body FAE?)] [app (fun-expr FAE?) (arg-expr FAE?)]) (define-type CFAE [cnum (n number?)] [cadd (lhs CFAE?) (rhs CFAE?)] [csub (lhs CFAE?) (rhs CFAE?)] [cat (pos number?)] [cfun (body CFAE?)] [capp (fun-expr CFAE?) (arg-expr CFAE?)]) (define-type CSubs [mtCSub] [aCSub (name symbol?) (rest CSubs?)]) (define-type CFAE-Value [cnumV (n number?)] [cclosureV (body CFAE?) (subs list?)]) ;; compile : FAE CSubs -> CFAE (define (compile a-fae cs) (type-case FAE a-fae [num (n) (cnum n)] [add (l r) (cadd (compile l cs) (compile r cs))] [sub (l r) (csub (compile l cs) (compile r cs))] [id (name) (cat (locate name cs))] [fun (param body-expr) (cfun (compile body-expr (aCSub param cs)))] [app (fun-expr arg-expr) (capp (compile fun-expr cs) (compile arg-expr cs))])) ;; locate : symbol CSubs -> number (define (locate name cs) (type-case CSubs cs [mtCSub () (error 'compile "free identifier")] [aCSub (sub-name rest) (if (symbol=? name sub-name) 0 (+ 1 (locate name rest)))])) ;; : CFAE list-of-CFAE-Value -> CFAE-Value (define (cinterp a-cfae subs) (type-case CFAE a-cfae [cnum (n) (cnumV n)] [cadd (l r) (cnum+ (cinterp l subs) (cinterp r subs))] [csub (l r) (cnum- (cinterp l subs) (cinterp r subs))] [cat (pos) (list-ref subs pos)] [cfun (body-expr) (cclosureV body-expr subs)] [capp (fun-expr arg-expr) (local [(define fun-val (cinterp fun-expr subs)) (define arg-val (cinterp arg-expr subs))] (cinterp (cclosureV-body fun-val) (cons arg-val (cclosureV-subs fun-val))))])) ;; num-op : (number number -> number) -> (CFAE-Value CFAE-Value -> CFAE-Value) (define (cnum-op op op-name) (lambda (x y) (cnumV (op (cnumV-n x) (cnumV-n y))))) (define cnum+ (cnum-op + '+)) (define cnum- (cnum-op - '-)) (define (interp a-fae) (cinterp (compile a-fae (mtCSub)) empty)) (test/exn (compile (id 'x) (mtCSub)) "free variable") (test (interp (num 10)) (cnumV 10)) (test (interp (add (num 10) (num 7))) (cnumV 17)) (test (interp (sub (num 10) (num 7))) (cnumV 3)) (test (interp (app (fun 'x (add (id 'x) (num 12))) (add (num 1) (num 17)))) (cnumV 30)) (test (interp (app (fun 'x (add (id 'x) (num 12))) (add (num 1) (num 17)))) (cnumV 30)) (test (interp (app (fun 'x (app (fun 'x (id 'x)) (num 3))) (add (num 1) (num 17)))) (cnumV 3)) (test (interp (app (fun 'y (app (fun 'x (id 'y)) (num 3))) (add (num 1) (num 17)))) (cnumV 18))