#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)]))
; returns expr[to/from].
; leaves no free occurences of `to'
(define (subst expr from to)
(type-case LAE expr
@$\vdots$@
[(Add l r) (Add (subst l from to)
(subst r from to))]
[(Id name) (if (eq? name from) to expr)]
[(Let1 bound-id named-expr bound-body)
(if (eq? bound-id from)
expr ; <-- don't go in!
(Let1 bound-id
named-expr
(subst bound-body from to)))]))