~ chicken-core (chicken-5) cef399243a2531d36831b8dcd25b834e627450f6

commit cef399243a2531d36831b8dcd25b834e627450f6
Merge: 074fdfc6 9ab3a617
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Apr 9 13:47:19 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Apr 9 13:47:19 2011 +0200

    resolved conflicts

diff --cc chicken-syntax.scm
index 998f5874,04e6658c..ef8f9292
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@@ -1110,27 -1110,65 +1110,84 @@@
       (##core#let-compiler-syntax (binding ...) body ...)))))
  
  
 +;;; type-declaration syntax
 +
 +(##sys#extend-macro-environment		;XXX not documented yet
 + ': '()
 + (##sys#er-transformer
 +  (lambda (x r c)
 +    (##sys#check-syntax ': x '(_ symbol _ . _))
 +    (if (memq #:csi ##sys#features) 
 +	'(##core#undefined)
 +	(let* ((type1 (##sys#strip-syntax (caddr x)))
 +	       (name1 (cadr x))
 +	       (type (##compiler#validate-type type1 (##sys#strip-syntax name1))))
 +	  (cond ((not type)
 +		 (syntax-error ': "invalid type syntax" name1 type1))
 +		(else
 +		 `(##core#declare 
 +		   (type (,name1 ,type ,@(cdddr x)))))))))))
 +
 +
+ ;;; interface definition
+ 
+ (##sys#extend-macro-environment
+  'define-interface '()
+  (##sys#er-transformer
+   (lambda (x r c)
+     (##sys#check-syntax 'define-interface x '(_ symbol _))
+     (let ((name (##sys#strip-syntax (cadr x)))
+ 	  (%quote (r 'quote)))
+       (when (eq? '* name)
+ 	(##sys#syntax-error-hook
+ 	 'define-interface "`*' is not allowed as a name for an interface"))
+       `(,(r 'begin-for-syntax)
+ 	(##sys#register-interface
+ 	 (,%quote ,name)
+ 	 (,%quote ,(let ((exps (##sys#strip-syntax (caddr x))))
+ 		     (cond ((eq? '* exps) '*)
+ 			   ((symbol? exps) `(#:interface ,exps))
+ 			   ((list? exps) 
+ 			    (##sys#validate-exports exps 'define-interface))
+ 			   (else
+ 			    (##sys#syntax-error-hook
+ 			     'define-interface "invalid exports" (caddr x))))))))))))
+ 
+ 
+ ;;; functor definition
+ 
+ (##sys#extend-macro-environment
+  'functor '()
+  (##sys#er-transformer
+   (lambda (x r c)
+     (##sys#check-syntax 'functor x '(_ (symbol . #((symbol _) 0)) _ . _))
+     (let* ((x (##sys#strip-syntax x))
+ 	   (head (cadr x))
+ 	   (name (car head))
+ 	   (exps (caddr x))
+ 	   (body (cdddr x))
+ 	   (registration
+ 	    `(##sys#register-functor
+ 	      ',name
+ 	      ',(map (lambda (arg)
+ 		       (let ((argname (car arg))
+ 			     (exps (##sys#validate-exports (cadr arg) 'functor)))
+ 			 (cons argname exps)))
+ 		     (cdr head))
+ 	      ',(##sys#validate-exports exps 'functor)
+ 	      ',body)))
+       `(##core#module
+ 	,name
+ 	#t
+ 	(import scheme chicken)
+ 	(begin-for-syntax ,registration))))))
+ 
+ 
+ ;; capture current macro env
+ 
  (##sys#macro-subset me0 ##sys#default-macro-environment)))
  
+ 
  ;; register features
  
  (eval-when (compile load eval)
diff --cc rules.make
index 43069955,8ad51102..5eed53fc
--- a/rules.make
+++ b/rules.make
@@@ -35,11 -35,10 +35,11 @@@ VPATH=$(SRCDIR
  
  SETUP_API_OBJECTS_1 = setup-api setup-download
  
 -LIBCHICKEN_OBJECTS_1 = \
 +LIBCHICKEN_SCHEME_OBJECTS_1 = \
         library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
         srfi-14 srfi-18 srfi-69 $(POSIXFILE) irregex scheduler \
-        profiler stub expand chicken-syntax chicken-ffi-syntax
 -       profiler stub expand modules chicken-syntax chicken-ffi-syntax runtime
++       profiler stub expand modules chicken-syntax chicken-ffi-syntax
 +LIBCHICKEN_OBJECTS_1 = $(LIBCHICKEN_SCHEME_OBJECTS_1) runtime
  LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
  LIBCHICKEN_STATIC_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=-static$(O))