#lang plait
(define-type LAE
[Num (val : Number)]
[Add (l : LAE) (r : LAE)]
[Sub (l : LAE) (r : LAE)]
[Mul (l : LAE) (r : LAE)]
[Div (l : LAE) (r : LAE)]
[Id (name : Symbol)]
[Let1 (name : Symbol) (val : LAE) (expr : LAE)])
(define (parse-error sx)
(error 'parse-sx (string-append "parse error: " (to-string sx))))
(define (sx-ref sx n) (list-ref (s-exp->list sx) n))
(define (parse-sx sx)
(cond
[(s-exp-number? sx) (Num (s-exp->number sx))]
[(s-exp-symbol? sx) (Id (s-exp->symbol sx))]
[(s-exp-match? `(let1 (SYMBOL ANY) ANY) sx)
(let* ([def (sx-ref sx 1)]
[id (s-exp->symbol (sx-ref def 0))]
[val (parse-sx (sx-ref def 1))]
[expr (parse-sx (sx-ref sx 2))])
(Let1 id val expr))]
[(s-exp-match? `(ANY ANY ANY) sx)
(let* ([l (λ () (parse-sx (sx-ref sx 1)))]
[r (λ () (parse-sx (sx-ref sx 2)))])
(case (s-exp->symbol (sx-ref sx 0))
[(+) (Add (l) (r))]
[(-) (Sub (l) (r))]
[(*) (Mul (l) (r))]
[(/) (Div (l) (r))]
[else (parse-error sx)]))]
[else (parse-error sx)]))
;; expr[to/from]
(define (subst expr from to)
(type-case LAE expr
[(Num n) expr]
[(Add l r) (Add (subst l from to) (subst r from to))]
[(Sub l r) (Sub (subst l from to) (subst r from to))]
[(Mul l r) (Mul (subst l from to) (subst r from to))]
[(Div l r) (Div (subst l from to) (subst r from to))]
[(Id name) (if (eq? name from) to expr)]
[(Let1 bound-id named-expr bound-body)
(Let1 bound-id
(subst named-expr from to)
(if (eq? bound-id from)
bound-body
(subst bound-body from to)))]))
(define (interp expr)
(type-case LAE expr
[(Num n) n]
[(Add l r) (+ (interp l) (interp r))]
[(Sub l r) (- (interp l) (interp r))]
[(Mul l r) (* (interp l) (interp r))]
[(Div l r) (* (interp l) (interp r))]
[(Let1 bound-id named-expr bound-body)
(interp (subst bound-body
bound-id
named-expr))] ; <- no interp
; and no Num wrapping
[(Id name) (error 'interp (string-append "free identifier: " (to-string name)))]))
;; evaluate a LAE program contained in an s-expression
(define (run sx)
(interp (parse-sx sx)))
(test (run `5) 5)
(test (run `{+ 5 5}) 10)
(test (run `{let1 {x {+ 5 5}} {+ x x}}) 20)
(test (run `{let1 {x 5} {+ x x}}) 10)
(test (run `{let1 {x {+ 5 5}} {let1 {y {- x 3}}
{+ y y}}}) 14)
(test (run `{let1 {x 5} {let1 {y {- x 3}} {+ y y}}}) 4)
(test (run `{let1 {x 5} {+ x {let1 {x 3} 10}}}) 15)
(test (run `{let1 {x 5} {+ x {let1 {x 3} x}}}) 8)
(test (run `{let1 {x 5} {+ x {let1 {y 3} x}}}) 10)
(test (run `{let1 {x 5} {let1 {y x} y}}) 5)
(test (run `{let1 {x 5} {let1 {x x} x}}) 5)
(test/exn (run `{let1 {x 1} y}) "free identifier")