From b89fc2153ec8a46ce55d16c3a90a559117bc3aa1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sun, 30 Jul 2006 21:01:40 +0000 Subject: [PATCH] Slowly improving support for macro compilation. * module/language/scheme/translate.scm (¤t-macros): Removed. (¤t-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 | 114 +++++++++++++++------------ testsuite/t-match.scm | 8 +- testsuite/t-records.scm | 15 +++- 3 files changed, 85 insertions(+), 52 deletions(-) diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm index 81fa3de63..843a8472a 100644 --- a/module/language/scheme/translate.scm +++ b/module/language/scheme/translate.scm @@ -29,18 +29,26 @@ :export (translate)) -;; Hash table containing the macros currently defined. -(define ¤t-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 ¤t-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 ((¤t-macros (make-hash-table)) - (¤t-macro-module (make-module))) + (parameterize ((&compile-time-module (make-module))) ;; Import only core bindings in the macro module. - (module-use! (¤t-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 (¤t-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 (¤t-macros) head))) - (if (not local-macro) - e - (if (procedure? local-macro) - (expand-macro - (save-module-excursion - (lambda () - (set-current-module (¤t-macro-module)) - (apply local-macro (cdr e))))) - (syntax-error #f (format #f "~a: invalid macro" head) - 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 () + (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) - (if (eq? x y) - (trans-pair e (or (location x) l) (car x) (cdr x)) - (trans e l y))))) + (let ((y (expand-macro x))) + (if (eq? x y) + (trans-pair e (or (location x) l) (car x) (cdr x)) + (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! (¤t-macros) macro-name - (catch #t - (lambda () - (eval `(lambda ,formal-args ,@body) - (¤t-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) ( 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)) ( e l (trans:x head) (map trans:x tail))))))) diff --git a/testsuite/t-match.scm b/testsuite/t-match.scm index d6afd3044..ed9d6f488 100644 --- a/testsuite/t-match.scm +++ b/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 (%make-stuff chbouib) diff --git a/testsuite/t-records.scm b/testsuite/t-records.scm index eedd44e21..243e9d97e 100644 --- a/testsuite/t-records.scm +++ b/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 (%make-stuff chbouib)