#lang plai ;; -------------------------------------------------- ;; DefrdSub (define-type DefrdSub [mtSub] [aSub (name symbol?) (val number?) (rest DefrdSub?)]) ;; Example DefrdSubs: ;; (mtSub) ;; (aSub 'x 5 (mtSub)) ;; (aSub 'x 6 (aSub 'x 5 (mtSub))) ;; lookup : sym DefrdSub -> num (define (lookup name ds) (type-case DefrdSub ds [mtSub () (error 'lookup "free variable: ~e" name)] [aSub (bound-name val rest) (if (symbol=? name bound-name) val (lookup name rest))])) (test/exn (lookup 'x (mtSub)) "free variable") (test (lookup 'x (aSub 'x 5 (mtSub))) 5) (test (lookup 'x (aSub 'x 5 (aSub 'y 10 (mtSub)))) 5) (test (lookup 'y (aSub 'x 5 (aSub 'y 10 (mtSub)))) 10) (test (lookup 'x (aSub 'x 5 (aSub 'x 10 (mtSub)))) 5) ;; -------------------------------------------------- ;; FunDef and F1WAE (define-type FunDef [fundef (fun-name symbol?) (arg-name symbol?) (body F1WAE?)]) (define-type F1WAE [num (n number?)] [add (lhs F1WAE?) (rhs F1WAE?)] [sub (lhs F1WAE?) (rhs F1WAE?)] [with (name symbol?) (named-expr F1WAE?) (body F1WAE?)] [id (name symbol?)] [app (fun-name symbol?) (arg F1WAE?)]) ;; -------------------------------------------------- ;; Parser ;; parse : s-expr -> F1WAE (define (parse input) (cond ;; [(number? input) (num input)] ;; ' [(symbol? input) (id input)] ;; '{+ } [(and (= 3 (length input)) (eq? (first input) '+)) (add (parse (second input)) (parse (third input)))] ;; '{- } [(and (= 3 (length input)) (eq? (first input) '-)) (sub (parse (second input)) (parse (third input)))] ;; '{with { } } [(and (= 3 (length input)) (eq? (first input) 'with)) (with (first (second input)) (parse (second (second input))) (parse (third input)))] ;; '{ } [(and (= 2 (length input)) (symbol? (first input))) (app (first input) (parse (second input)))] [else (error 'parse "bad syntax: ~a" input)])) ;; parse-fundef : s-expr -> FunDef (define (parse-fundef input) ;; '{deffun { } } (fundef (first (second input)) (second (second input)) (parse (third input)))) (test (parse-fundef '{deffun {x y} y}) (fundef 'x 'y (id 'y))) (test (parse '1) (num 1)) (test (parse '{+ 1 2}) (add (num 1) (num 2))) (test (parse '{+ {- 5 2} {+ 2 1}}) (add (sub (num 5) (num 2)) (add (num 2) (num 1)))) (test (parse 'x) (id 'x)) (test (parse '{with {x {+ 1 2}} {- x 8}}) (with 'x (add (num 1) (num 2)) (sub (id 'x) (num 8)))) ;; -------------------------------------------------- ;; Interpreter ;; interp : F1WAE list-of-FunDef DefrdSub -> num (define (interp a-wae fundefs ds) (type-case F1WAE a-wae [num (n) n] [add (l r) (+ (interp l fundefs ds) (interp r fundefs ds))] [sub (l r) (- (interp l fundefs ds) (interp r fundefs ds))] [with (bound-id named-expr body-expr) (interp body-expr fundefs (aSub bound-id (interp named-expr fundefs ds) ds))] [id (name) (lookup name ds)] [app (fun-name arg) (local [(define fun (lookup-fundef fun-name fundefs)) (define arg-val (interp arg fundefs ds))] (interp (fundef-body fun) fundefs (aSub (fundef-arg-name fun) arg-val (mtSub))))])) ;; lookup-fundef : symbol list-of-FunDef -> FunDef (define (lookup-fundef name fundefs) (cond [(empty? fundefs) (error 'interp "cannot find function: ~e" name)] [(cons? fundefs) (if (symbol=? name (fundef-fun-name (first fundefs))) (first fundefs) (lookup-fundef name (rest fundefs)))])) (test/exn (lookup-fundef 'f (list)) "cannot find") (test (lookup-fundef 'f (list (parse-fundef '{deffun {f x} x}))) (parse-fundef '{deffun {f x} x})) (test (lookup-fundef 'f (list (parse-fundef '{deffun {g y} y}) (parse-fundef '{deffun {f x} x}))) (parse-fundef '{deffun {f x} x})) (test (interp (num 5) (list) (mtSub)) 5) (test (interp (add (num 8) (num 9)) (list) (mtSub)) 17) (test (interp (sub (num 9) (num 8)) (list) (mtSub)) 1) (test (interp (with 'x (add (num 1) (num 17)) (add (id 'x) (num 12))) (list) (mtSub)) 30) (test (interp (id 'x) (list) (aSub 'x 5 (mtSub))) 5) (test/exn (interp (id 'x) (list) (mtSub)) "free variable") (test (interp (parse '{f {+ 5 5}}) (list (parse-fundef '{deffun {f x} {+ x x}})) (mtSub)) 20) (test/exn (interp (with 'y (num 8) (app 'f (num 10))) (list (fundef 'f 'x (add (id 'x) (id 'y)))) (mtSub)) "free variable")