~ chicken-core (chicken-5) b4315de45dcfbb61a99df44e4447c62ccde93d88
commit b4315de45dcfbb61a99df44e4447c62ccde93d88
Merge: 90c0d08e 2dac30b7
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Mar 17 12:28:44 2011 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Mar 17 12:28:44 2011 +0100
resolved conflicts
diff --cc compiler.scm
index 6cb63f89,0ba5b4a0..b7245a3e
--- a/compiler.scm
+++ b/compiler.scm
@@@ -1466,24 -1475,12 +1466,24 @@@
((type)
(for-each
(lambda (spec)
- (cond ((and (list? spec) (symbol? (car spec)) (= 2 (length spec)))
- (##sys#put! (car spec) '##core#type (cadr spec))
- (##sys#put! (car spec) '##core#declared-type #t))
- (else
- (warning "illegal `type' declaration item" spec))))
- (globalize-all (cdr spec))))
+ (if (not (and (list? spec)
+ (>= 2 (length spec))
+ (symbol? (car spec))))
+ (warning "illegal type declaration" (##sys#strip-syntax spec))
- (let ((name (globalize (car spec)))
++ (let ((name (##sys#globalize (car spec)))
+ (type (##sys#strip-syntax (cadr spec))))
+ (cond ((validate-type type name)
+ (mark-variable name '##core#type type)
+ (mark-variable name '##core#declared-type)
+ (when (pair? (cddr spec))
+ (mark-variable
+ name '##core#specializations
+ (##sys#strip-syntax (cddr spec)))))
+ (else
+ (warning
+ "illegal type declaration"
+ (##sys#strip-syntax spec)))))))
+ (cdr spec)))
((unsafe-specialized-arithmetic)
(set! unchecked-specialized-arithmetic #t))
(else (warning "illegal declaration specifier" spec)) )
diff --cc types.db
index b28ce80d,b6bf5f2d..eca8d8f3
--- a/types.db
+++ b/types.db
@@@ -429,12 -181,8 +429,12 @@@
(vector->list (procedure vector->list (vector) list))
(list->vector (procedure list->vector (list) vector))
(vector-fill! (procedure vector-fill! (vector *) vector))
- (vector-copy! (procedure vector-copy! (vector vector fixnum) undefined))
+
+(procedure? (procedure procedure? (*) boolean)
+ ((procedure) (let ((#:tmp #(1))) #t))
+ (((not procedure) (let ((#:tmp #(1))) #f)))) ;XXX test this!
+
+ (vector-copy! (procedure vector-copy! (vector vector #!optional fixnum) undefined))
-(procedure? (procedure procedure? (*) boolean))
(map (procedure map (procedure #!rest list) list))
(for-each (procedure for-each (procedure #!rest list) undefined))
(apply (procedure apply (procedure #!rest) . *))
Trap