Slowly improving support for macro compilation.

* module/language/scheme/translate.scm (&current-macros): Removed.
  (&current-macro-module): Removed.
  (&compile-time-module): New.
  (eval-at-compile-time): New.
  (translate): Initialize `&compile-time-module'.
  (expand-macro)[use-syntax]: New case.
  [begin let...]: Don't expand these built-in macros.
  [else]: Rewrote the macro detection and invocation logic.  Invoke macro
  transformers in the current compile-time module.
  (trans): Let `expand-macro' raise an exception if needed.
  (trans-pair)[defmacro define-macro]: Evaluate the macro definition in
  the compile-time module.

* testsuite/t-match.scm: Use `use-syntax' instead of `use-modules' for
  `(ice-9 match)' and `(srfi srfi-9)'.

* testsuite/t-records.scm: Likewise.

git-archimport-id: lcourtes@laas.fr--2005-mobile/guile-vm--mobile--0.6--patch-15

module/language/scheme/translate.scm

@@ -29,18 +29,26 @@
   :export (translate))
 
 
-;; Hash table containing the macros currently defined.
-(define &current-macros (make-parameter #f))
+;; Module in which compile-time code (macros) is evaluated.
+(define &compile-time-module (make-parameter #f))
 
-;; Module in which macros are evaluated.
-(define &current-macro-module (make-parameter #f))
+(define (eval-at-compile-time exp)
+  "Evaluate @var{exp} in the current compile-time module."
+  (catch #t
+    (lambda ()
+      (save-module-excursion
+       (lambda ()
+	 (eval exp (&compile-time-module)))))
+    (lambda (key . args)
+      (syntax-error #f
+		    (format #f "~a: compile-time evaluation failed" exp)
+		    (cons key args)))))
 
 (define (translate x e)
-  (parameterize ((&current-macros (make-hash-table))
-		 (&current-macro-module (make-module)))
+  (parameterize ((&compile-time-module (make-module)))
 
     ;; Import only core bindings in the macro module.
-    (module-use! (&current-macro-module) (resolve-module '(guile-user)))
+    (module-use! (&compile-time-module) the-root-module)
 
     (call-with-ghil-environment (make-ghil-mod e) '()
       (lambda (env vars)
@@ -54,34 +62,57 @@
 (define (expand-macro e)
   ;; Similar to `macroexpand' in `boot-9.scm' except that it does not expand
   ;; `define-macro' and `defmacro'.
-
-  ;; FIXME: This does not handle macros defined in modules used by the
-  ;; module being compiled.
   (cond
    ((pair? e)
     (let* ((head (car e))
 	   (val (and (symbol? head)
 		     (false-if-exception
-		      (module-ref (&current-macro-module) head)))))
+		      (module-ref (&compile-time-module) head)))))
       (case head
 	((defmacro define-macro)
 	 ;; Normally, these are expanded as `defmacro:transformer' but we
-	 ;; don't want it to happen.
+	 ;; don't want it to happen since they are handled by `trans-pair'.
 	 e)
+
+	((use-syntax)
+	 ;; `use-syntax' is used to express a compile-time dependency
+	 ;; (because we use a macro from that module, or because one of our
+	 ;; macros uses bindings from that module).  Thus, we arrange to get
+	 ;; the current compile-time module to use it.
+	 (let* ((module-name (cadr e))
+		(module (false-if-exception (resolve-module module-name))))
+	   (if (module? module)
+	       (let ((public-if (module-public-interface module)))
+		 (module-use! (&compile-time-module) public-if))
+	       (syntax-error #f "invalid `use-syntax' form" e)))
+	 '(void))
+
+	((begin let let* letrec lambda quote quasiquote if and or
+		set! cond case eval-case define do)
+	 ;; All these built-in macros should not be expanded.
+	 e)
+
 	(else
-	 (if (defmacro? val) ;; built-in macro?
-	     (expand-macro (apply (defmacro-transformer val) (cdr e)))
-	     (let ((local-macro (hashq-ref (&current-macros) head)))
-	       (if (not local-macro)
-		   e
-		   (if (procedure? local-macro)
+	 ;; Look for a macro.
+	 (let ((ref (false-if-exception
+		     (module-ref (&compile-time-module) head))))
+	   (if (macro? ref)
 	       (expand-macro
 		(save-module-excursion
 		 (lambda ()
-			    (set-current-module (&current-macro-module))
-			    (apply local-macro (cdr e)))))
-		       (syntax-error #f (format #f "~a: invalid macro" head)
-				     local-macro)))))))))
+		   (let ((transformer (macro-transformer ref))
+			 (syntax-error syntax-error))
+		     (set-current-module (&compile-time-module))
+		     (catch #t
+		       (lambda ()
+			 (transformer (copy-tree e) (current-module)))
+		       (lambda (key . args)
+			 (syntax-error #f
+				       (format #f "~a: macro transformer failed"
+					       head)
+				       (cons key args))))))))
+	       e))))))
+
    (#t e)))
 
 
@@ -101,12 +132,10 @@
 
 (define (trans e l x)
   (cond ((pair? x)
-	 (let ((y (false-if-exception (expand-macro x))))
-	   (if (not y)
-	       (syntax-error l "failed to expand macro" x)
+	 (let ((y (expand-macro x)))
 	   (if (eq? x y)
 	       (trans-pair e (or (location x) l) (car x) (cdr x))
-		   (trans e l y)))))
+	       (trans e l y))))
 	((symbol? x)
 	 (let ((y (symbol-expand x)))
 	   (if (symbol? y)
@@ -164,24 +193,11 @@
 
     ;; simple macros
     ((defmacro define-macro)
-     (let* ((shortcut? (eq? head 'defmacro))
-	    (macro-name (if shortcut? (car tail) (caar tail)))
-	    (formal-args (if shortcut? (cadr tail) (cdar tail)))
-	    (body (if shortcut? (cddr tail) (cdr tail))))
+     ;; Evaluate the macro definition in the current compile-time module.
+     (eval-at-compile-time (cons head tail))
 
-       ;; Evaluate the macro in the current macro module.
-       (hashq-set! (&current-macros) macro-name
-		   (catch #t
-		     (lambda ()
-		       (eval `(lambda ,formal-args ,@body)
-			     (&current-macro-module)))
-		     (lambda (key . args)
-		       (syntax-error l (string-append "failed to evaluate "
-						      "macro `" macro-name
-						      "'")
-				     (cons key args)))))
-
-       (make:void)))
+     ;; FIXME: We need to evaluate them in the runtime module as well.
+     (make:void))
 
     ((set!)
      (match tail
@@ -324,7 +340,7 @@
     (else
      (if (memq head %scheme-primitives)
 	 (<ghil-inline> e l head (map trans:x tail))
-	 (if (member head %forbidden-primitives)
+	 (if (memq head %forbidden-primitives)
 	     (syntax-error l (format #f "`~a' is forbidden" head)
 			   (cons head tail))
 	     (<ghil-call> e l (trans:x head) (map trans:x tail)))))))

testsuite/t-match.scm

@@ -1,5 +1,9 @@
-(use-modules (ice-9 match)
-	     (srfi srfi-9))  ;; record type
+;;; Pattern matching with `(ice-9 match)'.
+;;;
+
+;; Both modules are compile-time dependencies, hence `use-syntax'.
+(use-syntax (ice-9 match))
+(use-syntax (srfi srfi-9))  ;; record type (FIXME: See `t-records.scm')
 
 (define-record-type <stuff>
   (%make-stuff chbouib)

testsuite/t-records.scm

@@ -1,4 +1,17 @@
-(use-modules (srfi srfi-9))
+;;; SRFI-9 Records.
+;;;
+
+;; SRFI-9 is a compile-time dependency (it exports the `define-record-type'
+;; macro), hence the `use-syntax'.
+;;
+;; FIXME: The current definition of `use-syntax' in `boot-9.scm' is broken
+;; and is not consistent with what happens when using:
+;;
+;;  (define-module (module) :use-syntax (chbouib))
+;;
+;; This precludes the test-suite from running this program using the
+;; interpreter.
+(use-syntax (srfi srfi-9))
 
 (define-record-type <stuff>
   (%make-stuff chbouib)