├── amount ├── example.rkt ├── ast.rkt ├── parser.rkt ├── README.md ├── main.rkt └── interp.rkt ├── arithmetic ├── example.rkt ├── ast.rkt ├── README.md ├── main.rkt ├── parser.rkt └── interp.rkt ├── .gitignore ├── fraud ├── example.rkt ├── README.md ├── main.rkt ├── ast.rkt ├── parser.rkt └── interp.rkt ├── fraud-subst ├── example.rkt ├── README.md ├── main.rkt ├── ast.rkt ├── parser.rkt └── interp.rkt ├── con ├── example.rkt ├── README.md ├── ast.rkt ├── main.rkt ├── parser.rkt └── interp.rkt ├── defend ├── example.rkt ├── README.md ├── main.rkt ├── ast.rkt ├── parser.rkt └── interp.rkt ├── state ├── example.rkt ├── README.md ├── main.rkt ├── ast.rkt ├── parser.rkt ├── rewriter.rkt └── interp.rkt ├── gross ├── example.rkt ├── README.md ├── ast.rkt ├── main.rkt ├── parser.rkt └── interp.rkt ├── lambda ├── example.rkt ├── README.md ├── main.rkt ├── ast.rkt ├── parser.rkt ├── tests.rkt └── interp.rkt ├── README.md └── types ├── main.rkt ├── ast.rkt ├── parser.rkt ├── type.rkt └── interp.rkt /amount/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | 42 4 | -------------------------------------------------------------------------------- /arithmetic/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (+ (add1 5) (sub1 -9)) 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | compiled/ 3 | /doc/ 4 | *~ 5 | *.bak 6 | \#* 7 | .\#* 8 | -------------------------------------------------------------------------------- /fraud/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (let ((x (add1 6))) 4 | (let ((x (+ 6 x))) 5 | (/ x 2))) 6 | -------------------------------------------------------------------------------- /fraud-subst/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (let ((x (add1 6))) 4 | (let ((x (+ 6 x))) 5 | (/ x 2))) 6 | -------------------------------------------------------------------------------- /con/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (if (zero? (- 6 5)) 4 | (+ (add1 5) (sub1 -9)) 5 | (and #t (and 3 4))) 6 | -------------------------------------------------------------------------------- /defend/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (if (zero? (- 6 5)) 4 | (+ (add1 5) (sub1 -9)) 5 | (and #t (and 3 4))) 6 | -------------------------------------------------------------------------------- /state/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (let ((x (new 5))) 4 | (begin 5 | (set! x (add1 (deref x))) 6 | (+ 3 (deref x)))) 7 | -------------------------------------------------------------------------------- /amount/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Int UnOp BinOp) 4 | 5 | ;; type Expr = 6 | ;; | (Int Integer) 7 | (struct Int (i) #:prefab) 8 | -------------------------------------------------------------------------------- /gross/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (odd? x) 4 | (if (zero? x) #f 5 | (even? (sub1 x)))) 6 | 7 | (define (even? x) 8 | (if (zero? x) #t 9 | (odd? (sub1 x)))) 10 | 11 | (odd? 42) 12 | -------------------------------------------------------------------------------- /lambda/example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (odd? x) 4 | (if (zero? x) #f 5 | (even? (sub1 x)))) 6 | 7 | (define (even? x) 8 | (if (zero? x) #t 9 | (odd? (sub1 x)))) 10 | 11 | (odd? 42) 12 | -------------------------------------------------------------------------------- /amount/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Int s)] 11 | [_ (error "Parse error!")])) 12 | -------------------------------------------------------------------------------- /state/README.md: -------------------------------------------------------------------------------- 1 | # State 2 | 3 | This repository contains the interpreter for the State language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/13-mutation-state/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | -------------------------------------------------------------------------------- /arithmetic/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Int UnOp BinOp) 4 | 5 | ;; type Expr = 6 | ;; | (Int Integer) 7 | ;; | (UnOp u e) 8 | ;; | (BinOp b e e) 9 | (struct Int (i) #:prefab) 10 | (struct UnOp (u e) #:prefab) 11 | (struct BinOp (b e1 e2) #:prefab) 12 | -------------------------------------------------------------------------------- /amount/README.md: -------------------------------------------------------------------------------- 1 | # Amount 2 | 3 | This repository contains the interpreter for the Amount language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/03-numbers/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | **To test:** `raco test interp.rkt` 10 | -------------------------------------------------------------------------------- /con/README.md: -------------------------------------------------------------------------------- 1 | # Con 2 | 3 | This repository contains the interpreter for the Con language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/06-booleans/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | **To test:** `raco test interp.rkt` 10 | 11 | -------------------------------------------------------------------------------- /defend/README.md: -------------------------------------------------------------------------------- 1 | # Defend 2 | 3 | This repository contains the interpreter for the Defend language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/07-errors/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | **To test:** `raco test interp.rkt` 10 | 11 | -------------------------------------------------------------------------------- /gross/README.md: -------------------------------------------------------------------------------- 1 | # Gross 2 | 3 | This repository contains the interpreter for the Gross language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/09-functions/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | **To test:** `raco test interp.rkt` 10 | 11 | -------------------------------------------------------------------------------- /lambda/README.md: -------------------------------------------------------------------------------- 1 | # Lambda 2 | 3 | This repository contains the interpreter for the Lambda language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/10-lambda/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | **To test:** `raco test interp.rkt` 10 | 11 | -------------------------------------------------------------------------------- /fraud/README.md: -------------------------------------------------------------------------------- 1 | # Fraud 2 | 3 | This repository contains the interpreter for the Fraud language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/08-let-bindings/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | **To test:** `raco test interp.rkt` 10 | 11 | -------------------------------------------------------------------------------- /arithmetic/README.md: -------------------------------------------------------------------------------- 1 | # Arithmetic 2 | 3 | This repository contains the interpreter for the Arithmetic language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/04-arithmetic/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | **To test:** `raco test interp.rkt` 10 | -------------------------------------------------------------------------------- /fraud-subst/README.md: -------------------------------------------------------------------------------- 1 | # Fraud 2 | 3 | This repository contains the interpreter for the Fraud language. 4 | 5 | [Lecture notes](https://sankhs.com/eecs662/notes/08-let-bindings/) 6 | 7 | **To run:** `racket -t main.rkt -m example.rkt` 8 | 9 | **To test:** `raco test interp.rkt` 10 | 11 | -------------------------------------------------------------------------------- /con/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Val UnOp BinOp If) 4 | 5 | ;; type Expr = 6 | ;; | (Val v) 7 | ;; | (UnOp u e) 8 | ;; | (BinOp b e e) 9 | ;; | (If e e e) 10 | (struct Val (v) #:prefab) 11 | (struct UnOp (u e) #:prefab) 12 | (struct BinOp (b e1 e2) #:prefab) 13 | (struct If (e1 e2 e3) #:prefab) 14 | -------------------------------------------------------------------------------- /con/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | (define (main fn) 8 | (let ([p (open-input-file fn)]) 9 | (begin 10 | (read-line p) ;; ignore #lang racket line 11 | (println (interp (parse (read p)))) 12 | (close-input-port p)))) 13 | -------------------------------------------------------------------------------- /amount/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | (define (main fn) 8 | (let ([p (open-input-file fn)]) 9 | (begin 10 | (read-line p) ;; ignore #lang racket line 11 | (println (interp (parse (read p)))) 12 | (close-input-port p)))) 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # EECS 662 Interpreters 2 | 3 | This repository contains all the interpreters developed during the EECS 662: Programming languages class. 4 | 5 | Each folder contains its individual README pointing to usage instructions and lecture notes. 6 | 7 | **Website:** [https://sankhs.com/eecs662](https://sankhs.com/eecs662) 8 | -------------------------------------------------------------------------------- /arithmetic/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | (define (main fn) 8 | (let ([p (open-input-file fn)]) 9 | (begin 10 | (read-line p) ;; ignore #lang racket line 11 | (println (interp (parse (read p)))) 12 | (close-input-port p)))) 13 | -------------------------------------------------------------------------------- /defend/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | (define (main fn) 8 | (let ([p (open-input-file fn)]) 9 | (begin 10 | (read-line p) ;; ignore #lang racket line 11 | (println (interp-err (parse (read p)))) 12 | (close-input-port p)))) 13 | -------------------------------------------------------------------------------- /fraud/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | (define (main fn) 8 | (let ([p (open-input-file fn)]) 9 | (begin 10 | (read-line p) ;; ignore #lang racket line 11 | (println (interp-err (parse (read p)))) 12 | (close-input-port p)))) 13 | -------------------------------------------------------------------------------- /fraud-subst/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | (define (main fn) 8 | (let ([p (open-input-file fn)]) 9 | (begin 10 | (read-line p) ;; ignore #lang racket line 11 | (println (interp-err (parse (read p)))) 12 | (close-input-port p)))) 13 | -------------------------------------------------------------------------------- /defend/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Val UnOp BinOp If Err Err?) 4 | 5 | ;; type Expr = 6 | ;; | (Val v) 7 | ;; | (UnOp u e) 8 | ;; | (BinOp b e e) 9 | ;; | (If e e e) 10 | (struct Val (v) #:prefab) 11 | (struct UnOp (u e) #:prefab) 12 | (struct BinOp (b e1 e2) #:prefab) 13 | (struct If (e1 e2 e3) #:prefab) 14 | 15 | (struct Err (err) #:prefab) 16 | -------------------------------------------------------------------------------- /fraud/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Val UnOp BinOp If Err Err? Let Var) 4 | 5 | ;; type Expr = 6 | ;; | (Val v) 7 | ;; | (UnOp u e) 8 | ;; | (BinOp b e e) 9 | ;; | (If e e e) 10 | (struct Val (v) #:prefab) 11 | (struct Var (x) #:prefab) 12 | (struct UnOp (u e) #:prefab) 13 | (struct BinOp (b e1 e2) #:prefab) 14 | (struct If (e1 e2 e3) #:prefab) 15 | (struct Let (x e1 e2) #:prefab) 16 | 17 | (struct Err (err) #:prefab) 18 | -------------------------------------------------------------------------------- /fraud-subst/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Val UnOp BinOp If Err Err? Let Var) 4 | 5 | ;; type Expr = 6 | ;; | (Val v) 7 | ;; | (UnOp u e) 8 | ;; | (BinOp b e e) 9 | ;; | (If e e e) 10 | (struct Val (v) #:prefab) 11 | (struct Var (x) #:prefab) 12 | (struct UnOp (u e) #:prefab) 13 | (struct BinOp (b e1 e2) #:prefab) 14 | (struct If (e1 e2 e3) #:prefab) 15 | (struct Let (x e1 e2) #:prefab) 16 | 17 | (struct Err (err) #:prefab) 18 | -------------------------------------------------------------------------------- /amount/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit "ast.rkt" "parser.rkt") 4 | 5 | (provide interp) 6 | 7 | ;; interp :: Expr -> Int 8 | (define (interp e) 9 | (match e 10 | [(Int i) i])) 11 | 12 | (define (check-interp e) 13 | (check-eqv? (interp (parse e)) 14 | (eval e (make-base-namespace)))) 15 | 16 | (module+ test 17 | (check-eqv? (interp (parse 42)) 42) 18 | 19 | ; random testing 20 | (for ([i (in-range 10)]) 21 | (check-interp (random 100000)))) 22 | -------------------------------------------------------------------------------- /arithmetic/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Int s)] 11 | [(list (? unop? u) e) (UnOp u (parse e))] 12 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 13 | [_ (error "Parse error!")])) 14 | 15 | ;; Any -> Boolean 16 | (define (unop? x) 17 | (memq x '(add1 sub1))) 18 | 19 | ;; Any -> Boolean 20 | (define (binop? x) 21 | (memq x '(+ - * /))) 22 | 23 | -------------------------------------------------------------------------------- /gross/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Val UnOp BinOp If Err Err? Let Var App Defn Prog) 4 | 5 | ;; type Expr = 6 | ;; | (Val v) 7 | ;; | (UnOp u e) 8 | ;; | (BinOp b e e) 9 | ;; | (If e e e) 10 | (struct Val (v) #:prefab) 11 | (struct Var (x) #:prefab) 12 | (struct UnOp (u e) #:prefab) 13 | (struct BinOp (b e1 e2) #:prefab) 14 | (struct If (e1 e2 e3) #:prefab) 15 | (struct Let (x e1 e2) #:prefab) 16 | 17 | (struct App (f args) #:prefab) 18 | (struct Defn (f args e) #:prefab) 19 | (struct Prog (defns e) #:prefab) 20 | 21 | (struct Err (err) #:prefab) 22 | -------------------------------------------------------------------------------- /gross/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | ;; read all s-expression until eof 8 | (define (read-all p) 9 | (let ((r (read p))) 10 | (if (eof-object? r) 11 | '() 12 | (cons r (read-all p))))) 13 | 14 | (define (main fn) 15 | (let ([p (open-input-file fn)]) 16 | (begin 17 | (read-line p) ;; ignore #lang racket line 18 | (let ((r (interp-err (parse-prog (read-all p))))) 19 | (unless (void? r) 20 | (println r))) 21 | (close-input-port p)))) 22 | -------------------------------------------------------------------------------- /lambda/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | ;; read all s-expression until eof 8 | (define (read-all p) 9 | (let ((r (read p))) 10 | (if (eof-object? r) 11 | '() 12 | (cons r (read-all p))))) 13 | 14 | (define (main fn) 15 | (let ([p (open-input-file fn)]) 16 | (begin 17 | (read-line p) ;; ignore #lang racket line 18 | (let ((r (interp-err (parse-prog (read-all p))))) 19 | (unless (void? r) 20 | (println r))) 21 | (close-input-port p)))) 22 | -------------------------------------------------------------------------------- /state/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | ;; read all s-expression until eof 8 | (define (read-all p) 9 | (let ((r (read p))) 10 | (if (eof-object? r) 11 | '() 12 | (cons r (read-all p))))) 13 | 14 | (define (main fn) 15 | (let ([p (open-input-file fn)]) 16 | (begin 17 | (read-line p) ;; ignore #lang racket line 18 | (let ((r (interp-err (parse-prog (read-all p))))) 19 | (unless (void? r) 20 | (println r))) 21 | (close-input-port p)))) 22 | -------------------------------------------------------------------------------- /types/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide main) 4 | 5 | (require "parser.rkt" "interp.rkt") 6 | 7 | ;; read all s-expression until eof 8 | (define (read-all p) 9 | (let ((r (read p))) 10 | (if (eof-object? r) 11 | '() 12 | (cons r (read-all p))))) 13 | 14 | (define (main fn) 15 | (let ([p (open-input-file fn)]) 16 | (begin 17 | (read-line p) ;; ignore #lang racket line 18 | (let ((r (interp-err (parse-prog (read-all p))))) 19 | (unless (void? r) 20 | (println r))) 21 | (close-input-port p)))) 22 | -------------------------------------------------------------------------------- /con/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Val s)] 11 | [(? boolean?) (Val s)] 12 | [(list (? unop? u) e) (UnOp u (parse e))] 13 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 14 | [`(if ,e1 ,e2 ,e3) (If (parse e1) (parse e2) (parse e3))] 15 | [_ (error "Parse error!")])) 16 | 17 | ;; Any -> Boolean 18 | (define (unop? x) 19 | (memq x '(add1 sub1 zero?))) 20 | 21 | ;; Any -> Boolean 22 | (define (binop? x) 23 | (memq x '(+ - * / <= and))) 24 | 25 | -------------------------------------------------------------------------------- /defend/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Val s)] 11 | [(? boolean?) (Val s)] 12 | [(list (? unop? u) e) (UnOp u (parse e))] 13 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 14 | [`(if ,e1 ,e2 ,e3) (If (parse e1) (parse e2) (parse e3))] 15 | [_ (error "Parse error!")])) 16 | 17 | ;; Any -> Boolean 18 | (define (unop? x) 19 | (memq x '(add1 sub1 zero?))) 20 | 21 | ;; Any -> Boolean 22 | (define (binop? x) 23 | (memq x '(+ - * / <= and))) 24 | 25 | -------------------------------------------------------------------------------- /fraud/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Val s)] 11 | [(? boolean?) (Val s)] 12 | [(? symbol?) (Var s)] 13 | [(list (? unop? u) e) (UnOp u (parse e))] 14 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 15 | [`(if ,e1 ,e2 ,e3) (If (parse e1) (parse e2) (parse e3))] 16 | [`(let ((,x ,e1)) ,e2) (Let x (parse e1) (parse e2))] 17 | [_ (error "Parse error!")])) 18 | 19 | ;; Any -> Boolean 20 | (define (unop? x) 21 | (memq x '(add1 sub1 zero?))) 22 | 23 | ;; Any -> Boolean 24 | (define (binop? x) 25 | (memq x '(+ - * / <= and))) 26 | 27 | -------------------------------------------------------------------------------- /fraud-subst/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Val s)] 11 | [(? boolean?) (Val s)] 12 | [(? symbol?) (Var s)] 13 | [(list (? unop? u) e) (UnOp u (parse e))] 14 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 15 | [`(if ,e1 ,e2 ,e3) (If (parse e1) (parse e2) (parse e3))] 16 | [`(let ((,x ,e1)) ,e2) (Let x (parse e1) (parse e2))] 17 | [_ (error "Parse error!")])) 18 | 19 | ;; Any -> Boolean 20 | (define (unop? x) 21 | (memq x '(add1 sub1 zero?))) 22 | 23 | ;; Any -> Boolean 24 | (define (binop? x) 25 | (memq x '(+ - * / <= and))) 26 | 27 | -------------------------------------------------------------------------------- /lambda/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Val UnOp BinOp If Err Err? 4 | Let Var App Lam Defn DefnV Prog) 5 | 6 | ; type Values := 7 | ; | (Val v) 8 | ; | (Lam xs e) 9 | (struct Val (v) #:prefab) 10 | (struct Lam (xs e) #:prefab) 11 | 12 | ; type Expr := 13 | ; | Values 14 | ; | (Var x) 15 | ; | (UnOp u e) 16 | ; | (BinOp u e) 17 | ; | (If e e e) 18 | ; | (Let x e e) 19 | ; | (App e e) 20 | (struct Var (x) #:prefab) 21 | (struct UnOp (u e) #:prefab) 22 | (struct BinOp (b e1 e2) #:prefab) 23 | (struct If (e1 e2 e3) #:prefab) 24 | (struct Let (x e1 e2) #:prefab) 25 | (struct App (x args) #:prefab) 26 | 27 | ; type Defn := 28 | ; | (Defn x xs e) 29 | ; | (DefnV x e) 30 | (struct Defn (x xs e) #:prefab) 31 | (struct DefnV (x e) #:prefab) 32 | 33 | ; type Prog := (Prog Defns Expr) 34 | (struct Prog (defns e) #:prefab) 35 | 36 | (struct Err (err) #:prefab) 37 | -------------------------------------------------------------------------------- /types/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Val UnOp BinOp If Err Err? 4 | Let Var App Lam List Map 5 | T UnionT FnT ParamT) 6 | 7 | ; type Values := 8 | ; | (Val v) 9 | ; | (Lam xs e) 10 | (struct Val (v) #:prefab) 11 | (struct Lam (xts t e) #:prefab) 12 | 13 | ; type Expr := 14 | ; | Values 15 | ; | (Var x) 16 | ; | (UnOp u e) 17 | ; | (BinOp u e) 18 | ; | (If e e e) 19 | ; | (Let x e e) 20 | ; | (App e e) 21 | ; | (List es) 22 | (struct Var (x) #:prefab) 23 | (struct UnOp (u e) #:prefab) 24 | (struct BinOp (b e1 e2) #:prefab) 25 | (struct If (e1 e2 e3) #:prefab) 26 | (struct Let (x t e1 e2) #:prefab) 27 | (struct App (x args) #:prefab) 28 | (struct List (es) #:prefab) 29 | (struct Map (e1 e2) #:prefab) 30 | 31 | (struct Err (err) #:prefab) 32 | 33 | (struct T (t) #:prefab) ; int | bool 34 | (struct UnionT (t1 t2) #:prefab) ; T U T 35 | (struct ParamT (b p) #:prefab) ; B

36 | (struct FnT (args ret) #:prefab) ; T -> T 37 | -------------------------------------------------------------------------------- /gross/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse-prog) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Val s)] 11 | [(? boolean?) (Val s)] 12 | [(? symbol?) (Var s)] 13 | [(list (? unop? u) e) (UnOp u (parse e))] 14 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 15 | [`(if ,e1 ,e2 ,e3) (If (parse e1) (parse e2) (parse e3))] 16 | [`(let ((,x ,e1)) ,e2) (Let x (parse e1) (parse e2))] 17 | [`(,(? symbol? f) ,@args) (App f (map parse args))] 18 | [_ (error "Parse error!")])) 19 | 20 | ;; S-Expr -> Defn 21 | (define (parse-defn s) 22 | (match s 23 | [`(define (,(? symbol? f) ,@args) ,e) (Defn f args (parse e))] 24 | [_ (error "parse error!")])) 25 | 26 | ;; List S-Expr -> Prog 27 | (define (parse-prog s) 28 | (match s 29 | [(cons e '()) (Prog '() (parse e))] 30 | [(cons defn rest) (match (parse-prog rest) 31 | [(Prog d e) (Prog (cons (parse-defn defn) d) e)])])) 32 | 33 | ;; Any -> Boolean 34 | (define (unop? x) 35 | (memq x '(add1 sub1 zero?))) 36 | 37 | ;; Any -> Boolean 38 | (define (binop? x) 39 | (memq x '(+ - * / <= and))) 40 | 41 | -------------------------------------------------------------------------------- /state/ast.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide Val UnOp BinOp If Err Err? 4 | Let Var App Lam Defn DefnV Prog 5 | Seq New Deref Set!) 6 | 7 | ; type Values := 8 | ; | (Val v) 9 | ; | (Lam xs e) 10 | (struct Val (v) #:prefab) 11 | (struct Lam (xs e) #:prefab) 12 | 13 | ; type Expr := 14 | ; | Values 15 | ; | (Var x) 16 | ; | (UnOp u e) 17 | ; | (BinOp u e) 18 | ; | (If e e e) 19 | ; | (Let x e e) 20 | ; | (App e e) 21 | ; | (Seq es) 22 | ; | (New e) 23 | ; | (Deref e) 24 | ; | (Set e1 e2) 25 | (struct Var (x) #:prefab) 26 | (struct UnOp (u e) #:prefab) 27 | (struct BinOp (b e1 e2) #:prefab) 28 | (struct If (e1 e2 e3) #:prefab) 29 | (struct Let (x e1 e2) #:prefab) 30 | (struct App (x args) #:prefab) 31 | (struct Seq (es) #:prefab) 32 | (struct New (e) #:prefab) 33 | (struct Deref (e) #:prefab) 34 | (struct Set! (e1 e2) #:prefab) 35 | 36 | ; type Defn := 37 | ; | (Defn x xs e) 38 | ; | (DefnV x e) 39 | (struct Defn (x xs e) #:prefab) 40 | (struct DefnV (x e) #:prefab) 41 | 42 | ; type Prog := (Prog Defns Expr) 43 | (struct Prog (defns e) #:prefab) 44 | 45 | (struct Err (err) #:prefab) 46 | -------------------------------------------------------------------------------- /con/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit "ast.rkt" "parser.rkt") 4 | 5 | (provide interp) 6 | 7 | ;; interp :: Expr -> Int 8 | (define (interp e) 9 | (match e 10 | [(Val v) v] 11 | [(UnOp u e) (interp-unop u e)] 12 | [(BinOp b e1 e2) (interp-binop b e1 e2)] 13 | [(If e1 e2 e3) (interp-if e1 e2 e3)])) 14 | 15 | (define (interp-unop u e) 16 | (match u 17 | ['add1 (add1 (interp e))] 18 | ['sub1 (sub1 (interp e))] 19 | ['zero? (match (interp e) 20 | [0 #t] 21 | [_ #f])])) 22 | 23 | (define (interp-binop b e1 e2) 24 | (match b 25 | ['+ (+ (interp e1) (interp e2))] 26 | ['- (- (interp e1) (interp e2))] 27 | ['* (* (interp e1) (interp e2))] 28 | ['/ (quotient (interp e1) (interp e2))] 29 | ['<= (<= (interp e1) (interp e2))] 30 | ['and (match (interp e1) 31 | [#f #f] 32 | [? (interp e2)])])) 33 | 34 | (define (interp-if e1 e2 e3) 35 | (match (interp e1) 36 | [#f (interp e3)] 37 | [_ (interp e2)])) 38 | 39 | (module+ test 40 | (check-eqv? (interp (parse '(+ 42 (sub1 34)))) 75) 41 | (check-eqv? (interp (parse '(zero? (- 5 (sub1 6))))) #t) 42 | (check-eqv? (interp (parse '(if (zero? 0) (add1 5) (sub1 5)))) 6)) 43 | -------------------------------------------------------------------------------- /arithmetic/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit "ast.rkt" "parser.rkt") 4 | 5 | (provide interp) 6 | 7 | ;; interp :: Expr -> Int 8 | (define (interp e) 9 | (match e 10 | [(Int i) i] 11 | [(UnOp u e) (interp-unop u (interp e))] 12 | [(BinOp b e1 e2) (interp-binop b (interp e1) (interp e2))])) 13 | 14 | (define (interp-unop u i) 15 | (match u 16 | ['add1 (add1 i)] 17 | ['sub1 (sub1 i)])) 18 | 19 | (define (interp-binop b i1 i2) 20 | (match b 21 | ['+ (+ i1 i2)] 22 | ['- (- i1 i2)] 23 | ['* (* i1 i2)] 24 | ['/ (/ i1 i2)])) 25 | 26 | 27 | (define (check-interp e) 28 | (check-eqv? (interp (parse e)) 29 | (eval e (make-base-namespace)))) 30 | 31 | (define (random-expr) 32 | (contract-random-generate 33 | (flat-rec-contract b 34 | (list/c 'add1 b) 35 | (list/c 'sub1 b) 36 | (list/c '+ b b) 37 | (list/c '- b b) 38 | (list/c '* b b) 39 | (list/c '/ b b) 40 | (integer-in #f #f)))) 41 | 42 | (module+ test 43 | (check-eqv? (interp (parse '(- (sub1 45) (add1 -8)))) 51) 44 | 45 | ; random testing 46 | (for ([i (in-range 10)]) 47 | (check-interp (random-expr)))) 48 | -------------------------------------------------------------------------------- /lambda/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse-prog) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Val s)] 11 | [(? boolean?) (Val s)] 12 | [(? symbol?) (Var s)] 13 | [(list (? unop? u) e) (UnOp u (parse e))] 14 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 15 | [`(if ,e1 ,e2 ,e3) (If (parse e1) (parse e2) (parse e3))] 16 | [`(let ((,x ,e1)) ,e2) (Let x (parse e1) (parse e2))] 17 | [`(lambda (,@xs) ,e) (Lam xs (parse e))] 18 | [`(λ (,@xs) ,e) (Lam xs (parse e))] 19 | [(cons e es) (App (parse e) (map parse es))] 20 | [_ (error "Parse error!")])) 21 | 22 | ;; S-Expr -> Defns 23 | (define (parse-defn s) 24 | (match s 25 | [`(define (,(? symbol? f) ,@xs) ,e) (Defn f xs (parse e))] 26 | [`(define ,(? symbol? x) ,e) (DefnV x (parse e))] 27 | [_ (error "parse error!")])) 28 | 29 | ;; List S-Expr -> Prog 30 | (define (parse-prog s) 31 | (match s 32 | [(cons e '()) (Prog '() (parse e))] 33 | [(cons defn rest) (match (parse-prog rest) 34 | [(Prog d e) (Prog (cons (parse-defn defn) d) e)])])) 35 | 36 | ;; Any -> Boolean 37 | (define (unop? x) 38 | (memq x '(add1 sub1 zero?))) 39 | 40 | ;; Any -> Boolean 41 | (define (binop? x) 42 | (memq x '(+ - * / <= and))) 43 | -------------------------------------------------------------------------------- /state/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse-prog) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Val s)] 11 | [(? boolean?) (Val s)] 12 | [(? symbol?) (Var s)] 13 | [(list (? unop? u) e) (UnOp u (parse e))] 14 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 15 | [`(if ,e1 ,e2 ,e3) (If (parse e1) (parse e2) (parse e3))] 16 | [`(let ((,x ,e1)) ,e2) (Let x (parse e1) (parse e2))] 17 | [`(lambda (,@xs) ,e) (Lam xs (parse e))] 18 | [`(λ (,@xs) ,e) (Lam xs (parse e))] 19 | [`(begin ,@es) (Seq (map parse es))] 20 | [`(new ,e) (New (parse e))] 21 | [`(deref ,e) (Deref (parse e))] 22 | [`(set! ,e1 ,e2) (Set! (parse e1) (parse e2))] 23 | [(cons e es) (App (parse e) (map parse es))] 24 | [_ (error "Parse error!")])) 25 | 26 | ;; S-Expr -> Defns 27 | (define (parse-defn s) 28 | (match s 29 | [`(define (,(? symbol? f) ,@xs) ,e) (Defn f xs (parse e))] 30 | [`(define ,(? symbol? x) ,e) (DefnV x (parse e))] 31 | [_ (error "parse error!")])) 32 | 33 | ;; List S-Expr -> Prog 34 | (define (parse-prog s) 35 | (match s 36 | [(cons e '()) (Prog '() (parse e))] 37 | [(cons defn rest) (match (parse-prog rest) 38 | [(Prog d e) (Prog (cons (parse-defn defn) d) e)])])) 39 | 40 | ;; Any -> Boolean 41 | (define (unop? x) 42 | (memq x '(add1 sub1 zero?))) 43 | 44 | ;; Any -> Boolean 45 | (define (binop? x) 46 | (memq x '(+ - * / <= and))) 47 | -------------------------------------------------------------------------------- /state/rewriter.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt" "parser.rkt") 4 | 5 | ;; Prog -> List Int 6 | (define (find-ints e) 7 | (match e 8 | [(Val v) (if (integer? v) 9 | (list v) 10 | '())] 11 | [(Var x) '()] 12 | [(UnOp u e) (find-ints e)] 13 | [(BinOp b e1 e2) (append (find-ints e1) (find-ints e2))] 14 | [(If e1 e2 e3) (append (find-ints e1) (find-ints e2) (find-ints e3))] 15 | [(Let x e1 e2) (append (find-ints e1) (find-ints e2))] 16 | [(Lam xs e) (find-ints e)] 17 | [(Defn x xs e) (find-ints e)] 18 | [(DefnV x e) (find-ints e)] 19 | [(App e es) (flatten (append (find-ints e) (map find-ints es)))] 20 | [(Prog ds e) (flatten (append (find-ints e) (map find-ints ds)))])) 21 | 22 | ;; Prog -> Prog 23 | (define (optimize e) 24 | (match e 25 | [(Val v) (Val v)] 26 | [(Var x) (Var x)] 27 | [(UnOp u e) (UnOp u (optimize e))] 28 | [(BinOp b e1 e2) (optimize-binop b (optimize e1) (optimize e2))] 29 | [(If e1 e2 e3) (If (optimize e1) (optimize e2) (optimize e3))] 30 | [(Let x e1 e2) (App (Lam x (optimize e2)) (list (optimize e1)))] 31 | [(Lam xs e) (Lam xs (optimize e))] 32 | [(Defn x xs e) (Defn x xs (optimize e))] 33 | [(DefnV x e) (DefnV x (optimize e))] 34 | [(App e es) (App (optimize e) (map optimize es))] 35 | [(Prog ds e) (Prog (map optimize ds) (optimize e))])) 36 | 37 | (define (optimize-binop b e1 e2) 38 | (match b 39 | ['- (cond 40 | ;; e - e == 0 41 | [(equal? e1 e2) (Val 0)] 42 | ;; e - 0 == e 43 | [(equal? e2 (Val 0)) e1] 44 | [else (BinOp b e1 e2)])] 45 | [_ (BinOp b e1 e2)])) -------------------------------------------------------------------------------- /types/parser.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt") 4 | 5 | (provide parse) 6 | 7 | ;; S-Expr -> Expr 8 | (define (parse s) 9 | (match s 10 | [(? integer?) (Val s)] 11 | [(? boolean?) (Val s)] 12 | [(? symbol?) (Var s)] 13 | [(list (? unop? u) e) (UnOp u (parse e))] 14 | [(list (? binop? b) e1 e2) (BinOp b (parse e1) (parse e2))] 15 | [`(if ,e1 ,e2 ,e3) (If (parse e1) (parse e2) (parse e3))] 16 | [`(let ((,x : ,ty ,e1)) ,e2) (Let x (parse-type ty) (parse e1) (parse e2))] 17 | [`(lambda (,@xts) : ,t ,e) (Lam (parse-xts xts) (parse-type t) (parse e))] 18 | [`(λ (,@xts) : ,t ,e) (Lam (parse-xts xts) (parse-type t) (parse e))] 19 | [`(list ,@es) (List (map parse es))] 20 | [`(map ,e1 ,e2) (Map (parse e1) (parse e2))] 21 | [(cons e es) (App (parse e) (map parse es))] 22 | [_ (error "Parse error!")])) 23 | 24 | (define (parse-xts xts) 25 | (match xts 26 | ['() '()] 27 | [`(,x : ,t) (cons (list x (parse-type t)) '())] 28 | [`(,x : ,t ,@rest) (cons (list x (parse-type t)) (parse-xts rest))])) 29 | 30 | (define (parse-type t) 31 | (match t 32 | ['int (T 'int)] 33 | ['bool (T 'bool)] 34 | ['list (T 'list)] 35 | [`(U ,t1 ,t2) (UnionT (parse-type t1) (parse-type t2))] 36 | [`(-> ,@ts ,ret) (FnT (map parse-type ts) (parse-type ret))] 37 | [`(,bt ,pt) (ParamT (parse-type bt) (parse-type pt))] 38 | [_ (error "Unhandled type")])) 39 | 40 | ;; Any -> Boolean 41 | (define (unop? x) 42 | (memq x '(add1 sub1 zero?))) 43 | 44 | ;; Any -> Boolean 45 | (define (binop? x) 46 | (memq x '(+ - * / <= and))) 47 | -------------------------------------------------------------------------------- /defend/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit "ast.rkt" "parser.rkt") 4 | 5 | (provide interp-err) 6 | 7 | ;; interp-err :: Expr -> Val or Err 8 | (define (interp-err e) 9 | (with-handlers ([Err? (λ (err) err)]) 10 | (interp e))) 11 | 12 | ;; interp :: Expr -> Val 13 | (define (interp e) 14 | (match e 15 | [(Val v) v] 16 | [(UnOp u e) (interp-unop u e)] 17 | [(BinOp b e1 e2) (interp-binop b e1 e2)] 18 | [(If e1 e2 e3) (interp-if e1 e2 e3)])) 19 | 20 | ;; interp-unop :: UnOp -> Val 21 | (define (interp-unop u e) 22 | (match u 23 | ['add1 (match (interp e) 24 | [(? integer? i) (add1 i)] 25 | [_ (raise (Err "add1 expects int"))])] 26 | ['sub1 (match (interp e) 27 | [(? integer? i) (sub1 i)] 28 | [_ (raise (Err "sub1 expects int"))])] 29 | ['zero? (match (interp e) 30 | [0 #t] 31 | [_ #f])])) 32 | 33 | ;; interp-binop :: BinOp -> Val 34 | (define (interp-binop b e1 e2) 35 | (match b 36 | ['+ (match* ((interp e1) (interp e2)) 37 | [((? integer? i1) (? integer? i2)) (+ i1 i2)] 38 | [(_ _) (raise (Err "+ requires int"))])] 39 | ['- (match* ((interp e1) (interp e2)) 40 | [((? integer? i1) (? integer? i2)) (- i1 i2)] 41 | [(_ _) (raise (Err "- requires int"))])] 42 | ['* (match* ((interp e1) (interp e2)) 43 | [((? integer? i1) (? integer? i2)) (* i1 i2)] 44 | [(_ _) (raise (Err "* requires int"))])] 45 | ['/ (match* ((interp e1) (interp e2)) 46 | [((? integer? i1) (? integer? i2)) (if (eq? i2 0) 47 | (raise (Err "division by 0 not allowed")) 48 | (quotient i1 i2))] 49 | [(_ _) (raise (Err "/ requires int"))])] 50 | ['<= (match* ((interp e1) (interp e2)) 51 | [((? integer? i1) (? integer? i2)) (<= i1 i2)] 52 | [(_ _) (raise (Err "<= requires int"))])] 53 | ['and (match (interp e1) 54 | [#f #f] 55 | [? (interp e2)])])) 56 | 57 | ;; interp-if :: If -> Val 58 | (define (interp-if e1 e2 e3) 59 | (match (interp e1) 60 | [#f (interp e3)] 61 | [_ (interp e2)])) 62 | 63 | (module+ test 64 | (check-equal? (interp-err (parse '(+ 42 (sub1 34)))) 75) 65 | (check-equal? (interp-err (parse '(zero? (- 5 (sub1 6))))) #t) 66 | (check-equal? (interp-err (parse '(if (zero? 0) (add1 5) (sub1 5)))) 6) 67 | (check-equal? (interp-err (parse '(add1 (+ 3 #f)))) 68 | (Err "+ requires int")) 69 | (check-equal? (interp-err (parse '(add1 (and #t #t)))) 70 | (Err "add1 expects int")) 71 | (check-equal? (interp-err (parse '(/ 5 (sub1 1)))) 72 | (Err "division by 0 not allowed"))) 73 | -------------------------------------------------------------------------------- /types/type.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt" "parser.rkt") 4 | 5 | (provide tc) 6 | 7 | ;; tc :: TEnv -> Expr -> Type 8 | (define (tc TE e) 9 | (match e 10 | [(Val v) (tc-val v)] 11 | [(Var x) (lookup TE x)] 12 | [(UnOp u e) (tc-unop TE u e)] 13 | [(BinOp b e1 e2) (tc-binop TE b e1 e2)] 14 | [(If e1 e2 e3) (tc-if TE e1 e2 e3)] 15 | [(Let x t e1 e2) (tc-let TE x t e1 e2)] 16 | [(Lam xts t e) (tc-lam TE xts t e)] 17 | [(List es) (tc-list TE es)] 18 | [(Map e1 e2) (tc-map TE e1 e2)] 19 | [(App e es) (tc-app TE e es)])) 20 | 21 | (define (tc-val v) 22 | (match v 23 | [(? integer?) (T 'int)] 24 | [(? boolean?) (T 'bool)] 25 | [_ (error "Unexpected value")])) 26 | 27 | (define (tc-unop TE u e) 28 | (match* (u (tc TE e)) 29 | [('add1 (T 'int)) (T 'int)] 30 | [('sub1 (T 'int)) (T 'int)] 31 | [('zero? (T 'int)) (T 'bool)] 32 | [(_ _) (error "Type error!")])) 33 | 34 | (define (tc-binop TE b e1 e2) 35 | (match* (b (tc TE e1) (tc TE e2)) 36 | [('+ (T 'int) (T 'int)) (T 'int)] 37 | [('- (T 'int) (T 'int)) (T 'int)] 38 | [('* (T 'int) (T 'int)) (T 'int)] 39 | [('/ (T 'int) (T 'int)) (T 'int)] 40 | [('<= (T 'int) (T 'int)) (T 'bool)] 41 | [('and (T 'bool) (T 'bool)) (T 'bool)] 42 | [(_ _ _) (error "Type error!")])) 43 | 44 | (define (tc-if TE e1 e2 e3) 45 | (match* ((tc TE e1) (tc TE e2) (tc TE e3)) 46 | [((T 'bool) t2 t3) (union t2 t3)] 47 | [(_ _ _) (error "Type error!")])) 48 | 49 | (define (tc-let TE x t e1 e2) 50 | (if (equal? (tc TE e1) t) 51 | (tc (store TE x t) e2) 52 | (error "Type error!"))) 53 | 54 | (define (tc-lam TE xts t e) 55 | (if (equal? (tc (append xts TE) e) t) 56 | (FnT (map last xts) t) 57 | (error "Type error!"))) 58 | 59 | (define (tc-app TE e es) 60 | (match (tc TE e) 61 | [(FnT args ret) (if (equal? args (map (λ (e) (tc TE e)) es)) 62 | ret 63 | (error "Type error!"))] 64 | [_ (error "Type error!")])) 65 | 66 | (define (tc-list TE es) 67 | (let ((ts (map (λ (e) (tc TE e)) es))) 68 | (ParamT (T 'list) (foldl union (first ts) ts)))) 69 | 70 | (define (tc-map TE e1 e2) 71 | (match* ((tc TE e1) (tc TE e2)) 72 | [((FnT (list xt) ret) (ParamT (T 'list) p)) (if (equal? xt p) 73 | (ParamT (T 'list) ret) 74 | (error "Type error!"))] 75 | [(_ _) (error "Type error!")])) 76 | 77 | (define zip (lambda (l1 l2) (map list l1 l2))) 78 | 79 | (define (union t1 t2) 80 | (if (equal? t1 t2) 81 | t1 82 | (UnionT t1 t2))) 83 | 84 | ;; store :: TEnv -> Symbol -> Type -> Env 85 | (define (store TE x t) 86 | (cons (list x t) TE)) 87 | 88 | ;; lookup :: Defn -> TEnv -> Symbol -> Type 89 | (define (lookup TE x) 90 | (match TE 91 | ['() (raise (Err (string-append "Unbound identifier: " 92 | (symbol->string x))))] 93 | [(cons (list y val) rest) (if (equal? x y) val 94 | (lookup rest x))])) 95 | 96 | (module+ test 97 | (require rackunit) 98 | 99 | (check-equal? (tc '() (parse '(let ((x : int 5)) 100 | (+ x 5)))) (T 'int)) 101 | 102 | 103 | (check-equal? (tc '() (parse '((λ (x : int y : int) : int 104 | (+ x y)) 4 5))) (T 'int))) 105 | -------------------------------------------------------------------------------- /lambda/tests.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit "interp.rkt" "parser.rkt" "ast.rkt") 4 | 5 | (module+ test 6 | (check-equal? (interp-err (parse-prog '((+ 42 (sub1 34))))) 75) 7 | (check-equal? (interp-err (parse-prog '((zero? (- 5 (sub1 6)))))) #t) 8 | (check-equal? (interp-err (parse-prog '((if (zero? 0) (add1 5) (sub1 5))))) 6) 9 | (check-equal? (interp-err (parse-prog '((add1 (+ 3 #f))))) 10 | (Err "+ requires int")) 11 | (check-equal? (interp-err (parse-prog '((add1 (and #t #t))))) 12 | (Err "add1 expects int")) 13 | (check-equal? (interp-err (parse-prog '((/ 5 (sub1 1))))) 14 | (Err "division by 0 not allowed")) 15 | (check-equal? (interp-err (parse-prog '((let ((x 1)) (+ x 3))))) 4) 16 | (check-equal? (interp-err (parse-prog '((let ((x 1)) 17 | (let ((y 2)) 18 | (+ x y)))))) 3) 19 | (check-equal? (interp-err (parse-prog '((let ((x (add1 6))) 20 | (let ((x (+ 6 x))) 21 | (/ x 2)))))) 6) 22 | (check-equal? (interp-err (parse-prog '((let ((x (add1 6))) 23 | (let ((x (+ 6 x))) 24 | (/ x y)))))) 25 | (Err "Unbound identifier: y")) 26 | 27 | (check-equal? (interp-err (parse-prog '((define (abs x) 28 | (if (<= x 0) (* -1 x) x)) 29 | 30 | (abs -42)))) 42) 31 | 32 | (check-equal? (interp-err (parse-prog '((define (true? x) 33 | (and x y)) 34 | 35 | (let ((y #t)) 36 | (true? #t))))) 37 | (Err "Unbound identifier: y")) 38 | 39 | (check-equal? (interp-err (parse-prog '((define (odd? x) 40 | (if (zero? x) #f 41 | (even? (sub1 x)))) 42 | 43 | (define (even? x) 44 | (if (zero? x) #t 45 | (odd? (sub1 x)))) 46 | 47 | (odd? 45)))) #t) 48 | 49 | (check-equal? (interp-err (parse-prog '((let ((foo (λ (x) (+ x 42)))) 50 | (foo 3))))) 45) 51 | 52 | (check-equal? (interp-err (parse-prog '((define (foo x) 53 | (- x x)) 54 | 55 | (let ((foo (λ (x) (+ x 42)))) 56 | (foo 3))))) 45) 57 | 58 | (check-equal? (interp-err (parse-prog '((define (bar x) 59 | (- x x)) 60 | 61 | (let ((foo (λ (x) (+ x 42)))) 62 | (bar 3))))) 0) 63 | 64 | (check-equal? (interp-err (parse-prog '((define foo 42) 65 | 66 | (+ foo 3)))) 45) 67 | 68 | (check-equal? (interp-err (parse-prog '(((lambda (x) (add1 x)) 4)))) 5) 69 | 70 | (check-equal? (interp-err (parse-prog '((let ([adder (λ (x) (λ (y) (+ x y)))]) 71 | ((adder 3) 4))))) 7) 72 | 73 | (check-equal? (interp-err (parse-prog '((let ([adder (λ (x) (λ (y) (+ x y)))]) 74 | (let ([adder2 (adder 2)]) 75 | (adder2 4)))))) 6) 76 | 77 | (check-equal? (interp-err (parse-prog '((foo 4)))) 78 | (Err "Unbound identifier: foo"))) 79 | -------------------------------------------------------------------------------- /fraud-subst/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit "ast.rkt" "parser.rkt") 4 | 5 | (provide interp-err) 6 | 7 | ;; interp-err :: Expr -> Val or Err 8 | (define (interp-err e) 9 | (with-handlers ([Err? (λ (err) err)]) 10 | (interp e))) 11 | 12 | ;; interp :: Expr -> Val 13 | (define (interp e) 14 | (match e 15 | [(Val v) v] 16 | [(Var x) (raise (Err "unbound identifier"))] 17 | [(UnOp u e) (interp-unop u e)] 18 | [(BinOp b e1 e2) (interp-binop b e1 e2)] 19 | [(If e1 e2 e3) (interp-if e1 e2 e3)] 20 | [(Let x e1 e2) (interp (subst x (Val (interp e1)) e2))])) 21 | 22 | ;; interp-unop :: UnOp -> Val 23 | (define (interp-unop u e) 24 | (match u 25 | ['add1 (match (interp e) 26 | [(? integer? i) (add1 i)] 27 | [_ (raise (Err "add1 expects int"))])] 28 | ['sub1 (match (interp e) 29 | [(? integer? i) (sub1 i)] 30 | [_ (raise (Err "sub1 expects int"))])] 31 | ['zero? (match (interp e) 32 | [0 #t] 33 | [_ #f])])) 34 | 35 | ;; interp-binop :: BinOp -> Val 36 | (define (interp-binop b e1 e2) 37 | (match b 38 | ['+ (match* ((interp e1) (interp e2)) 39 | [((? integer? i1) (? integer? i2)) (+ i1 i2)] 40 | [(_ _) (raise (Err "+ requires int"))])] 41 | ['- (match* ((interp e1) (interp e2)) 42 | [((? integer? i1) (? integer? i2)) (- i1 i2)] 43 | [(_ _) (raise (Err "- requires int"))])] 44 | ['* (match* ((interp e1) (interp e2)) 45 | [((? integer? i1) (? integer? i2)) (* i1 i2)] 46 | [(_ _) (raise (Err "* requires int"))])] 47 | ['/ (match* ((interp e1) (interp e2)) 48 | [((? integer? i1) (? integer? i2)) (if (eq? i2 0) 49 | (raise (Err "division by 0 not allowed")) 50 | (quotient i1 i2))] 51 | [(_ _) (raise (Err "/ requires int"))])] 52 | ['<= (match* ((interp e1) (interp e2)) 53 | [((? integer? i1) (? integer? i2)) (<= i1 i2)] 54 | [(_ _) (raise (Err "<= requires int"))])] 55 | ['and (match (interp e1) 56 | [#f #f] 57 | [? (interp e2)])])) 58 | 59 | ;; interp-if :: If -> Val 60 | (define (interp-if e1 e2 e3) 61 | (match (interp e1) 62 | [#f (interp e3)] 63 | [_ (interp e2)])) 64 | 65 | ;; subst :: Symbol -> Expr -> Expr -> Expr 66 | (define (subst what with in) 67 | (match in 68 | [(Val v) (Val v)] 69 | [(Var x) (if (eq? x what) with (Var x))] 70 | [(UnOp u e) (UnOp u (subst what with e))] 71 | [(BinOp b e1 e2) (BinOp b (subst what with e1) 72 | (subst what with e2))] 73 | [(If e0 e1 e2) (If (subst what with e0) 74 | (subst what with e1) 75 | (subst what with e2))] 76 | [(Let x e1 e2) (if (eq? x what) 77 | (Let x (subst what with e1) e2) 78 | (Let x (subst what with e1) (subst what with e2)))])) 79 | 80 | (module+ test 81 | (check-equal? (interp-err (parse '(+ 42 (sub1 34)))) 75) 82 | (check-equal? (interp-err (parse '(zero? (- 5 (sub1 6))))) #t) 83 | (check-equal? (interp-err (parse '(if (zero? 0) (add1 5) (sub1 5)))) 6) 84 | (check-equal? (interp-err (parse '(add1 (+ 3 #f)))) 85 | (Err "+ requires int")) 86 | (check-equal? (interp-err (parse '(add1 (and #t #t)))) 87 | (Err "add1 expects int")) 88 | (check-equal? (interp-err (parse '(/ 5 (sub1 1)))) 89 | (Err "division by 0 not allowed")) 90 | (check-equal? (interp-err (parse '(let ((x 1)) (+ x 3)))) 4) 91 | (check-equal? (interp-err (parse '(let ((x 1)) 92 | (let ((y 2)) 93 | (+ x y))))) 3) 94 | (check-equal? (interp-err (parse '(let ((x (add1 6))) 95 | (let ((x (+ 6 x))) 96 | (/ x 2))))) 6) 97 | (check-equal? (interp-err (parse '(let ((x (add1 6))) 98 | (let ((x (+ 6 x))) 99 | (/ x y))))) 100 | (Err "unbound identifier")) 101 | ) 102 | -------------------------------------------------------------------------------- /types/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt" "parser.rkt" "type.rkt") 4 | 5 | (provide interp-err) 6 | 7 | ;; interp-err :: Expr -> Val 8 | (define (interp-err e) 9 | (with-handlers ([Err? (λ (err) err)]) 10 | (begin 11 | (tc '() e) 12 | (interp '() e)))) 13 | 14 | ;; interp :: Env -> Expr -> Val 15 | (define (interp E e) 16 | (match e 17 | [(Val v) v] 18 | [(Var x) (lookup E x)] 19 | [(UnOp u e) (interp-unop E u e)] 20 | [(BinOp b e1 e2) (interp-binop E b e1 e2)] 21 | [(If e1 e2 e3) (interp-if E e1 e2 e3)] 22 | [(Let x t e1 e2) (interp (store E x (interp E e1)) e2)] 23 | [(Lam xs t e) (interp-lam E xs e)] 24 | [(List es) (interp-list E es)] 25 | [(Map e1 e2) (interp-map E e1 e2)] 26 | [(App e es) (interp-app E e es)])) 27 | 28 | (define (interp-map E e1 e2) 29 | (map (λ (v) 30 | ((interp E e1) (list v))) 31 | (interp E e2))) 32 | 33 | (define (interp-list E es) 34 | (map (λ (e) (interp E e)) es)) 35 | 36 | ;; interp-lam :: Env -> Vars -> Expr -> Val 37 | (define (interp-lam E xs body) 38 | (λ (aargs) 39 | (interp (append (zip (map first xs) aargs) E) body))) 40 | 41 | ;; interp-app :: Env -> Expr -> Exprs -> Val 42 | (define (interp-app E f es) 43 | (let ([fn (interp E f)] 44 | [args (map (λ (arg) (interp E arg)) es)]) 45 | (fn args))) 46 | 47 | ;; interp-unop :: Env -> UnOp -> Val 48 | (define (interp-unop E u e) 49 | (match u 50 | ['add1 (match (interp E e) 51 | [(? integer? i) (add1 i)] 52 | [_ (raise (Err "add1 expects int"))])] 53 | ['sub1 (match (interp E e) 54 | [(? integer? i) (sub1 i)] 55 | [_ (raise (Err "sub1 expects int"))])] 56 | ['zero? (match (interp E e) 57 | [0 #t] 58 | [_ #f])])) 59 | 60 | ;; interp-binop :: Env -> BinOp -> Expr -> Expr -> Val 61 | (define (interp-binop E b e1 e2) 62 | (match b 63 | ['+ (+ (interp E e1) (interp E e2))] 64 | 65 | ['- (match* ((interp E e1) (interp E e2)) 66 | [((? integer? i1) (? integer? i2)) (- i1 i2)] 67 | [(_ _) (raise (Err "- requires int"))])] 68 | 69 | ['* (match* ((interp E e1) (interp E e2)) 70 | [((? integer? i1) (? integer? i2)) (* i1 i2)] 71 | [(_ _) (raise (Err "* requires int"))])] 72 | 73 | ['/ (match* ((interp E e1) (interp E e2)) 74 | [((? integer? i1) (? integer? i2)) (if (eq? i2 0) 75 | (raise (Err "division by 0 not allowed")) 76 | (quotient i1 i2))] 77 | [(_ _) (raise (Err "/ requires int"))])] 78 | 79 | ['<= (match* ((interp E e1) (interp E e2)) 80 | [((? integer? i1) (? integer? i2)) (<= i1 i2)] 81 | [(_ _) (raise (Err "<= requires int"))])] 82 | 83 | ['and (match (interp E e1) 84 | [#f #f] 85 | [? (interp E e2)])])) 86 | 87 | ;; interp-if :: Env -> Expr -> Expr -> Expr -> Val 88 | (define (interp-if E e1 e2 e3) 89 | (match (interp E e1) 90 | [#f (interp E e3)] 91 | [_ (interp E e2)])) 92 | 93 | (define zip (lambda (l1 l2) (map list l1 l2))) 94 | 95 | ;; store :: Env -> Symbol -> Val -> Env 96 | (define (store E x v) 97 | (cons (list x v) E)) 98 | 99 | ;; lookup :: Env -> Symbol -> Val 100 | (define (lookup E x) 101 | (match E 102 | ['() (raise (Err (string-append "Unbound identifier: " 103 | (symbol->string x))))] 104 | [(cons (list y val) rest) (if (eq? x y) val 105 | (lookup rest x))])) 106 | 107 | (module+ test 108 | (require rackunit) 109 | 110 | (check-equal? (interp-err (parse '((λ (x : (-> int int) y : int) : int 111 | (x y)) (λ (y : int) : int (+ y 5)) 6))) 11) 112 | (check-equal? (interp-err (parse '(let ((l : (list int) (list 1 2 3 0))) 113 | (map (λ (v : int) : int v) l)))) '(1 2 3 0))) 114 | -------------------------------------------------------------------------------- /fraud/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit "ast.rkt" "parser.rkt") 4 | 5 | (provide interp-err) 6 | 7 | ;; interp-err :: Expr -> Val or Err 8 | (define (interp-err e) 9 | (with-handlers ([Err? (λ (err) err)]) 10 | ; '() is the empty environment 11 | (interp '() e))) 12 | 13 | ;; interp :: Env -> Expr -> Val 14 | (define (interp env e) 15 | (match e 16 | [(Val v) v] 17 | [(Var x) (lookup env x)] 18 | [(UnOp u e) (interp-unop env u e)] 19 | [(BinOp b e1 e2) (interp-binop env b e1 e2)] 20 | [(If e1 e2 e3) (interp-if env e1 e2 e3)] 21 | [(Let x e1 e2) (interp 22 | (store env x ; env will be updated 23 | (interp env e1)) ; after e1 is evaled in old env 24 | e2)])) ; e2 evaluated in updated env 25 | 26 | ;; interp-unop :: Env -> UnOp -> Val 27 | (define (interp-unop env u e) 28 | (match u 29 | ['add1 (match (interp env e) 30 | [(? integer? i) (add1 i)] 31 | [_ (raise (Err "add1 expects int"))])] 32 | ['sub1 (match (interp env e) 33 | [(? integer? i) (sub1 i)] 34 | [_ (raise (Err "sub1 expects int"))])] 35 | ['zero? (match (interp env e) 36 | [0 #t] 37 | [_ #f])])) 38 | 39 | ;; interp-binop :: Env -> BinOp -> Val 40 | (define (interp-binop env b e1 e2) 41 | (match b 42 | ['+ (match* ((interp env e1) (interp env e2)) 43 | [((? integer? i1) (? integer? i2)) (+ i1 i2)] 44 | [(_ _) (raise (Err "+ requires int"))])] 45 | ['- (match* ((interp env e1) (interp env e2)) 46 | [((? integer? i1) (? integer? i2)) (- i1 i2)] 47 | [(_ _) (raise (Err "- requires int"))])] 48 | ['* (match* ((interp env e1) (interp env e2)) 49 | [((? integer? i1) (? integer? i2)) (* i1 i2)] 50 | [(_ _) (raise (Err "* requires int"))])] 51 | ['/ (match* ((interp env e1) (interp env e2)) 52 | [((? integer? i1) (? integer? i2)) (if (eq? i2 0) 53 | (raise (Err "division by 0 not allowed")) 54 | (quotient i1 i2))] 55 | [(_ _) (raise (Err "/ requires int"))])] 56 | ['<= (match* ((interp env e1) (interp env e2)) 57 | [((? integer? i1) (? integer? i2)) (<= i1 i2)] 58 | [(_ _) (raise (Err "<= requires int"))])] 59 | ['and (match (interp env e1) 60 | [#f #f] 61 | [? (interp env e2)])])) 62 | 63 | ;; interp-if :: If -> Val 64 | (define (interp-if env e1 e2 e3) 65 | (match (interp env e1) 66 | [#f (interp env e3)] 67 | [_ (interp env e2)])) 68 | 69 | ;; store :: Env -> Symbol -> Val -> Env 70 | (define (store env x val) 71 | (cons (list x val) env)) 72 | 73 | ;; lookup :: Env -> Symbol -> Val 74 | (define (lookup env x) 75 | (match env 76 | ['() (raise (Err "unbound identifier"))] 77 | [(cons (list y val) rest) (if (eq? x y) val 78 | (lookup rest x))])) 79 | 80 | (module+ test 81 | (check-equal? (interp-err (parse '(+ 42 (sub1 34)))) 75) 82 | (check-equal? (interp-err (parse '(zero? (- 5 (sub1 6))))) #t) 83 | (check-equal? (interp-err (parse '(if (zero? 0) (add1 5) (sub1 5)))) 6) 84 | (check-equal? (interp-err (parse '(add1 (+ 3 #f)))) 85 | (Err "+ requires int")) 86 | (check-equal? (interp-err (parse '(add1 (and #t #t)))) 87 | (Err "add1 expects int")) 88 | (check-equal? (interp-err (parse '(/ 5 (sub1 1)))) 89 | (Err "division by 0 not allowed")) 90 | (check-equal? (interp-err (parse '(let ((x 1)) (+ x 3)))) 4) 91 | (check-equal? (interp-err (parse '(let ((x 1)) 92 | (let ((y 2)) 93 | (+ x y))))) 3) 94 | (check-equal? (interp-err (parse '(let ((x (add1 6))) 95 | (let ((x (+ 6 x))) 96 | (/ x 2))))) 6) 97 | (check-equal? (interp-err (parse '(let ((x (add1 6))) 98 | (let ((x (+ 6 x))) 99 | (/ x y))))) 100 | (Err "unbound identifier"))) 101 | -------------------------------------------------------------------------------- /lambda/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt" "parser.rkt") 4 | 5 | (provide interp-err) 6 | 7 | ;; interp-err :: Expr -> Val or Err 8 | (define (interp-err e) 9 | (with-handlers ([Err? (λ (err) err)]) 10 | (interp-prog e))) 11 | 12 | ;; interp :: Defn -> Env -> Expr -> Val 13 | (define (interp D E e) 14 | (match e 15 | [(Val v) v] 16 | [(Var x) (lookup D E x)] 17 | [(UnOp u e) (interp-unop D E u e)] 18 | [(BinOp b e1 e2) (interp-binop D E b e1 e2)] 19 | [(If e1 e2 e3) (interp-if D E e1 e2 e3)] 20 | [(Let x e1 e2) (interp D (store E x (interp D E e1)) e2)] 21 | [(Lam xs e) (interp-lam D E xs e)] 22 | [(Defn x xs e) (interp-lam D '() xs e)] 23 | [(DefnV x e) (interp D '() e)] 24 | [(App e es) (interp-app D E e es)])) 25 | 26 | ;; interp-lam :: Defn -> Env -> Vars -> Expr -> Val 27 | (define (interp-lam D E xs body) 28 | (λ (aargs) 29 | (interp D (append (zip xs aargs) E) body))) 30 | 31 | ;; interp-app :: Defn -> Env -> Expr -> Exprs -> Val 32 | (define (interp-app D E f es) 33 | (let ([fn (interp D E f)] 34 | [args (map (λ (arg) (interp D E arg)) es)]) 35 | (fn args))) 36 | 37 | ;; interp-prog :: Prog -> Val 38 | (define (interp-prog prog) 39 | (match prog 40 | [(Prog D e) (interp D '() e)])) 41 | 42 | ;; interp-unop :: Defn -> Env -> UnOp -> Val 43 | (define (interp-unop D E u e) 44 | (match u 45 | ['add1 (match (interp D E e) 46 | [(? integer? i) (add1 i)] 47 | [_ (raise (Err "add1 expects int"))])] 48 | ['sub1 (match (interp D E e) 49 | [(? integer? i) (sub1 i)] 50 | [_ (raise (Err "sub1 expects int"))])] 51 | ['zero? (match (interp D E e) 52 | [0 #t] 53 | [_ #f])])) 54 | 55 | ;; interp-binop :: Defn -> Env -> BinOp -> Expr -> Expr -> Val 56 | (define (interp-binop D E b e1 e2) 57 | (match b 58 | ['+ (match* ((interp D E e1) (interp D E e2)) 59 | [((? integer? i1) (? integer? i2)) (+ i1 i2)] 60 | [(_ _) (raise (Err "+ requires int"))])] 61 | 62 | ['- (match* ((interp D E e1) (interp D E e2)) 63 | [((? integer? i1) (? integer? i2)) (- i1 i2)] 64 | [(_ _) (raise (Err "- requires int"))])] 65 | 66 | ['* (match* ((interp D E e1) (interp D E e2)) 67 | [((? integer? i1) (? integer? i2)) (* i1 i2)] 68 | [(_ _) (raise (Err "* requires int"))])] 69 | 70 | ['/ (match* ((interp D E e1) (interp D E e2)) 71 | [((? integer? i1) (? integer? i2)) (if (eq? i2 0) 72 | (raise (Err "division by 0 not allowed")) 73 | (quotient i1 i2))] 74 | [(_ _) (raise (Err "/ requires int"))])] 75 | 76 | ['<= (match* ((interp D E e1) (interp D E e2)) 77 | [((? integer? i1) (? integer? i2)) (<= i1 i2)] 78 | [(_ _) (raise (Err "<= requires int"))])] 79 | 80 | ['and (match (interp D E e1) 81 | [#f #f] 82 | [? (interp D E e2)])])) 83 | 84 | ;; interp-if :: Defn -> Env -> Expr -> Expr -> Expr -> Val 85 | (define (interp-if D E e1 e2 e3) 86 | (match (interp D E e1) 87 | [#f (interp D E e3)] 88 | [_ (interp D E e2)])) 89 | 90 | (define zip (lambda (l1 l2) (map list l1 l2))) 91 | 92 | ;; store :: Env -> Symbol -> Val -> Env 93 | (define (store E x v) 94 | (cons (list x v) E)) 95 | 96 | ;; lookup :: Defn -> Env -> Symbol -> Val 97 | (define (lookup D E x) 98 | ; lookup the environment first, then the list of definitions 99 | (match E 100 | ['() (lookup-defn D E D x)] 101 | [(cons (list y val) rest) (if (eq? x y) val 102 | (lookup D rest x))])) 103 | 104 | ;; lookup-defn :: Defn -> Defn -> Symbol -> Val 105 | (define (lookup-defn D E defns x) 106 | (match defns 107 | ['() (raise (Err 108 | (string-append "Unbound identifier: " 109 | (symbol->string x))))] 110 | [(cons (Defn f xs body) rest) (if (eq? f x) 111 | (interp D E (Defn f xs body)) 112 | (lookup-defn D E rest x))] 113 | [(cons (DefnV y e) rest) (if (eq? x y) 114 | (interp D E (DefnV y e)) 115 | (lookup-defn D rest x))])) 116 | -------------------------------------------------------------------------------- /state/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require "ast.rkt" "parser.rkt") 4 | 5 | (provide interp-err) 6 | 7 | ;; interp-err :: Expr -> Val or Err 8 | (define (interp-err e) 9 | (with-handlers ([Err? (λ (err) err)]) 10 | (interp-prog e))) 11 | 12 | ;; interp :: Defn -> Env -> State -> Expr -> (Val, Env) 13 | (define (interp D E S e) 14 | (match e 15 | [(Val v) v] 16 | [(Var x) (lookup D E S x)] 17 | [(UnOp u e) (interp-unop D E S u e)] 18 | [(BinOp b e1 e2) (interp-binop D E S b e1 e2)] 19 | [(If e1 e2 e3) (interp-if D E S e1 e2 e3)] 20 | [(Let x e1 e2) (interp D (store E x (interp D E S e1)) S e2)] 21 | [(Lam xs e) (interp-lam D E S xs e)] 22 | [(Defn x xs e) (interp-lam D '() S xs e)] 23 | [(DefnV x e) (interp D '() S e)] 24 | [(App e es) (interp-app D E S e es)] 25 | [(Seq es) (last (map (λ (e) (interp D E S e)) es))] 26 | [(New e) (interp-new D E S e)] 27 | [(Deref e) (interp-deref D E S e)] 28 | [(Set! e1 e2) (interp-set! D E S e1 e2)])) 29 | 30 | (define (interp-new D E S e) 31 | (let ([loc (gensym)] 32 | [v (interp D E S e)]) 33 | (begin 34 | (hash-set! S loc v) 35 | loc))) 36 | 37 | (define (interp-deref D E S e) 38 | (let ([loc (interp D E S e)]) 39 | (hash-ref S loc))) 40 | 41 | (define (interp-set! D E S e1 e2) 42 | (let ([loc (interp D E S e1)] 43 | [v (interp D E S e2)]) 44 | (begin 45 | (hash-set! S loc v) 46 | v))) 47 | 48 | ;; interp-lam :: Defn -> Env -> Vars -> Expr -> Val 49 | (define (interp-lam D E S xs body) 50 | (λ (aargs) 51 | (interp D (append (zip xs aargs) E) S body))) 52 | 53 | ;; interp-app :: Defn -> Env -> Expr -> Exprs -> Val 54 | (define (interp-app D E S f es) 55 | (let ([fn (interp D E S f)] 56 | [args (map (λ (arg) (interp D E S arg)) es)]) 57 | (fn args))) 58 | 59 | ;; interp-prog :: Prog -> Val 60 | (define (interp-prog prog) 61 | (match prog 62 | [(Prog D e) (interp D '() (make-hash) e)])) 63 | 64 | ;; interp-unop :: Defn -> Env -> UnOp -> Val 65 | (define (interp-unop D E S u e) 66 | (match u 67 | ['add1 (match (interp D E S e) 68 | [(? integer? i) (add1 i)] 69 | [_ (raise (Err "add1 expects int"))])] 70 | ['sub1 (match (interp D E S e) 71 | [(? integer? i) (sub1 i)] 72 | [_ (raise (Err "sub1 expects int"))])] 73 | ['zero? (match (interp D E S e) 74 | [0 #t] 75 | [_ #f])])) 76 | 77 | ;; interp-binop :: Defn -> Env -> BinOp -> Expr -> Expr -> Val 78 | (define (interp-binop D E S b e1 e2) 79 | (match b 80 | ['+ (match* ((interp D E S e1) (interp D E S e2)) 81 | [((? integer? i1) (? integer? i2)) (+ i1 i2)] 82 | [(_ _) (raise (Err "+ requires int"))])] 83 | 84 | ['- (match* ((interp D E S e1) (interp D E S e2)) 85 | [((? integer? i1) (? integer? i2)) (- i1 i2)] 86 | [(_ _) (raise (Err "- requires int"))])] 87 | 88 | ['* (match* ((interp D E S e1) (interp D E S e2)) 89 | [((? integer? i1) (? integer? i2)) (* i1 i2)] 90 | [(_ _) (raise (Err "* requires int"))])] 91 | 92 | ['/ (match* ((interp D E S e1) (interp D E S e2)) 93 | [((? integer? i1) (? integer? i2)) (if (eq? i2 0) 94 | (raise (Err "division by 0 not allowed")) 95 | (quotient i1 i2))] 96 | [(_ _) (raise (Err "/ requires int"))])] 97 | 98 | ['<= (match* ((interp D E S e1) (interp D E S e2)) 99 | [((? integer? i1) (? integer? i2)) (<= i1 i2)] 100 | [(_ _) (raise (Err "<= requires int"))])] 101 | 102 | ['and (match (interp D E S e1) 103 | [#f #f] 104 | [? (interp D E S e2)])])) 105 | 106 | ;; interp-if :: Defn -> Env -> Expr -> Expr -> Expr -> Val 107 | (define (interp-if D E S e1 e2 e3) 108 | (match (interp D E S e1) 109 | [#f (interp D E S e3)] 110 | [_ (interp D E S e2)])) 111 | 112 | (define zip (lambda (l1 l2) (map list l1 l2))) 113 | 114 | ;; store :: Env -> Symbol -> Val -> Env 115 | (define (store E x v) 116 | (cons (list x v) E)) 117 | 118 | ;; lookup :: Defn -> Env -> Symbol -> Val 119 | (define (lookup D E S x) 120 | ; lookup the environment first, then the list of definitions 121 | (match E 122 | ['() (lookup-defn D E S D x)] 123 | [(cons (list y val) rest) (if (eq? x y) val 124 | (lookup D rest S x))])) 125 | 126 | ;; lookup-defn :: Defn -> Defn -> Symbol -> Val 127 | (define (lookup-defn D E S defns x) 128 | (match defns 129 | ['() (raise (Err (string-append "Unbound identifier: " 130 | (symbol->string x))))] 131 | [(cons (Defn f xs body) rest) (if (eq? f x) 132 | (interp D E S (Defn f xs body)) 133 | (lookup-defn D E S rest x))] 134 | [(cons (DefnV y e) rest) (if (eq? x y) 135 | (interp D E S (DefnV y e)) 136 | (lookup-defn D E S rest x))])) 137 | -------------------------------------------------------------------------------- /gross/interp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit "ast.rkt" "parser.rkt") 4 | 5 | (provide interp-err) 6 | 7 | (define zip (lambda (l1 l2) (map list l1 l2))) 8 | 9 | ;; interp-err :: Expr -> Val or Err 10 | (define (interp-err e) 11 | (with-handlers ([Err? (λ (err) err)]) 12 | (interp-prog e))) 13 | 14 | ;; interp :: Defns -> Env -> Expr -> Val 15 | (define (interp defn env e) 16 | (match e 17 | [(Val v) v] 18 | [(Var x) (lookup env x)] 19 | [(UnOp u e) (interp-unop defn env u e)] 20 | [(BinOp b e1 e2) (interp-binop defn env b e1 e2)] 21 | [(If e1 e2 e3) (interp-if defn env e1 e2 e3)] 22 | [(Let x e1 e2) (interp defn 23 | (store env x (interp defn env e1)) 24 | e2)] 25 | [(App f actual) (interp-app defn env f actual)])) 26 | 27 | (define (interp-app defn env f actual-args) 28 | (match (lookup-defn f defn) ; lookup the function defintions 29 | [(cons formal-args body) (let ((interped-args (map (λ (arg) 30 | (interp defn env arg)) 31 | actual-args))) 32 | (interp defn (zip formal-args interped-args) body))])) 33 | 34 | ;; lookup-defn :: Symbol -> Listof Defn -> (Symbols, Expr) 35 | (define (lookup-defn f defns) 36 | (match defns 37 | ['() (raise (Err (string-append "Definition not found: " (symbol->string f))))] 38 | [(cons d rest) (match d 39 | [(Defn name args body) (if (eq? name f) 40 | (cons args body) 41 | (lookup-defn f rest))])])) 42 | 43 | ;; interp-prog :: Prog -> Val 44 | (define (interp-prog prog) 45 | (match prog 46 | ; '() is the empty environment 47 | [(Prog defns e) (interp defns '() e)])) 48 | 49 | ;; interp-unop :: Defns -> Env -> UnOp -> Val 50 | (define (interp-unop defn env u e) 51 | (match u 52 | ['add1 (match (interp defn env e) 53 | [(? integer? i) (add1 i)] 54 | [_ (raise (Err "add1 expects int"))])] 55 | ['sub1 (match (interp defn env e) 56 | [(? integer? i) (sub1 i)] 57 | [_ (raise (Err "sub1 expects int"))])] 58 | ['zero? (match (interp defn env e) 59 | [0 #t] 60 | [_ #f])])) 61 | 62 | ;; interp-binop :: Defns -> Env -> BinOp -> Val 63 | (define (interp-binop defn env b e1 e2) 64 | (match b 65 | ['+ (match* ((interp defn env e1) (interp defn env e2)) 66 | [((? integer? i1) (? integer? i2)) (+ i1 i2)] 67 | [(_ _) (raise (Err "+ requires int"))])] 68 | ['- (match* ((interp defn env e1) (interp defn env e2)) 69 | [((? integer? i1) (? integer? i2)) (- i1 i2)] 70 | [(_ _) (raise (Err "- requires int"))])] 71 | ['* (match* ((interp defn env e1) (interp defn env e2)) 72 | [((? integer? i1) (? integer? i2)) (* i1 i2)] 73 | [(_ _) (raise (Err "* requires int"))])] 74 | ['/ (match* ((interp defn env e1) (interp defn env e2)) 75 | [((? integer? i1) (? integer? i2)) (if (eq? i2 0) 76 | (raise (Err "division by 0 not allowed")) 77 | (quotient i1 i2))] 78 | [(_ _) (raise (Err "/ requires int"))])] 79 | ['<= (match* ((interp defn env e1) (interp defn env e2)) 80 | [((? integer? i1) (? integer? i2)) (<= i1 i2)] 81 | [(_ _) (raise (Err "<= requires int"))])] 82 | ['and (match (interp defn env e1) 83 | [#f #f] 84 | [? (interp defn env e2)])])) 85 | 86 | ;; interp-if :: Defns -> Env -> If -> Val 87 | (define (interp-if defn env e1 e2 e3) 88 | (match (interp defn env e1) 89 | [#f (interp defn env e3)] 90 | [_ (interp defn env e2)])) 91 | 92 | ;; store :: Env -> Symbol -> Val -> Env 93 | (define (store env x val) 94 | (cons (list x val) env)) 95 | 96 | ;; lookup :: Env -> Symbol -> Val 97 | (define (lookup env x) 98 | (match env 99 | ['() (raise (Err (string-append "Unbound identifier: " (symbol->string x))))] 100 | [(cons (list y val) rest) (if (eq? x y) val 101 | (lookup rest x))])) 102 | 103 | (module+ test 104 | (check-equal? (interp-err (parse-prog '((+ 42 (sub1 34))))) 75) 105 | (check-equal? (interp-err (parse-prog '((zero? (- 5 (sub1 6)))))) #t) 106 | (check-equal? (interp-err (parse-prog '((if (zero? 0) (add1 5) (sub1 5))))) 6) 107 | (check-equal? (interp-err (parse-prog '((add1 (+ 3 #f))))) 108 | (Err "+ requires int")) 109 | (check-equal? (interp-err (parse-prog '((add1 (and #t #t))))) 110 | (Err "add1 expects int")) 111 | (check-equal? (interp-err (parse-prog '((/ 5 (sub1 1))))) 112 | (Err "division by 0 not allowed")) 113 | (check-equal? (interp-err (parse-prog '((let ((x 1)) (+ x 3))))) 4) 114 | (check-equal? (interp-err (parse-prog '((let ((x 1)) 115 | (let ((y 2)) 116 | (+ x y)))))) 3) 117 | (check-equal? (interp-err (parse-prog '((let ((x (add1 6))) 118 | (let ((x (+ 6 x))) 119 | (/ x 2)))))) 6) 120 | (check-equal? (interp-err (parse-prog '((let ((x (add1 6))) 121 | (let ((x (+ 6 x))) 122 | (/ x y)))))) 123 | (Err "Unbound identifier: y")) 124 | 125 | (check-equal? (interp-err (parse-prog '((define (abs x) 126 | (if (<= x 0) (* -1 x) x)) 127 | 128 | (abs -42)))) 42) 129 | 130 | (check-equal? (interp-err (parse-prog '((define (true? x) 131 | (and x y)) 132 | 133 | (let ((y #t)) 134 | (true? #t))))) 135 | (Err "Unbound identifier: y")) 136 | 137 | (check-equal? (interp-err (parse-prog '((define (odd? x) 138 | (if (zero? x) #f 139 | (even? (sub1 x)))) 140 | 141 | (define (even? x) 142 | (if (zero? x) #t 143 | (odd? (sub1 x)))) 144 | 145 | (odd? 45)))) #t) 146 | 147 | (check-equal? (interp-err (parse-prog '((foo 4)))) 148 | (Err "Definition not found: foo"))) 149 | --------------------------------------------------------------------------------