UNB/ CS/ David Bremner/ teaching/ cs4613/ lectures/ lecture03/ let1.rkt
#lang plait
(define-type-alias Env (Hashof Symbol Value))
(define mt-env (hash empty)) ;; "empty environment"
(define-type Exp
  [numE (n : Number)]
  [plusE (left : Exp) (right : Exp)]
  [timesE (left : Exp) (right : Exp)]
  [varE (name : Symbol)]        ;; new
  [let1E (var : Symbol)         ;; new
         (value : Exp)
         (body : Exp)])

(define-type-alias Value Number)
(define (lookup (s : Symbol) (n : Env))
  (type-case (Optionof Value) (hash-ref n s)
    [(none) (error s "not bound")]
    [(some v) v]))

(define (extend old-env new-name value)
  (hash-set old-env new-name value))

(interp : (Exp Env -> Value))
(define (interp e nv)
  (type-case Exp e
    [(numE n) n]
    [(varE s) (lookup s nv)]
    [(plusE l r) (+ (interp l nv) (interp r nv))]
    [(timesE l r) (* (interp l nv) (interp r nv))]
    [(let1E var val body)
     (let ([new-env (extend nv
                            var
                            (interp val nv))])
       (interp body new-env))]))

(define (parse s)
  (local
      [(define (sx n) (list-ref (s-exp->list s) n))
       (define (px n) (parse (sx n)))
       (define (? pat) (s-exp-match? pat s))]
    (cond
      [(? `SYMBOL) (varE (s-exp->symbol s))]
      [(? `NUMBER) (numE (s-exp->number s))]
      [(? `(+ ANY ANY)) (plusE (px 1) (px 2))]
      [(? `(* ANY ANY)) (timesE (px 1) (px 2))]
      [(? `(let1 (SYMBOL ANY) ANY))
       (let* ([def (sx 1)]
              [parts (s-exp->list def)]
              [var (s-exp->symbol (list-ref parts 0))]
              [val (parse (list-ref parts 1))]
              [body (px 2)])
         (let1E var val body))]
      [else (error 'parse (to-string s))])))

(run : (S-Exp -> Value))
(define (run s)
  (interp (parse s) mt-env))

(test (run `{let1 {x 1} {+ x x}} )
      2)

(test (run `{let1 {x 1}
                  {let1 {y 2}
                        {+ x y}}})
      3)

(test (run `{let1 {x 1}
                  {let1 {y 2}
                        {let1 {x 3}
                              {+ x y}}}})
      5)

(test (run `{let1 {x 1}
                  {+ x
                     {let1 {x 2} x}}})
      3)