~ chicken-core (chicken-5) 04b3b77967ad4b7c573ed59df5926ef0bf8a43d1

commit 04b3b77967ad4b7c573ed59df5926ef0bf8a43d1
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Feb 16 16:06:36 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Feb 16 16:06:36 2010 +0100

    core-forms for define-inline and define-constant

diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 33494dd5..14154fee 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -42,6 +42,29 @@
 (define ##sys#chicken-macro-environment
   (let ((me0 (##sys#macro-environment)))
 
+(##sys#extend-macro-environment
+ 'define-constant
+ '()
+ (##sys#er-transformer
+  (lambda (form r c)
+    (##sys#check-syntax 'define-constant form '(_ symbol _))
+    `(##core#define-constant ,@(cdr form)))))
+
+(##sys#extend-macro-environment
+ 'define-inline
+ '()
+ (##sys#er-transformer
+  (lambda (form r c)
+    (let ((head (cadr form)))
+      (cond ((pair? head)
+	     (##sys#check-syntax 'define-inline form '(_ (symbol . _) . #(_ 1)))
+	     `(##core#define-inline
+	       ,(car head)
+	       `(,(r 'lambda) ,(cdr head) ,@(cdr form))))
+	    (else
+	     (##sys#check-syntax 'define-inline form '(_ symbol _))
+	     `(##core#define-inline ,@(cdr form))))))))
+
 (##sys#extend-macro-environment
  'define-record '()
  (##sys#er-transformer
diff --git a/compiler.scm b/compiler.scm
index 6ec64faf..1c728b16 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -133,7 +133,7 @@
 ; (##core#foreign-safe-lambda* <type> ({(<type> <var>)})) {<string>})
 ; (##core#foreign-primitive <type> ({(<type> <var>)}) {<string>})
 ; (##core#define-inline <name> <exp>)
-; (define-constant <name> <exp>)
+; (##core#define-constant <name> <exp*>)
 ; (##core#foreign-callback-wrapper '<name> <qualifiers> '<type> '({<type>}) <exp>)
 ; (##core#define-external-variable <name> <type> <bool> [<symbol>])
 ; (##core#check <exp>)
@@ -1096,7 +1096,7 @@
 			     (set! inline-table-used #t)
 			     '(##core#undefined)))
 
-			((define-constant)
+			((##core#define-constant)
 			 (let* ([name (second x)]
 				[valexp (third x)]
 				[val (handle-exceptions ex
diff --git a/eval.scm b/eval.scm
index 5543a48a..f0d37497 100644
--- a/eval.scm
+++ b/eval.scm
@@ -731,7 +731,7 @@
 			      (##sys#warn "declarations are ignored in interpreted code" x) )
 			  (compile '(##core#undefined) e #f tf cntr se) ]
 
-			 [(define-inline define-constant)
+			 [(##core#define-inline ##core#define-constant)
 			  (compile `(,(rename 'define se) ,@(cdr x)) e #f tf cntr se) ]
                    
 			 [(##core#primitive ##core#inline ##core#inline_allocate ##core#foreign-lambda