#lang scheme
(require (only-in mzlib/trace trace))

; The grammar of object programs

(define-struct lit (num) #:transparent)
(define-struct sub (e1 e2) #:transparent)
(define-struct save (e1) #:transparent)
(define-struct load () #:transparent)

(define test-expr
  (make-sub (make-sub (make-save (make-lit 6))
                      (make-save (make-sub (make-lit 3) (make-lit 2))))
            (make-load)))

; Evaluator (denotational semantics)

(define-struct result (n r) #:transparent)

(define eval-big
  (lambda (e r)
    (match e
      ((struct lit (n))
       (make-result n r))
      ((struct sub (e1 e2))
       (match (eval-big e1 r)
         ((struct result (n1 r1))
          (match (eval-big e2 r1)
            ((struct result (n2 r2))
             (make-result (- n1 n2) r2))))))
      ((struct save (e1))
       (match (eval-big e1 r)
         ((struct result (n1 r1))
          (make-result n1 n1))))
      ((struct load ())
       (make-result r r)))))

; Try: (eval-big test-expr 0)

(trace eval-big)

; Step function (operational semantics)

(define-struct done () #:transparent)
(define-struct sub1 (c e2) #:transparent)
(define-struct sub2 (n1 c) #:transparent)
(define-struct save1 (c) #:transparent)

(define-struct eval (e r c) #:transparent)
(define-struct apply (c n r) #:transparent)

(define step
  (lambda (s)
    (match s
      ((struct eval ((struct lit (n)) r c))
       (make-apply c n r))
      ((struct eval ((struct sub (e1 e2)) r c))
       (make-eval e1 r (make-sub1 c e2)))
      ((struct eval ((struct save (e1)) r c))
       (make-eval e1 r (make-save1 c)))
      ((struct eval ((struct load ()) r c))
       (make-apply c r r))
      ((struct apply ((struct done ()) n r))
       (make-result n r))
      ((struct apply ((struct sub1 (c e2)) n r))
       (make-eval e2 r (make-sub2 n c)))
      ((struct apply ((struct sub2 (n1 c)) n r))
       (make-apply c (- n1 n) r))
      ((struct apply ((struct save1 (c)) n r))
       (make-apply c n n))
      (_
       #f))))

(define steps
  (lambda (s0)
    (match (step s0)
      (#f s0)
      (s (steps s)))))

(define eval-small
  (lambda (e r)
    (steps (make-eval e r (make-done)))))

; Try: (eval-small test-expr 0)

(trace steps)

; Evaluator using metalanguage state

(define register 0)

(define eval-meta
  (lambda (e)
    (match e
      ((struct lit (n))
       n)
      ((struct sub (e1 e2))
       (- (eval-meta e1) (eval-meta e2)))
      ((struct save (e1))
       (match (eval-meta e1)
         (n1
          (set! register n1)
          n1)))
      ((struct load ())
       register))))

; Try: (eval-meta test-expr)

(trace eval-meta)