Straightforward, finishes off "chicken.module".
Cheers,
Evan
>From 47280d5a93d160aaf71fc586cc313a78fe3eea8a Mon Sep 17 00:00:00 2001
From: Evan Hanson <ev...@foldling.org>
Date: Sun, 23 Jul 2017 23:08:19 +1200
Subject: [PATCH] Move `functor' and `define-interface' into (chicken module)
---
chicken-syntax.scm | 65 ------------------------------------------------------
expand.scm | 60 +++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 60 insertions(+), 65 deletions(-)
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))
--
2.11.0
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
