#lang plai (define-type WAE [num (n number?)] [add (lhs WAE?) (rhs WAE?)] [sub (lhs WAE?) (rhs WAE?)] [with (name symbol?) (named-expr WAE?) (body WAE?)] [id (name symbol?)]) ;; parse : s-expr -> WAE (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)))] [else (error 'parse "bad syntax: ~a" input)])) (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)))) (define (interp a-wae) (type-case WAE a-wae [num (n) n] [add (l r) (+ (interp l) (interp r))] [sub (l r) (- (interp l) (interp r))] [with (bound-id named-expr body-expr) (interp (subst body-expr bound-id (interp named-expr)))] [id (name) (error 'interp "free variable")])) (define (subst a-wae sub-id val) (type-case WAE a-wae [num (n) a-wae] [add (l r) (add (subst l sub-id val) (subst r sub-id val))] [sub (l r) (sub (subst l sub-id val) (subst r sub-id val))] [with (bound-id named-expr body-expr) (with bound-id (subst named-expr sub-id val) (if (symbol=? bound-id sub-id) body-expr (subst body-expr sub-id val)))] [id (name) (if (symbol=? name sub-id) (num val) a-wae)])) (test (subst (add (num 1) (id 'x)) 'x 10) (add (num 1) (num 10))) (test (subst (id 'x) 'x 10) (num 10)) (test (subst (id 'y) 'x 10) (id 'y)) (test (subst (sub (id 'x) (num 1)) 'y 10) (sub (id 'x) (num 1))) (test (subst (with 'y (num 17) (id 'x)) 'x 10) (with 'y (num 17) (num 10))) (test (subst (with 'y (id 'x) (id 'y)) 'x 10) (with 'y (num 10) (id 'y))) (test (subst (with 'x (id 'y) (id 'x)) 'x 10) (with 'x (id 'y) (id 'x))) (test (subst (parse '{with {x y} x}) 'x 10) (parse '{with {x y} x})) (test (interp (num 5)) 5) (test (interp (add (num 8) (num 9))) 17) (test (interp (sub (num 9) (num 8))) 1) (test (interp (with 'x (add (num 1) (num 17)) (add (id 'x) (num 12)))) 30) (test/exn (interp (id 'x)) "free variable")