The memoirs of Dr. John Racket

#lang racket
(require rackunit
         plai)

(define-type WAE
  [num (n number?)]
  [plus (lhs WAE?)
        (rhs WAE?)]
  [minus (lhs WAE?)
         (rhs WAE?)]
  [id (sym symbol?)]
  [with (var id?)
        (val WAE?)
        (body WAE?)
        ])

(define (parse sexp)
  (cond
    [(number? sexp) (num sexp)]
    [(symbol? sexp) (id sexp)]
    [(equal? (first sexp) '+)
     (plus (parse (second sexp))
           (parse (third sexp)))]
    [(equal? (first sexp) '-)
     (minus (parse (second sexp))
            (parse (third sexp)))]
    [(equal? (first sexp) 'with)
     (with (parse (first (second sexp)))
           (parse (second (second sexp)))
           (parse (third sexp)))]
    [else (error 'parse "Unexpected expression: ~a" sexp)]
    ))

(define (interp ast)
  (type-case WAE ast
    [num (n) n]
    [id (sym)
        (error 'interp "Unbound identifier: ~a" sym)]
    [plus (lhs rhs)
          (+ (interp lhs)
             (interp rhs))]
    [minus (lhs rhs)
           (- (interp lhs)
              (interp rhs))]
    [with (var val body)
          (interp (subst var val body))]
    ))


(define (subst var val body)
  (type-case WAE body
    [num (n) (num n)]
    [id (sym)
        (if (equal? var body)
            val
            body)]
    [plus (lhs rhs)
          (plus (subst var val lhs)
             (subst var val rhs))]
    [minus (lhs rhs) 'FIXME]
    [else (error 'subst "Unbound identifier: ~a" body)]
    ))

;;Testing suite------------------------------------------------------------
(define e1 '5)
(check-equal? (parse e1) (num 5))
(check-equal? (interp (parse e1)) 5)

(define e2 '(+ 3 5))
(check-equal? (parse e2) (plus (num 3) (num 5)))
(check-equal? (interp (parse e2)) 8)

(define e3 '(with (x 25) x))
(check-equal? (parse e3) (with (id 'x) (num 25) (id 'x)))
(check-equal? (interp (parse e3)) 25)

(define e4 '(with (x 10) (+ x 90)))
(check-equal? (parse e4) (with (id 'x) (num 10) (plus (id 'x) (num 90))))
(check-equal? (interp (parse e4)) 100)

;;=========================================================================