aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--HW01.rkt54
-rw-r--r--HW02.rkt35
-rw-r--r--HW03.rkt42
-rw-r--r--HW05a.scm48
-rw-r--r--HW05a_adt.scm61
-rw-r--r--HW05a_rib.scm50
-rw-r--r--hw02.scm156
-rw-r--r--hw03.scm133
-rw-r--r--hw04_bintree.scm191
-rw-r--r--hw04_path.scm21
-rw-r--r--hw05_arith_scanner.scm38
-rw-r--r--hw06.zipbin0 -> 2855 bytes
-rw-r--r--hw06/hw06_alpha.scm52
-rw-r--r--hw06/hw06_combinators.scm21
-rw-r--r--hw06/hw06_eta.scm50
-rw-r--r--hw06_alpha.scm52
-rw-r--r--hw06_combinators.scm21
-rw-r--r--hw06_eta.scm50
-rw-r--r--hw07.scm278
-rw-r--r--hw08.rkt403
-rw-r--r--hw08.scm394
21 files changed, 2150 insertions, 0 deletions
diff --git a/HW01.rkt b/HW01.rkt
new file mode 100644
index 0000000..4885c33
--- /dev/null
+++ b/HW01.rkt
@@ -0,0 +1,54 @@
+#lang scheme
+
+;; circlearea
+;;
+;; find the area of a circle with radius r
+(define
+ (circlearea r)
+ (* 3.142 (expt r 2))
+)
+
+;; between?
+;;
+;; check whether a is between x and y
+(define
+ (between? a x y)
+ (if
+ (or
+ (and (< y a) (> x a)) ;; y < a < x
+ (and (> y a) (< x a)) ;; x < a < y
+ )
+ #t
+ #f
+ )
+)
+
+;; shorter
+;;
+;; returns the list with fewer elements
+(define
+ (shorter a b)
+ (if
+ (< (length a) (length b))
+ a
+ b
+ )
+)
+
+;; righttri?
+;;
+;; checks whether 3 integers can be the side lengths
+;; of a right triangle.
+(define
+ (righttri? a b c)
+ (cond
+ ;; a is largest (b^2 + c^2 = a^2)
+ [ (and (> a b) (> a c)) (= (+ (expt b 2) (expt c 2)) (expt a 2)) ]
+
+ ;; b is largest (a^2 + c^2 = b^2)
+ [ (and (> b a) (> b c)) (= (+ (expt a 2) (expt c 2)) (expt b 2)) ]
+
+ ;; c is largest (a^2 + b^2 = c^2)
+ [ (and (> c a) (> c b)) (= (+ (expt a 2) (expt b 2)) (expt c 2)) ]
+ )
+) \ No newline at end of file
diff --git a/HW02.rkt b/HW02.rkt
new file mode 100644
index 0000000..5e26219
--- /dev/null
+++ b/HW02.rkt
@@ -0,0 +1,35 @@
+#lang scheme
+
+;; invert
+;;
+;; takes a list of 2-lists and returns a list with each
+;; 2-list reversed
+(define
+ (invert list)
+ list
+)
+
+;; vector-index
+;;
+;; returns the zero-based index of the first occurrence of
+;; a parameter in a vector, or -1 if there is no occurrence
+(define
+ (vector-index needle haystack)
+ haystack
+)
+
+;; count-occurrences
+;;
+;; returns the number of occurrences of a parameter in a list
+(define
+ (count-occurrences needle haystack)
+ haystack
+)
+
+;; compose23
+;;
+;;
+(define
+ (compose23 a b c)
+ (a (b c))
+) \ No newline at end of file
diff --git a/HW03.rkt b/HW03.rkt
new file mode 100644
index 0000000..b6310a1
--- /dev/null
+++ b/HW03.rkt
@@ -0,0 +1,42 @@
+#lang scheme
+
+; ------------------------------------------------------------
+; PROGRAM NAME: HW02.rkt
+;
+; DESCRIPTION: Second homework assignment for CSI310
+;
+; AUTHOR: Ben Burwell ; CS 310: Theory of Programming Languages
+; Muhlenberg College
+;
+
+;; ---------
+;; NAME: invert
+;; DESC: takes a list of 2-lists (lists of length 2), and returns a list with each 2-list reversed.
+
+(define invert
+ (lambda (l)
+ (map swap l)))
+
+(define swap
+ (lambda (l)
+ (if (= 2 (length l))
+ (list (cadr l) (car l))
+ (display "Error"))))
+
+;; TEST
+(invert '((2 1) (4 3) (6 5))) ;; should return (1 2) (3 4) (5 6)
+
+
+;; ---------
+;; NAME: compose23
+;; DESC: that takes 1, 2, or 3 procedures and composes them, as specified by the equation:
+;; (compose f g h) = (compose f (compose g h))
+
+(define compose23
+ (lambda funcs
+ (if (= (length funcs) 1)
+ (car funcs)
+ (if (= (length funcs) 2)
+ ((car funcs) (cadr funcs))
+ (if (= (length funcs) 3)
+ ((car funcs (cadr funcs) (caddr funcs)))))))) \ No newline at end of file
diff --git a/HW05a.scm b/HW05a.scm
new file mode 100644
index 0000000..869ceec
--- /dev/null
+++ b/HW05a.scm
@@ -0,0 +1,48 @@
+#lang eopl
+
+;; HW05a - Environments
+;; Part 1: Procedural Implementation
+;;
+;; CSI-310 Programming Languages
+;; Due: 2013-02-25
+;; Name: Ben Burwell
+
+;; empty environment
+(define empty-env
+ (lambda ()
+ (lambda (sym) (eopl:error 'apply-env "No binding for ~s" sym))))
+
+;; helpers
+(define in-sym-list
+ (lambda (item lst)
+ (cond
+ [ (equal? (length lst) 0) #f ]
+ [ (equal? (caar lst) item) #t ]
+ [ else (in-sym-list item (cdr lst)) ]
+ )))
+
+(define get-val
+ (lambda (sym lst)
+ (cond
+ [ (equal? (length lst) 0) 'err ]
+ [ (equal? (caar lst) sym) (cadar lst) ]
+ [ else (get-val sym (cdr lst)) ]
+ )))
+
+;; extend environment
+(define extend-env
+ (lambda (sym-val-lst env)
+ (lambda (sym)
+ (if (in-sym-list sym sym-val-lst)
+ (get-val sym sym-val-lst)
+ (apply-env env sym)))))
+
+;; apply environment
+(define apply-env
+ (lambda (env sym)
+ (env sym)))
+
+;; tests
+(apply-env (extend-env '((a 5) (b 9)) (extend-env '((a 1) (b 2) (c 3)) (empty-env))) 'a)
+(apply-env (extend-env '((a 5) (b 9)) (extend-env '((a 1) (b 2) (c 3)) (empty-env))) 'b)
+(apply-env (extend-env '((a 5) (b 9)) (extend-env '((a 1) (b 2) (c 3)) (empty-env))) 'c) \ No newline at end of file
diff --git a/HW05a_adt.scm b/HW05a_adt.scm
new file mode 100644
index 0000000..5f8bd34
--- /dev/null
+++ b/HW05a_adt.scm
@@ -0,0 +1,61 @@
+#lang eopl
+
+;; HW05a - Environments
+;; Part 2: Abstract Syntax Tree
+;;
+;; CSI-310 Programming Languages
+;; Due: 2013-02-25
+;; Name: Ben Burwell
+
+
+;; helpers and data types
+(define scheme-value?
+ (lambda (a) #t))
+
+(define-datatype env env?
+ (empty-env-record)
+ (extended-env-record
+ (defs (list-of (list-of scheme-value?)))
+ (prev-env env?)))
+
+;; some basics
+(define empty-env
+ (lambda ()
+ (empty-env-record)))
+
+(define extend-env
+ (lambda (defs prev-env)
+ (extended-env-record defs prev-env)))
+
+;; more helpers
+(define def-exists?
+ (lambda (sym defs)
+ (cond
+ [ (equal? (length defs) 0) #f ]
+ [ (equal? (caar defs) sym) #t ]
+ [ else (def-exists? sym (cdr defs)) ]
+ )))
+
+(define get-def
+ (lambda (sym defs)
+ (cond
+ [ (equal? (length defs) 0) 'error ]
+ [ (equal? (caar defs) sym) (cadar defs) ]
+ [ else (get-def sym (cdr defs)) ]
+ )))
+
+;; now the fun stuff
+(define apply-env
+ (lambda (this-env sym)
+ (cases env this-env
+ (empty-env-record
+ ()
+ (eopl:error 'apply-env "No binding for ~s" sym))
+ (extended-env-record
+ (defs prev-env)
+ (if (def-exists? sym defs)
+ (get-def sym defs)
+ (apply-env prev-env sym))))))
+
+;; tests
+(apply-env (extend-env '((a 4) (b 5)) (extend-env '((a 1) (b 2) (c 3)) (empty-env))) 'a) \ No newline at end of file
diff --git a/HW05a_rib.scm b/HW05a_rib.scm
new file mode 100644
index 0000000..e057a8e
--- /dev/null
+++ b/HW05a_rib.scm
@@ -0,0 +1,50 @@
+#lang eopl
+
+;; HW05a - Environments
+;; Part 3: Rib-Cage Implementation
+;;
+;; CSI-310 Programming Languages
+;; Due: 2013-02-25
+;; Name: Ben Burwell
+
+;; empty environment
+(define empty-env
+ (lambda () '(())
+ ))
+
+;; extend environment
+(define extend-env
+ (lambda (sym-val-lst env)
+ (cons sym-val-lst env)))
+
+;; helper
+(define in-sym-list?
+ (lambda (item lst)
+ (cond
+ [ (equal? (length lst) 0) #f ]
+ [ (equal? (caar lst) item) #t ]
+ [ else (in-sym-list? item (cdr lst)) ]
+ )))
+
+(define get-val
+ (lambda (sym lst)
+ (cond
+ [ (equal? (length lst) 0) 'err ]
+ [ (equal? (caar lst) sym) (cadar lst) ]
+ [ else (get-val sym (cdr lst)) ]
+ )))
+
+;; apply environment
+(define apply-env
+ (lambda (env sym)
+ (cond
+ [ (in-sym-list? sym (car env)) (get-val sym (car env)) ]
+ [ (equal? (length (car env)) 0) (eopl:error "No binding for" sym) ]
+ [ else (apply-env (cdr env) sym) ]
+ )))
+
+
+;; tests
+(apply-env (extend-env '((a 5) (b 9)) (extend-env '((a 1) (b 2) (c 3)) (empty-env))) 'a)
+(apply-env (extend-env '((a 5) (b 9)) (extend-env '((a 1) (b 2) (c 3)) (empty-env))) 'b)
+(apply-env (extend-env '((a 5) (b 9)) (extend-env '((a 1) (b 2) (c 3)) (empty-env))) 'c) \ No newline at end of file
diff --git a/hw02.scm b/hw02.scm
new file mode 100644
index 0000000..9f551a4
--- /dev/null
+++ b/hw02.scm
@@ -0,0 +1,156 @@
+#lang scheme
+
+;; PROGRAM NAME: hw02.rkt
+;; DESCRIPTION: Homework 2 for CSI 310
+;; AUTHOR: Ben Burwell
+;; HISTORY: Turned in 2013-01-29
+;; NOTES: When this program runs, a series of expected and
+;; actual results will print out. Compare them to
+;; ensure the code functions properly.
+
+;; ============ PROCEDURE ============
+;; NAME: invert
+;;
+;; DESC:
+;; takes a list of 2-lists and inverts each of the lists
+;; hence, the list
+;; ((2 1) (4 3) (6 5))
+;; will become
+;; ((1 2) (3 4) (5 6))
+
+(define invert
+ (λ (lst)
+ (cond
+ [ (null? lst) null ]
+ [ (not (list? lst)) (display "Invalid Parameters") ]
+ [ (null? (cdr lst)) (list (invert-reverse (car lst))) ]
+ [ else (append (list (invert-reverse (car lst))) (invert (cdr lst))) ] )))
+
+;; a helper function that reverses a 2-list
+;; PRECONDITION: lst is a list of the form (a b)
+;; POSTCONDITION: lst is a list of the form (b a)
+;; ERROR: lst is not a list with 2 elements
+(define invert-reverse
+ (λ (lst)
+ (cond
+ [ (null? lst) null ]
+ [ (not (list? lst)) (display "Invalid Parameters") ]
+ [ (not (equal? (length lst) 2)) (display "Invalid Parameters") ]
+ [ else (list (cadr lst) (car lst)) ] )))
+
+;; ============ TEST CODE ============
+(newline)
+(display "Testing (invert) =========================================")
+(newline)
+
+(display "Expected output: () ")
+(invert '())
+
+(display "Expected output: ((1 2)) ")
+(invert '((2 1)))
+
+(display "Expected output: ((1 2) (3 4) (5 6)) ")
+(invert '((2 1) (4 3) (6 5)))
+
+
+;; ============ PROCEDURE ============
+;; NAME: vector-index
+;;
+;; DESC:
+;; returns the zero-based index of the first
+;; occurence of a parameter in a vector, or
+;; -1 if there is no occurrence.
+(define vector-index
+ (λ (needle haystack)
+ (cond
+ [ (null? needle) (display "Invalid Parameters") ]
+ [ (vector? haystack) (list-index needle (vector->list haystack)) ]
+ [ else (display "Invalid Parameters") ] )))
+
+;; a helper function
+;; PRECONDITION: haystack is a non-nested list (e.g. the result of vector->list)
+(define list-index
+ (λ (needle haystack)
+ (if (null? haystack)
+ -1
+ (if (equal? (car haystack) needle)
+ 0
+ (if (equal? (list-index needle (cdr haystack)) -1)
+ -1
+ (+ 1 (list-index needle (cdr haystack))))))))
+
+;; ============ TEST CODE ============
+(newline)
+(display "Testing (vector-index) ===================================")
+(newline)
+
+(display "Expected output: 2 ")
+(vector-index 3 #(1 2 3 4 5 6 7 8 9))
+
+(display "Expected output: -1 ")
+(vector-index 4 #(1 2 3))
+
+(display "Expected output: -1 ")
+(vector-index 3 #())
+
+
+;; ============ PROCEDURE ============
+;; NAME: count-occurrences
+;;
+;; DESC:
+;; counts the occurrences of needle in haystack
+(define count-occurrences
+ (λ (needle haystack)
+ (cond
+ [ (null? needle) (display "Error: nothing to search for") ]
+ [ (null? haystack) 0 ]
+ [ (list? (car haystack)) (+ (count-occurrences needle (car haystack)) (count-occurrences needle (cdr haystack))) ]
+ [ (equal? (car haystack) needle) (+ 1 (count-occurrences needle (cdr haystack))) ]
+ [ else (count-occurrences needle (cdr haystack)) ] )))
+
+;; ============ TEST CODE ============
+(newline)
+(display "Testing (count-occurrences) ==============================")
+(newline)
+
+(display "Expected output: 10 ")
+(count-occurrences 'a '(a b a c d (((((((((a))))))))) e f a b a a (d e) (a) c (a (a (a)))))
+
+(display "Expected output: 0 ")
+(count-occurrences 'a '())
+
+(display "Expected output: 1 ")
+(count-occurrences 'a '(a))
+
+;; ============ PROCEDURE ============
+;; NAME: compose
+;;
+;; DESC:
+;; takes 1, 2, or 3 procedures and composes them, as specified by the equation:
+;; (compose f g h) = (compose f (compose g h))
+(define compose
+ (λ funcs
+ (cond
+ [ (equal? (length funcs) 1) (car funcs) ]
+ [ (equal? (length funcs) 2) (λ (x) ((car funcs) ((cadr funcs) x))) ]
+ [ (equal? (length funcs) 3) (λ (x) ((car funcs) ((cadr funcs) ((caddr funcs) x)))) ]
+ [ else (display "Invalid parameters") ] )))
+
+;; ============ TEST CODE ============
+(newline)
+(display "Testing (compose) ========================================")
+(newline)
+
+(display "Expected output: 1 ")
+((compose car cdr cdr) '(0 2 1 3))
+
+(display "Expected output: 1 ")
+((compose car) '(1 2 3 4))
+
+(display "Expected output: 1 ")
+((compose car cdr) '(0 1 2 3))
+
+(display "Expected output: 1 ")
+((compose - -) 1)
+
+;; =========== END OF FILE =========== \ No newline at end of file
diff --git a/hw03.scm b/hw03.scm
new file mode 100644
index 0000000..eced079
--- /dev/null
+++ b/hw03.scm
@@ -0,0 +1,133 @@
+#lang scheme
+;; NAME: hw03.scm
+;; AUTHOR: Ben Burwell
+;; DESC: CSI310 - Programming Languages - Homework 3
+;; HISTORY: Created 2013-01-31
+
+;; ========== PROCEDURE ==========
+;; NAME: merge
+;; DESC: returns a sorted list of all of the numbers in
+;; the two parameters
+(define merge
+ (λ (lon1 lon2)
+ (qsort (append lon1 lon2))
+ ))
+
+;; helper function
+;; this is an implementation of quicksort
+(define qsp-helper
+ (λ (all check less more)
+ (cond
+ [ (null? all) (cons less (cons check (cons more '()))) ]
+ [ else (let ((x (car all)))
+ (if (<= x check)
+ (qsp-helper (cdr all) check (cons x less) more)
+ (qsp-helper (cdr all) check less (cons x more)))) ]
+ )))
+
+(define qspartition
+ (λ (lst)
+ (qsp-helper (cdr lst) (car lst) '() '())
+ ))
+
+(define qsort
+ (λ (lst)
+ (cond
+ [ (null? lst) lst ]
+ [ else (let ((list1 (qspartition lst)))
+ (append
+ (qsort (car list1))
+ (cons
+ (cadr list1)
+ (qsort (caddr list1)))
+ )) ]
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (merge) ==========================================================================")
+(newline)
+
+(display "Expected output: (1 2 3 4 5 6) ")
+(merge '(1 3 5) '(2 4 6))
+
+(display "Expected output: (1 2 2 3) ")
+(merge '(1 2) '(2 3))
+
+;; ========== PROCEDURE ==========
+;; NAME: car&cdr
+;; DESC: returns the code for a procedure
+;; that takes a list with the same structure
+;; as slst and returns the value in the
+;; same position as the leftmost occurrence
+;; of s in slst. If s does not occur in
+;; slst then errval is returned.
+(define car&cdr-help
+ (λ (s slst errval var)
+ (cond
+ [ (null? slst) errval ]
+ [ (equal? (car slst) s) (list 'λ '(lst) (list 'car var)) ]
+ [ (and (list? (car slst)) (car&cdr-help s (car slst) errval (list 'car var))) ]
+ [ (car&cdr-help s (cdr slst) errval (list 'cdr var)) ]
+ [ else errval ]
+ )))
+
+(define car&cdr
+ (λ (s slst errval)
+ (cond
+ [ (not (list? slst)) (display "Not a list") ]
+ [ (list? s) (display "Cannot find a list") ]
+ [ else (car&cdr-help s slst errval 'lst) ]
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (car&cdr) ========================================================================")
+(newline)
+
+(display "Expected output: (λ (lst) (car (cdr (cdr lst)))) ")
+(car&cdr 'c '(a b c d) 'fail)
+
+(display "Expected output: pass ")
+(car&cdr 'a '(b c d) 'pass)
+
+
+
+
+;; ========== PROCEDURE ==========
+;; NAME: if->cond
+;; DESC: that takes an if expression and
+;; returns the corresponding cond
+;; expression.
+
+(define if->cond
+ (λ (condlist)
+ (cond
+ [ (equal? 3 (length condlist)) (list 'cond (list 'else (list 'if (cadr condlist) (caddr condlist)))) ]
+ [ (list? (cadddr condlist)) (cons 'cond (ifcondhelper condlist)) ]
+ [ else (list 'cond (list (cadr condlist) (caddr condlist)) (list 'else (cadddr condlist))) ]
+ )))
+
+(define ifcondhelper
+ (λ (condlist)
+ (cond
+ [ (list? (cadddr condlist)) (cons (list (cadr condlist) (caddr condlist)) (ifcondhelper (cadddr condlist))) ]
+ [ else (list (list (cadr condlist) (caddr condlist)) (list 'else (cadddr condlist))) ]
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (if->cond) =======================================================================")
+(newline)
+
+(display "Expected output: (cond (else (if a b))) ")
+(if->cond '(if a b))
+
+(display "Expected output: (cond (a b) (else c)) ")
+(if->cond '(if a b c))
+
+(display "Expected output: (cond (a b) (c d) (else e)) ")
+(if->cond '(if a b (if c d e)))
+
+(display "Expected output: (cond (a (if b c d)) (e f) (else g)) ")
+(if->cond '(if a (if b c d) (if e f g))) \ No newline at end of file
diff --git a/hw04_bintree.scm b/hw04_bintree.scm
new file mode 100644
index 0000000..dbff02c
--- /dev/null
+++ b/hw04_bintree.scm
@@ -0,0 +1,191 @@
+#lang scheme
+
+;; NAME: hw04_bintree.scm
+;; AUTHOR: Ben Burwell
+;; DESC: CSI310 - Programming Languages - Homework 4 - Binary Tree
+;; HISTORY: Created 2013-02-11
+
+;; ========== PROCEDURE ==========
+;; NAME: tree?
+;; DESC: takes a parameter and returns true if it is a tree
+;; and false otherwise
+(define tree?
+ (λ (arg)
+ ;; a tree has the following properties:
+ (and
+
+ ;; it is a list
+ (list? arg)
+
+ ;; it has three elements
+ (equal? (length arg) 3)
+
+ ;; its first element is a number
+ (number? (car arg))
+
+ ;; its second element has one of the following:
+ (or
+
+ ;; it is an empty list...
+ (and (list? (cadr arg)) (equal? (length (cadr arg)) 0))
+
+ ;; ...or it is a tree
+ (tree? (cadr arg)))
+
+ ;; its third element also has one of the above conditions
+ (or
+ (and (list? (caddr arg)) (equal? (length (caddr arg)) 0))
+ (tree? (caddr arg)))
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (tree?) ==========================================================================")
+(newline)
+
+(display "Expected output: #t ")
+(tree? '(1 () ()))
+
+(display "Expected output: #t ")
+(tree? '(5 (2 () ()) ()))
+
+(display "Expected output: #f ")
+(tree? '())
+
+(display "Expected output: #f ")
+(tree? 1)
+
+(display "Expected output: #t ")
+(tree? '( 14 (7 () (12 () ())) (26 (20 (17 () ()) ()) (31 () ()))))
+
+
+
+
+
+;; ========== PROCEDURE ==========
+;; NAME: make-tree
+;; DESC: makes a tree from three parameters
+(define make-tree
+ (λ (val lc rc)
+ (cond
+ [ (and (tree? lc) (tree? rc)) (list val lc rc) ]
+ [ (tree? lc) (list val lc '()) ]
+ [ (tree? rc) (list val '() rc) ]
+ [ else (list val '() '()) ]
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (make-tree) ======================================================================")
+(newline)
+
+(display "Expected output: (1 () ()) ")
+(make-tree 1 '() '())
+
+(display "Expected output: (5 (4 (3 (2 (1 () ()) ()) ()) ()) ()) ")
+(make-tree 5 (make-tree 4 (make-tree 3 (make-tree 2 (make-tree 1 '() '()) '()) '()) '()) '())
+
+
+;; ========== PROCEDURE ==========
+;; NAME: get-value
+;; DESC: returns the value of the root element of the
+;; tree parameter, not-a-tree if the argument is
+;; not a tree
+(define get-value
+ (λ (tree)
+ (if (tree? tree)
+ (car tree)
+ 'not-a-tree
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (get-value) ======================================================================")
+(newline)
+
+(display "Expected output: 1 ")
+(get-value (make-tree 1 '() '()))
+
+(display "Expected output: 5 ")
+(get-value (make-tree 5 (make-tree 4 (make-tree 3 (make-tree 2 (make-tree 1 '() '()) '()) '()) '()) '()))
+
+;; ========== PROCEDURE ==========
+;; NAME: get-left
+;; DESC: returns the left child of the tree parameter
+;; or not-a-tree if the parameter is not a tree
+(define get-left
+ (λ (tree)
+ (if (tree? tree)
+ (cadr tree)
+ 'not-a-tree
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (get-left) =======================================================================")
+(newline)
+
+(display "Expected output: (1 () ()) ")
+(get-left (make-tree 5 (make-tree 1 '() '()) '()))
+
+;; ========== PROCEDURE ==========
+;; NAME: get-right
+;; DESC: returns the right child of the tree parameter
+;; or not-a-tree if the parameter is not a tree
+(define get-right
+ (λ (tree)
+ (if (tree? tree)
+ (caddr tree)
+ 'not-a-tree
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (get-right) ======================================================================")
+(newline)
+
+(display "Expected output: (1 () ()) ")
+(get-right (make-tree 5 '() (make-tree 1 '() '())))
+
+;; ========== HELP FUNC ==========
+;; takes a number to find in a bst as well as a path to append to
+(define path-helper
+ (λ (n bst pth)
+ (cond
+
+ ;; we have found the path
+ [ (equal? (get-value bst) n) pth ]
+
+ ;; the element is not in the tree, return not-found
+ [ (and (not (tree? (get-left bst))) (not (tree? (get-right bst)))) 'not-found ]
+
+ ;; n < value, we must go left
+ [ (< n (get-value bst)) (cons 'left (path-helper n (get-left bst) pth)) ]
+
+ ;; n > value, we must go right
+ [ (> n (get-value bst)) (cons 'right (path-helper n (get-right bst) pth)) ]
+ )))
+
+;; ========== PROCEDURE ==========
+;; NAME: path
+;; DESC: takes a number and a binary search tree in which
+;; to find it and returns a list containing the
+;; appropriate "left"s and "right"s to navigate from
+;; the root of the tree to the element
+;;
+;; returns not-found if the needle is not in the
+;; haystack.
+(define path
+ (λ (n bst)
+ (cond
+ [ (not (tree? bst)) 'not-a-tree ]
+ [ else (path-helper n bst '()) ]
+ )))
+
+;; ========== TEST CODE ==========
+(newline)
+(display "Testing (path) ===========================================================================")
+(newline)
+
+(display "Expected output: (right left left) ")
+(path 17 '( 14 (7 () (12 () ())) (26 (20 (17 () ()) ()) (31 () ())))) \ No newline at end of file
diff --git a/hw04_path.scm b/hw04_path.scm
new file mode 100644
index 0000000..4d404fb
--- /dev/null
+++ b/hw04_path.scm
@@ -0,0 +1,21 @@
+#lang scheme
+
+;; NAME: hw04_bintree.scm
+;; AUTHOR: Ben Burwell
+;; DESC: CSI310 - Programming Languages - Homework 4 - Binary Tree
+;; HISTORY: Created 2013-02-11
+
+(define path-helper
+ (λ (n bst pth)
+ [ (equal? (get-value bst) n) pth ]
+ [ (< n (get-value bst)) (cons 'left (path-helper n (get-left bst))) ]
+ [ (> n (get-value bst)) (cons 'right (path-helper n (get-right bst))) ]
+ ))
+
+
+(define path
+ (λ (n bst)
+ (cond
+ [ (not (tree? bst)) 'not-a-tree ]
+ [ else (path-helper n bst '()) ]
+ ))) \ No newline at end of file
diff --git a/hw05_arith_scanner.scm b/hw05_arith_scanner.scm
new file mode 100644
index 0000000..f15833f
--- /dev/null
+++ b/hw05_arith_scanner.scm
@@ -0,0 +1,38 @@
+#lang eopl
+
+;; <arith-expr> ::== <arith-term> { <add-op> <arith-term> }*
+;; <arith-term> ::== <arith-factor> { <mult-op> <arith-factor> }*
+;; <arith-factor> ::== <number>
+;; <arith-factor> ::== ( <arith-expr> )
+;; <add-op> ::== + | -
+;; <mult-op> ::== * | /
+
+(define arith-scanner
+ '(
+ (add-op (or "+" "-") symbol)
+ (mult-op (or "*" "/") symbol)
+ (number (digit (arbno digit)) number)
+ ))
+
+(define arith-grammar
+ '(
+ (expression (number) arith-factor)
+ ;(expression (number add-op number) arith-factor)
+ ;(expression (expression add-op expression) arith-factor)
+ ))
+
+(sllgen:make-define-datatypes arith-scanner arith-grammar)
+
+(define list-the-datatypes
+ (lambda ()
+ (sllgen:list-define-datatypes arith-scanner arith-grammar)))
+
+(define just-scan
+ (sllgen:make-string-scanner arith-scanner '()))
+
+(define scan&parse
+ (sllgen:make-string-parser arith-scanner arith-grammar) )
+
+(define read-eval-print
+ (sllgen:make-rep-loop "--> " stmt-evaluator
+ (sllgen:make-stream-parser arith-scanner arith-grammar) )) \ No newline at end of file
diff --git a/hw06.zip b/hw06.zip
new file mode 100644
index 0000000..81f5916
--- /dev/null
+++ b/hw06.zip
Binary files differ
diff --git a/hw06/hw06_alpha.scm b/hw06/hw06_alpha.scm
new file mode 100644
index 0000000..1a6cb1b
--- /dev/null
+++ b/hw06/hw06_alpha.scm
@@ -0,0 +1,52 @@
+#lang eopl
+
+; Ben Burwell
+; Dr. Kussmaul
+; CSI-310 :: Programming Languages
+; Homework 6: Alpha conversions
+
+;; ========== PROCEDURE ==========
+;; NAME: alpha-conv
+;; DESC: returns the alpha conversion of an expression if
+;; it exists. If there is no alpha conversion, the
+;; expression itself is returned.
+(define alpha-conv
+ (lambda (from to exp)
+ (if
+ (list? exp)
+ (if
+ (equal? (length exp) 3)
+ (if
+ (and
+ (equal? (car exp) 'lambda)
+ (list? (cadr exp))
+ (equal? (length (cadr exp)) 1)
+ (list? (caddr exp))
+ )
+ (list 'lambda (list to) (list-repl from to (caddr exp)))
+ exp)
+ exp)
+ exp)))
+
+;; ========== PROCEDURE ==========
+;; NAME: list-repl
+;; DESC: a helper function for the alpha conversion
+;; replaces all occurrences of from with to in
+;; exp unless there is a nested lambda function,
+;; in which case it remains intact.
+(define list-repl
+ (lambda (from to exp)
+ (cond
+ [ (equal? (length exp) 0) '() ]
+ [ (equal? (car exp) from) (cons to (list-repl from to (cdr exp))) ]
+ [ (and (list? (car exp)) (equal? (caar exp) 'lambda)) (cons (car exp) (list-repl from to (cdr exp))) ]
+ [ (list? (car exp)) (cons (list-repl from to (car exp)) (list-repl from to (cdr exp))) ]
+ [ else (cons (car exp) (list-repl from to (cdr exp))) ]
+ )))
+
+;; ========== TEST CODE ==========
+(alpha-conv 'x 'y '(x z))
+(alpha-conv 'x 'y '((lambda ( x ) (+ x 5)) 2))
+(alpha-conv 'x 'y '(lambda ( x ) (x z x)))
+(alpha-conv 'x 'y '(lambda ( y ) (y z y)))
+(alpha-conv 'x 'y '(lambda ( x ) (+ x ((lambda (x) (* 2 x)) 7)))) \ No newline at end of file
diff --git a/hw06/hw06_combinators.scm b/hw06/hw06_combinators.scm
new file mode 100644
index 0000000..0c3fdaf
--- /dev/null
+++ b/hw06/hw06_combinators.scm
@@ -0,0 +1,21 @@
+#lang eopl
+
+; Ben Burwell
+; Dr. Kussmaul
+; CSI-310 Programming Languages
+; HW06 :: Combinators
+
+; A. evaluate boolean logic expression
+(or F (and T (not F)))
+(or F (and T T))
+(or F T)
+T
+
+; B. compute 2+1 using Church numerals
+(increment 2)
+
+((λ (n) (λ (f) (λ (x) (f ((n f) x))))) (λ (f) (λ (x) (f (f x)))))
+( λ (f) (λ (x) (f (((λ (f) (λ (x) (f (f x)))) f) x))))
+( λ (f) (λ (x) (f ( (λ (x) (f (f x))) x))))
+( λ (f) (λ (x) (f (f (f x)))))
+(λ (f) (λ (x) (f (f (f x))))) \ No newline at end of file
diff --git a/hw06/hw06_eta.scm b/hw06/hw06_eta.scm
new file mode 100644
index 0000000..991ee65
--- /dev/null
+++ b/hw06/hw06_eta.scm
@@ -0,0 +1,50 @@
+#lang eopl
+
+; Ben Burwell
+; Dr. Kussmaul
+; CSI-310 :: Programming Languages
+; Homework 6: Eta Conversion
+
+;; ========== PROCEDURE ==========
+;; NAME: eta-conv
+;; DESC: takes a lambda expression and returns
+;; its eta conversion. If the expression
+;; does not have an eta-conversion, it
+;; returns the expression itself.
+
+(define eta-conv
+ (lambda (lst)
+ (if ;; check that the parameter is a list of length 3
+ (and
+ (list? lst)
+ (equal? (length lst) 3)
+ )
+ (if ;; it is a list with the correct length, check
+ ;; that it has an eta-conversion
+ (and
+ (equal? (car lst) 'lambda)
+ (list? (cadr lst))
+ (equal? (length (cadr lst)) 1)
+ (list? (caddr lst))
+ (equal? (length (caddr lst)) 2)
+ (equal? (caadr lst) (cadr (caddr lst)))
+ )
+
+ ;; it does, so return the conversion
+ (car (caddr lst))
+
+ ;; it doesn't, so return the expression
+ lst)
+
+ ;; not a parseable expression, return it
+ lst)))
+
+;; ========== TEST CODE ==========
+;; should return a:
+(eta-conv '(lambda (x) (a x)))
+
+;; should return (lambda (x) (x a))
+(eta-conv '(lambda (x) (x a)))
+
+;; should return ()
+(eta-conv '())
diff --git a/hw06_alpha.scm b/hw06_alpha.scm
new file mode 100644
index 0000000..1a6cb1b
--- /dev/null
+++ b/hw06_alpha.scm
@@ -0,0 +1,52 @@
+#lang eopl
+
+; Ben Burwell
+; Dr. Kussmaul
+; CSI-310 :: Programming Languages
+; Homework 6: Alpha conversions
+
+;; ========== PROCEDURE ==========
+;; NAME: alpha-conv
+;; DESC: returns the alpha conversion of an expression if
+;; it exists. If there is no alpha conversion, the
+;; expression itself is returned.
+(define alpha-conv
+ (lambda (from to exp)
+ (if
+ (list? exp)
+ (if
+ (equal? (length exp) 3)
+ (if
+ (and
+ (equal? (car exp) 'lambda)
+ (list? (cadr exp))
+ (equal? (length (cadr exp)) 1)
+ (list? (caddr exp))
+ )
+ (list 'lambda (list to) (list-repl from to (caddr exp)))
+ exp)
+ exp)
+ exp)))
+
+;; ========== PROCEDURE ==========
+;; NAME: list-repl
+;; DESC: a helper function for the alpha conversion
+;; replaces all occurrences of from with to in
+;; exp unless there is a nested lambda function,
+;; in which case it remains intact.
+(define list-repl
+ (lambda (from to exp)
+ (cond
+ [ (equal? (length exp) 0) '() ]
+ [ (equal? (car exp) from) (cons to (list-repl from to (cdr exp))) ]
+ [ (and (list? (car exp)) (equal? (caar exp) 'lambda)) (cons (car exp) (list-repl from to (cdr exp))) ]
+ [ (list? (car exp)) (cons (list-repl from to (car exp)) (list-repl from to (cdr exp))) ]
+ [ else (cons (car exp) (list-repl from to (cdr exp))) ]
+ )))
+
+;; ========== TEST CODE ==========
+(alpha-conv 'x 'y '(x z))
+(alpha-conv 'x 'y '((lambda ( x ) (+ x 5)) 2))
+(alpha-conv 'x 'y '(lambda ( x ) (x z x)))
+(alpha-conv 'x 'y '(lambda ( y ) (y z y)))
+(alpha-conv 'x 'y '(lambda ( x ) (+ x ((lambda (x) (* 2 x)) 7)))) \ No newline at end of file
diff --git a/hw06_combinators.scm b/hw06_combinators.scm
new file mode 100644
index 0000000..0c3fdaf
--- /dev/null
+++ b/hw06_combinators.scm
@@ -0,0 +1,21 @@
+#lang eopl
+
+; Ben Burwell
+; Dr. Kussmaul
+; CSI-310 Programming Languages
+; HW06 :: Combinators
+
+; A. evaluate boolean logic expression
+(or F (and T (not F)))
+(or F (and T T))
+(or F T)
+T
+
+; B. compute 2+1 using Church numerals
+(increment 2)
+
+((λ (n) (λ (f) (λ (x) (f ((n f) x))))) (λ (f) (λ (x) (f (f x)))))
+( λ (f) (λ (x) (f (((λ (f) (λ (x) (f (f x)))) f) x))))
+( λ (f) (λ (x) (f ( (λ (x) (f (f x))) x))))
+( λ (f) (λ (x) (f (f (f x)))))
+(λ (f) (λ (x) (f (f (f x))))) \ No newline at end of file
diff --git a/hw06_eta.scm b/hw06_eta.scm
new file mode 100644
index 0000000..991ee65
--- /dev/null
+++ b/hw06_eta.scm
@@ -0,0 +1,50 @@
+#lang eopl
+
+; Ben Burwell
+; Dr. Kussmaul
+; CSI-310 :: Programming Languages
+; Homework 6: Eta Conversion
+
+;; ========== PROCEDURE ==========
+;; NAME: eta-conv
+;; DESC: takes a lambda expression and returns
+;; its eta conversion. If the expression
+;; does not have an eta-conversion, it
+;; returns the expression itself.
+
+(define eta-conv
+ (lambda (lst)
+ (if ;; check that the parameter is a list of length 3
+ (and
+ (list? lst)
+ (equal? (length lst) 3)
+ )
+ (if ;; it is a list with the correct length, check
+ ;; that it has an eta-conversion
+ (and
+ (equal? (car lst) 'lambda)
+ (list? (cadr lst))
+ (equal? (length (cadr lst)) 1)
+ (list? (caddr lst))
+ (equal? (length (caddr lst)) 2)
+ (equal? (caadr lst) (cadr (caddr lst)))
+ )
+
+ ;; it does, so return the conversion
+ (car (caddr lst))
+
+ ;; it doesn't, so return the expression
+ lst)
+
+ ;; not a parseable expression, return it
+ lst)))
+
+;; ========== TEST CODE ==========
+;; should return a:
+(eta-conv '(lambda (x) (a x)))
+
+;; should return (lambda (x) (x a))
+(eta-conv '(lambda (x) (x a)))
+
+;; should return ()
+(eta-conv '())
diff --git a/hw07.scm b/hw07.scm
new file mode 100644
index 0000000..5434729
--- /dev/null
+++ b/hw07.scm
@@ -0,0 +1,278 @@
+#lang eopl
+
+; 3.4 INTERPRETER
+; - this interpreter consists of several components
+; - SCANNER - converts characters to tokens
+; - PARSER - converts tokens to abstract syntax trees
+; - ENVIRONMENT - maps identifiers to values
+; - EVALUATOR - converts abstract syntax trees to values/results
+; - this interpreter supports:
+; - (3.1) basic functionality
+; - whitespace & comments (skipped)
+; - integers & built-in defined constants
+; - 3 binary primitive operations - add, sub, mult
+; - 2 unary primitive operations - incr, decr
+; - (3.3) conditionals - if-then-else
+; - (3.4) local bindings - let
+;
+; - things to do (save as 3.4a)
+;
+
+; ------------------------------------------------------------
+; scanner specification
+
+(define scanner-spec
+ '(
+ (whitespace (whitespace) skip)
+ (comment ("%" (arbno (not #\newline))) skip)
+ (identifier (letter (arbno (or letter digit "?"))) symbol)
+ (number (digit (arbno digit)) number) ))
+
+; ------------------------------------------------------------
+; grammar specification
+
+(define grammar
+ '(
+ ; (3.1) program
+ (program (expression)
+ a-program)
+ ; (3.1) expressions
+ (expression (number)
+ lit-exp)
+ (expression (identifier)
+ var-exp)
+
+ (expression (primitive "(" (separated-list expression ",") ")" )
+ primapp-exp)
+
+ (expression (primitive-one "(" expression ")") primapp-one-exp)
+
+ (expression (primitive-two "(" expression "," expression ")") primapp-two-exp)
+
+ ; (3.3) conditional
+ (expression ("if" expression "then" expression "else" expression)
+ if-exp)
+ ; (3.4) local binding
+ (expression ("let" (arbno identifier "=" expression) "in" expression)
+ let-exp)
+
+ (expression ("cond" (arbno expression "==>" expression) "end") cond-exp)
+
+ ; (3.1) primitives
+ (primitive ("+") add-prim)
+ (primitive ("*") mult-prim)
+ (primitive ("cons") cons-prim)
+ (primitive ("car") car-prim)
+ (primitive ("cdr") cdr-prim)
+ (primitive ("list") list-prim)
+
+ (primitive-one ("add1") incr-prim)
+ (primitive-one ("sub1") decr-prim)
+
+ (primitive-two ("-") subtract-prim)
+ ))
+
+; ------------------------------------------------------------
+; define datatypes before defining interpreter
+
+(sllgen:make-define-datatypes scanner-spec grammar)
+(define dump-datatypes
+ (lambda () (sllgen:list-define-datatypes scanner-spec grammar)))
+
+; ------------------------------------------------------------
+; environment (using ribcage implementation - see 2.3.4)
+; - maps identifiers to values
+
+(define-datatype environment environment?
+ (empty-env-record)
+ (extended-env-record
+ (syms (list-of symbol?))
+ (vec vector?) ; can use this for anything.
+ (env environment?))
+ )
+
+(define empty-env
+ (lambda ()
+ (extend-env '(emptylist) '(()) (empty-env-record))))
+
+(define extend-env
+ (lambda (syms vals env)
+ (extended-env-record syms (list->vector vals) env)))
+
+(define apply-env
+ (lambda (env sym)
+ (cases environment env
+ (empty-env-record ()
+ (eopl:error 'apply-env "No binding for ~s" sym))
+ (extended-env-record (syms vals env)
+ (let ((position (rib-find-position sym syms)))
+ (if (number? position)
+ (vector-ref vals position)
+ (apply-env env sym)))))))
+
+(define rib-find-position
+ (lambda (sym los)
+ (list-find-position sym los)))
+
+(define list-find-position
+ (lambda (sym los)
+ (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
+
+(define list-index
+ (lambda (pred ls)
+ (cond
+ ((null? ls) #f)
+ ((pred (car ls)) 0)
+ (else (let ((list-index-r (list-index pred (cdr ls))))
+ (if (number? list-index-r)
+ (+ list-index-r 1)
+ #f))))))
+
+; ------------------------------------------------------------
+; evaluator
+
+; evaluate program
+(define eval-program
+ (lambda (pgm)
+ (cases program pgm
+ (a-program (body) (eval-expression body (init-env)) ))))
+
+; evaluate expression
+(define eval-expression
+ (lambda (exp env)
+ (cases expression exp
+ ; (3.1) literals, variables, primitive applications
+ (lit-exp (datum) datum)
+ (var-exp (id) (apply-env env id))
+ (primapp-exp (prim rands)
+ (let ((args (eval-rands rands env)))
+ (apply-primitive prim args) ))
+ (primapp-one-exp (prim rand)
+ (let ((arg (eval-rand rand env)))
+ (apply-primitive-one prim arg)))
+
+ (primapp-two-exp (prim rand1 rand2)
+ (apply-primitive-two prim (eval-rand rand1 env) (eval-rand rand2 env)))
+
+ ; (3.3) conditional
+ (if-exp (test-exp true-exp false-exp)
+ (if (true-value? (eval-expression test-exp env))
+ (eval-expression true-exp env)
+ (eval-expression false-exp env)))
+ ; (3.4) local binding
+ (let-exp (ids rands body)
+ (let ((args (eval-rands rands env)))
+ (eval-expression body (extend-env ids args env))))
+
+ (cond-exp (conditions returns)
+ (eval-cond conditions returns env))
+ )))
+
+; (3.3) 0=false, anything else is true
+; - placeholder for other definitions of true & false
+(define true-value?
+ (lambda (x) (not (zero? x))))
+
+; (3.4) evaluate operands for a procedure call
+(define eval-rands
+ (lambda (rands env) (map (lambda (x) (eval-rand x env)) rands) ))
+(define eval-rand
+ (lambda (rand env) (eval-expression rand env) ))
+
+(define eval-cond
+ (lambda (conditions returns env)
+ (if (null? conditions)
+ 0
+ (if (true-value? (eval-expression (car conditions) env))
+ (eval-expression (car returns) env)
+ (eval-cond (cdr conditions) (cdr returns) env)))))
+
+
+; find list sum
+(define list-sum
+ (lambda (lst)
+ (if
+ (equal? (length lst) 0)
+ (eopl:error "Trying to add nothing?!?! Absolutely NOT!")
+ (if
+ (equal? (length lst) 1)
+ (car lst)
+ (+ (car lst) (list-sum (cdr lst)))))))
+
+; find list product
+(define list-prod
+ (lambda (lst)
+ (if
+ (equal? (length lst) 0)
+ (eopl:error "Trying to multiply nothing?!?! Absolutely NOT!")
+ (if
+ (equal? (length lst) 1)
+ (car lst)
+ (* (car lst) (list-prod (cdr lst)))))))
+
+; (3.1) apply primitive procedure to arguments
+(define apply-primitive
+ (lambda (prim args)
+ (cases primitive prim
+ (add-prim () (list-sum args))
+ (mult-prim () (* (list-prod args)))
+ (car-prim () (car args))
+ (cdr-prim () (cdar args))
+ (cons-prim () (cons (car args) (cadr args)))
+ (list-prim () args))))
+
+(define apply-primitive-one
+ (lambda (prim arg)
+ (cases primitive-one prim
+ (incr-prim () (+ arg 1))
+ (decr-prim () (- arg 1)))))
+
+(define apply-primitive-two
+ (lambda (prim arg1 arg2)
+ (cases primitive-two prim
+ (subtract-prim () (- arg1 arg2)))))
+
+; initial environment (named constants only, since it can't be changed)
+(define init-env
+ (lambda () (extend-env '(i v x) '(1 5 10) (empty-env)) ))
+
+; ------------------------------------------------------------
+; interpreter
+
+(define scan
+ (sllgen:make-string-scanner scanner-spec
+ grammar))
+(define scan&parse
+ (sllgen:make-string-parser scanner-spec
+ grammar))
+(define read-dump
+ (sllgen:make-rep-loop "--> " (lambda (tree) tree)
+ (sllgen:make-stream-parser scanner-spec
+ grammar)))
+
+(define scan&parse&eval
+ (lambda (s) (eval-program(scan&parse s))) )
+
+(define read-eval-print
+ (sllgen:make-rep-loop "--> " eval-program
+ (sllgen:make-stream-parser scanner-spec
+ grammar)))
+
+; ------------------------------------------------------------
+; testing - use (scan), (scan&parse), (read-dump), (read-eval-print)
+
+(define test-3.1a "add1(2)")
+
+; ignores extra parameters
+(define test-3.1b "add1(2,3)")
+(define test-3.1c "+(3,4,5)")
+
+; more tests
+(define test-3.1d "+(add1(2),-(6,4))")
+(define test-3.1e "*(2,+(3,sub1(4)))")
+(define test-3.3a "if -(3,+(1,2)) then 2 else 3")
+(define test-3.4a "let x = 5 y = 6 in +(x,y)")
+(scan&parse test-3.3a)
+(scan&parse test-3.4a)
+
+(read-eval-print) \ No newline at end of file
diff --git a/hw08.rkt b/hw08.rkt
new file mode 100644
index 0000000..718432f
--- /dev/null
+++ b/hw08.rkt
@@ -0,0 +1,403 @@
+#lang eopl
+
+; 3.9 INTERPRETER
+; - the interpreter consists of several components
+; - SCANNER - converts characters to tokens
+; - PARSER - converts tokens to abstract syntax trees
+; - ENVIRONMENT - maps identifiers to values
+; - EVALUATOR - converts abstract syntax trees to values/results
+; - this interpreter supports:
+; - (3.1) basic functionality
+; - whitespace & comments (skipped)
+; - integers & built-in defined constants
+; - 3 binary primitive operations - add, sub, mult
+; - 2 unary primitive operations - incr, decr
+; - (3.3) conditionals - if-then-else
+; - (3.4) local bindings - let
+; - (3.5) procedures - proc, app-exp
+; - (3.6) recursion - letrec
+; - (3.7) variable assignment - set
+; - (3.9) statements - assign, print, compound, if, while, block
+;
+; THINGS DO DO (save as 3.9a)
+
+; ------------------------------------------------------------
+; scanner specification
+
+(define scanner-spec
+ '(
+ (whitespace (whitespace) skip)
+ (comment ("%" (arbno (not #\newline))) skip)
+ (identifier (letter (arbno (or letter digit "?"))) make-symbol)
+ (number (digit (arbno digit)) make-number) ))
+
+; ------------------------------------------------------------
+; grammar specification
+
+(define grammar
+ '(
+ ; (3.1) program
+ (program (statement) a-program)
+
+ ; (3.9) statements
+ (statement (identifier "=" expression)
+ assign-statement)
+ (statement ("print" "(" expression ")")
+ print-statement)
+ (statement ("{" (separated-list statement ";") "}")
+ compound-statement)
+ (statement ("if" expression statement statement)
+ if-statement)
+ (statement ("while" expression "do" statement)
+ while-statement)
+ (statement ("var" (separated-list identifier ",") ";" statement)
+ block-statement)
+ (statement ("do" "{" statement "}" "while" expression) do-while-statement)
+
+ ; (3.1) expressions
+ (expression (number) lit-exp)
+ (expression (identifier) var-exp)
+ (expression (primitive "(" (separated-list expression ",") ")")
+ primapp-exp)
+
+ ; (3.3) conditional evaluation
+ (expression ("if" expression "then" expression "else" expression)
+ if-exp)
+ ; (3.4) local binding
+ (expression ("let" (arbno identifier "=" expression) "in" expression)
+ let-exp)
+
+ ; (3.5) procedure definition & application
+ (expression ("proc" "(" (separated-list identifier ",") ")" expression)
+ proc-exp)
+ (expression ("(" expression (arbno expression) ")")
+ app-exp)
+
+ ; (3.6) recursion
+ (expression ("letrec"
+ (arbno identifier "(" (separated-list identifier ",") ")"
+ "=" expression)
+ "in" expression)
+ letrec-exp)
+
+ ; (3.7) variable assignment
+ (expression ("set" identifier "=" expression)
+ varassign-exp)
+
+ ; (3.7 HW) sequential expressions
+ (expression ("begin" expression (arbno ";" expression) "end")
+ begin-exp)
+
+ ; (3.1) primitives
+ (primitive ("+") add-prim)
+ (primitive ("-") subtract-prim)
+ (primitive ("*") mult-prim)
+ (primitive ("add1") incr-prim)
+ (primitive ("sub1") decr-prim)
+ ; (3.3) primitives
+ (primitive ("equal?") equal-prim)
+ (primitive ("zero?") zero-prim)
+ (primitive ("greater?") greater-prim)
+ (primitive ("less?") less-prim)
+ ))
+
+; ------------------------------------------------------------
+; define datatypes before defining interpreter
+
+(sllgen:make-define-datatypes scanner-spec grammar)
+(define dump-datatypes
+ (lambda () (sllgen:list-define-datatypes scanner-spec grammar)))
+
+; ------------------------------------------------------------
+; booleans
+
+(define truth 1)
+(define falsity 0)
+
+(define true-value? (lambda (x) (not (zero? x))))
+
+; ------------------------------------------------------------
+; environments
+
+(define init-env
+ (lambda () (extend-env '(stdout) '(*uninitialized*) (empty-env)) ))
+
+(define-datatype environment environment?
+ (empty-env-record)
+ (extended-env-record
+ (syms (list-of symbol?))
+ (vec vector?) ; can use this for anything
+ (env environment?) ))
+
+(define empty-env (lambda () (empty-env-record)))
+
+(define extend-env
+ (lambda (syms vals env) (extended-env-record syms (list->vector vals) env)))
+
+(define extend-env-recursively
+ (lambda (proc-names idss bodies old-env)
+ (let ((len (length proc-names)))
+ (let ((vec (make-vector len)))
+ (let ((env (extended-env-record proc-names vec old-env)))
+ (for-each
+ (lambda (pos ids body)
+ (vector-set! vec pos (closure ids body env)))
+ (iota len)
+ idss
+ bodies)
+ env)))))
+
+(define apply-env-ref
+ (lambda (env sym)
+ (cases environment env
+ (empty-env-record ()
+ (eopl:error 'apply-env "no association for symbol ~s" sym))
+ (extended-env-record (syms vals env)
+ (let ((position (env-find-position sym syms)))
+ (if (number? position) (a-ref position vals) (apply-env-ref env sym)))))))
+
+(define apply-env
+ (lambda (env sym) (deref (apply-env-ref env sym))))
+
+(define env-find-position
+ (lambda (sym los) (list-find-position sym los)))
+
+(define list-find-position
+ (lambda (sym los) (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
+
+(define list-index
+ (lambda (pred ls)
+ (cond
+ ((null? ls) #f)
+ ((pred (car ls)) 0)
+ (else (let ((list-index-r (list-index pred (cdr ls))))
+ (if (number? list-index-r) (+ list-index-r 1) #f))))))
+
+(define iota
+ (lambda ( n ) (do ((n n (- n 1)) (x '() (cons (- n 1) x))) ((zero? n) x))))
+
+; ------------------------------------------------------------
+; evaluator
+
+; evaluator for root of abstract syntax tree
+(define execute-program
+ (lambda (pgm)
+ (cases program pgm
+ (a-program (statement)
+ (execute-statement statement (init-env)) ))))
+
+; (3.9) statement evaluator
+(define execute-statement
+ (lambda (stmt env)
+ (cases statement stmt
+
+ (assign-statement (id exp)
+ (setref!
+ (apply-env-ref env id)
+ (eval-expression exp env) ))
+
+ (print-statement (exp)
+ (write (eval-expression exp env)) (newline) )
+
+ (compound-statement (statements)
+ (for-each
+ (lambda (statement) (execute-statement statement env))
+ statements) )
+
+ (if-statement (exp true-statement false-statement)
+ (if (true-value? (eval-expression exp env))
+ (execute-statement true-statement env)
+ (execute-statement false-statement env) ))
+
+ ; alternate "named" LET syntax
+ (while-statement (exp statement)
+ (let loop ()
+ (if (true-value? (eval-expression exp env))
+ (begin
+ (execute-statement statement env)
+ (loop) ))))
+
+ (do-while-statement (stmt exp)
+ (execute-statement stmt env)
+ (let loop ()
+ (if (true-value? (eval-expression exp env))
+ (begin
+ (execute-statement stmt env)
+ (loop)) )))
+
+
+ (block-statement (ids statement)
+ (execute-statement statement
+ (extend-env ids (map (lambda (id) 0) ids) env) ))
+ )))
+
+; expression evaluator
+(define eval-expression
+ (lambda (exp env)
+ (cases expression exp
+ (lit-exp (datum) datum)
+ (var-exp (id) (apply-env env id))
+
+ (primapp-exp (prim rands)
+ (let ((args (eval-rands rands env)))
+ (apply-primitive prim args)))
+
+ ; (3.3) conditional evaluation
+ (if-exp (test-exp true-exp false-exp)
+ (if (true-value? (eval-expression test-exp env))
+ (eval-expression true-exp env)
+ (eval-expression false-exp env) ))
+
+ ; (3.4) local binding
+ (let-exp (ids rands body)
+ (let ((args (eval-rands rands env)))
+ (eval-expression body (extend-env ids args env))))
+
+ ; (3.5) procedure definition
+ (proc-exp (ids body) (closure ids body env))
+
+ ; (3.5) procedure application
+ (app-exp (rator rands)
+ (let ((proc (eval-expression rator env))
+ (args (eval-rands rands env)) )
+ (if (procval? proc)
+ (apply-procval proc args)
+ (eopl:error 'eval-expression
+ "attempt to apply non-procedure ~s"
+ proc))))
+
+ ; (3.6) recursion
+ (letrec-exp (proc-names idss bodies letrec-body)
+ (eval-expression letrec-body
+ (extend-env-recursively proc-names idss bodies env)))
+
+ ; (3.7) variable assignment
+ (varassign-exp (id rhs-exp)
+ (begin (setref!
+ (apply-env-ref env id)
+ (eval-expression rhs-exp env))
+ 1))
+
+ ; (3.7) sequential expressions
+ (begin-exp (exp1 exps)
+ (letrec
+ ((loop (lambda (acc exps)
+ (if (null? exps) acc
+ (loop (eval-expression (car exps) env)
+ (cdr exps))))))
+ (loop (eval-expression exp1 env) exps)))
+ )))
+
+; (3.4) evaluate operands
+(define eval-rands
+ (lambda (rands env) (map (lambda (x) (eval-rand x env)) rands)))
+(define eval-rand
+ (lambda (rand env) (eval-expression rand env)))
+
+; (3.1) apply primitive operations
+(define apply-primitive
+ (lambda (prim args)
+ (define (check arity)
+ (if (not (= arity (length args)))
+ (eopl:error 'apply-primitive
+ "wrong number of arguments to primitive ~s"
+ prim)))
+ (cases primitive prim
+ (add-prim () (check 2) (+ (car args) (cadr args)))
+ (subtract-prim () (check 2) (- (car args) (cadr args)))
+ (mult-prim () (check 2) (* (car args) (cadr args)))
+ (incr-prim () (check 1) (+ (car args) 1))
+ (decr-prim () (check 1) (- (car args) 1))
+ (equal-prim () (check 2) (if (= (car args) (cadr args)) truth falsity))
+ (zero-prim () (check 1) (if (zero? (car args)) truth falsity))
+ (greater-prim () (check 2) (if (> (car args) (cadr args)) truth falsity))
+ (less-prim () (check 2) (if (< (car args) (cadr args)) truth falsity))
+ )))
+
+; ------------------------------------------------------------
+; procedures (3.5)
+
+(define-datatype procval procval?
+ (closure
+ (ids (list-of symbol?)) ; formal parameters
+ (body expression?) ; procedure body
+ (env environment?))) ; closure (calling environment)
+
+(define apply-procval
+ (lambda (proc args)
+ (cases procval proc
+ (closure (ids body env)
+ (if (= (length ids) (length args))
+ (eval-expression body (extend-env ids args env))
+ (eopl:error 'apply-procval
+ "wrong number of arguments to procedure ~s"
+ ids))))))
+
+; ------------------------------------------------------------
+; references - for variable assignment (3.7)
+
+(define-datatype reference reference?
+ (a-ref
+ (position integer?)
+ (vec vector?) ))
+
+(define primitive-deref
+ (lambda (ref)
+ (cases reference ref
+ (a-ref (pos vec)
+ (vector-ref vec pos) ))))
+
+(define primitive-setref!
+ (lambda (ref value)
+ (cases reference ref
+ (a-ref (pos vec)
+ (vector-set! vec pos value)))))
+
+(define deref (lambda (ref) (primitive-deref ref)))
+(define setref! (lambda (ref value) (primitive-setref! ref value)))
+
+; ------------------------------------------------------------
+; interpreter
+
+; scanner only, and parser only
+(define scan
+ (sllgen:make-string-scanner scanner-spec grammar))
+(define scan&parse
+ (sllgen:make-string-parser scanner-spec grammar))
+(define read-dump
+ (sllgen:make-rep-loop "--> " (lambda (tree) tree)
+ (sllgen:make-stream-parser scanner-spec grammar)))
+
+(define scan&parse&eval
+ (lambda (s) (execute-program (scan&parse s))) )
+
+(define read-eval-print
+ (sllgen:make-rep-loop "--> " execute-program
+ (sllgen:make-stream-parser scanner-spec grammar)))
+
+; ------------------------------------------------------------
+; tests
+
+(define test-3.1a "add1(2)")
+; ignores extra parameters
+(define test-3.1b "add1(2,3)")
+(define test-3.1c "+(3,4,5)")
+; more tests
+(define test-3.1d "+(add1(2),-(6,4))")
+(define test-3.1e "*(2,+(3,sub1(4)))")
+(define test-3.3a "if -(3,+(1,2)) then 2 else 3")
+(define test-3.4a "let x = 5 y = 6 in +(x,y)")
+
+(define test3.5a "print(let f=proc(y,z) +(y,-(z,5)) in (f 2 28))")
+(define test3.5b "print((proc (x) +(x,2) 4))")
+(define test3.5c "print(let x=5 in let f=proc(y,z) +(y,-(z,x)) x=28 in (f 2 x))")
+
+(define test3.6a "print(letrec fact(x)=if zero?(x) then 1 else *(x,(fact sub1(x)))
+in (fact 6))")
+(define test3.6b "print(letrec even(x)=if zero?(x) then 1 else (odd sub1(x))
+odd(x)=if zero?(x) then 0 else (even sub1(x))
+in (odd 13))")
+
+(define test3.9a "var x,y; {x=3; y=4; print(+(x,y))}")
+(define test3.9b "var x,y,z; {x=3; y=4; z=0;
+while x do {z=+(z,y); x=sub1(x)}; print(z)}") \ No newline at end of file
diff --git a/hw08.scm b/hw08.scm
new file mode 100644
index 0000000..fe329f2
--- /dev/null
+++ b/hw08.scm
@@ -0,0 +1,394 @@
+#lang eopl
+
+; 3.9 INTERPRETER
+; - the interpreter consists of several components
+; - SCANNER - converts characters to tokens
+; - PARSER - converts tokens to abstract syntax trees
+; - ENVIRONMENT - maps identifiers to values
+; - EVALUATOR - converts abstract syntax trees to values/results
+; - this interpreter supports:
+; - (3.1) basic functionality
+; - whitespace & comments (skipped)
+; - integers & built-in defined constants
+; - 3 binary primitive operations - add, sub, mult
+; - 2 unary primitive operations - incr, decr
+; - (3.3) conditionals - if-then-else
+; - (3.4) local bindings - let
+; - (3.5) procedures - proc, app-exp
+; - (3.6) recursion - letrec
+; - (3.7) variable assignment - set
+; - (3.9) statements - assign, print, compound, if, while, block
+;
+; THINGS DO DO (save as 3.9a)
+
+; ------------------------------------------------------------
+; scanner specification
+
+(define scanner-spec
+ '(
+ (whitespace (whitespace) skip)
+ (comment ("%" (arbno (not #\newline))) skip)
+ (identifier (letter (arbno (or letter digit "?"))) make-symbol)
+ (number (digit (arbno digit)) make-number) ))
+
+; ------------------------------------------------------------
+; grammar specification
+
+(define grammar
+ '(
+ ; (3.1) program
+ (program (statement) a-program)
+
+ ; (3.9) statements
+ (statement (identifier "=" expression)
+ assign-statement)
+ (statement ("print" "(" expression ")")
+ print-statement)
+ (statement ("{" (separated-list statement ";") "}")
+ compound-statement)
+ (statement ("if" expression statement statement)
+ if-statement)
+ (statement ("while" expression "do" statement)
+ while-statement)
+ (statement ("var" (separated-list identifier ",") ";" statement)
+ block-statement)
+
+ ; (3.1) expressions
+ (expression (number) lit-exp)
+ (expression (identifier) var-exp)
+ (expression (primitive "(" (separated-list expression ",") ")")
+ primapp-exp)
+
+ ; (3.3) conditional evaluation
+ (expression ("if" expression "then" expression "else" expression)
+ if-exp)
+ ; (3.4) local binding
+ (expression ("let" (arbno identifier "=" expression) "in" expression)
+ let-exp)
+
+ ; (3.5) procedure definition & application
+ (expression ("proc" "(" (separated-list identifier ",") ")" expression)
+ proc-exp)
+ (expression ("(" expression (arbno expression) ")")
+ app-exp)
+
+ ; (3.6) recursion
+ (expression ("letrec"
+ (arbno identifier "(" (separated-list identifier ",") ")"
+ "=" expression)
+ "in" expression)
+ letrec-exp)
+
+ ; (3.7) variable assignment
+ (expression ("set" identifier "=" expression)
+ varassign-exp)
+
+ ; (3.7 HW) sequential expressions
+ (expression ("begin" expression (arbno ";" expression) "end")
+ begin-exp)
+
+ ; (3.1) primitives
+ (primitive ("+") add-prim)
+ (primitive ("-") subtract-prim)
+ (primitive ("*") mult-prim)
+ (primitive ("add1") incr-prim)
+ (primitive ("sub1") decr-prim)
+ ; (3.3) primitives
+ (primitive ("equal?") equal-prim)
+ (primitive ("zero?") zero-prim)
+ (primitive ("greater?") greater-prim)
+ (primitive ("less?") less-prim)
+ ))
+
+; ------------------------------------------------------------
+; define datatypes before defining interpreter
+
+(sllgen:make-define-datatypes scanner-spec grammar)
+(define dump-datatypes
+ (lambda () (sllgen:list-define-datatypes scanner-spec grammar)))
+
+; ------------------------------------------------------------
+; booleans
+
+(define truth 1)
+(define falsity 0)
+
+(define true-value? (lambda (x) (not (zero? x))))
+
+; ------------------------------------------------------------
+; environments
+
+(define init-env
+ (lambda () (extend-env '(stdout) '(*uninitialized*) (empty-env)) ))
+
+(define-datatype environment environment?
+ (empty-env-record)
+ (extended-env-record
+ (syms (list-of symbol?))
+ (vec vector?) ; can use this for anything
+ (env environment?) ))
+
+(define empty-env (lambda () (empty-env-record)))
+
+(define extend-env
+ (lambda (syms vals env) (extended-env-record syms (list->vector vals) env)))
+
+(define extend-env-recursively
+ (lambda (proc-names idss bodies old-env)
+ (let ((len (length proc-names)))
+ (let ((vec (make-vector len)))
+ (let ((env (extended-env-record proc-names vec old-env)))
+ (for-each
+ (lambda (pos ids body)
+ (vector-set! vec pos (closure ids body env)))
+ (iota len)
+ idss
+ bodies)
+ env)))))
+
+(define apply-env-ref
+ (lambda (env sym)
+ (cases environment env
+ (empty-env-record ()
+ (eopl:error 'apply-env "no association for symbol ~s" sym))
+ (extended-env-record (syms vals env)
+ (let ((position (env-find-position sym syms)))
+ (if (number? position) (a-ref position vals) (apply-env-ref env sym)))))))
+
+(define apply-env
+ (lambda (env sym) (deref (apply-env-ref env sym))))
+
+(define env-find-position
+ (lambda (sym los) (list-find-position sym los)))
+
+(define list-find-position
+ (lambda (sym los) (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
+
+(define list-index
+ (lambda (pred ls)
+ (cond
+ ((null? ls) #f)
+ ((pred (car ls)) 0)
+ (else (let ((list-index-r (list-index pred (cdr ls))))
+ (if (number? list-index-r) (+ list-index-r 1) #f))))))
+
+(define iota
+ (lambda ( n ) (do ((n n (- n 1)) (x '() (cons (- n 1) x))) ((zero? n) x))))
+
+; ------------------------------------------------------------
+; evaluator
+
+; evaluator for root of abstract syntax tree
+(define execute-program
+ (lambda (pgm)
+ (cases program pgm
+ (a-program (statement)
+ (execute-statement statement (init-env)) ))))
+
+; (3.9) statement evaluator
+(define execute-statement
+ (lambda (stmt env)
+ (cases statement stmt
+
+ (assign-statement (id exp)
+ (setref!
+ (apply-env-ref env id)
+ (eval-expression exp env) ))
+
+ (print-statement (exp)
+ (write (eval-expression exp env)) (newline) )
+
+ (compound-statement (statements)
+ (for-each
+ (lambda (statement) (execute-statement statement env))
+ statements) )
+
+ (if-statement (exp true-statement false-statement)
+ (if (true-value? (eval-expression exp env))
+ (execute-statement true-statement env)
+ (execute-statement false-statement env) ))
+
+ ; alternate "named" LET syntax
+ (while-statement (exp statement) (while-loop exp statement env))
+
+ (block-statement (ids statement)
+ (execute-statement statement
+ (extend-env ids (map (lambda (id) 0) ids) env) ))
+ )))
+
+(define while-loop
+ (lambda (exp stmt env)
+ (if (true-value? exp)
+ (lambda () (execute-statement stmt env) (while-loop exp stmt env))
+ (#f))))
+
+; expression evaluator
+(define eval-expression
+ (lambda (exp env)
+ (cases expression exp
+ (lit-exp (datum) datum)
+ (var-exp (id) (apply-env env id))
+
+ (primapp-exp (prim rands)
+ (let ((args (eval-rands rands env)))
+ (apply-primitive prim args)))
+
+ ; (3.3) conditional evaluation
+ (if-exp (test-exp true-exp false-exp)
+ (if (true-value? (eval-expression test-exp env))
+ (eval-expression true-exp env)
+ (eval-expression false-exp env) ))
+
+ ; (3.4) local binding
+ (let-exp (ids rands body)
+ (let ((args (eval-rands rands env)))
+ (eval-expression body (extend-env ids args env))))
+
+ ; (3.5) procedure definition
+ (proc-exp (ids body) (closure ids body env))
+
+ ; (3.5) procedure application
+ (app-exp (rator rands)
+ (let ((proc (eval-expression rator env))
+ (args (eval-rands rands env)) )
+ (if (procval? proc)
+ (apply-procval proc args)
+ (eopl:error 'eval-expression
+ "attempt to apply non-procedure ~s"
+ proc))))
+
+ ; (3.6) recursion
+ (letrec-exp (proc-names idss bodies letrec-body)
+ (eval-expression letrec-body
+ (extend-env-recursively proc-names idss bodies env)))
+
+ ; (3.7) variable assignment
+ (varassign-exp (id rhs-exp)
+ (begin (setref!
+ (apply-env-ref env id)
+ (eval-expression rhs-exp env))
+ 1))
+
+ ; (3.7) sequential expressions
+ (begin-exp (exp1 exps)
+ (letrec
+ ((loop (lambda (acc exps)
+ (if (null? exps) acc
+ (loop (eval-expression (car exps) env)
+ (cdr exps))))))
+ (loop (eval-expression exp1 env) exps)))
+ )))
+
+; (3.4) evaluate operands
+(define eval-rands
+ (lambda (rands env) (map (lambda (x) (eval-rand x env)) rands)))
+(define eval-rand
+ (lambda (rand env) (eval-expression rand env)))
+
+; (3.1) apply primitive operations
+(define apply-primitive
+ (lambda (prim args)
+ (define (check arity)
+ (if (not (= arity (length args)))
+ (eopl:error 'apply-primitive
+ "wrong number of arguments to primitive ~s"
+ prim)))
+ (cases primitive prim
+ (add-prim () (check 2) (+ (car args) (cadr args)))
+ (subtract-prim () (check 2) (- (car args) (cadr args)))
+ (mult-prim () (check 2) (* (car args) (cadr args)))
+ (incr-prim () (check 1) (+ (car args) 1))
+ (decr-prim () (check 1) (- (car args) 1))
+ (equal-prim () (check 2) (if (= (car args) (cadr args)) truth falsity))
+ (zero-prim () (check 1) (if (zero? (car args)) truth falsity))
+ (greater-prim () (check 2) (if (> (car args) (cadr args)) truth falsity))
+ (less-prim () (check 2) (if (< (car args) (cadr args)) truth falsity))
+ )))
+
+; ------------------------------------------------------------
+; procedures (3.5)
+
+(define-datatype procval procval?
+ (closure
+ (ids (list-of symbol?)) ; formal parameters
+ (body expression?) ; procedure body
+ (env environment?))) ; closure (calling environment)
+
+(define apply-procval
+ (lambda (proc args)
+ (cases procval proc
+ (closure (ids body env)
+ (if (= (length ids) (length args))
+ (eval-expression body (extend-env ids args env))
+ (eopl:error 'apply-procval
+ "wrong number of arguments to procedure ~s"
+ ids))))))
+
+; ------------------------------------------------------------
+; references - for variable assignment (3.7)
+
+(define-datatype reference reference?
+ (a-ref
+ (position integer?)
+ (vec vector?) ))
+
+(define primitive-deref
+ (lambda (ref)
+ (cases reference ref
+ (a-ref (pos vec)
+ (vector-ref vec pos) ))))
+
+(define primitive-setref!
+ (lambda (ref value)
+ (cases reference ref
+ (a-ref (pos vec)
+ (vector-set! vec pos value)))))
+
+(define deref (lambda (ref) (primitive-deref ref)))
+(define setref! (lambda (ref value) (primitive-setref! ref value)))
+
+; ------------------------------------------------------------
+; interpreter
+
+; scanner only, and parser only
+(define scan
+ (sllgen:make-string-scanner scanner-spec grammar))
+(define scan&parse
+ (sllgen:make-string-parser scanner-spec grammar))
+(define read-dump
+ (sllgen:make-rep-loop "--> " (lambda (tree) tree)
+ (sllgen:make-stream-parser scanner-spec grammar)))
+
+(define scan&parse&eval
+ (lambda (s) (execute-program (scan&parse s))) )
+
+(define read-eval-print
+ (sllgen:make-rep-loop "--> " execute-program
+ (sllgen:make-stream-parser scanner-spec grammar)))
+
+; ------------------------------------------------------------
+; tests
+
+(define test-3.1a "add1(2)")
+; ignores extra parameters
+(define test-3.1b "add1(2,3)")
+(define test-3.1c "+(3,4,5)")
+; more tests
+(define test-3.1d "+(add1(2),-(6,4))")
+(define test-3.1e "*(2,+(3,sub1(4)))")
+(define test-3.3a "if -(3,+(1,2)) then 2 else 3")
+(define test-3.4a "let x = 5 y = 6 in +(x,y)")
+
+(define test3.5a "print(let f=proc(y,z) +(y,-(z,5)) in (f 2 28))")
+(define test3.5b "print((proc (x) +(x,2) 4))")
+(define test3.5c "print(let x=5 in let f=proc(y,z) +(y,-(z,x)) x=28 in (f 2 x))")
+
+(define test3.6a "print(letrec fact(x)=if zero?(x) then 1 else *(x,(fact sub1(x)))
+in (fact 6))")
+(define test3.6b "print(letrec even(x)=if zero?(x) then 1 else (odd sub1(x))
+odd(x)=if zero?(x) then 0 else (even sub1(x))
+in (odd 13))")
+
+(define test3.9a "var x,y; {x=3; y=4; print(+(x,y))}")
+(define test3.9b "var x,y,z; {x=3; y=4; z=0;
+while x do {z=+(z,y); x=sub1(x)}; print(z)}") \ No newline at end of file