; CSE341, Programming Languages ; Section 7: Implementing Languages Including Closures #lang racket (provide (all-defined-out)) ; create a language A interpreted in Racket ;=========================================== ; A has two kinds of values: booleans & numbers (displayln "=====Language A=====") ; an expression is any of these: ; a value in this language is a legal const or bool (struct const (int) #:transparent) ; int should hold a number (struct bool (b) #:transparent) ; b should hold #t or #f ; (struct opaque-const (int)) ; limited info, different behaviors for equal? (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 eq-num (e1 e2) #:transparent) ; e1, e2 should hold expressions (struct if-then-else (e1 e2 e3) #:transparent) ; e1, e2, e3 should hold expressions ; negate? negate-e1 are provided ; we can write expressions/programs in language A as abstract syntax tree in Racket (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)))) ; however, notice Racket is dynamically typed ; since type is determined at runtime, we can define illegal programs: (define non-test1 (multiply (negate (add (const #t) ; const should take int (const 2))) (const 7))) ; 1 and 2 are not legal expression in A, but (const 1) and (const 2) are (define non-test2 (multiply 1 2)) ; eval-exp should take an expression/program in A, ; and evaluate it to get a value in A. ; assume input program A is syntactically correct, ; so no such things like : (bool 1) (const #t) ; but there might be type errors such as : (add (bool #t) (const 1)) ; here is the incoreect example: ; any type can goes into A's expression (dynamically type-check) ; unwanted exception happens when applying some functions like const-int (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 )) ; what does error message tell? ; const-int calls const? ; (eval-exp-wrong (multiply (bool #t) (const 1))) ; to fix eval-exp-wrong, check the result's type (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))) ; or (add e e) (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)) ; symbol ;======== (displayln "=====Symbol=====") (printf "+ is differnet from '+: ~s is different from ~s~n" + '+) ; quoting ;======== (displayln "=====Quote=====") ; to define a list (define l0 (list 1 2 (list 3 4) 5)) ; quote also gives back a list so you can apply car/cdr to it (define l1 (quote (1 2 (3 4) 5))) (define l2 '(1 2 (3 4) 5)) (printf "l0: ~v~n" l0) (printf "l1: ~v~n" l1) (printf "get '(3 4) in l1: ~v~n" (caddr l1)) ; but quote treats variable as symbol (define s0 (list 1 2 (+ 1 2))) (define s1 '(1 2 (+ 1 2))) (printf "s0 is different from s1: ~v is different from ~v~n" s0 s1) ; quasiquote & unquote ;====================== (displayln "=====Quasiquote & Unquote=====") ; you can choose where to treat as quote and unquote (define s2 (quasiquote (+ 1 2 (unquote (+ 1 2))))) (printf "s2 is ~v~n" s2) ; shorthand ` ' (quasiquote) and , (unquote) (define s3 `(+ 1 2 ,(+ 1 2))) ; we can evaluate s3 by eval ; (eval s3) doesn't work here but can work in REPL ; need wrap so it won't get exception in evaluation (define eval-s3 (lambda () (eval s3))) ; function wrapping for (+ 1 2 3) ; partial evaluation : a more useful thing to do ;================================================ (displayln "=====Partial Eval=====") ; normal version of the pow function 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 ; what's 2 ^ 3? ; (eval '(* 2 2 2)) ; pow x y is x ^ y ; never call with y < 1 (define (powh y) (if (eq? y 1) (quote x) ; 'x is from quasiquote below (quasiquote (* x (unquote (powh (- y 1))))))) ; mul-exp '(* x x x ...) x appear for y times (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) ; build-list passes 0 ~ y-1 to lambda z to create a list of y elements (let ([xs (build-list y (lambda (z) 'x))]) ; 'x is from quasiquote below (cons '* xs))) (define (pow2 y) (let ([mul-exp (powh2 y)]) (eval (quasiquote (lambda (x) (unquote mul-exp)))))) ; apply is similar to eval, but use procedure instead of symbol (printf "2 ^ 3 is ~v~n" (apply * '(2 2 2))) ; get error when arguments don't match ; (printf "2 ^ 3 is ~v~n" (apply pow2 '(3 2))) ; any num of arguments (define double2 (lambda xs (* (car xs) 2))) ; ok to treat as list