112 lines
4 KiB
Scheme
112 lines
4 KiB
Scheme
;;; Ported from Scheme 48 1.9. See file COPYING for notices and license.
|
|
;;;
|
|
;;; Port Author: Andrew Whatson
|
|
;;;
|
|
;;; Original Authors: Richard Kelsey, Jonathan Rees, Mike Sperber
|
|
;;;
|
|
;;; scheme48-1.9.2/scheme/bcomp/cenv.scm
|
|
|
|
(define-module (prescheme bcomp cenv)
|
|
#:use-module (srfi srfi-9)
|
|
#:use-module (prescheme record-discloser)
|
|
#:export (make-compiler-env ;; re-exported by syntactic
|
|
compiler-env?
|
|
lookup
|
|
bind1
|
|
|
|
bind-source-file-name ;; re-exported by syntactic
|
|
source-file-name
|
|
|
|
comp-env-macro-eval
|
|
comp-env-define!
|
|
|
|
extract-package-from-comp-env)
|
|
#:re-export (bind))
|
|
|
|
;; Compile-time environments
|
|
;; These are functions
|
|
;; name -> node ; lexical variable
|
|
;; binding ; package variable, any syntax
|
|
;; #f ; free
|
|
;;
|
|
;; Special names are used to retrieve various values from compiler environments.
|
|
|
|
(define-record-type :compiler-specials
|
|
(make-compiler-specials lookup define! macro-eval package source-file-name)
|
|
compiler-specials?
|
|
(lookup compiler-specials-lookup)
|
|
(define! compiler-specials-define!)
|
|
(macro-eval compiler-specials-macro-eval)
|
|
(package compiler-specials-package)
|
|
(source-file-name compiler-specials-source-file-name))
|
|
|
|
(define-record-type :compiler-env
|
|
(really-make-compiler-env specials alist)
|
|
compiler-env?
|
|
(specials compiler-env-specials)
|
|
(alist compiler-env-alist))
|
|
|
|
(define (lookup cenv name)
|
|
(cond
|
|
((assq name (compiler-env-alist cenv)) => cdr)
|
|
(else
|
|
((compiler-specials-lookup (compiler-env-specials cenv)) name))))
|
|
|
|
(define (bind1 name binding cenv)
|
|
(really-make-compiler-env (compiler-env-specials cenv)
|
|
(cons (cons name binding) (compiler-env-alist cenv))))
|
|
|
|
(define (bind names bindings cenv)
|
|
(really-make-compiler-env (compiler-env-specials cenv)
|
|
(append (map cons names bindings)
|
|
(compiler-env-alist cenv))))
|
|
|
|
;; Making the initial compiler environment.
|
|
;;
|
|
;; lookup : name -> binding or (binding . path) or #f
|
|
;; define! : name type [static] -> void
|
|
;; macro-eval : reflective tower, i.e. promise that returns
|
|
;; (<eval> . <env>) for evaluating macro expanders
|
|
|
|
(define (make-compiler-env lookup define! macro-eval package)
|
|
(really-make-compiler-env (make-compiler-specials lookup define! macro-eval package #f)
|
|
'()))
|
|
|
|
;; EVAL function for evaluating macro expanders.
|
|
|
|
(define (comp-env-macro-eval cenv)
|
|
(compiler-specials-macro-eval (compiler-env-specials cenv)))
|
|
|
|
;; Function for adding definitions to the outer package.
|
|
|
|
(define (comp-env-define! cenv name type . maybe-value)
|
|
(apply (compiler-specials-define! (compiler-env-specials cenv))
|
|
name type maybe-value))
|
|
|
|
;; The package on which the compiler environment is based. This is a
|
|
;; temporary hack to keep the package-editing code working.
|
|
|
|
(define (extract-package-from-comp-env cenv)
|
|
(compiler-specials-package (compiler-env-specials cenv)))
|
|
|
|
;; The name of the source file.
|
|
;; This is used by the %FILE-NAME% special form,
|
|
;; which is in turn used by the (MODULE ...) form to save the current file in
|
|
;; each package,
|
|
;; which is (finally) used to look up filenames in the correct directory.
|
|
|
|
(define (bind-source-file-name filename env)
|
|
(if filename
|
|
(let ((specials (compiler-env-specials env)))
|
|
(really-make-compiler-env (make-compiler-specials
|
|
(compiler-specials-lookup specials)
|
|
(compiler-specials-define! specials)
|
|
(compiler-specials-macro-eval specials)
|
|
(compiler-specials-package specials)
|
|
filename)
|
|
(compiler-env-alist env)))
|
|
env))
|
|
|
|
(define (source-file-name cenv)
|
|
(compiler-specials-source-file-name (compiler-env-specials cenv)))
|