(define const-exp
  (lambda (n)
    (cons 'const-exp (cons n '()))))

(define diff-exp
  (lambda (e1 e2)
    (cons 'diff-exp (cons e1 (cons e2 '())))))

(define zero?-exp
  (lambda (e1)
    (cons 'zero?-exp (cons e1 '()))))

(define if-exp
  (lambda (e1 e2 e3)
    (cons 'if-exp (cons e1 (cons e2 (cons e3 '()))))))

(define const-exp?
  (lambda (e)
    (eq? (car e) 'const-exp)))

(define diff-exp?
  (lambda (e)
    (eq? (car e) 'diff-exp)))

(define zero?-exp?
  (lambda (e)
    (eq? (car e) 'zero?-exp)))

(define if-exp?
  (lambda (e)
    (eq? (car e) 'if-exp)))

(define const-exp-n
  (lambda (e)
    (car (cdr e))))

(define diff-exp-e1
  (lambda (e)
    (car (cdr e))))

(define diff-exp-e2
  (lambda (e)
    (car (cdr (cdr e)))))

(define zero?-exp-e1
  (lambda (e)
    (car (cdr e))))

(define if-exp-e1
  (lambda (e)
    (car (cdr e))))

(define if-exp-e2
  (lambda (e)
    (car (cdr (cdr e)))))

(define if-exp-e3
  (lambda (e)
    (car (cdr (cdr (cdr e))))))

(define num-val
  (lambda (n)
    (cons 'num-val (cons n '()))))

(define bool-val
  (lambda (b)
    (cons 'bool-val (cons b '()))))

(define num-val?
  (lambda (v)
    (eq? (car v) 'num-val)))

(define bool-val?
  (lambda (v)
    (eq? (car v) 'bool-val)))

(define num-val-n
  (lambda (v)
    (car (cdr v))))

(define bool-val-b
  (lambda (v)
    (car (cdr v))))

; value-of : exp -> val
(define value-of
  (lambda (e)
    (cond
      ((const-exp? e)
       (num-val (const-exp-n e)))
      ((diff-exp? e)
       (num-val (- (num-val-n (value-of (diff-exp-e1 e)))
                   (num-val-n (value-of (diff-exp-e2 e))))))
      ((zero?-exp? e)
       (bool-val (zero? (num-val-n (value-of (zero?-exp-e1 e))))))
      ((if-exp? e)
       (if (bool-val-b (value-of (if-exp-e1 e)))
           (value-of (if-exp-e2 e))
           (value-of (if-exp-e3 e)))))))

(define morphology
  '((white-sp
     (whitespace) skip)
    (comment
     ("%" (arbno (not #\newline))) skip)
    (constant
     (digit (arbno digit)) number)))

(define grammar
  '((exp
     (constant)
     const-exp)
    (exp
     ("-" "(" exp "," exp ")")
     diff-exp)
    (exp
     ("zero?" "(" exp ")")
     zero?-exp)
    (exp
     ("if" exp "then" exp "else" exp)
     if-exp)))

(define read-eval-print
  (sllgen:make-rep-loop "--> " value-of
    (sllgen:make-stream-parser morphology grammar)))