serialize module information into syncase's output -- getting ready for hygiene

* module/ice-9/Makefile.am: Replace annotate.scm with expand-support.scm.

* module/ice-9/annotate.scm: Removed; subsumed into expand-support.scm.

* module/ice-9/compile-psyntax.scm: Strip out expansion structures before
  writing to disk.

* module/ice-9/expand-support.scm: New file. Provides annotation support,
  and other compound data types for use by the expander. Currently the
  only one that is used is the toplevel reference, <module-ref>, but we
  will record lexicals this way soon.

* module/ice-9/psyntax-pp.scm: Regenerate.

* module/ice-9/psyntax.scm (build-global-reference)
  (build-global-assignment): Instead of expanding out global references
  as symbols, expand them as <module-ref> structures, with space to
  record the module that they should be scoped against. This is in
  anticipation of us actually threading the module info through the
  syntax transformation, so that we can get hygiene with respect to
  modules.

* module/ice-9/syncase.scm: Replace eval-when. Since sc-expand will give
  us something that isn't Scheme because we put the <module-ref>
  structures in it, strip that info whenever we actually do need scheme.

* module/language/scheme/compile-ghil.scm (lookup-transformer): Strip
  expansion structures here too.

* module/language/scheme/expand.scm (language): Swap annotate for
  expand-support. But this file will die soon, I think.

module/ice-9/Makefile.am

@@ -30,7 +30,7 @@ modpath = ice-9
 # and forth between interpreted and compiled code, we end up using more
 # of the C stack than the interpreter would have; so avoid that by
 # putting these core modules first.
-SOURCES = psyntax-pp.scm annotate.scm boot-9.scm \
+SOURCES = psyntax-pp.scm expand-support.scm boot-9.scm \
 	and-let-star.scm calling.scm common-list.scm			\
 	debug.scm debugger.scm documentation.scm emacs.scm expect.scm	\
 	format.scm getopt-long.scm hcons.scm i18n.scm			\

module/ice-9/compile-psyntax.scm

@@ -20,7 +20,9 @@
 	    (close-port out)
 	    (close-port in))
 	  (begin
-	    (write (sc-expand3 x 'c '(compile load eval)) out)
+	    (write (strip-expansion-structures
+                    (sc-expand3 x 'c '(compile load eval)))
+                   out)
 	    (newline out)
 	    (loop (read in)))))))
 

module/ice-9/expand-support.scm

@@ -16,11 +16,19 @@
 ;;;; 
 
 
-(define-module (ice-9 annotate)
+(define-module (ice-9 expand-support)
   :export (<annotation> annotation? annotate deannotate make-annotation
            annotation-expression annotation-source annotation-stripped
            set-annotation-stripped!
-           deannotate/source-properties))
+           deannotate/source-properties
+
+           <module-ref> make-module-ref
+           module-ref-symbol module-ref-modname module-ref-public?
+
+           <lexical> make-lexical
+           lexical-name lexical-gensym
+
+           strip-expansion-structures))
 
 (define <annotation>          
   (make-vtable "prprpw"
@@ -78,3 +86,77 @@
                (set-source-properties! e source))
            e))
         (else e)))
+
+
+
+(define <module-ref>          
+  (make-vtable "prprpr"
+               (lambda (struct port)
+                 (display "#<" port)
+                 (display (if (module-ref-public? struct) "@ " "@@ ") port)
+                 (display (module-ref-modname struct) port)
+                 (display " " port)
+                 (display (module-ref-symbol struct) port)
+                 (display ">" port))))
+
+(define (module-ref? x)
+  (and (struct? x) (eq? (struct-vtable x) <module-ref>)))
+
+(define (make-module-ref modname symbol public?)
+  (make-struct <module-ref> 0 modname symbol public?))
+
+(define (module-ref-modname a)
+  (struct-ref a 0))
+(define (module-ref-symbol a)
+  (struct-ref a 1))
+(define (module-ref-public? a)
+  (struct-ref a 2))
+
+
+
+(define <lexical>          
+  (make-vtable "prpr"
+               (lambda (struct port)
+                 (display "#<lexical " port)
+                 (display (lexical-name struct) port)
+                 (display "/" port)
+                 (display (lexical-gensym struct) port)
+                 (display ">" port))))
+
+(define (lexical? x)
+  (and (struct? x) (eq? (struct-vtable x) <lexical>)))
+
+(define (make-lexical name gensym)
+  (make-struct <lexical> 0 name gensym))
+
+(define (lexical-name a)
+  (struct-ref a 0))
+(define (lexical-gensym a)
+  (struct-ref a 1))
+
+
+
+(define (strip-expansion-structures e)
+  (cond ((list? e)
+         (map strip-expansion-structures e))
+        ((pair? e)
+         (cons (strip-expansion-structures (car e))
+               (strip-expansion-structures (cdr e))))
+        ((annotation? e)
+         (let ((e (strip-expansion-structures (annotation-expression e)))
+               (source (annotation-source e)))
+           (if (pair? e)
+               (set-source-properties! e source))
+           e))
+        ((module-ref? e)
+         (if (module-ref-modname e)
+             `(,(if (module-ref-public? e) '@ '@@)
+               ,(module-ref-modname e)
+               ,(module-ref-symbol e))
+             (module-ref-symbol e)))
+        ((lexical? e)
+         (lexical-gensym e))
+        ((record? e)
+         (error "unexpected record in expansion" e))
+        (else e)))
+

module/ice-9/psyntax.scm

@@ -373,12 +373,12 @@
 (define-syntax build-global-reference
   (syntax-rules ()
     ((_ source var)
-     (build-annotated source var))))
+     (build-annotated source (make-module-ref #f var #f)))))
 
 (define-syntax build-global-assignment
   (syntax-rules ()
     ((_ source var exp)
-     (build-annotated source `(set! ,var ,exp)))))
+     (build-annotated source `(set! ,(make-module-ref #f var #f) ,exp)))))
 
 (define-syntax build-global-definition
   (syntax-rules ()

module/ice-9/syncase.scm

@@ -17,10 +17,11 @@
 
 
 (define-module (ice-9 syncase)
+  :use-module (ice-9 expand-support)
   :use-module (ice-9 debug)
   :use-module (ice-9 threads)
   :export-syntax (sc-macro define-syntax define-syntax-public 
-                  eval-when fluid-let-syntax
+                  fluid-let-syntax
 		  identifier-syntax let-syntax
 		  letrec-syntax syntax syntax-case  syntax-rules
 		  with-syntax
@@ -30,7 +31,7 @@
 	   datum->syntax-object free-identifier=?
 	   generate-temporaries identifier? syntax-object->datum
 	   void syncase)
-  :replace (eval))
+  :replace (eval eval-when))
 
 
 
@@ -48,7 +49,7 @@
   (procedure->memoizing-macro
     (lambda (exp env)
       (with-fluids ((expansion-eval-closure (env->eval-closure env)))
-        (sc-expand exp)))))
+        (strip-expansion-structures (sc-expand exp))))))
 
 ;;; Exported variables
 
@@ -147,7 +148,7 @@
 		      e
 		      ;; perform Guile macro transform
 		      (let ((e ((macro-transformer m)
-				e
+				(strip-expansion-structures e)
 				(append r (list eval-closure)))))
 			(if (variable? e)
 			    e
@@ -224,8 +225,8 @@
 (define (eval x environment)
   (internal-eval (if (and (pair? x)
 			  (equal? (car x) "noexpand"))
-		     (cadr x)
+		     (strip-expansion-structures (cadr x))
-		     (sc-expand x))
+		     (strip-expansion-structures (sc-expand x)))
 		 environment))
 
 ;;; Hack to make syncase macros work in the slib module
@@ -238,7 +239,7 @@
 (define (syncase exp)
   (with-fluids ((expansion-eval-closure
 		 (module-eval-closure (current-module))))
-    (sc-expand exp)))
+    (strip-expansion-structures (sc-expand exp))))
 
 (set-module-transformer! the-syncase-module syncase)
 

module/language/scheme/compile-ghil.scm

@@ -27,6 +27,7 @@
   #:use-module (system vm objcode)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 optargs)
+  #:use-module (ice-9 expand-support)
   #:use-module ((ice-9 syncase) #:select (sc-macro))
   #:use-module ((system base compile) #:select (syntax-error))
   #:export (compile-ghil translate-1
@@ -119,7 +120,8 @@
         (lambda (env loc exp)
           (retrans
            (with-fluids ((eec (module-eval-closure mod)))
-             (sc-expand3 exp 'c '(compile load eval)))))))
+             (strip-expansion-structures
+              (sc-expand3 exp 'c '(compile load eval))))))))
 
      ((primitive-macro? val)
       (syntax-error #f "unhandled primitive macro" head))

module/language/scheme/expand.scm

@@ -21,7 +21,7 @@
 
 (define-module (language scheme expand)
   #:use-module (language scheme amatch)
-  #:use-module (ice-9 annotate)
+  #:use-module (ice-9 expand-support)
   #:use-module (ice-9 optargs)
   #:use-module ((ice-9 syncase) #:select (sc-macro))
   #:use-module ((system base compile) #:select (syntax-error))