~ chicken-r7rs (master) /scheme.eval.scm

 1(module scheme.eval (eval environment)
 2  (import (rename scheme (eval %eval)))
 3  (import chicken.base chicken.type)
 4  (import r7rs-library)
 5
 6;;;
 7;;; 6.12. Environments and evaluation
 8;;;
 9
10  (: eval (* (struct environment) -> *))
11
12  (define (eval expr env) (%eval expr env))
13
14  (: environment (#!rest list -> (struct environment)))
15
16  (define (environment . specs)
17    (let ((name (gensym "environment-module-")))
18      (define (delmod)
19	(and-let* ((modp (assq name ##sys#module-table)))
20	  (set! ##sys#module-table (##sys#delq modp ##sys#module-table))))
21      (dynamic-wind
22       void
23       (lambda ()
24	 ;; create module...
25	 (%eval `(module ,name ()
26		   (import r7rs) ; for `import`
27		   ,@(map (lambda (spec)
28			    `(import ,(fixup-import/export-spec spec 'environment)))
29			  specs)))
30	 (let ((mod (##sys#find-module name)))
31	   (##sys#make-structure 'environment
32	    (cons 'import specs)
33	    (let ((env (##sys#slot mod 13)))
34	      (append (car env) (cdr env))) ; combine env and syntax bindings
35	    #t)))
36       ;; ...and remove it right away
37       delmod)))
38
39)