#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 catch (e1) #:transparent) (define-struct throw (e1) #:transparent) (define test-expr (make-sub (make-catch (make-sub (make-throw (make-lit 5)) (make-lit 1))) (make-sub (make-lit 3) (make-lit 2)))) ; Evaluator (denotational semantics) (define eval-big (lambda (e c) (match e ((struct lit (n)) (c n)) ((struct sub (e1 e2)) (eval-big e1 (lambda (n1) (eval-big e2 (lambda (n2) (c (- n1 n2))))))) ((struct catch (e1)) (c (eval-big e1 (lambda (n) n)))) ((struct throw (e1)) (eval-big e1 (lambda (n) n)))))) ; Try: (eval-big test-expr (lambda (n) n)) (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 finish () #:transparent) (define-struct caught (c d) #:transparent) (define-struct eval (e c d) #:transparent) (define-struct apply (c n d) #:transparent) (define-struct return (d n) #:transparent) (define step (lambda (s) (match s ((struct eval ((struct lit (n)) c d)) (make-apply c n d)) ((struct eval ((struct sub (e1 e2)) c d)) (make-eval e1 (make-sub1 c e2) d)) ((struct eval ((struct catch (e1)) c d)) (make-eval e1 (make-done) (make-caught c d))) ((struct eval ((struct throw (e1)) c d)) (make-eval e1 (make-done) d)) ((struct apply ((struct done ()) n d)) (make-return d n)) ((struct apply ((struct sub1 (c e2)) n d)) (make-eval e2 (make-sub2 n c) d)) ((struct apply ((struct sub2 (n1 c)) n d)) (make-apply c (- n1 n) d)) ((struct return ((struct finish ()) n)) n) ((struct return ((struct caught (c d)) n)) (make-apply c n d)) (_ #f)))) (define steps (lambda (s0) (match (step s0) (#f s0) (s (steps s))))) (define eval-small (lambda (e) (steps (make-eval e (make-done) (make-finish))))) ; Try: (eval-small test-expr) (trace steps) ; Evaluator using metalanguage exception (require (only-in scheme/control reset abort)) (define eval-meta (lambda (e) (match e ((struct lit (n)) n) ((struct sub (e1 e2)) (- (eval-meta e1) (eval-meta e2))) ((struct catch (e1)) (reset (eval-meta e1))) ((struct throw (e1)) (abort (eval-meta e1)))))) ; Try: (eval-meta test-expr) (trace eval-meta)