├── readme ├── readme~ ├── fb.rkt ├── ct.rkt ├── parser.rkt └── ast.rkt /readme: -------------------------------------------------------------------------------- 1 | Implemention of lambda calculus 2 | 3 | 4 | 5 | ;;; Abstract Syntax for the LAMBDA CALCULUS 6 | ;;; ======================================= 7 | 8 | ;;; ::= 9 | ;;; 10 | ;;; | 11 | ;;; | 12 | ;;; 13 | 14 | ;;; ::= (function ) 15 | ;;; ::= (app ) 16 | -------------------------------------------------------------------------------- /readme~: -------------------------------------------------------------------------------- 1 | Implemention of reduction based evaluation of lambda calculus expressions. 2 | 3 | 4 | 5 | ;;; Abstract Syntax for the LAMBDA CALCULUS 6 | ;;; ======================================= 7 | 8 | ;;; ::= 9 | ;;; 10 | ;;; | 11 | ;;; | 12 | ;;; 13 | 14 | ;;; ::= (function ) 15 | ;;; ::= (app ) 16 | -------------------------------------------------------------------------------- /fb.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require eopl/eopl) 4 | 5 | (require "ast.rkt") 6 | 7 | (require racket/set) 8 | 9 | (provide 10 | free-vars 11 | free?) 12 | 13 | ;;; free-vars : ast? -> (set-of id?) 14 | (define free-vars 15 | (lambda (a) 16 | (cases ast a 17 | [id-ref (id) (set id)] 18 | [function (i b) (let ([s (free-vars b)]) (if (set-member? s i) (set-remove s i) s))] 19 | [app (a b) (set-union (free-vars a) (free-vars b))] 20 | ))) ; FIX THIS DEFINITION! 21 | 22 | 23 | ;;; free? checks if id x is free in ast a. 24 | ;;; free?: [id? ast?] -> boolean? 25 | (define free? 26 | (lambda (id a) 27 | (if (set-member? (free-vars a) id) #t #f) 28 | )) ; FIX THIS DEFINITION! 29 | 30 | (require rackunit) 31 | 32 | (define set-empty (set)) 33 | 34 | ;;; THESE WILL PASS ONLY AFTER YOU SUPPLY THE CORRECT 35 | ;;; DEFINITIONS ABOVE? 36 | 37 | (check-equal? (free-vars (id-ref 'x)) (set 'x)) 38 | (check-equal? (free-vars (function 'x (id-ref 'x))) set-empty) 39 | (check-equal? (free? 'x (id-ref 'x)) #t) 40 | (check-equal? (free? 'x (function 'x (id-ref 'x))) #f) 41 | (check-equal? (free? 'y (function 'x (id-ref 'x))) #f) 42 | (check-equal? (free? 'y (function 'x (id-ref 'y))) #t) 43 | (check-equal? (free? 'y (function 'x (app (id-ref 'y) (id-ref 'x)))) #t) 44 | (check-equal? (free? 'x (function 'x (app (id-ref 'y) (id-ref 'x)))) #f) 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | -------------------------------------------------------------------------------- /ct.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | ;;; ======================================= 3 | ;;; Concrete Syntax for the LAMBDA CALCULUS 4 | ;;; ======================================= 5 | 6 | ;;; canonical single-argument syntax 7 | ;;; 8 | ;;; ::= 9 | ;;; | 10 | ;;; (lambda () ) | 11 | ;;; ( ) 12 | 13 | 14 | ;;; extended multi-argument syntax 15 | ;;; 16 | ;;; ::= 17 | ;;; | 18 | ;;; (lambda ( ...) ) | 19 | ;;; ( ...) 20 | 21 | (provide 22 | ct 23 | ) 24 | 25 | (require eopl/eopl) 26 | (require "ast.rkt") 27 | 28 | ;;; ct: transforms an expression in the multi-argument 29 | ;;; lambda calculus into the canonical (i.e., curried) 30 | ;;; lambda calculus. note that exp? and cexp? are types 31 | ;;; that (informally) denote the class of extended 32 | ;;; multi-argument lambda calculus expressions and the 33 | ;;; canonical lambda calculus expressions, respectively. 34 | 35 | ;;; ct: exp? -> cexp? 36 | (define ct 37 | (lambda (d) 38 | (match d 39 | [(? id? x) x] 40 | 41 | [(list 'lambda (list (? id? x)) body) 42 | `(lambda (,x) ,(ct body))] 43 | 44 | ;; (lambda (x y ...) b) => (lambda (x) (lambda (y ...) b)) 45 | [(list 'lambda (list (? id? x) (? id? more) ...) body) 46 | (ct `(lambda (,x) (lambda ,more ,body)))] 47 | 48 | [(list rator rand) 49 | `(,(ct rator) ,(ct rand))] 50 | 51 | ;;; (x y z ...) => ((x y) z ...) 52 | [(list rator rand more ...) 53 | (ct `((,rator ,rand) ,@more))] 54 | 55 | [_ (error 'ct "incorrect concrete syntax ~a" d)]))) 56 | 57 | 58 | (require rackunit) 59 | 60 | (check-equal? (ct 'x) 'x "ct 01") 61 | (check-equal? (ct '(x y)) '(x y) "ct 02") 62 | (check-equal? (ct '(x y z)) '((x y) z) "ct 03") 63 | (check-equal? (ct '(x (y z))) '(x (y z)) "ct 04") 64 | (check-equal? (ct '(lambda (x) x)) '(lambda (x) x) "ct 05") 65 | (check-equal? (ct '(lambda (x) (x y))) '(lambda (x) (x y)) "ct 06") 66 | (check-equal? (ct '(lambda (x y) x)) '(lambda (x) (lambda (y) x)) "ct 07") 67 | (check-equal? (ct '(lambda (x y) (x y z))) '(lambda (x) (lambda (y) ((x y) z))) "ct 08") 68 | (check-exn exn:fail? (lambda () (ct '(x))) "ct 09") 69 | (check-exn exn:fail? (lambda () (ct '())) "ct 10") 70 | (check-exn exn:fail? (lambda () (ct '(lambda x (x y)))) "ct 11") 71 | (check-exn exn:fail? (lambda () (ct '(lambda () (x y)))) "ct 12") 72 | (check-exn exn:fail? (lambda () (ct '(lambda (x y) x (x y)))) "ct 13") 73 | -------------------------------------------------------------------------------- /parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require eopl/eopl) 4 | (require "ast.rkt") 5 | (require "ct.rkt") 6 | 7 | (provide 8 | parse 9 | unparse) 10 | 11 | ;;; parse takes a cexp 12 | ;;; and returns an ast. 13 | ;;; parse : cexp? -> ast? 14 | 15 | (define parse 16 | (lambda (d) 17 | (match d 18 | ((? id? d) (id-ref d)) 19 | ((? list? d) (if (eq? (length d ) 1) 20 | (first d) 21 | (if (eq? (first d) 'lambda) 22 | (function (parse (second d)) (parse (third d))) 23 | (app (parse (first d)) (parse (second d)))))) 24 | ))) ; FIX THIS DEFINITION! 25 | 26 | ;;; unit tests 27 | 28 | (require rackunit) 29 | 30 | 31 | ;;; THESE WILL PASS ONLY AFTER YOU HAVE SUPPLIED THE CORRECT DEFINITIONS! 32 | (check-equal? (parse 'x) (id-ref 'x) "parse 01") 33 | 34 | (check-equal? 35 | (parse '(x y)) 36 | (app (id-ref 'x) (id-ref 'y)) 37 | "parse 02") 38 | 39 | (check-equal? 40 | (parse '((x y) z)) 41 | (app 42 | (app (id-ref 'x) (id-ref 'y)) 43 | (id-ref 'z)) 44 | "parse 03") 45 | 46 | (check-equal? 47 | (parse '(x (y z))) 48 | (app 49 | (id-ref 'x) 50 | (app 51 | (id-ref 'y) 52 | (id-ref 'z))) 53 | "parse 04") 54 | 55 | (check-equal? 56 | (parse '(lambda (x) x)) 57 | (function 58 | 'x 59 | (id-ref 'x)) 60 | "parse 05") 61 | 62 | (check-equal? 63 | (parse '(lambda (x) (x y))) 64 | (function 65 | 'x 66 | (app (id-ref 'x) (id-ref 'y))) 67 | "parse 06") 68 | 69 | (check-equal? 70 | (parse '((lambda (x) (x y)) z)) 71 | (app 72 | (function 73 | 'x 74 | (app (id-ref 'x) (id-ref 'y))) 75 | (id-ref 'z)) 76 | "parse 07") 77 | 78 | 79 | ;;; unparse takes an ast and returns an cexp 80 | ;;; unparse : ast? -> cexp? 81 | (define unparse 82 | (lambda (a) 83 | (cases ast a 84 | [id-ref (id) id] 85 | [function (a b) (list 'lambda (list a) (unparse b) )] 86 | [app (a b) (list ( unparse a) (unparse b))] 87 | ))) 88 | ; FIX THIS DEFINITION! 89 | 90 | 91 | 92 | ;;; THESE WILL PASS ONLY AFTER YOU HAVE SUPPLIED THE CORRECT DEFINITIONS! 93 | (check-equal? 94 | (unparse (id-ref 'x)) 95 | 'x 96 | "unparse 01") 97 | 98 | (check-equal? 99 | (unparse (app (id-ref 'x) (id-ref 'y))) 100 | '(x y) 101 | "unparse 02") 102 | 103 | (check-equal? 104 | (unparse (function 'x (id-ref 'x))) 105 | '(lambda (x) x) 106 | "unparse 03") 107 | 108 | (check-equal? 109 | (unparse (function 'x (app (id-ref 'x) (id-ref 'y)))) 110 | '(lambda (x) (x y)) 111 | "unparse 04") 112 | 113 | (check-equal? 114 | (unparse (app (function 'x (app (id-ref 'x) (id-ref 'y))) (id-ref 'z))) 115 | '((lambda (x) (x y)) z) 116 | "unparse 05") 117 | 118 | 119 | 120 | -------------------------------------------------------------------------------- /ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | 4 | ;;; ======================================= 5 | ;;; Abstract Syntax for the LAMBDA CALCULUS 6 | ;;; ======================================= 7 | 8 | ;;; ::= 9 | ;;; 10 | ;;; | 11 | ;;; | 12 | ;;; 13 | 14 | ;;; ::= (function ) 15 | ;;; ::= (app ) 16 | 17 | (require eopl/eopl) 18 | 19 | (provide 20 | ast 21 | ast? 22 | id? 23 | id-ref 24 | function 25 | app 26 | id-ref-ast? 27 | function-ast? 28 | app-ast? 29 | id-ref.id 30 | function.formal 31 | function.body 32 | app.rator 33 | app.rand 34 | check-ast?) 35 | 36 | (define id? 37 | (lambda (thing) 38 | (and (symbol? thing) (not (eq? thing 'lambda))))) 39 | 40 | (define-datatype ast ast? 41 | [id-ref (id id?)] 42 | [function (formal id?) (body ast?)] 43 | [app (rator ast?) (rand ast?)]) 44 | 45 | 46 | (define id-ref-ast? 47 | (lambda (a) 48 | (cases ast a 49 | [id-ref (id) #t] 50 | [else #f]))) 51 | 52 | 53 | (define function-ast? 54 | (lambda (a) 55 | (cases ast a 56 | [function (formal body) #t] 57 | [else #f]))) 58 | 59 | (define app-ast? 60 | (lambda (a) 61 | (cases ast a 62 | [app (rator rand) #t] 63 | [else #f]))) 64 | 65 | ;;; id-ref-id : id-ref-ast? -> id? 66 | (define id-ref.id 67 | (lambda (a) 68 | (cases ast a 69 | [id-ref (id) id] 70 | [else (error 'id-ref.id "contract violation: id-ref.id expects an id-ref-ast?, given ~a" a)]))) 71 | 72 | 73 | ;;; function.formal: function-ast? -> id? 74 | (define function.formal 75 | (lambda (a) 76 | (cases ast a 77 | [function (formal body) formal] 78 | [else (error 'function.formal "contract violation: function.formal expects an function-ast?, given ~a" a)]))) 79 | 80 | 81 | ;;; function.body: function-ast? -> ast? 82 | (define function.body 83 | (lambda (a) 84 | (cases ast a 85 | [function (formal body) body] 86 | [else (error 'function.body "contract violation: function.body expects an function-ast?, given ~a" a)]))) 87 | 88 | 89 | ;;; app.rator: app-ast? -> ast? 90 | (define app.rator 91 | (lambda (a) 92 | (cases ast a 93 | [app (rator rand) rator] 94 | [else (error 'app.rator "contract violation: app.rator expects an app-ast?, given ~a" a)]))) 95 | 96 | ;;; app.rand: app-ast? -> ast? 97 | (define app.rand 98 | (lambda (a) 99 | (cases ast a 100 | [app (rator rand) rand] 101 | [else (error 'app.rand "contract violation: app.rand expects an app-ast?, given ~a" a)]))) 102 | 103 | 104 | ;;; unit Testing 105 | ;;; ============ 106 | 107 | ;;; Racket's unit testing framework 108 | (require rackunit) 109 | 110 | 111 | (define-simple-check (check-ast? thing) 112 | (ast? thing)) 113 | 114 | (check-ast? (id-ref 'x) "id-ref-x test") 115 | 116 | (check-ast? 117 | (app (id-ref 'x) (id-ref 'y)) 118 | "ifte-test1") 119 | 120 | 121 | (check-ast? 122 | (function 123 | 'x 124 | (app (app (id-ref '+) (id-ref 'x)) (id-ref 'y))) "function-test") 125 | 126 | 127 | (check-exn ;; app constructor is incorrectly invoked 128 | exn:fail? 129 | (lambda () 130 | (app (id-ref '+))) "app test") 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | --------------------------------------------------------------------------------