racket/collects/tests/eopl/chapter4/explicit-refs/environments.rkt
David Van Horn 7491e172ea EOPL test suite re-written in Racket-based #lang eopl and rackunit
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.
2012-02-24 14:46:18 -05:00

62 lines
1.9 KiB
Racket
Executable File

#lang eopl
(require "data-structures.rkt")
(provide init-env empty-env extend-env apply-env)
;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
;; init-env : () -> Env
;; usage: (init-env) = [i=1, v=5, x=10]
;; (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.
;; Page: 69
(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 ;;;;;;;;;;;;;;;;
(define apply-env
(lambda (env search-sym)
(cases environment env
(empty-env ()
(eopl:error 'apply-env "No binding for ~s" search-sym))
(extend-env (bvar bval saved-env)
(if (eqv? search-sym bvar)
bval
(apply-env saved-env search-sym)))
(extend-env-rec* (p-names b-vars p-bodies saved-env)
(cond
((location search-sym p-names)
=> (lambda (n)
(proc-val
(procedure
(list-ref b-vars n)
(list-ref p-bodies n)
env))))
(else (apply-env saved-env search-sym)))))))
;; location : Sym * Listof(Sym) -> Maybe(Int)
;; (location sym syms) returns the location of sym in syms or #f is
;; sym is not in syms. We can specify this as follows:
;; if (memv sym syms)
;; then (list-ref syms (location sym syms)) = sym
;; else (location sym syms) = #f
(define location
(lambda (sym syms)
(cond
((null? syms) #f)
((eqv? sym (car syms)) 0)
((location sym (cdr syms))
=> (lambda (n)
(+ n 1)))
(else #f))))