source: project/release/4/r7rs/trunk/scheme.eval.scm @ 31483

Last change on this file since 31483 was 31483, checked in by evhan, 6 years ago

r7rs/eval: Use r7rs' when building environment modules

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