~ chicken-core (chicken-5) 1518daab965bbde5e5c99b3b56b3dbd56af67094

commit 1518daab965bbde5e5c99b3b56b3dbd56af67094
Merge: 4d3a7dd7 7a9d96de
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jul 15 16:11:30 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Jul 15 16:11:30 2011 +0200

    resolved conflicts

diff --cc chicken-syntax.scm
index 98ad27e8,aea116fd..3050fdcc
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@@ -1104,34 -1104,11 +1104,33 @@@
  
  (##sys#extend-macro-environment
   'let-compiler-syntax '()
-  (##sys#er-transformer
-   (syntax-rules ()
-     ((_ (binding ...) body ...)
-      (##core#let-compiler-syntax (binding ...) body ...)))))
+  (syntax-rules ()
+    ((_ (binding ...) body ...)
+     (##core#let-compiler-syntax (binding ...) body ...))))
  
  
 +;;; type-declaration syntax
 +
 +(##sys#extend-macro-environment
 + ': '()
 + (##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)))
 +	  (let-values (((type pred)
 +			(##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)))
 +		     (enforce-argument-types ,name1)
 +		     ,@(if pred `((predicate (,name1 ,pred))) '()))))))))))
 +
 +
  ;;; interface definition
  
  (##sys#extend-macro-environment
diff --cc types.db
index 807ac96d,7363afb0..17209d8c
--- a/types.db
+++ b/types.db
@@@ -583,10 -265,11 +583,11 @@@
  (current-milliseconds (procedure current-milliseconds () float))
  (current-read-table (procedure current-read-table () (struct read-table)))
  (current-seconds (procedure current-seconds () number))
 -(define-reader-ctor (procedure define-reader-ctor (symbol procedure) undefined))
 -(delete-file (procedure delete-file (string) string))
 +(define-reader-ctor (procedure! define-reader-ctor (symbol procedure) undefined))
 +(delete-file (procedure! delete-file (string) string))
  (enable-warnings (procedure enable-warnings (#!optional *) *))
  (equal=? (procedure equal=? (* *) boolean))
 -(er-macro-transformer (procedure er-macro-transformer ((procedure (* * *) *)) (struct transformer)))
++(er-macro-transformer (procedure! er-macro-transformer ((procedure (* * *) *)) (struct transformer)))
  (errno (procedure errno () fixnum))
  (error (procedure error (#!rest) noreturn))
  (exit (procedure exit (#!optional fixnum) noreturn))
@@@ -732,23 -349,22 +733,24 @@@
  (fxxor (procedure fxxor (fixnum fixnum) fixnum))
  (gc (procedure gc (#!optional *) fixnum))
  (gensym (procedure gensym (#!optional *) symbol))
 -(get (procedure get (symbol symbol #!optional *) *))
 -(get-call-chain (procedure get-call-chain (#!optional fixnum *) list))
 -(get-condition-property (procedure get-condition-property ((struct condition) symbol symbol #!optional *) *))
 -(get-environment-variable (procedure get-environment-variable (string) *))
 -(get-keyword (procedure get-keyword (symbol list #!optional *) *))
 -(get-output-string (procedure get-output-string (port) string))
 -(get-properties (procedure get-properties (symbol list) symbol * list))
 -(getenv (deprecated get-environment-variable))
 -(getter-with-setter (procedure getter-with-setter (procedure procedure #!optional string) procedure))
 -(implicit-exit-handler (procedure implicit-exit-handler (#!optional procedure) procedure))
 +
 +(get (procedure! get (symbol symbol #!optional *) *)
 +     ((symbol symbol *) (##core#inline "C_i_getprop" #(1) #(2) #(3))))
 +
 +(get-call-chain (procedure! get-call-chain (#!optional fixnum *) list))
 +(get-condition-property (procedure! get-condition-property ((struct condition) symbol symbol #!optional *) *))
 +(get-environment-variable (procedure! get-environment-variable (string) *))
 +(get-keyword (procedure! get-keyword (symbol list #!optional *) *))
 +(get-output-string (procedure! get-output-string (port) string))
 +(get-properties (procedure! get-properties (symbol list) symbol * list))
 +(getter-with-setter (procedure! getter-with-setter (procedure procedure #!optional string) procedure))
 +(implicit-exit-handler (procedure! implicit-exit-handler (#!optional procedure) procedure))
+ (ir-macro-transformer (procedure ir-macro-transformer ((procedure (* * *) *)) (struct transformer)))
 -(keyword->string (procedure keyword->string (symbol) string))
 +(keyword->string (procedure! keyword->string (symbol) string))
  (keyword-style (procedure keyword-style (#!optional *) *))
  (keyword? (procedure keyword? (*) boolean))
 -(load-library (procedure load-library (symbol #!optional string) undefined))
 -(load-relative (procedure load-relative (string #!optional procedure) undefined))
 +(load-library (procedure! load-library (symbol #!optional string) undefined))
 +(load-relative (procedure! load-relative (string #!optional procedure) undefined))
  (load-verbose (procedure load-verbose (#!optional *) *))
  (machine-byte-order (procedure machine-byte-order () symbol))
  (machine-type (procedure machine-type () symbol))