~ chicken-core (chicken-5) 4ec47dad87572ad6523c3c23747e523f397ed12d
commit 4ec47dad87572ad6523c3c23747e523f397ed12d
Merge: 9235b64d d7863afd
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Aug 31 11:47:27 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed Aug 31 11:47:27 2011 +0200
resolved conflicts
diff --cc defaults.make
index ed124439,9fe05c47..b1f971ed
--- a/defaults.make
+++ b/defaults.make
@@@ -301,8 -299,9 +301,8 @@@ CHICKEN_INSTALL_PROGRAM = $(PROGRAM_PRE
CHICKEN_UNINSTALL_PROGRAM = $(PROGRAM_PREFIX)chicken-uninstall$(PROGRAM_SUFFIX)
CHICKEN_STATUS_PROGRAM = $(PROGRAM_PREFIX)chicken-status$(PROGRAM_SUFFIX)
CHICKEN_BUG_PROGRAM = $(PROGRAM_PREFIX)chicken-bug$(PROGRAM_SUFFIX)
- IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix srfi-13 srfi-69 extras srfi-14 tcp foreign scheme srfi-18 utils csi irregex
+ IMPORT_LIBRARIES = chicken lolevel srfi-1 srfi-4 data-structures ports files posix srfi-13 srfi-69 extras srfi-14 tcp foreign srfi-18 utils csi irregex
IMPORT_LIBRARIES += setup-api setup-download
-SCRUTINIZED_LIBRARIES = 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 modules chicken-syntax chicken-ffi-syntax
ifdef STATICBUILD
CHICKEN_STATIC_EXECUTABLE = $(CHICKEN_PROGRAM)$(EXE)
diff --cc types.db
index 769b8d5b,4688ddb8..09488319
--- a/types.db
+++ b/types.db
@@@ -835,130 -691,117 +835,131 @@@
((float float) (##core#inline_allocate ("C_a_i_flonum_expt" 4)
#(1) #(2))))
-(fpfloor (procedure! fpfloor (float) float)
+(fpfloor (#(procedure #:clean #:enforce) fpfloor (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1) )))
-(fpinteger? (procedure! fpinteger? (float) boolean)
+(fpinteger? (#(procedure #:clean #:enforce) fpinteger? (float) boolean)
((float) (##core#inline "C_u_i_flonum_intergerp" #(1) )))
-(fplog (procedure! fplog (float) float)
+(fplog (#(procedure #:clean #:enforce) fplog (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1) )))
-(fpmax (procedure! fpmax (float float) float)
+(fpmax (#(procedure #:clean #:enforce) fpmax (float float) float)
((float float) (##core#inline "C_i_flonum_max" #(1) #(2))))
-(fpmin (procedure! fpmin (float float) float)
+(fpmin (#(procedure #:clean #:enforce) fpmin (float float) float)
((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
-(fpneg (procedure! fpneg (float) float)
+(fpneg (#(procedure #:clean #:enforce) fpneg (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1) )))
-(fpround (procedure! fpround (float) float)
+(fpround (#(procedure #:clean #:enforce) fpround (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1) )))
-(fpsin (procedure! fpsin (float) float)
+(fpsin (#(procedure #:clean #:enforce) fpsin (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1) )))
-(fpsqrt (procedure! fpsqrt (float) float)
+(fpsqrt (#(procedure #:clean #:enforce) fpsqrt (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1) )))
-(fptan (procedure! fptan (float) float)
+(fptan (#(procedure #:clean #:enforce) fptan (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1) )))
-(fptruncate (procedure! fptruncate (float) float)
+(fptruncate (#(procedure #:clean #:enforce) fptruncate (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1) )))
-(fx- (procedure fx- (fixnum fixnum) fixnum))
-(fx* (procedure fx* (fixnum fixnum) fixnum))
-(fx/ (procedure fx/ (fixnum fixnum) fixnum))
-(fx+ (procedure fx+ (fixnum fixnum) fixnum))
-(fx< (procedure fx< (fixnum fixnum) boolean))
-(fx<= (procedure fx<= (fixnum fixnum) boolean))
-(fx= (procedure fx= (fixnum fixnum) boolean))
-(fx> (procedure fx> (fixnum fixnum) boolean))
-(fx>= (procedure fx>= (fixnum fixnum) boolean))
-(fxand (procedure fxand (fixnum fixnum) fixnum))
-(fxeven? (procedure fxeven? (fixnum) boolean))
-(fxior (procedure fxior (fixnum fixnum) fixnum))
-(fxmax (procedure fxmax (fixnum fixnum) fixnum))
-(fxmin (procedure fxmin (fixnum fixnum) fixnum))
-(fxmod (procedure fxmod (fixnum fixnum) fixnum))
-(fxneg (procedure fxneg (fixnum) fixnum))
-(fxnot (procedure fxnot (fixnum) fixnum))
-(fxodd? (procedure fxodd? (fixnum) boolean))
-(fxshl (procedure fxshl (fixnum fixnum) fixnum))
-(fxshr (procedure fxshr (fixnum fixnum) fixnum))
-(fxxor (procedure fxxor (fixnum fixnum) fixnum))
-(gc (procedure gc (#!optional *) fixnum))
-(gensym (procedure gensym (#!optional *) symbol))
-
-(get (procedure! get (symbol symbol #!optional *) *)
+;;XXX should these be enforcing?
+(fx- (#(procedure #:clean) fx- (fixnum fixnum) fixnum))
+(fx* (#(procedure #:clean) fx* (fixnum fixnum) fixnum))
+(fx/ (#(procedure #:clean) fx/ (fixnum fixnum) fixnum))
+(fx+ (#(procedure #:clean) fx+ (fixnum fixnum) fixnum))
+(fx< (#(procedure #:clean) fx< (fixnum fixnum) boolean))
+(fx<= (#(procedure #:clean) fx<= (fixnum fixnum) boolean))
+(fx= (#(procedure #:clean) fx= (fixnum fixnum) boolean))
+(fx> (#(procedure #:clean) fx> (fixnum fixnum) boolean))
+(fx>= (#(procedure #:clean) fx>= (fixnum fixnum) boolean))
+(fxand (#(procedure #:clean) fxand (fixnum fixnum) fixnum))
+(fxeven? (#(procedure #:clean) fxeven? (fixnum) boolean))
+(fxior (#(procedure #:clean) fxior (fixnum fixnum) fixnum))
+(fxmax (#(procedure #:clean) fxmax (fixnum fixnum) fixnum))
+(fxmin (#(procedure #:clean) fxmin (fixnum fixnum) fixnum))
+(fxmod (#(procedure #:clean) fxmod (fixnum fixnum) fixnum))
+(fxneg (#(procedure #:clean) fxneg (fixnum) fixnum))
+(fxnot (#(procedure #:clean) fxnot (fixnum) fixnum))
+(fxodd? (#(procedure #:clean) fxodd? (fixnum) boolean))
+(fxshl (#(procedure #:clean) fxshl (fixnum fixnum) fixnum))
+(fxshr (#(procedure #:clean) fxshr (fixnum fixnum) fixnum))
+(fxxor (#(procedure #:clean) fxxor (fixnum fixnum) fixnum))
+(gc (#(procedure #:clean) gc (#!optional *) fixnum))
+(gensym (#(procedure #:clean) gensym (#!optional (or string symbol)) symbol))
+
+(get (#(procedure #:clean #:enforce) 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-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-verbose (procedure load-verbose (#!optional *) *))
-(machine-byte-order (procedure machine-byte-order () symbol))
-(machine-type (procedure machine-type () symbol))
-
-(make-blob (procedure! make-blob (fixnum) blob)
+(get-call-chain (#(procedure #:clean #:enforce) get-call-chain (#!optional fixnum (struct thread)) (list vector)))
+(get-condition-property (#(procedure #:clean #:enforce) get-condition-property ((struct condition) symbol symbol #!optional *) *))
+(get-environment-variable (#(procedure #:clean #:enforce) get-environment-variable (string) *))
+(get-keyword (#(procedure #:clean #:enforce) get-keyword (symbol list #!optional *) *))
+(get-output-string (#(procedure #:clean #:enforce) get-output-string (port) string))
+(get-properties (#(procedure #:clean #:enforce) get-properties (symbol list) symbol * list))
+
+(getter-with-setter
+ (#(procedure #:clean #:enforce)
+ getter-with-setter
+ ((procedure (#!rest) *) (procedure (* #!rest) . *) #!optional string)
+ procedure))
+
+(implicit-exit-handler
+ (#(procedure #:clean #:enforce) implicit-exit-handler (#!optional (procedure () . *)) procedure))
+
+(ir-macro-transformer
+ (#(procedure #:clean #:enforce)
+ ir-macro-transformer
+ ((procedure (* (procedure (*) *) (procedure (* *) *)) *))
+ (struct transformer)))
+
+(keyword->string (#(procedure #:clean #:enforce) keyword->string (symbol) string))
+(keyword-style (#(procedure #:clean) keyword-style (#!optional symbol) symbol))
+(keyword? (#(procedure #:pure) keyword? (*) boolean))
+(load-library (#(procedure #:enforce) load-library (symbol #!optional string) undefined))
+(load-relative (#(procedure #:enforce) load-relative (string #!optional (procedure (*) . *)) undefined))
+(load-verbose (#(procedure #:clean) load-verbose (#!optional *) *))
+(machine-byte-order (#(procedure #:pure) machine-byte-order () symbol))
+(machine-type (#(procedure #:pure) machine-type () symbol))
+
+(make-blob (#(procedure #:clean #:enforce) make-blob (fixnum) blob)
((fixnum) (##sys#make-blob #(1))))
-(make-composite-condition (procedure! make-composite-condition (#!rest (struct condition)) (struct condition)))
-(make-parameter (procedure! make-parameter (* #!optional procedure) procedure))
-(make-property-condition (procedure! make-property-condition (symbol #!rest *) (struct condition)))
+(make-composite-condition (#(procedure #:clean #:enforce) make-composite-condition (#!rest (struct condition)) (struct condition)))
+(make-parameter (#(procedure #:clean #:enforce) make-parameter (* #!optional procedure) procedure))
+(make-property-condition (#(procedure #:clean #:enforce) make-property-condition (symbol #!rest *) (struct condition)))
(maximum-flonum float)
-(memory-statistics (procedure memory-statistics () vector))
+(memory-statistics (#(procedure #:clean) memory-statistics () (vector fixnum)))
(minimum-flonum float)
+ (module-environment (procedure module-environment (symbol #!optional symbol) (struct environment)))
(most-negative-fixnum fixnum)
(most-positive-fixnum fixnum)
-(on-exit (procedure! on-exit ((procedure () . *)) undefined))
-(open-input-string (procedure! open-input-string (string #!rest) port))
-(open-output-string (procedure open-output-string (#!rest) port))
-(parentheses-synonyms (procedure parentheses-synonyms (#!optional *) *))
+(on-exit (#(procedure #:clean #:enforce) on-exit ((procedure () . *)) undefined))
+(open-input-string (#(procedure #:clean #:enforce) open-input-string (string #!rest) port))
+(open-output-string (#(procedure #:clean) open-output-string (#!rest) port))
+(parentheses-synonyms (#(procedure #:clean) parentheses-synonyms (#!optional *) *))
-(port-name (procedure! port-name (#!optional port) *)
+(port-name (#(procedure #:clean #:enforce) port-name (#!optional port) *)
((port) (##sys#slot #(1) '3)))
-(port-position (procedure! port-position (#!optional port) fixnum))
+(port-position (#(procedure #:clean #:enforce) port-position (#!optional port) fixnum fixnum))
-(port? (procedure? port port? (*) boolean))
+(port? (#(procedure #:pure #:predicate port) port? (*) boolean))
(print (procedure print (#!rest *) undefined))
-(print-call-chain (procedure! print-call-chain (#!optional port fixnum * string) undefined))
-(print-error-message (procedure! print-error-message (* #!optional port string) undefined))
+(print-call-chain (#(procedure #:clean #:enforce) print-call-chain (#!optional port fixnum * string) undefined))
+(print-error-message (#(procedure #:clean #:enforce) print-error-message (* #!optional port string) undefined))
(print* (procedure print* (#!rest) undefined))
-(procedure-information (procedure! procedure-information (procedure) *))
-(program-name (procedure! program-name (#!optional string) string))
-(promise? (procedure? (struct promise) promise? (*) boolean))
+(procedure-information (#(procedure #:clean #:enforce) procedure-information (procedure) *))
+(program-name (#(procedure #:clean #:enforce) program-name (#!optional string) string))
+(promise? (#(procedure #:pure #:predicate (struct promise)) promise? (*) boolean))
-(put! (procedure! put! (symbol symbol *) undefined)
+(put! (#(procedure #:clean #:enforce) put! (symbol symbol *) undefined)
((symbol symbol *)
(##core#inline_allocate ("C_a_i_putprop" 8) #(1) #(2) #(3))))
Trap