7491e172ea
The eopl language is now racket-based rather than mzscheme-based. This test-suite, which was originally distributed on the book's web-site has been re-written in the new language. Changes include dropping all drscheme-init.scm and top.scm files. Remaining files were renamed to use the .rkt extension and edited to use the #lang syntax (instead of modulue). Require and provide forms were changed to reflect racket's syntax instead of mzscheme's (eg, only-in vs. only). Several occurrences of one-armed ifs were changed to use when and unless. All tests have been run successfully.
69 lines
1.8 KiB
Racket
Executable File
69 lines
1.8 KiB
Racket
Executable File
#lang eopl
|
|
|
|
(require "data-structures.rkt")
|
|
(provide init-env empty-env extend-env extend-env-rec apply-env)
|
|
|
|
;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
|
|
|
|
;; init-env : () -> environment
|
|
|
|
;; (init-env) builds an environment in which i is bound to the
|
|
;; expressed value 1, v is bound to the expressed value 5, and x is
|
|
;; bound to the expressed value 10.
|
|
|
|
(define init-env
|
|
(lambda ()
|
|
(extend-env
|
|
'i (num-val 1)
|
|
(extend-env
|
|
'v (num-val 5)
|
|
(extend-env
|
|
'x (num-val 10)
|
|
(empty-env))))))
|
|
|
|
;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
|
|
|
|
;;; represent environment as an alist ((id rhs) ...)
|
|
|
|
;;; rhs is either an expval or a list (bvar body)
|
|
;;; expval is for extend-env; the list is for extend-env-rec.
|
|
|
|
;;; this representation is designed to make the printed representation
|
|
;;; of the environment more readable.
|
|
|
|
(define empty-env
|
|
(lambda ()
|
|
'()))
|
|
|
|
(define empty-env?
|
|
(lambda (x) (null? x)))
|
|
|
|
(define extend-env
|
|
(lambda (sym val old-env)
|
|
(cons (list sym val) old-env)))
|
|
|
|
(define extend-env-rec
|
|
(lambda (p-name b-var p-body saved-env)
|
|
(cons
|
|
(list p-name b-var p-body)
|
|
saved-env)))
|
|
|
|
(define apply-env
|
|
(lambda (env search-sym)
|
|
(if (null? env)
|
|
(eopl:error 'apply-env "No binding for ~s" search-sym)
|
|
(let* ((binding (car env))
|
|
(id (list-ref binding 0))
|
|
(expval-or-bvar (list-ref binding 1)))
|
|
(cond
|
|
((not (eqv? search-sym id))
|
|
(apply-env (cdr env) search-sym))
|
|
((not (symbol? expval-or-bvar))
|
|
;; this was built by extend-env
|
|
expval-or-bvar)
|
|
(else
|
|
;; this was built by extend-env-rec
|
|
(let ((bvar (cadr binding))
|
|
(body (caddr binding)))
|
|
(proc-val (procedure bvar body env)))))))))
|