#lang racket ; tree abstract data type ; a leaf is a single element list with Content ; a branch is a 3 element list with Content, Left, and Right (define Content (lambda (tree) (first tree))) (define Left (lambda (tree) (second tree))) (define Right (lambda (tree) (third tree))) (define AtLeaf? (lambda (tree) (null? (rest tree)))) (define At+? (lambda (tree) (eq? (Content tree) '+))) (define At*? (lambda (tree) (eq? (Content tree) '*))) (define At-? (lambda (tree) (eq? (Content tree) '-))) (define At/? (lambda (tree) (eq? (Content tree) '/))) ; evaluate the expression, but do bogus things with bad situations ; we should bailout to the caller when we cannot proceed to compute (define ArithEvalV1 (lambda (tree) (if (AtLeaf? tree) (Content tree) (let ( (lval (ArithEvalV1 (Left tree))) (rval (ArithEvalV1 (Right tree))) ) (cond ( (At+? tree) (+ lval rval) ) ( (At*? tree) (* lval rval) ) ( (At-? tree) (- lval rval) ) ( (At/? tree) (if (= rval 0) "Divide by 0" (/ lval rval) ) ) ( #t (list "Unknown Operator" (Content tree))) ) ))) ) (define t1 '(+ (1) (* (2) (3) ))) ;(ArithEvalV1 t1) (define t2 '(/ (10) (- (7) (+ (1) (* (2) (3) ))))) ;(ArithEvalV1 t2) (define t3 '(+ (1) (** (2) (3) ))) ;(ArithEvalV1 t3) ; ok, this is what we would like to do, passing in a routine that terminates ; and bailout to the caller returning an error value. (define ArithEvalV2 (lambda (tree) (letrec ( (E (lambda (tree bailout) (if (AtLeaf? tree) (Content tree) (let ( (lval (E (Left tree) bailout)) (rval (E (Right tree) bailout)) ) (cond ( (At+? tree) (+ lval rval) ) ( (At*? tree) (* lval rval) ) ( (At-? tree) (- lval rval) ) ( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) ) ( #t (bailout (list "Unknown Operator" (Content tree))) ) ) ))) )) (E tree (lambda (x) (list "bailing out with" x))) ) ) ) ;(ArithEvalV2 t1) ;(ArithEvalV2 t2) ;(ArithEvalV2 t3) (define ArithEvalV3 (lambda (tree) ; this next operation calls the function with the current continuation ; so we can bailout and leap to the future with our return value. (call-with-current-continuation ; see also let/cc (lambda (bailout) (letrec ( (E (lambda (tree) (if (AtLeaf? tree) (Content tree) (let ( (lval (E (Left tree))) (rval (E (Right tree))) ) (cond ( (At+? tree) (+ lval rval) ) ( (At*? tree) (* lval rval) ) ( (At-? tree) (- lval rval) ) ( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) ) ( #t (bailout (list "Unknown Operator" (Content tree))) ) ) ))) )) (E tree) ) ) ) ) ) (ArithEvalV3 t1) (ArithEvalV3 t2) (ArithEvalV3 t3) (define ArithEvalV4 (lambda (tree) ; an escape continuation is a more lightweight version of the current ; continuation, and only exists within the dynamic context of the ; call-with-escape-continuation (call-with-escape-continuation ; see also let/ec (lambda (bailout) (letrec ( (E (lambda (tree) (if (AtLeaf? tree) (Content tree) (let ( (lval (E (Left tree))) (rval (E (Right tree))) ) (cond ( (At+? tree) (+ lval rval) ) ( (At*? tree) (* lval rval) ) ( (At-? tree) (- lval rval) ) ( (At/? tree) (if (= rval 0) (bailout "Divide by 0") (/ lval rval) ) ) ( #t (bailout (list "Unknown Operator" (Content tree))) ) ) ))) )) (E tree) ) ) ) ) ) ;(ArithEvalV4 t1) ;(ArithEvalV4 t2) ;(ArithEvalV4 t3)