; CSE341, Programming Languages ; Lecture 17: Implementing Languages Including Closures #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)))) ;;this is an illegal program (define non-test (multiply (negate (add (const #t) (const 2))) (const 7))) (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 )) (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 )) ; Here are some 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))) (define (negative-x-plus-one e) (negate (add (const 1) e))) ; 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 (andalso (eq-num (double (const 4)) (list-product (list (const 2) (const 2) (const 1) (const 2)))) (bool #t))) ; notice we have not changed our interpreter at all (define result (eval-exp test)) ; quoting ;======== (define l0 (list 1 2 (list 3 4) 5)) (define l1 (quote (1 2 (3 4) 5))) (define l2 '(1 2 (3 4) 5)) (define s0 (list 1 2 (+ 1 2))) (define s1 '(1 2 (+ 1 2))) (define s2 (quasiquote (1 2 (unquote (+ 1 2))))) (define s3 `(1 2 ,(+ 1 2))) ;; A more useful thing to do: partial evaluation ;; We might want to specialize the pow function ;; normal version below, calculates x ^ y ;; never call with y < 1 (define (pow-normal y x) (if (eq? y 1) x (* x (pow-normal (- y 1) x)))) ;; Now suppose we want a version specialized to a particular y ;; Here we can specialize for a given y, and get back a function ;; which doesn't use recursion ;; pow x y is x ^ y ;; never call with y < 1 (define (powh y) (if (eq? y 1) (quote x) (quasiquote (* x (unquote (powh (- y 1))))))) (define (pow y) (let ([mul-exp (powh y)]) (eval (quasiquote (lambda (x) (unquote mul-exp)))))) ;; Racket is cool, and lets us do something even simpler (define (powh2 y) (let ([xs (build-list y (lambda (z) 'x))]) (cons '* xs))) (define (pow2 y) (let ([mul-exp (powh2 y)]) (eval (quasiquote (lambda (x) (unquote mul-exp)))))) ;;Another example below, probably no time in section ; eval ; ====== ; setup (current-namespace (make-base-namespace)) (define (join-symbols s0 s1) (string->symbol (string-append (symbol->string s0) (symbol->string s1)))) ; quoting, simple example (define f (lambda (x) (+ x x))) (define f-data '(lambda (x) (+ x x))) (define f-from-data (eval f-data)) ; (quasi)quoting, realistic example (struct employee (name age salary manager address jobtitle hiredate vacation sickdays overtime)) (define-namespace-anchor a) (current-namespace (namespace-anchor->namespace a)) (define me (employee "Tam" 20 1000000 'no "Somewhere" "TA" 2017 10 2 20)) (define print-employee (lambda (e) (printf "~a: ~a\n" "name" (employee-name e)) (printf "~a: ~a\n" "age" (employee-age e)) (printf "~a: ~a\n" "salary" (employee-salary e)) (printf "~a: ~a\n" "manager" (employee-manager e)) (printf "~a: ~a\n" "address" (employee-address e)) (printf "~a: ~a\n" "jobtitle" (employee-jobtitle e)) (printf "~a: ~a\n" "hiredate" (employee-hiredate e)) (printf "~a: ~a\n" "vacation" (employee-vacation e)) (printf "~a: ~a\n" "sickdays" (employee-sickdays e)) (printf "~a: ~a\n" "overtime" (employee-overtime e)))) (define print-employee-data (append '(lambda (e)) (map (lambda (field) `(printf "~a: ~a\n" ,(symbol->string field) (,(join-symbols 'employee- field) e))) '(name age salary manager address jobtitle hiredate vacation sickdays overtime)))) (define print-employee-from-data (eval print-employee-data))