; CSE341, Programming Languages #lang racket (provide (all-defined-out)) ; a larger language with two kinds of values, booleans and numbers ; an expression is any of these: (struct const (int) #:transparent) ; int should hold a number (struct negate (e1) #:transparent) ; e1 should hold an expression (struct add (e1 e2) #:transparent) ; e1, e2 should hold expressions (struct multiply (e1 e2) #:transparent) ; e1, e2 should hold expressions (struct bool (b) #:transparent) ; b should hold #t or #f (struct eq-num (e1 e2) #:transparent) ; e1, e2 should hold expressions (struct if-then-else (e1 e2 e3) #:transparent) ; e1, e2, e3 should hold expressions ; a value in this language is a legal const or bool (define test1 (multiply (negate (add (const 2) (const 2))) (const 7))) (define test2 (multiply (negate (add (const 2) (const 2))) (if-then-else (bool #f) (const 7) (bool #t)))) (define test3 (multiply (negate (if-then-else (bool #f) (const 7) (bool #t))) (const 3))) (define (eval-exp-wrong e) (cond [(const? e) e] [(negate? e) (const (- (const-int (eval-exp-wrong (negate-e1 e)))))] [(add? e) (let ([i1 (const-int (eval-exp-wrong (add-e1 e)))] [i2 (const-int (eval-exp-wrong (add-e2 e)))]) (const (+ i1 i2)))] [(multiply? e) (let ([i1 (const-int (eval-exp-wrong (multiply-e1 e)))] [i2 (const-int (eval-exp-wrong (multiply-e2 e)))]) (const (* i1 i2)))] [(bool? e) e] [(eq-num? e) (let ([i1 (const-int (eval-exp-wrong (eq-num-e1 e)))] [i2 (const-int (eval-exp-wrong (eq-num-e2 e)))]) (bool (= i1 i2)))] ; creates (bool #t) or (bool #f) [(if-then-else? e) (if (bool-b (eval-exp-wrong (if-then-else-e1 e))) (eval-exp-wrong (if-then-else-e2 e)) (eval-exp-wrong (if-then-else-e3 e)))] [#t (error "eval-exp expected an exp")] ; not strictly necessary but helps debugging )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DEBUGGING: TRACE (require racket/trace) (define (fact n) (if (= n 0) 1 (* n (fact (sub1 n))))) ;(trace fact) ; `set!`s fact to a new function, ; which wraps fact, ; printing args / return values ; Call: (fact 4) ; Prints: ; >(fact 4) ; > (fact 3) ; > >(fact 2) ; > > (fact 1) ; > > >(fact 0) ; < < <1 ; < < 1 ; < <2 ; < 6 ; <24 ; Wrinkle: tail-recursion loses context! (define (fact-tr n [base 1]) (if (= n 0) base (fact-tr (sub1 n) (* n base)))) (trace fact-tr) ; Call: (fact-tr 4) ; Prints: ; >(fact-tr 4) ; >(fact-tr 3 4) ; >(fact-tr 2 12) ; >(fact-tr 1 24) ; >(fact-tr 0 24) ; <24 ;(trace eval-exp-wrong) (define (eval-exp e) (cond [(const? e) e] [(negate? e) (let ([v (eval-exp (negate-e1 e))]) (if (const? v) (const (- (const-int v))) (error "negate applied to non-number")))] [(add? e) (let ([v1 (eval-exp (add-e1 e))] [v2 (eval-exp (add-e2 e))]) (if (and (const? v1) (const? v2)) (const (+ (const-int v1) (const-int v2))) (error "add applied to non-number")))] [(multiply? e) (let ([v1 (eval-exp (multiply-e1 e))] [v2 (eval-exp (multiply-e2 e))]) (if (and (const? v1) (const? v2)) (const (* (const-int v1) (const-int v2))) (error "multiply applied to non-number")))] [(bool? e) e] [(eq-num? e) (let ([v1 (eval-exp (eq-num-e1 e))] [v2 (eval-exp (eq-num-e2 e))]) (if (and (const? v1) (const? v2)) (bool (= (const-int v1) (const-int v2))) ; creates (bool #t) or (bool #f) (error "eq-num applied to non-number")))] [(if-then-else? e) (let ([v-test (eval-exp (if-then-else-e1 e))]) (if (bool? v-test) (if (bool-b v-test) (eval-exp (if-then-else-e2 e)) (eval-exp (if-then-else-e3 e))) (error "if-then-else applied to non-boolean")))] [#t (error "eval-exp expected an exp")] ; not strictly necessary but helps debugging )) ;(trace eval-exp) ; Hey! What's the difference between those two implementations? ; Typechecking! ; (Subtlety: a const will always hold an int, because they are only created by ; * the (imaginary) parser, which we can trust to do its job ; * the interpreter, which we carefully code to maintain this invariant.) ; ; Consider: (define non-test (multiply (negate (add (const #t) (const 2))) (const 7))) ; Here are two Racket functions that given language-being-implemented syntax, ; produce language-being-implemented syntax (define (andalso e1 e2) (if-then-else e1 e2 (bool #f))) (define (double e) (multiply e (const 2))) ; this one takes a Racket list of language-being-implemented syntax ; and makes language-being-implemented syntax (define (list-product es) (if (null? es) (const 1) (multiply (car es) (list-product (cdr es))))) (define test (list-product (list (const 2) (const 2) (const 1) (const 2)))) ; notice we have not changed our interpreter at all (define result (eval-exp test)) ; quoting ;======== (define l0 (list 1 2 (+ 3 4) 5)) ; => '(1 2 7 5) (define l1 (quote (1 2 (+ 3 4) 5))) ; => '(1 2 (+ 3 4) 5) ; = (list 1 2 (list '+ 3 4) 5) (define l2 '(1 2 (+ 3 4) 5)) ; syntactic sugar for the above (define s0 (list 1 2 (+ 1 2))) (define s1 '(1 2 (+ 1 2))) (define s2 (quasiquote (1 2 (unquote (+ 1 2))))) ; => (list 1 2 (+ 1 2)) ; = (list 1 2 3) (define s3 `(1 2 ,(+ 1 2))) ; syntactic sugar for the above ; eval ; ====== ; quoting, simple example (define (repl) (let ([r (read)]) (begin (println (eval r)) (repl)))) ; Quasiquoting ; Maybe you want to test your interpreter's correctness by comparing its results ; to the results *Racket* would compute evaluating an equivalent expression. ; You might write a "translator" that would ; take a Fred expression, like (multiply (add (const 3) (const 4)) (const 2)) ; and return a corresponding Racket expression, like '(* (+ 3 4) 2) (define (translate-ftr e) (define tr translate-ftr) (cond [(const? e) (const-int e)] [(negate? e) `(- ,(tr (negate-e1 e)))] [(add? e) `(+ ,(tr (add-e1 e)) ,(tr (add-e2 e)))] [(multiply? e) `(* ,(tr (multiply-e1 e)) ,(tr (multiply-e2 e)))] [(bool? e) (bool-b e)] [(eq-num? e) `(= ,(tr (eq-num-e1 e)) ,(tr (eq-num-e2 e)))] [(if-then-else? e) `(if ,(tr (if-then-else-e1 e)) ,(tr (if-then-else-e2 e)) ,(tr (if-then-else-e3 e)))] [#t (error "eval-exp expected an exp")] ; not strictly necessary but helps debugging )) (define (demonstrate-translation) (printf "test1 is ~v~n" test1) (printf "translated is ~v~n" (translate-ftr test1)) (printf "evaluated is ~v~n" (eval-exp test1)) (printf "translated and evaluated is ~v~n" (eval (translate-ftr test1))))