UNB/ CS/ David Bremner/ teaching/ cs4613/ lectures/ lecture5/ snippet-014.rkt
#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)))

(run `{let1 {x {/ 8 0}} 7})