aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--HW05b.scm52
-rw-r--r--hw09.scm588
2 files changed, 637 insertions, 3 deletions
diff --git a/HW05b.scm b/HW05b.scm
index 906ec38..2e8bade 100644
--- a/HW05b.scm
+++ b/HW05b.scm
@@ -1,85 +1,130 @@
#lang eopl
+;; scanner spec
(define scanner-spec
'(
(whitespace (whitespace) skip)
(number (digit (arbno digit)) make-number)
- (operator ((or "+" "-" "*" "/" "(" ")")) make-symbol)))
+ (operator ((or "+" "-" "*" "/" "(" ")")) make-symbol)))
+;; grammar
(define grammar
'(
+ ;; expression - 2+4*2*(1+2+3)
(expression (term (arbno add-op term)) arith-expr)
+
+ ;; term - 1*2*3
(term (factor (arbno mult-op factor)) arith-factor)
+
+ ;; factors - 2, (1+2+3)
(factor (number) number-factor)
(factor ("(" expression ")") expr-factor)
+
+ ;; addition and subtraction
(add-op ("+") plus-op)
(add-op ("-") minus-op)
+
+ ;; multiplication and division
(mult-op ("*") times-op)
(mult-op ("/") divide-op)
))
+;; make the datatypes
(sllgen:make-define-datatypes scanner-spec grammar)
(define dump-datatypes
(lambda ()
(sllgen:list-define-datatypes scanner-spec grammar)))
-
+;; top level expression evaluator
(define execute-expression
(lambda (expr)
(cases expression expr
+ ;; use a helper function to keep code out of here
(arith-expr (term ops terms) (expr-helper term ops terms))
)))
+;; helper function to evaluate an expression
(define expr-helper
(lambda (term ops terms)
(if (null? ops)
+ ;; single term
(eval-term term)
+
+ ;; else, check if there's just one term
(if (equal? (length ops) 1)
(eval-add-op (car ops) term (car terms))
+ ;; else, handle multiple terms
'a
))))
+;; evaluates an add operator
(define eval-add-op
(lambda (op term1 term2)
(cases add-op op
+
+ ;; perform addition
(plus-op () (+ (eval-term term1) (eval-term term2)))
+
+ ;; perform subtraction
(minus-op () (- (eval-term term1) (eval-term term2)))
)))
+;; evaluate a term
(define eval-term
(lambda (term1)
(cases term term1
+
+ ;; use a helper function to keep this one clean
(arith-factor (factor ops factors) (term-helper factor ops factors))
)))
+;; helper function for evaluating terms
(define term-helper
(lambda (factor ops factors)
+
+ ;; if there is a single factor...
(if (null? ops)
+ ;; ... evaluate and return it
(eval-factor factor)
+
+ ;; otherwise, if there are 2 factors...
(if (equal? (length ops) 1)
+
+ ;; evaluate and return them.
(eval-mult-op (car ops) factor (car factors))
+ ;; otherwise, handle multiple factors
'b
))))
+;; handles multiplication and division
(define eval-mult-op
(lambda (op fac1 fac2)
(cases mult-op op
+
+ ;; perform multiplication
(times-op () (* (eval-factor fac1) (eval-factor fac2)))
+
+ ;; perform division
(divide-op () (/ (eval-factor fac1) (eval-factor fac2)))
)))
+;; evaluate a factor
(define eval-factor
(lambda (fac)
(cases factor fac
+
+ ;; if it's a number, give the number
(number-factor (num) num)
+
+ ;; if it's an expression, evaluate the expression
(expr-factor (expr) (execute-expression expr))
)))
-
+;; SLLGEN things
(define scan
(sllgen:make-string-scanner scanner-spec grammar))
(define scan&parse
@@ -93,4 +138,5 @@
(define read-eval-print
(sllgen:make-rep-loop "> " execute-expression (sllgen:make-stream-parser scanner-spec grammar)))
+;; shortcut for quicker testing
(define spe scan&parse&eval) \ No newline at end of file
diff --git a/hw09.scm b/hw09.scm
new file mode 100644
index 0000000..f21c3c5
--- /dev/null
+++ b/hw09.scm
@@ -0,0 +1,588 @@
+#lang eopl
+; 4.3 INTERPRETER
+; - this interpreter supports:
+; - (3.x) expressions, bindings, procedures, recursion
+; - (4.2) type-checking
+; - (4.3) abstraction boundaries
+
+; ------------------------------------------------------------
+; grammar specification for scanner & parser
+
+(define scanner-spec
+ '((whitespace (whitespace) skip)
+ (comment ("%" (arbno (not #\newline))) skip)
+ (identifier (letter (arbno (or letter digit "_" "-" "?"))) symbol)
+ (number (digit (arbno digit)) number) ))
+
+(define parser-spec
+ '((program (expression) stmt-prog)
+ ; (3.1) literal numbers and booleans, identifiers, primitive operations
+ (expression (number) lit-expr)
+ (expression ("true") true-expr)
+ (expression ("false") false-expr)
+ (expression (identifier) var-expr)
+ (expression (primitive "(" (separated-list expression ",") ")")
+ primapp-expr)
+ ; (3.3) conditionals
+ (expression ("if" expression "then" expression "else" expression)
+ if-expr)
+ ; (3.4) local bindings
+ (expression ("let" (arbno identifier "=" expression) "in" expression)
+ let-expr)
+ ; (3.5) procedure definitions(w/types) & applications
+ (expression ("proc" "(" (separated-list type-exp identifier ",") ")" expression)
+ proc-expr)
+ (expression ("(" expression (arbno expression) ")")
+ app-expr)
+ ; (3.6) mutually recursive bindings (w/types)
+ (expression ("letrec" (arbno type-exp identifier
+ "(" (separated-list type-exp identifier ",") ")"
+ "=" expression) "in" expression)
+ letrec-expr)
+ ; (4.3) type definitions
+ (expression ("lettype" identifier "=" type-exp
+ (arbno type-exp identifier
+ "(" (separated-list type-exp identifier ",") ")"
+ "=" expression)
+ "in" expression)
+ lettype-expr)
+
+ ; (3.1) primitive operations
+ (primitive ("+") add-prim)
+ (primitive ("-") sub-prim)
+ (primitive ("*") mult-prim)
+ (primitive ("add1") incr-prim)
+ (primitive ("sub1") decr-prim)
+ (primitive ("zero?") zero-prim)
+
+ ; (4.2) types
+ (type-exp ("int") int-type-exp)
+ (type-exp ("bool") bool-type-exp)
+ (type-exp (identifier) tid-type-exp)
+ (type-exp ("(" (separated-list type-exp "*") "->" type-exp ")") proc-type-exp)
+ ))
+
+ ; ------------------------------------------------------------
+; define data types before defining interpreter
+
+(sllgen:make-define-datatypes scanner-spec parser-spec)
+(define show-the-datatype
+ (lambda () (sllgen:list-define-datatypes scanner-spec parser-spec)) )
+
+; ------------------------------------------------------------
+; types (4.2-4.3, pg 134, revised pg 147)
+
+(define-datatype type type?
+ ; named atomic type
+ (atomic-type (name symbol?))
+ ; procedure type (parameter types and result type)
+ ( proc-type (arg-types (list-of type?)) (result-type type?)) )
+
+; primitive types
+(define int-type (atomic-type 'int ))
+(define bool-type (atomic-type 'bool))
+
+; type-expressions
+(define expand-type-expression
+ (lambda (texp tenv)
+ (cases type-exp texp
+ ; (4.2) primitive expression types
+ ( int-type-exp () int-type)
+ (bool-type-exp () bool-type)
+ ; (4.3) type definitions
+ ( tid-type-exp (id) (find-typedef tenv id))
+ ; (4.2) procedure types using
+ ; (4.3) type environment
+ (proc-type-exp (arg-texps result-texp)
+ (proc-type
+ (expand-type-expressions arg-texps tenv)
+ (expand-type-expression result-texp tenv) )) )))
+
+(define expand-type-expressions
+ (lambda (texps tenv)
+ (map (lambda (texp) (expand-type-expression texp tenv)) texps)))
+
+; check that two types are equal
+(define check-equal-type!
+ (lambda (t1 t2 exp)
+ (or (equal? t1 t2)
+ (eopl:error 'type-of-expression
+ "Types didn't match: ~s != ~s in~%~s"
+ (type-to-external-form t1)
+ (type-to-external-form t2)
+ exp))))
+
+ ; ------------------------------------------------------------
+; type checker (pg 136-137)
+
+(define type-of-program
+ (lambda (prog)
+ (cases program prog
+ (stmt-prog (exp) (type-of-expression exp (empty-tenv))))))
+
+(define type-of-expression
+ (lambda (expr tenv)
+ (cases expression expr
+ ; (4.2) literals - have fixed type
+ (lit-expr (number) int-type)
+ (true-expr () bool-type)
+ (false-expr () bool-type)
+ ; (4.2) variables (identifiers) - look up in type environment
+ (var-expr (id) (apply-tenv tenv id))
+ ; (4.2) conditionals
+ (if-expr (test-expr then-expr else-expr)
+ (let ((test-type (type-of-expression test-expr tenv))
+ (then-type (type-of-expression then-expr tenv))
+ (else-type (type-of-expression else-expr tenv)) )
+ ;; these tests either succeed or raise an error
+ ; check that test-expr has bool-type
+ (check-equal-type! test-type bool-type test-expr)
+ ; check that then-exp and else-exp have the same type
+ (check-equal-type! then-type else-type expr)
+ ; return result type (then-expr and else-expr have same type)
+ then-type))
+ ; (4.2) procedure definitions
+ (proc-expr (texps ids body)
+ (type-of-proc-expr texps ids body tenv))
+ ; (4.2) primitive applications
+ (primapp-expr (prim rands)
+ (type-of-application (type-of-primitive prim)
+ (types-of-expressions rands tenv)
+ prim rands expr))
+ ; (4.2) procedure applications
+ (app-expr (rator rands)
+ (type-of-application (type-of-expression rator tenv)
+ (types-of-expressions rands tenv)
+ rator rands expr))
+ ; (4.2) local bindings
+ (let-expr (ids rands body)
+ (type-of-let-expr ids rands body tenv))
+ (letrec-expr (result-texps proc-names texpss idss bodies body)
+ (type-of-letrec-expr
+ result-texps proc-names texpss idss bodies body tenv))
+ ; (4.3) type definitions
+ (lettype-expr (type-name texp result-texps proc-names texpss idss bodies body)
+ (type-of-lettype-expr
+ type-name texp
+ result-texps proc-names texpss idss bodies body tenv))
+ )))
+
+; get list of types for list of expressions (typically operands)
+(define types-of-expressions
+ (lambda (rands tenv)
+ (map (lambda (expr) (type-of-expression expr tenv)) rands) ))
+
+ (define type-of-primitive
+ (lambda (prim)
+ (cases primitive prim
+ ( add-prim () (proc-type (list int-type int-type) int-type))
+ ( sub-prim () (proc-type (list int-type int-type) int-type))
+ (mult-prim () (proc-type (list int-type int-type) int-type))
+ (incr-prim () (proc-type (list int-type) int-type))
+ (decr-prim () (proc-type (list int-type) int-type))
+ (zero-prim () (proc-type (list int-type) bool-type)) )))
+
+(define type-of-proc-expr
+ (lambda (texps ids body tenv)
+ ; get argument types and result type (must be inferred from procedure body)
+ (let ((arg-types (expand-type-expressions texps tenv)))
+ (let ((result-type (type-of-expression body (extend-tenv ids arg-types tenv))))
+ ; proc type is determined by argument types and result type
+ (proc-type arg-types result-type) ))))
+
+(define type-of-application
+ (lambda (rator-type rand-types rator rands exp)
+ (cases type rator-type
+ (proc-type (arg-types result-type)
+ ; if same # of args and rands, and types line up, then return result-type
+ (if (= (length arg-types) (length rand-types))
+ (begin
+ (for-each check-equal-type! rand-types arg-types rands)
+ result-type)
+ (eopl:error 'type-of-expression
+ (string-append
+ "Wrong number of arguments in expression"
+ "~s:~%expected ~s~%got ~s")
+ exp
+ (map type-to-external-form arg-types)
+ (map type-to-external-form rand-types) )))
+ (else (eopl:error 'type-of-expression
+ "Rator not a proc type:~%~s~%had rator type ~s"
+ rator (type-to-external-form rator-type) )) )))
+
+; (4.2)
+(define type-of-let-expr
+ (lambda (ids rands body tenv)
+ (let ((tenv-for-body (extend-tenv ids (types-of-expressions rands tenv) tenv)))
+ (type-of-expression body tenv-for-body))))
+
+ ; (4.2)
+(define type-of-letrec-expr
+ ; takes set of procedures (result types, names, arg types, arg names, and bodies)
+ ; body in which new type is used, and parent type environment
+ (lambda (result-texps proc-names texpss idss bodies letrec-body tenv)
+ ; determine arg types, result types, and resulting procedure types
+ (let ((arg-typess ; list of lists of argument types
+ (map (lambda (texps) (expand-type-expressions texps tenv)) texpss))
+ (result-types ; list of result types
+ (expand-type-expressions result-texps tenv) ))
+ (let ((the-proc-types ; list of procedure types
+ (map proc-type arg-typess result-types)))
+ (let ((tenv-for-body ; type env for all proc-bodies
+ (extend-tenv proc-names the-proc-types tenv)))
+ ; check that each procedure body matches declared procedure type
+ (for-each
+ (lambda (ids arg-types body result-type)
+ (check-equal-type!
+ (type-of-expression body (extend-tenv ids arg-types tenv-for-body))
+ result-type
+ body))
+ idss arg-typess bodies result-types)
+ ; return type of letrec-body
+ (type-of-expression letrec-body tenv-for-body))))))
+
+; (4.3)
+(define type-of-lettype-expr
+ ; takes name of new type, type expression for representation,
+ ; set of procedures (result types, names, arg types, arg names, and bodies)
+ ; body in which new type is used, and parent type environment
+ (lambda (type-name texp
+ result-texps proc-names arg-texpss idss bodies
+ lettype-body tenv)
+ (let ((the-new-type (fresh-type type-name))
+ (rhs-texps (map proc-type-exp arg-texpss result-texps)))
+ (let (
+ ; for implementation, defined type is bound to definition (TRANSPARENT)
+ (tenv-for-implementation
+ (extend-tenv-with-typedef-exp type-name texp tenv))
+ ; for client (body), defined type is bound to atomic type (OPAQUE)
+ (tenv-for-client
+ (extend-tenv-with-typedef type-name the-new-type tenv)))
+ (let ((tenv-for-proc ; type env for all proc-bodies
+ (extend-tenv-with-type-exps
+ proc-names rhs-texps tenv-for-implementation))
+ (tenv-for-body ; type env for body
+ (extend-tenv-with-type-exps
+ proc-names rhs-texps tenv-for-client)))
+ ; check that each procedure body matches declared procedure type
+ (for-each
+ (lambda (ids arg-texps body result-texp)
+ (check-equal-type!
+ (type-of-expression
+ body
+ (extend-tenv-with-type-exps ids arg-texps tenv-for-proc))
+ (expand-type-expression result-texp tenv-for-proc)
+ body))
+ idss arg-texpss bodies result-texps)
+ ; return type of lettype-body
+ (type-of-expression lettype-body tenv-for-body))))))
+
+ ; create fresh type based on parameter name (4.3, pg 149)
+; - each time this is called, counter is incremented
+(define fresh-type
+ (let ((counter 0))
+ (lambda (s)
+ (set! counter (+ counter 1))
+ (atomic-type (string->symbol
+ (string-append (symbol->string s) (number->string counter)) )))))
+
+; extend type environment (4.3, pg 149)
+(define extend-tenv-with-typedef-exp
+ (lambda (typename texp tenv)
+ (extend-tenv-with-typedef typename (expand-type-expression texp tenv) tenv)))
+
+; extend type environment (4.3, pg 149)
+(define extend-tenv-with-type-exps
+ (lambda (ids texps tenv)
+ (extend-tenv ids (expand-type-expressions texps tenv) tenv)))
+
+; ------------------------------------------------------------
+; type environments
+
+(define-datatype type-environment type-environment?
+ ; (4.2) empty & extended type environments
+ (empty-tenv-record)
+ (extended-tenv-record (syms (list-of symbol?))
+ (vals (list-of type?))
+ (tenv type-environment?))
+ ; (4.3, pg 146) environment extended with new type definition
+ (typedef-record (name symbol?)
+ (definition type?)
+ (tenv type-environment?) ))
+
+(define empty-tenv empty-tenv-record)
+(define extend-tenv extended-tenv-record)
+(define extend-tenv-with-typedef typedef-record)
+
+; (4.3)
+(define apply-tenv
+ (lambda (tenv sym)
+ (cases type-environment tenv
+ (empty-tenv-record ()
+ (eopl:error 'apply-tenv
+ "Variable ~s unbound in type environment" sym))
+ (extended-tenv-record (syms vals tenv)
+ (let ((pos (list-find-position sym syms)))
+ (if (number? pos)
+ (list-ref vals pos) (apply-tenv tenv sym))))
+ (typedef-record (name type tenv)
+ (apply-tenv tenv sym)))))
+
+; (4.3)
+(define find-typedef
+ (lambda (tenv0 sym)
+ (let loop ((tenv tenv0))
+ (cases type-environment tenv
+ (empty-tenv-record ()
+ (eopl:error 'apply-tenv
+ "Type variable ~s unbound in type environment ~s"
+ sym tenv0))
+ (extended-tenv-record (syms vals tenv) (loop tenv))
+ (typedef-record (name type tenv)
+ (if (eqv? name sym) type (loop tenv)))))))
+
+ ; ------------------------------------------------------------
+; external form of types (pg 135)
+
+(define type-to-external-form
+ (lambda (ty)
+ (cases type ty
+ (atomic-type (name) name)
+ ( proc-type (arg-types result-type)
+ (append (arg-types-to-external-form arg-types) '(->)
+ (list (type-to-external-form result-type)) )))))
+
+(define arg-types-to-external-form
+ (lambda (types)
+ (if (null? types)
+ '()
+ (if (null? (cdr types))
+ (list (type-to-external-form (car types)))
+ (cons (type-to-external-form (car types))
+ (cons '* (arg-types-to-external-form (cdr types)) ))))))
+
+; ------------------------------------------------------------
+; interpreter
+
+(define eval-expression
+ (lambda (expr env)
+ (cases expression expr
+ (lit-expr (datum) datum)
+ (true-expr () 1)
+ (false-expr () 0)
+ (var-expr (id) (apply-env env id))
+ (primapp-expr (prim rands)
+ (let ((args (eval-primapp-expr-rands rands env)))
+ (apply-primitive prim args)))
+ (if-expr (test-expr then-expr else-expr)
+ (if (true-value? (eval-expression test-expr env))
+ (eval-expression then-expr env)
+ (eval-expression else-expr env)))
+ (let-expr (ids rands body)
+ (let ((args (eval-rands rands env)))
+ (eval-expression body (extend-env ids args env))))
+ (proc-expr (texps ids body)
+ (closure ids body env))
+ (app-expr (rator rands)
+ (let ((proc (eval-expression rator env))
+ (args (eval-rands rands env)))
+ (if (procval? proc) ; always true in typechecked code
+ (apply-procval proc args)
+ (eopl:error 'eval-expr "Attempt to apply non-proc ~s" proc) )))
+ (letrec-expr (result-texps proc-names texpss idss bodies letrec-body)
+ (eval-expression letrec-body
+ (extend-env-recursively proc-names idss bodies env)))
+ (lettype-expr (type-name texp
+ result-texps proc-names texpss
+ idss bodies lettype-body)
+ (eval-expression lettype-body
+ (extend-env-recursively proc-names idss bodies env)))
+
+ )))
+
+ (define eval-program
+ (lambda (prog)
+ (cases program prog
+ (stmt-prog (body) (eval-expression body (empty-env))) )))
+
+(define eval-primapp-expr-rands
+ (lambda (rands env)
+ (map (lambda (x) (eval-expression x env)) rands)))
+
+(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 apply-primitive
+ (lambda (prim args)
+ (cases primitive prim
+ ( add-prim () (+ (car args) (cadr args)))
+ ( sub-prim () (- (car args) (cadr args)))
+ (mult-prim () (* (car args) (cadr args)))
+ (incr-prim () (+ (car args) 1))
+ (decr-prim () (- (car args) 1))
+ (zero-prim () (if (zero? (car args)) 1 0))
+ )))
+
+; ------------------------------------------------------------
+; booleans
+
+(define true-value? (lambda (x) (not (zero? x))))
+
+; ------------------------------------------------------------
+; procedures
+
+(define-datatype procval procval?
+ (closure
+ (ids (list-of symbol?))
+ (body expression?)
+ (env environment?) ))
+
+(define apply-procval
+ (lambda (proc args)
+ (cases procval proc
+ (closure (ids body env)
+ (eval-expression body (extend-env ids args env))))))
+
+ ; ------------------------------------------------------------
+; environments
+
+(define-datatype environment environment?
+ (empty-env-record)
+ (extended-env-record
+ (syms (list-of symbol?))
+ (vals vector?)
+ (env environment?)))
+
+(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 old-env)
+ (let ((pos (rib-find-position sym syms)))
+ (if (number? pos)
+ (vector-ref vals pos)
+ (apply-env old-env sym)))))))
+
+(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 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))))))
+
+(define iota
+ (lambda (end)
+ (let loop ((next 0))
+ (if (>= next end) '() (cons next (loop (+ 1 next)))) )))
+
+ ; ------------------------------------------------------------
+; interpreter
+
+(define scan (sllgen:make-string-scanner scanner-spec parser-spec))
+(define scan&parse (sllgen:make-string-parser scanner-spec parser-spec))
+
+
+(define ext-type-of-program
+ (lambda (program)
+ (type-to-external-form (type-of-program program)) ))
+(define ext-type-and-eval-program
+ (lambda (program)
+ (display "type= ") (display (ext-type-of-program program)) (newline)
+ (display (eval-program program)) (newline) ))
+
+; string versions
+(define internal-type
+ (lambda (string) ( type-of-program (scan&parse string))) )
+(define external-type
+ (lambda (string) ( ext-type-of-program (scan&parse string))) )
+(define run
+ (lambda (string) ( eval-program (scan&parse string))) )
+(define type&run
+ (lambda (string) (ext-type-and-eval-program (scan&parse string))) )
+
+; loop versions
+(define stream-parser (sllgen:make-stream-parser scanner-spec parser-spec))
+; prints internal type or external type for each entered expression
+(define read-internal-type
+ (sllgen:make-rep-loop "--> " type-of-program stream-parser))
+(define read-external-type
+ (sllgen:make-rep-loop "--> " ext-type-of-program stream-parser))
+; eval each entered expression without or with type checking
+(define read-eval-print
+ (sllgen:make-rep-loop "--> " eval-program stream-parser))
+(define read-type-eval-print
+ (sllgen:make-rep-loop "--> " ext-type-and-eval-program stream-parser))
+
+ ; ------------------------------------------------------------
+; tests
+
+(define test-4a "+(3,4)")
+(define test-4b "if zero?(-(2,3)) then 1 else *(2,4)")
+
+; proc that takes int and adds 1
+(define test-4.2a "proc (int x) add1(x)")
+(define test-4.2b "(proc (int x) add1(x) 12)")
+; recursive proc that takes int and returns factorial
+(define test-4.2c "letrec int fact (int x)
+ = if zero?(x) then 1 else *(x,(fact sub1(x)))
+ in fact")
+(define test-4.2d "letrec int fact (int x)
+ = if zero?(x) then 1 else *(x,(fact sub1(x)))
+ in (fact 4)")
+
+(type&run test-4.2a)
+(type&run test-4.2b)
+(type&run test-4.2c)
+(type&run test-4.2d)
+
+; type "myint" which represents 0 as 1, etc.
+(define test-4.3a "lettype myint = int
+ myint zero() = 1
+ myint succ(myint x) = add1(x)
+ myint pred(myint x) = sub1(x)
+ bool iszero?(myint x) = zero?(sub1(x))
+ in (iszero?(pred(succ(zero))))")
+(type&run test-4.3a)
+
+; type "ff" for finite functions (map ints to ints)
+(define test-4.3b "lettype ff = (int -> int)
+ ff zero-ff() % create ff that returns 0 (base case)
+ = proc (int k) 0
+ ff extend-ff(int k, int val, ff old-ff) % extend ff with new pair
+ = proc (int k1)
+ if zero?(-(k1,k)) then val else (apply-ff old-ff k1)
+ int apply-ff(ff f, int k) = (f k) % apply ff to value
+ in let ff1 = (extend-ff 1 11 (extend-ff 2 22 (zero-ff)))
+ in (apply-ff ff1 2)")
+(type&run test-4.3b) \ No newline at end of file