108 lines
3.8 KiB
Scheme
108 lines
3.8 KiB
Scheme
(define-type FWAE
|
|
[num (n number?)]
|
|
[add (lhs FWAE?) (rhs FWAE?)]
|
|
[sub (lhs FWAE?) (rhs FWAE?)]
|
|
[id (name symbol?)]
|
|
[with (name symbol?) (named-expr FWAE?) (body FWAE?)]
|
|
[fun (param symbol?) (body FWAE?)]
|
|
[app (fun-expr FWAE?) (arg-expr FWAE?)])
|
|
|
|
;; parse : sexp $\longrightarrow$ FWAE
|
|
;; to convert s-expressions into FWAEs
|
|
|
|
(define (parse sexp)
|
|
(cond
|
|
[(symbol? sexp) (id sexp)]
|
|
[(number? sexp) (num sexp)]
|
|
[(list? sexp)
|
|
(case (first sexp)
|
|
[(+) (add (parse (second sexp))
|
|
(parse (third sexp)))]
|
|
[(-) (sub (parse (second sexp))
|
|
(parse (third sexp)))]
|
|
[(with) (with (first (second sexp))
|
|
(parse (second (second sexp)))
|
|
(parse (third sexp)))]
|
|
[(fun) (fun (first (second sexp)) (parse (third sexp)))]
|
|
[else (app (parse (first sexp)) (parse (second sexp)))])]))
|
|
|
|
;; num+ : \scheme|num| \scheme|num| -> \scheme|num|
|
|
|
|
(define (num+ n1 n2)
|
|
(num (+ (num-n n1) (num-n n2))))
|
|
|
|
;; num- : \scheme|num| \scheme|num| -> \scheme|num|
|
|
|
|
(define (num- n1 n2)
|
|
(num (- (num-n n1) (num-n n2))))
|
|
|
|
(define-type Subcache
|
|
[mtSub]
|
|
[aSub (name symbol?) (value FWAE?) (sc Subcache?)])
|
|
|
|
;; lookup : symbol \scheme|SubCache| -> \scheme|FWAE|
|
|
|
|
(define (lookup name sc)
|
|
(type-case Subcache sc
|
|
[mtSub () (error 'lookup "no binding for identifier")]
|
|
[aSub (bound-name bound-value rest-sc)
|
|
(if (symbol=? bound-name name)
|
|
bound-value
|
|
(lookup name rest-sc))]))
|
|
|
|
;; interp : \scheme|FWAE| \scheme|SubCache| $\rightarrow$ \scheme|FWAE|
|
|
;; evaluates \scheme|FWAE| expressions by reducing them to their corresponding values
|
|
;; return values are either \scheme|num| or \scheme|fun|
|
|
|
|
(define (interp expr sc)
|
|
(type-case FWAE expr
|
|
[num (n) expr]
|
|
[add (l r) (num+ (interp l sc) (interp r sc))]
|
|
[sub (l r) (num- (interp l sc) (interp r sc))]
|
|
[with (bound-id named-expr bound-body)
|
|
(interp bound-body
|
|
(aSub bound-id
|
|
(interp named-expr sc)
|
|
sc))]
|
|
[id (v) (lookup v sc)]
|
|
[fun (bound-id bound-body)
|
|
expr]
|
|
[app (fun-expr arg-expr)
|
|
(local ([define fun-val (interp fun-expr sc)])
|
|
(interp (fun-body fun-val)
|
|
(aSub (fun-param fun-val)
|
|
(interp arg-expr sc)
|
|
sc)))]))
|
|
|
|
(define (interp-test expr ans)
|
|
(test (interp (parse expr) (mtSub)) (num ans)))
|
|
|
|
(define (interp-test-error expr expected-exception-msg)
|
|
(test/exn (lambda () (interp (parse expr) (mtSub))) expected-exception-msg))
|
|
|
|
|
|
(interp-test 5 5)
|
|
(interp-test '{+ 5 5} 10)
|
|
(interp-test '{with {x {+ 5 5}} {+ x x}} 20)
|
|
(interp-test '{with {x 5} {+ x x}} 10)
|
|
(interp-test '{with {x {+ 5 5}} {with {y {- x 3}} {+ y y}}} 14)
|
|
(interp-test '{with {x 5} {with {y {- x 3}} {+ y y}}} 4)
|
|
(interp-test '{with {x 5} {+ x {with {x 3} 10}}} 15)
|
|
(interp-test '{with {x 5} {+ x {with {x 3} x}}} 8)
|
|
(interp-test '{with {x 5} {+ x {with {y 3} x}}} 10)
|
|
(interp-test '{with {x 5} {with {y x} y}} 5)
|
|
(interp-test '{with {x 5} {with {x x} x}} 5)
|
|
(interp-test '{{fun {x} {+ x 5}} 5} 10)
|
|
(interp-test '{with {double {fun {x} {+ x x}}} {+ {double 5} {double 10}}} 30)
|
|
(interp-test '{{{fun {x} x} {fun {x} {+ x 5}}} 3} 8)
|
|
"expect error: should yield 7, dyn scope yields 9"
|
|
(interp-test '{with {f {with {x 3} {fun {y} {+ x y}}}}
|
|
{with {x 5} {f 4}}} 7)
|
|
|
|
(test/pred (interp (parse '{fun {x} x}) (mtSub)) fun?)
|
|
|
|
(test/pred (interp (parse '{with {x 3} {fun {y} {+ x y}}}) (mtSub)) fun?)
|
|
|
|
(interp-test-error '{with {x x} x} "no binding")
|
|
|