[Guile-commits] GNU Guile branch, master, updated. release_1-9-10-91-gd615172

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=d61517239da142bafae2d656d82b3af599cac1ee

The branch, master has been updated
       via  d61517239da142bafae2d656d82b3af599cac1ee (commit)
       via  4e3328ce698e68765e4bd944de243b2aa077b418 (commit)
       via  074e036ee25e34cb4002b5a1d4045896bb50a3e4 (commit)
       via  a40e1c9078aa8b2adc73f303f0d3686a0a477405 (commit)
      from  e96bac4523d22715bd665f40c585046bebfd6c24 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit d61517239da142bafae2d656d82b3af599cac1ee
Author: Andy Wingo <address@hidden>
Date:   Mon May 3 16:34:12 2010 +0200

    export, re-export etc as syntax-rules macros
    
    * module/ice-9/boot-9.scm (export, re-export, export-syntax)
      (re-export-syntax): Rewrite as syntax-rules macros.

commit 4e3328ce698e68765e4bd944de243b2aa077b418
Author: Andy Wingo <address@hidden>
Date:   Mon May 3 16:31:32 2010 +0200

    rewrite use-modules and use-syntax using syntax-case
    
    * module/ice-9/boot-9.scm (use-modules): Rewrite as a syntax-case macro.
      (use-syntax): Likewise.
      (compile-interface-spec): Remove unused function

commit 074e036ee25e34cb4002b5a1d4045896bb50a3e4
Author: Andy Wingo <address@hidden>
Date:   Mon May 3 15:38:29 2010 +0200

    rewrite define-module as a syntax-case macro
    
    * module/ice-9/boot-9.scm (define-module): Rewrite as a syntax-case
      macro, so that the expansion has proper module hygiene. Otherwise
      process-define-module isn't properly resolved against the root module
      -- a bytecode file that starts with a define-module would just try to
      look up process-define-module from the current module.
      (compile-define-module-args): Remove. Internal, and no one else used
      it.

commit a40e1c9078aa8b2adc73f303f0d3686a0a477405
Author: Andy Wingo <address@hidden>
Date:   Sun May 2 19:08:26 2010 +0200

    remove duplicate quasisyntax.scm EXTRA_DIST
    
    * module/Makefile.am (EXTRA_DIST): Remove quasisyntax.scm, as the
      NOCOMP_SOURCES handles that case.

-----------------------------------------------------------------------

Summary of changes:
 module/Makefile.am      |    1 -
 module/ice-9/boot-9.scm |  242 ++++++++++++++++++++++++++++-------------------
 2 files changed, 145 insertions(+), 98 deletions(-)

diff --git a/module/Makefile.am b/module/Makefile.am
index 16013b0..90c1dff 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -70,7 +70,6 @@ SOURCES =                                     \
 EXTRA_DIST +=                                  \
   ice-9/test.scm                               \
   ice-9/compile-psyntax.scm                    \
-  ice-9/quasisyntax.scm                                \
   ice-9/ChangeLog-2008
 
 # We expect this to never be invoked when there is not already
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index d83b0bf..35714f7 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3256,76 +3256,81 @@ module '(ice-9 q) '(make-q q-length))}."
  (if (memq 'prefix (read-options))
      (error "boot-9 must be compiled with #:kw, not :kw")))
 
-(define (compile-interface-spec spec)
-  (define (make-keyarg sym key quote?)
-    (cond ((or (memq sym spec)
-               (memq key spec))
-           => (lambda (rest)
-                (if quote?
-                    (list key (list 'quote (cadr rest)))
-                    (list key (cadr rest)))))
-          (else
-           '())))
-  (define (map-apply func list)
-    (map (lambda (args) (apply func args)) list))
-  (define keys
-    ;; sym     key      quote?
-    '((:select #:select #t)
-      (:hide   #:hide   #t)
-      (:prefix #:prefix #t)
-      (:renamer #:renamer #f)
-      (:version #:version #t)))
-  (if (not (pair? (car spec)))
-      `(',spec)
-      `(',(car spec)
-        ,@(apply append (map-apply make-keyarg keys)))))
-
 (define (keyword-like-symbol->keyword sym)
   (symbol->keyword (string->symbol (substring (symbol->string sym) 1))))
 
-(define (compile-define-module-args args)
-  ;; Just quote everything except #:use-module and #:use-syntax.  We
-  ;; need to know about all arguments regardless since we want to turn
-  ;; symbols that look like keywords into real keywords, and the
-  ;; keyword args in a define-module form are not regular
-  ;; (i.e. no-backtrace doesn't take a value).
-  (let loop ((compiled-args `((quote ,(car args))))
-             (args (cdr args)))
-    (cond ((null? args)
-           (reverse! compiled-args))
-          ;; symbol in keyword position
-          ((symbol? (car args))
-           (loop compiled-args
-                 (cons (keyword-like-symbol->keyword (car args)) (cdr args))))
-          ((memq (car args) '(#:no-backtrace #:pure))
-           (loop (cons (car args) compiled-args)
-                 (cdr args)))
-          ((null? (cdr args))
-           (error "keyword without value:" (car args)))
-          ((memq (car args) '(#:use-module #:use-syntax))
-           (loop (cons* `(list ,@(compile-interface-spec (cadr args)))
-                        (car args)
-                        compiled-args)
-                 (cddr args)))
-          ((eq? (car args) #:autoload)
-           (loop (cons* `(quote ,(caddr args))
-                        `(quote ,(cadr args))
-                        (car args)
-                        compiled-args)
-                 (cdddr args)))
-          (else
-           (loop (cons* `(quote ,(cadr args))
-                        (car args)
-                        compiled-args)
-                 (cddr args))))))
-
-(defmacro define-module args
-  `(eval-when
-    (eval load compile)
-    (let ((m (process-define-module
-              (list ,@(compile-define-module-args args)))))
-      (set-current-module m)
-      m)))
+;; FIXME: we really need to clean up the guts of the module system.
+;; We can compile to something better than process-define-module.
+(define-syntax define-module
+  (lambda (x)
+    (define (keyword-like? stx)
+      (let ((dat (syntax->datum stx)))
+        (and (symbol? dat)
+             (eqv? (string-ref (symbol->string dat) 0) #\:))))
+    (define (->keyword sym)
+      (symbol->keyword (string->symbol (substring (symbol->string sym) 1))))
+    
+    (define (quotify-iface args)
+      (let loop ((in args) (out '()))
+        (syntax-case in ()
+          (() (reverse! out))
+          ;; The user wanted #:foo, but wrote :foo. Fix it.
+          ((sym . in) (keyword-like? #'sym)
+           (loop #`(#,(->keyword (syntax->datum #'sym)) . in) out))
+          ((kw . in) (not (keyword? (syntax->datum #'kw)))
+           (syntax-violation 'define-module "expected keyword arg" x #'kw))
+          ((#:renamer renamer . in)
+           (loop #'in (cons* #'renamer #:renamer out)))
+          ((kw val . in)
+           (loop #'in (cons* #''val #'kw out))))))
+
+    (define (quotify args)
+      ;; Just quote everything except #:use-module and #:use-syntax.  We
+      ;; need to know about all arguments regardless since we want to turn
+      ;; symbols that look like keywords into real keywords, and the
+      ;; keyword args in a define-module form are not regular
+      ;; (i.e. no-backtrace doesn't take a value).
+      (let loop ((in args) (out '()))
+        (syntax-case in ()
+          (() (reverse! out))
+          ;; The user wanted #:foo, but wrote :foo. Fix it.
+          ((sym . in) (keyword-like? #'sym)
+           (loop #`(#,(->keyword (syntax->datum #'sym)) . in) out))
+          ((kw . in) (not (keyword? (syntax->datum #'kw)))
+           (syntax-violation 'define-module "expected keyword arg" x #'kw))
+          ((#:no-backtrace . in)
+           (loop #'in (cons #:no-backtrace out)))
+          ((#:pure . in)
+           (loop #'in (cons #:pure out)))
+          ((kw)
+           (syntax-violation 'define-module "keyword arg without value" x 
#'kw))
+          ((use-module (name name* ...) . in)
+           (and (memq (syntax->datum #'use-module) '(#:use-module 
#:use-syntax))
+                (and-map symbol? (syntax->datum #'(name name* ...))))
+           (loop #'in
+                 (cons* #''((name name* ...))
+                        #'use-module
+                        out)))
+          ((use-module ((name name* ...) arg ...) . in)
+           (and (memq (syntax->datum #'use-module) '(#:use-module 
#:use-syntax))
+                (and-map symbol? (syntax->datum #'(name name* ...))))
+           (loop #'in
+                 (cons* #`(list '(name name* ...) #,@(quotify-iface #'(arg 
...)))
+                        #'use-module
+                        out)))
+          ((#:autoload name bindings . in)
+           (loop #'in (cons* #''bindings #''name #:autoload out)))
+          ((kw val . in)
+           (loop #'in (cons* #''val #'kw out))))))
+    
+    (syntax-case x ()
+      ((_ (name name* ...) arg ...)
+       (with-syntax (((quoted-arg ...) (quotify #'(arg ...))))
+         #'(eval-when (eval load compile)
+             (let ((m (process-define-module
+                       (list '(name name* ...) quoted-arg ...))))
+               (set-current-module m)
+               m)))))))
 
 ;; The guts of the use-modules macro.  Add the interfaces of the named
 ;; modules to the use-list of the current module, in order.
@@ -3342,22 +3347,57 @@ module '(ice-9 q) '(make-q q-length))}."
      (lambda ()
        (module-use-interfaces! (current-module) interfaces)))))
 
-(defmacro use-modules modules
-  `(eval-when
-    (eval load compile)
-    (process-use-modules
-     (list ,@(map (lambda (m)
-                    `(list ,@(compile-interface-spec m)))
-                  modules)))
-    *unspecified*))
-
-(defmacro use-syntax (spec)
-  `(eval-when
-    (eval load compile)
-    (issue-deprecation-warning
-     "`use-syntax' is deprecated. Please contact guile-devel for more info.")
-    (process-use-modules (list (list ,@(compile-interface-spec spec))))
-    *unspecified*))
+(define-syntax use-modules
+  (lambda (x)
+    (define (keyword-like? stx)
+      (let ((dat (syntax->datum stx)))
+        (and (symbol? dat)
+             (eqv? (string-ref (symbol->string dat) 0) #\:))))
+    (define (->keyword sym)
+      (symbol->keyword (string->symbol (substring (symbol->string sym) 1))))
+    
+    (define (quotify-iface args)
+      (let loop ((in args) (out '()))
+        (syntax-case in ()
+          (() (reverse! out))
+          ;; The user wanted #:foo, but wrote :foo. Fix it.
+          ((sym . in) (keyword-like? #'sym)
+           (loop #`(#,(->keyword (syntax->datum #'sym)) . in) out))
+          ((kw . in) (not (keyword? (syntax->datum #'kw)))
+           (syntax-violation 'define-module "expected keyword arg" x #'kw))
+          ((#:renamer renamer . in)
+           (loop #'in (cons* #'renamer #:renamer out)))
+          ((kw val . in)
+           (loop #'in (cons* #''val #'kw out))))))
+
+    (define (quotify specs)
+      (let lp ((in specs) (out '()))
+        (syntax-case in ()
+          (() (reverse out))
+          (((name name* ...) . in)
+           (and-map symbol? (syntax->datum #'(name name* ...)))
+           (lp #'in (cons #''((name name* ...)) out)))
+          ((((name name* ...) arg ...) . in)
+           (and-map symbol? (syntax->datum #'(name name* ...)))
+           (with-syntax (((quoted-arg ...) (quotify-iface #'(arg ...))))
+             (lp #'in (cons #`(list '(name name* ...) quoted-arg ...)
+                            out)))))))
+    
+    (syntax-case x ()
+      ((_ spec ...)
+       (with-syntax (((quoted-args ...) (quotify #'(spec ...))))
+         #'(eval-when (eval load compile)
+             (process-use-modules (list quoted-args ...))
+             *unspecified*))))))
+
+(define-syntax use-syntax
+  (syntax-rules ()
+    ((_ spec ...)
+     (begin
+       (eval-when (eval load compile)
+         (issue-deprecation-warning
+          "`use-syntax' is deprecated. Please contact guile-devel for more 
info."))
+       (use-modules spec ...)))))
 
 (define-syntax define-private
   (syntax-rules ()
@@ -3441,23 +3481,31 @@ module '(ice-9 q) '(make-q q-length))}."
                          (module-add! public-i external-name var)))))
               names)))
 
-(defmacro export names
-  `(eval-when (eval load compile)
-     (call-with-deferred-observers
-      (lambda ()
-        (module-export! (current-module) ',names)))))
+(define-syntax export
+  (syntax-rules ()
+    ((_ name ...)
+     (eval-when (eval load compile)
+       (call-with-deferred-observers
+        (lambda ()
+          (module-export! (current-module) '(name ...))))))))
 
-(defmacro re-export names
-  `(eval-when (eval load compile)
-     (call-with-deferred-observers
-       (lambda ()
-         (module-re-export! (current-module) ',names)))))
+(define-syntax re-export
+  (syntax-rules ()
+    ((_ name ...)
+     (eval-when (eval load compile)
+       (call-with-deferred-observers
+        (lambda ()
+          (module-re-export! (current-module) '(name ...))))))))
 
-(defmacro export-syntax names
-  `(export ,@names))
+(define-syntax export-syntax
+  (syntax-rules ()
+    ((_ name ...)
+     (export name ...))))
 
-(defmacro re-export-syntax names
-  `(re-export ,@names))
+(define-syntax re-export-syntax
+  (syntax-rules ()
+    ((_ name ...)
+     (re-export name ...))))
 
 (define load load-module)
 


hooks/post-receive
-- 
GNU Guile