add `compile-time-environment'

* ice-9/boot-9.scm (compile-time-environment): New function, with
  documentation. The trick is that the compiler recognizes calls to
  (compile-time-environment) and replaces it with a representation of the
  *available* lexicals. Note that this might not be all the lexicals;
  only the heap-allocated ones are returned.

* module/language/scheme/translate.scm (custom-transformer-table):
  Compile `compile-time-environment' to <ghil-reified-env>.

* module/system/il/compile.scm (codegen): Add <ghil-reified-env> clause,
  which calls ghil-env-reify.

* module/system/il/ghil.scm (ghil-env-reify): New procedure, returns a
  list of (NAME . EXTERNAL-INDEX).
  (<ghil>): Add <ghil-reified-env> object.

ice-9/boot-9.scm

@@ -123,6 +123,12 @@
 	(else
 	 (loop (cdr clauses))))))))
 
+(define (compile-time-environment)
+  "A special function known to the compiler that, when compiled, will
+return a representation of the lexical environment in place at compile
+time. Useful for supporting some forms of dynamic compilation."
+  (error "compile-time-environment and the interpreter do not mix"))
+
 
 
 ;; Before compiling, make sure any symbols are resolved in the (guile)

module/language/scheme/translate.scm

@@ -381,7 +381,10 @@
 
     (values
      ((,x) (retrans x))
-     (,args (make-ghil-values e l (map retrans args))))))
+     (,args (make-ghil-values e l (map retrans args))))
+
+    (compile-time-environment
+     (() (make-ghil-reified-env e l)))))
 
 (define (lookup-apply-transformer proc)
   (cond ((eq? proc values)

module/system/il/compile.scm

@@ -397,7 +397,11 @@
            (push-code! loc (make-glil-call (if tail 'goto/nargs 'call/nargs) 0))
            (cond ((not tail)
                   (push-label! POST)
-                  (maybe-drop)))))))
+                  (maybe-drop)))))
+
+        ((<ghil-reified-env> env loc)
+         (return-object! loc (ghil-env-reify env)))))
+
     ;;
     ;; main
     (record-case ghil

module/system/il/ghil.scm

@@ -93,7 +93,11 @@
    <ghil-env> make-ghil-env ghil-env?
    ghil-env-parent ghil-env-table ghil-env-variables
 
+   <ghil-reified-env> make-ghil-reified-env ghil-reified-env?
+   ghil-reified-env-env ghil-reified-env-loc
+
    ghil-env-add!
+   ghil-env-reify
    ghil-var-is-bound? ghil-var-for-ref! ghil-var-for-set! ghil-var-define!
    ghil-var-at-module!
    call-with-ghil-environment call-with-ghil-bindings))
@@ -126,7 +130,8 @@
   (<ghil-mv-call> env loc producer consumer)
   (<ghil-inline> env loc inline args)
   (<ghil-values> env loc values)
-  (<ghil-values*> env loc values))
+  (<ghil-values*> env loc values)
+  (<ghil-reified-env> env loc))
 
 
 
@@ -274,6 +279,21 @@
     (for-each (lambda (v) (ghil-env-remove! e v)) vars)
     ret))
 
+(define (ghil-env-reify env)
+  (let loop ((e env) (out '()))
+    (record-case e
+      ((<ghil-toplevel-env> table)
+       (map (lambda (v)
+              (cons (ghil-var-name v)
+                    (or (ghil-var-index v)
+                        (error "reify called before indices finalized"))))
+            out))
+      ((<ghil-env> parent table variables)
+       (loop parent
+             (append out
+                     (filter (lambda (v) (eq? (ghil-var-kind v) 'external))
+                             variables)))))))
+
 
 ;;;
 ;;; Parser