~ chicken-core (chicken-5) 9767d784c45621732bbdd080260cfc011cd5da7b
commit 9767d784c45621732bbdd080260cfc011cd5da7b
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Dec 10 16:22:47 2009 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Dec 10 16:22:47 2009 +0100
- deprecated `define-compiled-syntax'
- `define-syntax' is now a core macro and can be renamed and reexported
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index b7ad3133..31db6dff 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -1066,6 +1066,15 @@
(,(r 'define) ,@(cdr form))))))
+;;; compiled syntax (DEPRECATED)
+
+(##sys#extend-macro-environment
+ 'define-compiled-syntax '()
+ (##sys#er-transformer
+ (lambda (form r c)
+ `(,(r 'define-syntax) ,@(cdr form)))))
+
+
;;; use
(##sys#extend-macro-environment
diff --git a/compiler.scm b/compiler.scm
index 4010ad8f..3251ed86 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -5,8 +5,8 @@
;
;
;-----------------------------------------------------------------------------------------------------------
-; Copyright (c) 2000-2007, Felix L. Winkelmann
; Copyright (c) 2008-2009, The Chicken Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
@@ -141,10 +141,7 @@
; (##core#app <exp> {<exp>})
; ([##core#]syntax <exp>)
; (<exp> {<exp>})
-; (define-syntax <symbol> <expr>)
-; (define-syntax (<symbol> . <llist>) <expr> ...)
-; (define-compiled-syntax <symbol> <expr>)
-; (define-compiled-syntax (<symbol> . <llist>) <expr> ...)
+; (##core#define-syntax <symbol> <expr>)
; (##core#define-compiler-syntax <symbol> <expr>)
; (##core#let-compiler-syntax ((<symbol> <expr>) ...) <expr> ...)
; (##core#module <symbol> #t | (<name> | (<name> ...) ...) <body>)
@@ -720,7 +717,7 @@
(##sys#canonicalize-body (cddr x) se2 compiler-syntax-enabled)
e se2 dest)))
- ((define-syntax define-compiled-syntax)
+ ((##core#define-syntax)
(##sys#check-syntax
(car x) x
(if (pair? (cadr x))
@@ -738,8 +735,7 @@
(##sys#current-environment)
(##sys#er-transformer (eval/meta body)))
(walk
- (if (or ##sys#enable-runtime-macros
- (eq? 'define-compiled-syntax (car x)))
+ (if ##sys#enable-runtime-macros
`(##sys#extend-macro-environment
',var
(##sys#current-environment)
@@ -1332,7 +1328,7 @@
(let ([fds (cdr spec)])
(if (every string? fds)
(set! foreign-declarations (append foreign-declarations fds))
- (syntax-error "invalid declaration" spec) ) ) )
+ (syntax-error 'declare "invalid declaration" spec) ) ) )
((c-options)
(emit-control-file-item `(c-options ,@(strip (cdr spec)))) )
((link-options)
diff --git a/eval.scm b/eval.scm
index 7f539917..5ed213dc 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1,7 +1,7 @@
;;;; eval.scm - Interpreter for CHICKEN
;
-; Copyright (c) 2000-2007, Felix L. Winkelmann
; Copyright (c) 2008-2009, The Chicken Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
@@ -619,17 +619,9 @@
(##sys#canonicalize-body (cddr x) se2 #f)
e #f tf cntr se2)))
- ((define-syntax define-compiled-syntax)
- (##sys#check-syntax
- 'define-syntax x
- (if (and (pair? (cdr x)) (pair? (cadr x)))
- '(_ (variable . lambda-list) . #(_ 1))
- '(_ variable _))
- #f se)
- (let* ((var (if (pair? (cadr x)) (caadr x) (cadr x)))
- (body (if (pair? (cadr x))
- `(,(rename 'lambda se) ,(cdadr x) ,@(cddr x))
- (caddr x)))
+ ((##core#define-syntax)
+ (let* ((var (cadr x))
+ (body (caddr x))
(name (rename var se)))
(##sys#register-syntax-export
name (##sys#current-module)
diff --git a/expand.scm b/expand.scm
index d575f777..1bf1984c 100644
--- a/expand.scm
+++ b/expand.scm
@@ -497,8 +497,9 @@
(loop
(cdr body)
(cons (if (pair? (cadr def))
- `(define-syntax ,(caadr def)
- (,(macro-alias 'lambda se) ,(cdadr def) ,@(cddr def)))
+ `(,(macro-alias 'define-syntax se)
+ ,(caadr def)
+ (,(macro-alias 'lambda se) ,(cdadr def) ,@(cddr def)))
def)
defs)
#f)))
@@ -532,7 +533,8 @@
(##sys#expand-curried-define head (cddr x) se))) ]
[else
(##sys#check-syntax
- 'define x '(define (variable . lambda-list) . #(_ 1)) #f se)
+ 'define x
+ '(define (variable . lambda-list) . #(_ 1)) #f se)
(loop rest
(cons (car head) vars)
(cons `(##core#lambda ,(cdr head) ,@(cddr x)) vals)
@@ -972,6 +974,25 @@
(##sys#check-syntax 'define body '#(_ 1))
(loop (list (car head) `(,(r 'lambda) ,(cdr head) ,@body))))))))))
+(##sys#extend-macro-environment
+ 'define-syntax
+ '()
+ (##sys#er-transformer
+ (lambda (form r c)
+ (let ((head (cadr form))
+ (body (cddr form)) )
+ (cond ((not (pair? head))
+ (##sys#check-syntax 'define-syntax head 'symbol)
+ (##sys#check-syntax 'define-syntax body '#(_ 1))
+ (##sys#register-export head (##sys#current-module))
+ `(##core#define-syntax ,head ,(car body)))
+ (else
+ (##sys#check-syntax 'define-syntax head '(_ . lambda-list))
+ (##sys#check-syntax 'define-syntax body '#(_ 1))
+ `(##core#define-syntax
+ ,(car head)
+ (,(r 'lambda) ,(cdr head) ,@body))))))))
+
(##sys#extend-macro-environment
'and
'()
diff --git a/manual/Modules and macros b/manual/Modules and macros
index 483b5b0d..73f02a65 100644
--- a/manual/Modules and macros
+++ b/manual/Modules and macros
@@ -48,14 +48,6 @@ The effect of destructively modifying the s-expression passed to a
transformer procedure is undefined.
-==== define-compiled-syntax
-
-<macro>(define-compiled-syntax IDENTIFIER TRANSFORMER)</macro>
-
-Equivalent to {{define-syntax}}, but when compiled, will also define the macro
-at runtime.
-
-
==== syntax
<macro>(syntax EXPRESSION)</macro>
diff --git a/tests/module-tests.scm b/tests/module-tests.scm
index 7372423d..816030b7 100644
--- a/tests/module-tests.scm
+++ b/tests/module-tests.scm
@@ -38,7 +38,7 @@
(module baz ((x s:list))
(import (prefix scheme s:))
- (define-syntax x
+ (s:define-syntax x
(syntax-rules ()
((_ x) (s:list x)))))
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index b36d5fc7..95ac3334 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -371,3 +371,16 @@
;;; canonicalization of body captures 'begin (reported by Abdulaziz Ghuloum)
(let ((begin (lambda (x y) (bomb)))) 1 2)
+
+
+;;; redefinition of defining forms
+
+(module m0001 (foo bar)
+ (import (prefix scheme s:))
+ (s:define-syntax foo (syntax-rules () ((_ x) (s:list x))))
+ (s:define bar 99))
+
+(module m0002 ()
+ (import scheme m0001 extras)
+ (pp (foo bar)))
+
Trap