~ chicken-core (chicken-5) 9c60c5cdb3d8ed0cfe650dd78498ca830e5ee006

commit 9c60c5cdb3d8ed0cfe650dd78498ca830e5ee006
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Feb 12 14:23:56 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Feb 12 14:23:56 2010 +0100

    added internal aliases for some FFI forms

diff --git a/chicken-ffi-syntax.scm b/chicken-ffi-syntax.scm
index 7a5151ad..de1598a6 100644
--- a/chicken-ffi-syntax.scm
+++ b/chicken-ffi-syntax.scm
@@ -41,8 +41,8 @@
 	     (##sys#check-syntax 'define-external form '(symbol _ . #(_ 0 1)))
 	     (let ([var (car form)])
 	       `(,(r 'begin)
-		 (,(r 'define-foreign-variable) ,var ,(cadr form))
-		 (,(r 'define-external-variable) ,var ,(cadr form) #t)
+		 (##core#define-foreign-variable ,var ,(cadr form))
+		 (##core#define-external-variable ,var ,(cadr form) #t)
 		 ,@(if (pair? (cddr form))
 		       `((##core#set! ,var ,(caddr form)))
 		       '() ) ) ) ]
@@ -77,8 +77,8 @@
 	  (init (optional (cdddr form) #f))
 	  (name (r (gensym))))
       `(,(r 'begin)
-	(,(r 'define-foreign-variable) ,var ,type ,(symbol->string name))
-	(,(r 'define-external-variable) ,var ,type #f ,name)
+	(##core#define-foreign-variable ,var ,type ,(symbol->string name))
+	(##core#define-external-variable ,var ,type #f ,name)
 	,@(if (pair? init)
 	      `((##core#set! ,var ,(car init)))
 	      '() ) ) ) ) ) )
@@ -141,7 +141,7 @@
     (let ((tmp (gensym 'code_))
 	  (code (cadr form)))
       `(,(r 'begin)
-	(,(r 'define-foreign-variable) ,tmp
+	(##core#define-foreign-variable ,tmp
 	 ,(caddr form)
 	 ,(cond ((string? code) code)
 		((symbol? code) (symbol->string code))
@@ -160,4 +160,28 @@
     `(##core#declare (foreign-declare ,@(cdr form))))))
 
 
+;;; Aliases for internal forms
+
+(##sys#extend-macro-environment
+ 'define-foreign-type
+ '()
+ (##sys#er-transformer
+  (lambda (form r c)
+    `(##core#define-foreign-type ,@(cdr form)))))
+
+(##sys#extend-macro-environment
+ 'define-foreign-variable
+ '()
+ (##sys#er-transformer
+  (lambda (form r c)
+    `(##core#define-foreign-variable ,@(cdr form)))))
+
+(##sys#extend-macro-environment
+ 'foreign-primitive
+ '()
+ (##sys#er-transformer
+  (lambda (form r c)
+    `(##core#foreign-primitive ,@(cdr form)))))
+
+
 (##sys#macro-subset me0)))
diff --git a/compiler.scm b/compiler.scm
index 12af8c50..bcf62ddd 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -125,17 +125,17 @@
 ; (##core#compiletimeonly <exp>)
 ; (##core#elaborationtimetoo <exp>)
 ; (##core#elaborationtimeonly <exp>)
-; (define-foreign-variable <symbol> <type> [<string>])
-; (define-foreign-type <symbol> <type> [<proc1> [<proc2>]])
+; (##core#define-foreign-variable <symbol> <type> [<string>])
+; (##core#define-foreign-type <symbol> <type> [<proc1> [<proc2>]])
 ; (foreign-lambda <type> <string> {<type>})
 ; (foreign-lambda* <type> ({(<type> <var>)})) {<string>})
 ; (foreign-safe-lambda <type> <string> {<type>})
 ; (foreign-safe-lambda* <type> ({(<type> <var>)})) {<string>})
-; (foreign-primitive <type> ({(<type> <var>)}) {<string>})
+; (##core#foreign-primitive <type> ({(<type> <var>)}) {<string>})
 ; (##core#define-inline <name> <exp>)
 ; (define-constant <name> <exp>)
 ; (##core#foreign-callback-wrapper '<name> <qualifiers> '<type> '({<type>}) <exp>)
-; (##core#define-external-variable (quote <name>) (quote <type>) (quote <bool>))
+; (##core#define-external-variable <name> <type> <bool> [<symbol>])
 ; (##core#check <exp>)
 ; (##core#require-for-syntax <exp> ...)
 ; (##core#require-extension (<id> ...) <bool>)
@@ -1009,10 +1009,10 @@
 			((foreign-safe-lambda*)
 			 (walk (expand-foreign-lambda* x #t) e se dest) )
 
-			((foreign-primitive)
+			((##core#foreign-primitive)
 			 (walk (expand-foreign-primitive x) e se dest) )
 
-			((define-foreign-variable)
+			((##core#define-foreign-variable)
 			 (let* ([var (##sys#strip-syntax (second x))]
 				[type (##sys#strip-syntax (third x))]
 				[name (if (pair? (cdddr x))
@@ -1026,7 +1026,7 @@
 				   foreign-variables))
 			   '(##core#undefined) ) )
 
-			((define-foreign-type)
+			((##core#define-foreign-type)
 			 (let ([name (second x)]
 			       [type (##sys#strip-syntax (third x))] 
 			       [conv (cdddr x)] )
@@ -1049,7 +1049,7 @@
 				  (##sys#hash-table-set! foreign-type-table name type)
 				  '(##core#undefined) ] ) ) )
 
-			((define-external-variable)
+			((##core#define-external-variable)
 			 (let* ([sym (second x)]
 				[name (symbol->string sym)]
 				[type (third x)]