~ chicken-core (chicken-5) 3a5150e02d1124a633197dbf1f4a6415bbad78d2

commit 3a5150e02d1124a633197dbf1f4a6415bbad78d2
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sun Jul 23 23:08:19 2017 +1200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Mon Jul 31 17:11:28 2017 +0200

    Move `functor' and `define-interface' into (chicken module)
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index c45f6c33..e3a2fe11 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -1167,71 +1167,6 @@
     (##core#let-compiler-syntax (binding ...) body ...))))
 
 
-;;; interface definition
-
-;; TODO: Move this into "chicken.module"
-(##sys#extend-macro-environment
- 'define-interface '()
- (##sys#er-transformer
-  (lambda (x r c)
-    (##sys#check-syntax 'define-interface x '(_ variable _))
-    (let ((name (chicken.syntax#strip-syntax (cadr x)))
-	  (%quote (r 'quote)))
-      (when (eq? '* name)
-	(syntax-error-hook
-	 'define-interface "`*' is not allowed as a name for an interface"))
-      `(##core#elaborationtimeonly
-	(##sys#put/restore!
-	 (,%quote ,name)
-	 (,%quote ##core#interface)
-	 (,%quote
-	  ,(let ((exps (chicken.syntax#strip-syntax (caddr x))))
-	     (cond ((eq? '* exps) '*)
-		   ((symbol? exps) `(#:interface ,exps))
-		   ((list? exps) 
-		    (##sys#validate-exports exps 'define-interface))
-		   (else
-		    (syntax-error-hook
-		     'define-interface "invalid exports" (caddr x))))))))))))
-
-
-;;; functor definition
-
-;; TODO: Move this into "chicken.module"
-(##sys#extend-macro-environment
- 'functor '()
- (##sys#er-transformer
-  (lambda (x r c)
-    (##sys#check-syntax 'functor x '(_ (_ . #((_ _) 0)) _ . _))
-    (let* ((x (chicken.syntax#strip-syntax x))
-	   (head (cadr x))
-	   (name (car head))
-	   (args (cdr head))
-	   (exps (caddr x))
-	   (body (cdddr x))
-	   (registration
-	    `(##sys#register-functor
-	      ',(chicken.internal#library-id name)
-	      ',(map (lambda (arg)
-		       (let ((argname (car arg))
-			     (exps (##sys#validate-exports (cadr arg) 'functor)))
-			 (unless (or (symbol? argname)
-				     (and (list? argname)
-					  (= 2 (length argname))
-					  (symbol? (car argname))
-					  (chicken.internal#valid-library-specifier? (cadr argname))))
-			   (##sys#syntax-error-hook "invalid functor argument" name arg))
-			 (cons argname exps)))
-		     args)
-	      ',(##sys#validate-exports exps 'functor)
-	      ',body)))
-      `(##core#module
-	,(chicken.internal#library-id name)
-	#t
-	(import scheme chicken)
-	(begin-for-syntax ,registration))))))
-
-
 ;;; type-related syntax
 
 (##sys#extend-macro-environment
diff --git a/expand.scm b/expand.scm
index 91ab9a2c..8e89530e 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1084,6 +1084,66 @@
        ##sys#current-environment ##sys#macro-environment
        #f #t 'reexport)))
 
+;;; functor definition
+
+(##sys#extend-macro-environment
+ 'functor '()
+ (##sys#er-transformer
+  (lambda (x r c)
+    (##sys#check-syntax 'functor x '(_ (_ . #((_ _) 0)) _ . _))
+    (let* ((x (strip-syntax x))
+	   (head (cadr x))
+	   (name (car head))
+	   (args (cdr head))
+	   (exps (caddr x))
+	   (body (cdddr x))
+	   (registration
+	    `(##sys#register-functor
+	      (##core#quote ,(library-id name))
+	      (##core#quote
+	       ,(map (lambda (arg)
+		       (let ((argname (car arg))
+			     (exps (##sys#validate-exports (cadr arg) 'functor)))
+			 (unless (or (symbol? argname)
+				     (and (list? argname)
+					  (= 2 (length argname))
+					  (symbol? (car argname))
+					  (valid-library-specifier? (cadr argname))))
+			   (##sys#syntax-error-hook "invalid functor argument" name arg))
+			 (cons argname exps)))
+		     args))
+	      (##core#quote ,(##sys#validate-exports exps 'functor))
+	      (##core#quote ,body))))
+      `(##core#module ,(library-id name)
+	#t
+	(import scheme chicken)
+	(begin-for-syntax ,registration))))))
+
+;;; interface definition
+
+(##sys#extend-macro-environment
+ 'define-interface '()
+ (##sys#er-transformer
+  (lambda (x r c)
+    (##sys#check-syntax 'define-interface x '(_ variable _))
+    (let ((name (strip-syntax (cadr x))))
+      (when (eq? '* name)
+	(syntax-error-hook
+	 'define-interface "`*' is not allowed as a name for an interface"))
+      `(##core#elaborationtimeonly
+	(##sys#put/restore!
+	 (##core#quote ,name)
+	 (##core#quote ##core#interface)
+	 (##core#quote
+	  ,(let ((exps (strip-syntax (caddr x))))
+	     (cond ((eq? '* exps) '*)
+		   ((symbol? exps) `(#:interface ,exps))
+		   ((list? exps)
+		    (##sys#validate-exports exps 'define-interface))
+		   (else
+		    (syntax-error-hook
+		     'define-interface "invalid exports" (caddr x))))))))))))
+
 ;; The chicken.module syntax environment
 (define ##sys#chicken.module-macro-environment (##sys#macro-environment))