Hi all,
The attached patch moves foldable binding annotations out of
c-platform.scm and into types.db.
While looking into #986[1], I realized there are currently several
library procedures that are marked foldable when they really shouldn't
be (such as the example in the ticket itself!).
So, I audited the whole lot of `foldable-bindings`, and in doing so
moved them into types.db as #:foldable properties for clarity. I have a
hunch that many of the incorrect markings were there in part due to the
indirect way the set of foldable bindings was defined, and in any case
now that we have types.db I think it makes sense to keep as many of
these properties as possible in a single, declarative place.
It's also safe to fold predicates, so rather than redundantly mark all
of those procedures redundantly, I've made #:predicate imply #:foldable
in the optimizer.
A summary of the changed annotations follows. Note that you'll have to
build this revision with itself via boot-chicken, as the new types.db
property is unrecognized on older versions and they'll take this as a
reason to bomb.
If I've missed anything, let me know.
Cheers,
Evan
[1]: http://bugs.call-cc.org/ticket/986
No longer foldable, because they no longer exist:
hash-table-ref
thread-specific
thread-specific-set!
No longer foldable, either because (a) that can't ever actually happen,
(b) doing so seems wrong to me, or (c) they mustn't be folded according
to the spec (or some similar line of thought):
alist-cons
append
block-ref
block-set!
call-with-input-file
call-with-output-file
call/cc
f32vector-ref
f64vector-ref
foldl
foldr
list->string
list->vector
locative->object
locative-ref
locative-set!
pointer+
pointer->object
pointer=?
reverse
string->list
string-append
substring
vector->list
xcons
Now foldable, though they weren't previously:
alist-ref
blob=?
eighth
equal=?
fifth
imag-part
last
last-pair
length+
ninth
rassoc
real-part
seventh
sixth
string->symbol
symbol-append
tenth
##sys#gcd
##sys#lcm
##sys#substring-index
##sys#substring-index-ci
For reference, the remaining procedures were previously foldable, and
still are:
http://paste.call-cc.org/paste?id=41f31ee251427d3d42efdb55f98d21bfeb0cfb3f
>From c8e25dd9b0a912bd70d6d0e18163bbc77b475ffc Mon Sep 17 00:00:00 2001
From: Evan Hanson <ev...@foldling.org>
Date: Mon, 22 Sep 2014 18:37:31 +1200
Subject: [PATCH] Move foldable binding annotations into types.db
This adds a #:foldable property for procedures in types.db and migrates
the list of foldable bindings out of c-platform.scm and into that file.
It also makes the optimizer consider #:predicate procedures foldable,
unmarks some identifiers that shouldn't be marked foldable, and adds a
handful of identifiers from the core units that should.
Also, update the list of standard and extended bindings in manual/faq
and remove all remaining references to hash-table-ref, thread-specific,
and thread-specific-set!
---
batch-driver.scm | 8 +-
c-platform.scm | 54 +-----
core.scm | 4 +-
manual/faq | 16 +-
optimizer.scm | 5 +-
scrutinizer.scm | 9 +-
support.scm | 4 +-
types.db | 479 +++++++++++++++++++++++++++++-------------------------
8 files changed, 288 insertions(+), 291 deletions(-)
diff --git a/batch-driver.scm b/batch-driver.scm
index 3cc16cb..27d296d 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -85,15 +85,11 @@
(when initial
(for-each
(lambda (s)
- (mark-variable s '##compiler#intrinsic 'standard)
- (when (memq s foldable-bindings)
- (mark-variable s '##compiler#foldable #t)))
+ (mark-variable s '##compiler#intrinsic 'standard))
standard-bindings)
(for-each
(lambda (s)
- (mark-variable s '##compiler#intrinsic 'extended)
- (when (memq s foldable-bindings)
- (mark-variable s '##compiler#foldable #t)))
+ (mark-variable s '##compiler#intrinsic 'extended))
extended-bindings)
(for-each
(lambda (s)
diff --git a/c-platform.scm b/c-platform.scm
index 57d2295..e646ef7 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -147,7 +147,7 @@
fp> fp< fp= fp>= fp<= fxand fxnot fxior fxxor fxshr fxshl bit-set? fxodd?
fxeven?
fpfloor fpceiling fptruncate fpround fpsin fpcos fptan fpasin fpacos fpatan
fpatan2 fpexp fpexpt fplog fpsqrt fpabs fpinteger?
- arithmetic-shift void flush-output thread-specific thread-specific-set!
+ arithmetic-shift void flush-output
not-pair? atom? null-list? print print* error proper-list? call/cc
blob-size u8vector->blob/shared s8vector->blob/shared
u16vector->blob/shared
s16vector->blob/shared u32vector->blob/shared s32vector->blob/shared
@@ -156,9 +156,11 @@
blob->s16vector/shared blob->u32vector/shared blob->s32vector/shared
blob->f32vector/shared blob->f64vector/shared
block-ref block-set! number-of-slots substring-index substring-index-ci
- hash-table-ref any? read-string substring=? substring-ci=?
- first second third fourth make-record-instance
- foldl foldr
+ any? read-string substring=? substring-ci=? blob=? equal=?
+ first second third fourth fifth sixth seventh eighth ninth tenth
+ alist-ref length+ rassoc real-part imag-part
+ last last-pair string->symbol symbol-append
+ make-record-instance foldl foldr
u8vector-length s8vector-length u16vector-length s16vector-length
u32vector-length
s32vector-length
f32vector-length f64vector-length setter
@@ -195,45 +197,7 @@
##sys#foreign-integer-argument ##sys#foreign-unsigned-integer-argument
##sys#peek-fixnum ##sys#setislot ##sys#poke-integer ##sys#permanent?
##sys#values ##sys#poke-double
##sys#intern-symbol ##sys#make-symbol ##sys#null-pointer? ##sys#peek-byte
- ##sys#file-exists?) )
-
-(define non-foldable-bindings
- '(vector
- cons list string make-vector make-string string->symbol values
current-input-port current-output-port
- read-char write-char printf fprintf format
- apply call-with-current-continuation set-car! set-cdr! write-char newline
write display
- peek-char char-ready?
- read read-char for-each map string-set! vector-set! string-fill!
vector-fill! open-input-file
- open-output-file close-input-port close-output-port call-with-input-port
call-with-output-port
- call-with-values eval
- ##sys#slot ##sys#setslot ##sys#call-with-current-continuation ##sys#fudge
flush-output print void
- u8vector->blob/shared s8vector->blob/shared u16vector->blob/shared
s16vector->blob/shared u32vector->blob/shared
- f32vector->blob/shared f64vector->blob/shared
- s32vector->blob/shared read-string read-string! o
- address->pointer pointer->address
- ##sys#make-structure print* ##sys#make-vector ##sys#apply ##sys#setislot
##sys#block-ref
- ##sys#byte ##sys#setbyte ##sys#get-keyword get-keyword
- u8vector-length s8vector-length u16vector-length s16vector-length
u32vector-length s32vector-length
- f32vector-length f64vector-length ##sys#apply-values ##sys#setter setter
- f32vector-set! f64vector-set!
- u8vector-ref s8vector-ref u16vector-ref s16vector-ref u32vector-ref
s32vector-ref
- u8vector-set! s8vector-set! u16vector-set! s16vector-set! u32vector-set!
s32vector-set!
- ##sys#intern-symbol ##sys#make-symbol make-record-instance error
##sys#block-set!
- current-error-port current-thread
- pointer-u8-ref pointer-u8-set!
- pointer-s8-ref pointer-s8-set!
- pointer-u16-ref pointer-u16-set!
- pointer-s16-ref pointer-s16-set!
- pointer-u32-ref pointer-u32-set!
- pointer-s32-ref pointer-s32-set!
- pointer-f32-ref pointer-f32-set!
- pointer-f64-ref pointer-f64-set!))
-
-(set! foldable-bindings
- (lset-difference
- eq?
- (lset-union eq? default-standard-bindings default-extended-bindings)
- non-foldable-bindings) )
+ ##sys#file-exists? ##sys#substring-index ##sys#substring-index-ci
##sys#lcm ##sys#gcd))
(for-each
(cut mark-variable <> '##compiler#pure '#t)
@@ -1068,9 +1032,6 @@
(rewrite 'make-vector 8 rewrite-make-vector)
(rewrite '##sys#make-vector 8 rewrite-make-vector) )
-(rewrite 'thread-specific 7 1 "C_slot" 10 #f)
-(rewrite 'thread-specific-set! 20 2 "C_i_setslot" 10 #f)
-
(let ()
(define (rewrite-call/cc db classargs cont callargs)
;; (call/cc <var>), <var> = (lambda (kont k) ... k is never used ...) ->
(<var> #f)
@@ -1099,7 +1060,6 @@
(define setter-map
'((car . set-car!)
(cdr . set-cdr!)
- (hash-table-ref . hash-table-set!)
(block-ref . block-set!)
(locative-ref . locative-set!)
(u8vector-ref . u8vector-set!)
diff --git a/core.scm b/core.scm
index 86e6e2b..56310cc 100644
--- a/core.scm
+++ b/core.scm
@@ -297,8 +297,7 @@
target-heap-size target-stack-size unit-name used-units
;; bindings, set by the (c) platform
- default-extended-bindings default-standard-bindings
- internal-bindings foldable-bindings
+ default-extended-bindings default-standard-bindings internal-bindings
;; Only read or called by the (c) backend
foreign-declarations foreign-lambda-stubs foreign-stub-argument-types
@@ -414,7 +413,6 @@
(define default-extended-bindings '())
(define default-standard-bindings '())
(define internal-bindings '())
-(define foldable-bindings '())
;;; Initialize globals:
diff --git a/manual/faq b/manual/faq
index a32136a..2ae9469 100644
--- a/manual/faq
+++ b/manual/faq
@@ -408,6 +408,7 @@ and compiler settings:
{{>}}
{{abs}}
{{acos}}
+{{append}}
{{apply}}
{{asin}}
{{assoc}}
@@ -478,6 +479,7 @@ and compiler settings:
{{read-string}}
{{real?}}
{{remainder}}
+{{reverse}}
{{round}}
{{set-car!}}
{{set-cdr!}}
@@ -521,6 +523,8 @@ The following extended bindings are handled specially:
{{block-ref}}
{{block-set!}}
{{call/cc}}
+{{call-with-input-file}}
+{{call-with-output-file}}
{{current-error-port}}
{{current-thread}}
{{error}}
@@ -546,11 +550,8 @@ The following extended bindings are handled specially:
{{fp<=}}
{{fp<}}
{{fp=}}
-{{fp=}}
-{{fp>=}}
{{fp>=}}
{{fp>}}
-{{fp>}}
{{fpabs}}
{{fpacos}}
{{fpasin}}
@@ -595,8 +596,9 @@ The following extended bindings are handled specially:
{{fxshl}}
{{fxshr}}
{{fxxor}}
-{{hash-table-ref}}
{{identity}}
+{{list->string}}
+{{list->vector}}
{{locative->object}}
{{locative-ref}}
{{locative-set!}}
@@ -644,14 +646,15 @@ The following extended bindings are handled specially:
{{second}}
{{signum}}
{{sprintf}}
+{{string-append}}
+{{string->list}}
{{sub1}}
+{{substring}}
{{substring-ci=?}}
{{substring-index-ci}}
{{substring-index}}
{{substring=?}}
{{third}}
-{{thread-specific-set!}}
-{{thread-specific}}
{{u16vector->blob/shared}}
{{u16vector-length}}
{{u16vector-ref}}
@@ -664,6 +667,7 @@ The following extended bindings are handled specially:
{{u8vector-length}}
{{u8vector-ref}}
{{u8vector-set!}}
+{{vector->list}}
{{xcons}}
==== What's the difference betweem "block" and "local" mode?
diff --git a/optimizer.scm b/optimizer.scm
index 193ffec..4c00c22 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -203,8 +203,9 @@
(if (eq? '##core#variable (node-class (car subs)))
(let ((var (first (node-parameters (car subs)))))
(if (and (intrinsic? var)
- (foldable? var)
- (every constant-node? (cddr subs)) )
+ (or (foldable? var)
+ (predicate? var))
+ (every constant-node? (cddr subs)))
(constant-form-eval
var
(cddr subs)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 5f61d6a..9d5cb02 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1762,6 +1762,9 @@
((#:enforce)
(mark-variable name '##compiler#enforce #t)
(loop (cdr props)))
+ ((#:foldable)
+ (mark-variable name '##compiler#foldable
#t)
+ (loop (cdr props)))
((#:predicate)
(mark-variable name '##compiler#predicate
(cadr props))
(loop (cddr props)))
@@ -1804,7 +1807,8 @@
(pred (variable-mark sym '##compiler#predicate))
(pure (variable-mark sym '##compiler#pure))
(clean (variable-mark sym '##compiler#clean))
- (enforce (variable-mark sym '##compiler#enforce)))
+ (enforce (variable-mark sym '##compiler#enforce))
+ (foldable (variable-mark sym '##compiler#foldable)))
(pp (cons*
sym
(let wrap ((type type))
@@ -1815,7 +1819,8 @@
,@(if enforce '(#:enforce) '())
,@(if pred `(#:predicate ,pred) '())
,@(if pure '(#:pure) '())
- ,@(if clean '(#:clean) '()))
+ ,@(if clean '(#:clean) '())
+ ,@(if foldable '(#:foldable) '()))
,@(cdr type)))
((forall)
`(forall ,(second type) ,(wrap (third type))))
diff --git a/support.scm b/support.scm
index bc522b2..ca0f353 100644
--- a/support.scm
+++ b/support.scm
@@ -66,7 +66,8 @@
source-info->string source-info->line call-info constant-form-eval
dump-nodes read-info-hook read/source-info big-fixnum?
hide-variable export-variable variable-visible?
- mark-variable variable-mark intrinsic? foldable? load-identifier-database
+ mark-variable variable-mark intrinsic? predicate? foldable?
+ load-identifier-database
print-version print-usage print-debug-options
;; XXX: These are evil globals that were too hairy to get rid of.
@@ -1561,6 +1562,7 @@
(define intrinsic? (cut variable-mark <> '##compiler#intrinsic))
;; Used only in optimizer.scm
(define foldable? (cut variable-mark <> '##compiler#foldable))
+(define predicate? (cut variable-mark <> '##compiler#predicate))
;;; Load support files
diff --git a/types.db b/types.db
index 96f209b..11527e5 100644
--- a/types.db
+++ b/types.db
@@ -37,7 +37,8 @@
; - "#(procedure PROPERTY ...)" may be used in place of "procedure",
properties are:
; #:clean - procedure does not modify state that might be used locally
; #:enforce - when procedure returns, arguments are of correct type
-; #:predicate TYPE - procedure is a predicate on TYPE
+; #:foldable - procedure may be constant-folded
+; #:predicate TYPE - procedure is a predicate on TYPE (implies #:foldable)
; #:pure - procedure has no side effects
; - "#:clean" means: will not invoke procedures that modify local variables and
; will not modify list or vector data held locally (note that I/O may invoke
@@ -46,22 +47,24 @@
; since arity-mismatch will for example always have a side effect.
; - "#:enforce" means: after return from this procedure, the argument is of
; the correct type (it would have signalled an error otherwise)
+; - "#:foldable" means: when applied to constant arguments, direct calls
+; to this procedure may be evaluated at compile time.
;; scheme
-(not (#(procedure #:pure) not (*) boolean)
+(not (#(procedure #:pure #:foldable) not (*) boolean)
(((not boolean)) (let ((#(tmp) #(1))) '#f)))
(boolean? (#(procedure #:pure #:predicate boolean) boolean? (*) boolean))
-(eq? (#(procedure #:pure) eq? (* *) boolean))
+(eq? (#(procedure #:pure #:foldable) eq? (* *) boolean))
-(eqv? (#(procedure #:pure) eqv? (* *) boolean)
+(eqv? (#(procedure #:pure #:foldable) eqv? (* *) boolean)
(((not float) *) (eq? #(1) #(2)))
((* (not float)) (eq? #(1) #(2))))
-(equal? (#(procedure #:pure) equal? (* *) boolean)
+(equal? (#(procedure #:pure #:foldable) equal? (* *) boolean)
(((or fixnum symbol char eof null) *) (eq? #(1) #(2)))
((* (or fixnum symbol char eof null)) (eq? #(1) #(2))))
@@ -71,74 +74,74 @@
(##sys#cons (forall (a b) (#(procedure #:pure) ##sys#cons (a b) (pair a b))))
-(car (forall (a) (#(procedure #:clean #:enforce) car ((pair a *)) a)) ((pair)
(##core#inline "C_u_i_car" #(1))))
-(cdr (forall (a) (#(procedure #:clean #:enforce) cdr ((pair * a)) a)) ((pair)
(##core#inline "C_u_i_cdr" #(1))))
+(car (forall (a) (#(procedure #:clean #:enforce #:foldable) car ((pair a *))
a)) ((pair) (##core#inline "C_u_i_car" #(1))))
+(cdr (forall (a) (#(procedure #:clean #:enforce #:foldable) cdr ((pair * a))
a)) ((pair) (##core#inline "C_u_i_cdr" #(1))))
-(caar (forall (a) (#(procedure #:clean #:enforce) caar ((pair (pair a *) *))
a))
+(caar (forall (a) (#(procedure #:clean #:enforce #:foldable) caar ((pair (pair
a *) *)) a))
(((pair (pair * *) *)) (##core#inline "C_u_i_car" (##core#inline
"C_u_i_car" #(1)))))
-(cadr (forall (a) (#(procedure #:clean #:enforce) cadr ((pair * (pair a *)))
a))
+(cadr (forall (a) (#(procedure #:clean #:enforce #:foldable) cadr ((pair *
(pair a *))) a))
(((pair * (pair * *))) (##core#inline "C_u_i_car" (##core#inline
"C_u_i_cdr" #(1)))))
-(cdar (forall (a) (#(procedure #:clean #:enforce) cdar ((pair (pair * a) *))
a))
+(cdar (forall (a) (#(procedure #:clean #:enforce #:foldable) cdar ((pair (pair
* a) *)) a))
(((pair (pair * *) *)) (##core#inline "C_u_i_cdr" (##core#inline
"C_u_i_car" #(1)))))
-(cddr (forall (a) (#(procedure #:clean #:enforce) cddr ((pair * (pair * a)))
a))
+(cddr (forall (a) (#(procedure #:clean #:enforce #:foldable) cddr ((pair *
(pair * a))) a))
(((pair * (pair * *))) (##core#inline "C_u_i_cdr" (##core#inline
"C_u_i_cdr" #(1)))))
-(caaar (forall (a) (#(procedure #:clean #:enforce) caaar ((pair (pair (pair a
*) *) *)) a))
+(caaar (forall (a) (#(procedure #:clean #:enforce #:foldable) caaar ((pair
(pair (pair a *) *) *)) a))
(((pair (pair (pair * *) *) *))
(##core#inline "C_u_i_car"
(##core#inline "C_u_i_car" (##core#inline "C_u_i_car"
#(1))))))
-(caadr (forall (a) (#(procedure #:clean #:enforce) caadr ((pair * (pair (pair
a *) *))) a))
+(caadr (forall (a) (#(procedure #:clean #:enforce #:foldable) caadr ((pair *
(pair (pair a *) *))) a))
(((pair * (pair (pair * *) *)))
(##core#inline "C_u_i_car"
(##core#inline "C_u_i_car" (##core#inline "C_u_i_cdr"
#(1))))))
-(cadar (forall (a) (#(procedure #:clean #:enforce) cadar ((pair (pair * (pair
a *)) *)) a))
+(cadar (forall (a) (#(procedure #:clean #:enforce #:foldable) cadar ((pair
(pair * (pair a *)) *)) a))
(((pair (pair * (pair * *)) *))
(##core#inline "C_u_i_car"
(##core#inline "C_u_i_cdr" (##core#inline "C_u_i_car"
#(1))))))
-(caddr (forall (a) (#(procedure #:clean #:enforce) caddr ((pair * (pair *
(pair a *)))) a))
+(caddr (forall (a) (#(procedure #:clean #:enforce #:foldable) caddr ((pair *
(pair * (pair a *)))) a))
(((pair * (pair * (pair * *))))
(##core#inline "C_u_i_car"
(##core#inline "C_u_i_cdr" (##core#inline "C_u_i_cdr"
#(1))))))
-(cdaar (forall (a) (#(procedure #:clean #:enforce) cdaar ((pair (pair (pair *
a) *) *)) a))
+(cdaar (forall (a) (#(procedure #:clean #:enforce #:foldable) cdaar ((pair
(pair (pair * a) *) *)) a))
(((pair (pair (pair * *) *) *))
(##core#inline "C_u_i_cdr"
(##core#inline "C_u_i_car" (##core#inline "C_u_i_car"
#(1))))))
-(cdadr (forall (a) (#(procedure #:clean #:enforce) cdadr ((pair * (pair (pair
* a) *))) a))
+(cdadr (forall (a) (#(procedure #:clean #:enforce #:foldable) cdadr ((pair *
(pair (pair * a) *))) a))
(((pair * (pair (pair * *) *)))
(##core#inline "C_u_i_cdr"
(##core#inline "C_u_i_car" (##core#inline "C_u_i_cdr"
#(1))))))
-(cddar (forall (a) (#(procedure #:clean #:enforce) cddar ((pair (pair * (pair
* a)) *)) a))
+(cddar (forall (a) (#(procedure #:clean #:enforce #:foldable) cddar ((pair
(pair * (pair * a)) *)) a))
(((pair (pair * (pair * *)) *))
(##core#inline "C_u_i_cdr"
(##core#inline "C_u_i_cdr" (##core#inline "C_u_i_car"
#(1))))))
-(cdddr (forall (a) (#(procedure #:clean #:enforce) cdddr ((pair * (pair *
(pair * a)))) a))
+(cdddr (forall (a) (#(procedure #:clean #:enforce #:foldable) cdddr ((pair *
(pair * (pair * a)))) a))
(((pair * (pair * (pair * *))))
(##core#inline "C_u_i_cdr"
(##core#inline "C_u_i_cdr" (##core#inline "C_u_i_cdr"
#(1))))))
-(caaaar (forall (a) (#(procedure #:clean #:enforce) caaaar ((pair (pair (pair
(pair a *) *) *) *)) a)))
-(caaadr (forall (a) (#(procedure #:clean #:enforce) caaadr ((pair * (pair
(pair (pair a *) *) *))) a)))
-(caadar (forall (a) (#(procedure #:clean #:enforce) caadar ((pair (pair *
(pair (pair a *) *)) *)) a)))
-(caaddr (forall (a) (#(procedure #:clean #:enforce) caaddr ((pair * (pair *
(pair (pair a *) *)))) a)))
-(cadaar (forall (a) (#(procedure #:clean #:enforce) cadaar ((pair (pair (pair
* (pair a *)) *) *)) a)))
-(cadadr (forall (a) (#(procedure #:clean #:enforce) cadadr ((pair * (pair
(pair * (pair a *)) *))) a)))
-(caddar (forall (a) (#(procedure #:clean #:enforce) caddar ((pair (pair *
(pair * (pair a *))) *)) a)))
-(cadddr (forall (a) (#(procedure #:clean #:enforce) cadddr ((pair * (pair *
(pair * (pair a *))))) a)))
-(cdaaar (forall (a) (#(procedure #:clean #:enforce) cdaaar ((pair (pair (pair
(pair * a) *) *) *)) a)))
-(cdaadr (forall (a) (#(procedure #:clean #:enforce) cdaadr ((pair * (pair
(pair (pair * a) *) *))) a)))
-(cdadar (forall (a) (#(procedure #:clean #:enforce) cdadar ((pair (pair *
(pair (pair * a) *)) *)) a)))
-(cdaddr (forall (a) (#(procedure #:clean #:enforce) cdaddr ((pair * (pair *
(pair (pair * a) *)))) a)))
-(cddaar (forall (a) (#(procedure #:clean #:enforce) cddaar ((pair (pair (pair
* (pair * a)) *) *)) a)))
-(cddadr (forall (a) (#(procedure #:clean #:enforce) cddadr ((pair * (pair
(pair * (pair * a)) *))) a)))
-(cdddar (forall (a) (#(procedure #:clean #:enforce) cdddar ((pair (pair *
(pair * (pair * a))) *)) a)))
-(cddddr (forall (a) (#(procedure #:clean #:enforce) cddddr ((pair * (pair *
(pair * (pair * a))))) a)))
+(caaaar (forall (a) (#(procedure #:clean #:enforce #:foldable) caaaar ((pair
(pair (pair (pair a *) *) *) *)) a)))
+(caaadr (forall (a) (#(procedure #:clean #:enforce #:foldable) caaadr ((pair *
(pair (pair (pair a *) *) *))) a)))
+(caadar (forall (a) (#(procedure #:clean #:enforce #:foldable) caadar ((pair
(pair * (pair (pair a *) *)) *)) a)))
+(caaddr (forall (a) (#(procedure #:clean #:enforce #:foldable) caaddr ((pair *
(pair * (pair (pair a *) *)))) a)))
+(cadaar (forall (a) (#(procedure #:clean #:enforce #:foldable) cadaar ((pair
(pair (pair * (pair a *)) *) *)) a)))
+(cadadr (forall (a) (#(procedure #:clean #:enforce #:foldable) cadadr ((pair *
(pair (pair * (pair a *)) *))) a)))
+(caddar (forall (a) (#(procedure #:clean #:enforce #:foldable) caddar ((pair
(pair * (pair * (pair a *))) *)) a)))
+(cadddr (forall (a) (#(procedure #:clean #:enforce #:foldable) cadddr ((pair *
(pair * (pair * (pair a *))))) a)))
+(cdaaar (forall (a) (#(procedure #:clean #:enforce #:foldable) cdaaar ((pair
(pair (pair (pair * a) *) *) *)) a)))
+(cdaadr (forall (a) (#(procedure #:clean #:enforce #:foldable) cdaadr ((pair *
(pair (pair (pair * a) *) *))) a)))
+(cdadar (forall (a) (#(procedure #:clean #:enforce #:foldable) cdadar ((pair
(pair * (pair (pair * a) *)) *)) a)))
+(cdaddr (forall (a) (#(procedure #:clean #:enforce #:foldable) cdaddr ((pair *
(pair * (pair (pair * a) *)))) a)))
+(cddaar (forall (a) (#(procedure #:clean #:enforce #:foldable) cddaar ((pair
(pair (pair * (pair * a)) *) *)) a)))
+(cddadr (forall (a) (#(procedure #:clean #:enforce #:foldable) cddadr ((pair *
(pair (pair * (pair * a)) *))) a)))
+(cdddar (forall (a) (#(procedure #:clean #:enforce #:foldable) cdddar ((pair
(pair * (pair * (pair * a))) *)) a)))
+(cddddr (forall (a) (#(procedure #:clean #:enforce #:foldable) cddddr ((pair *
(pair * (pair * (pair * a))))) a)))
(set-car! (#(procedure #:enforce) set-car! (pair *) undefined)
((pair (or fixnum char boolean eof null undefined)) (##sys#setislot
#(1) '0 #(2)))
@@ -155,31 +158,35 @@
(list (#(procedure #:pure) list (#!rest) list))
(##sys#list (#(procedure #:pure) ##sys#list (#!rest) list))
-(length (#(procedure #:clean #:enforce) length (list) fixnum) ; may loop
+(length (#(procedure #:clean #:enforce #:foldable) length (list) fixnum) ; may
loop
((null) (let ((#(tmp) #(1))) '0))
((list) (##core#inline "C_u_i_length" #(1))))
-(##sys#length (#(procedure #:clean #:enforce) ##sys#length (list) fixnum)
+(##sys#length (#(procedure #:clean #:enforce #:foldable) ##sys#length (list)
fixnum)
((null) (let ((#(tmp) #(1))) '0))
((list) (##core#inline "C_u_i_length" #(1))))
;; these are special cased (see scrutinizer.scm)
-(list-tail (forall (a) (#(procedure #:clean #:enforce) list-tail ((list-of a)
fixnum) (list-of a))))
-(list-ref (forall (a) (#(procedure #:clean #:enforce) list-ref ((list-of a)
fixnum) a)))
+(list-tail (forall (a) (#(procedure #:clean #:enforce #:foldable) list-tail
((list-of a) fixnum) (list-of a))))
+(list-ref (forall (a) (#(procedure #:clean #:enforce #:foldable) list-ref
((list-of a) fixnum) a)))
(append (#(procedure #:clean) append (#!rest *) *)) ; sic
(##sys#append (#(procedure #:clean) ##sys#append (#!rest *) *))
(reverse (forall (a) (#(procedure #:clean #:enforce) reverse ((list-of a))
(list-of a))))
-(memq (forall (a b) (#(procedure #:clean) memq (a (list-of b)) (or false
(list-of b))))
+(memq (forall (a b) (#(procedure #:clean #:foldable) memq
+ (a (list-of b))
+ (or false (list-of b))))
((* list) (##core#inline "C_u_i_memq" #(1) #(2))))
-(memv (forall (a b) (#(procedure #:clean) memv (a (list-of b)) (or false
(list-of b))))
+(memv (forall (a b) (#(procedure #:clean #:foldable) memv
+ (a (list-of b))
+ (or false (list-of b))))
(((or symbol procedure immediate) list)
(##core#inline "C_u_i_memq" #(1) #(2))))
-(member (forall (a b) (#(procedure #:clean) member
+(member (forall (a b) (#(procedure #:clean #:foldable) member
(a (list-of b) #!optional (procedure (b a) *)) ; sic
(or false (list-of b))))
(((or symbol procedure immediate) list)
@@ -187,20 +194,22 @@
((* (list-of (or symbol procedure immediate)))
(##core#inline "C_u_i_memq" #(1) #(2))))
-(assq (forall (a b) (#(procedure #:clean) assq (* (list-of (pair a b)))
+(assq (forall (a b) (#(procedure #:clean #:foldable) assq
+ (* (list-of (pair a b)))
(or false (pair a b))))
((* (list-of pair)) (##core#inline "C_u_i_assq" #(1) #(2))))
-(assv (forall (a b) (#(procedure #:clean) assv (* (list-of (pair a b)))
+(assv (forall (a b) (#(procedure #:clean #:foldable) assv
+ (* (list-of (pair a b)))
(or false (pair a b))))
(((or symbol immediate procedure) (list-of pair))
(##core#inline "C_u_i_assq" #(1) #(2)))
((* (list-of (pair (or symbol procedure immediate) *)))
(##core#inline "C_u_i_assq" #(1) #(2))))
-(assoc (forall (a b c) (#(procedure #:clean) assoc (a (list-of (pair b c))
- #!optional (procedure (b
a) *)) ; sic
- (or false (pair b c))))
+(assoc (forall (a b c) (#(procedure #:clean #:foldable) assoc
+ (a (list-of (pair b c)) #!optional (procedure (b a) *))
; sic
+ (or false (pair b c))))
(((or symbol procedure immediate) (list-of pair))
(##core#inline "C_u_i_assq" #(1) #(2)))
((* (list-of (pair (or symbol procedure immediate) *)))
@@ -208,54 +217,54 @@
(symbol? (#(procedure #:pure #:predicate symbol) symbol? (*) boolean))
-(symbol-append (#(procedure #:clean #:enforce) symbol-append (#!rest symbol)
symbol))
-(symbol->string (#(procedure #:clean #:enforce) symbol->string (symbol)
string))
-(string->symbol (#(procedure #:clean #:enforce) string->symbol (string)
symbol))
+(symbol-append (#(procedure #:clean #:enforce #:foldable) symbol-append
(#!rest symbol) symbol))
+(symbol->string (#(procedure #:clean #:enforce #:foldable) symbol->string
(symbol) string))
+(string->symbol (#(procedure #:clean #:enforce #:foldable) string->symbol
(string) symbol))
(number? (#(procedure #:pure #:predicate number) number? (*) boolean))
;;XXX predicate?
-(integer? (#(procedure #:pure) integer? (*) boolean)
+(integer? (#(procedure #:pure #:foldable) integer? (*) boolean)
((fixnum) (let ((#(tmp) #(1))) '#t))
((float) (##core#inline "C_u_i_fpintegerp" #(1))))
(real? (#(procedure #:pure #:predicate number) real? (*) boolean))
(complex? (#(procedure #:pure #:predicate number) complex? (*) boolean))
-(exact? (#(procedure #:clean #:enforce) exact? (number) boolean)
+(exact? (#(procedure #:clean #:enforce #:foldable) exact? (number) boolean)
((fixnum) (let ((#(tmp) #(1))) '#t))
((float) (let ((#(tmp) #(1))) '#f)))
-(inexact? (#(procedure #:clean #:enforce) inexact? (number) boolean)
+(inexact? (#(procedure #:clean #:enforce #:foldable) inexact? (number) boolean)
((fixnum) (let ((#(tmp) #(1))) '#f))
((float) (let ((#(tmp) #(1))) '#t)))
;;XXX predicate?
-(rational? (#(procedure #:pure) rational? (*) boolean)
+(rational? (#(procedure #:pure #:foldable) rational? (*) boolean)
((fixnum) (let ((#(tmp) #(1))) '#t)))
-(zero? (#(procedure #:clean #:enforce) zero? (number) boolean)
+(zero? (#(procedure #:clean #:enforce #:foldable) zero? (number) boolean)
((fixnum) (eq? #(1) '0))
((number) (##core#inline "C_u_i_zerop" #(1))))
-(odd? (#(procedure #:clean #:enforce) odd? (number) boolean) ((fixnum) (fxodd?
#(1))))
-(even? (#(procedure #:clean #:enforce) even? (number) boolean) ((fixnum)
(fxeven? #(1))))
+(odd? (#(procedure #:clean #:enforce #:foldable) odd? (number) boolean)
((fixnum) (fxodd? #(1))))
+(even? (#(procedure #:clean #:enforce #:foldable) even? (number) boolean)
((fixnum) (fxeven? #(1))))
-(positive? (#(procedure #:clean #:enforce) positive? (number) boolean)
+(positive? (#(procedure #:clean #:enforce #:foldable) positive? (number)
boolean)
((fixnum) (##core#inline "C_fixnum_greaterp" #(1) '0))
((number) (##core#inline "C_u_i_positivep" #(1))))
-(negative? (#(procedure #:clean #:enforce) negative? (number) boolean)
+(negative? (#(procedure #:clean #:enforce #:foldable) negative? (number)
boolean)
((fixnum) (##core#inline "C_fixnum_lessp" #(1) '0))
((number) (##core#inline "C_u_i_negativep" #(1))))
-(max (#(procedure #:clean #:enforce) max (#!rest number) number)
+(max (#(procedure #:clean #:enforce #:foldable) max (#!rest number) number)
((fixnum fixnum) (fxmax #(1) #(2)))
((float float) (##core#inline "C_i_flonum_max" #(1) #(2))))
-(min (#(procedure #:clean #:enforce) min (#!rest number) number)
+(min (#(procedure #:clean #:enforce #:foldable) min (#!rest number) number)
((fixnum fixnum) (fxmin #(1) #(2)))
((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
-(+ (#(procedure #:clean #:enforce) + (#!rest number) number)
+(+ (#(procedure #:clean #:enforce #:foldable) + (#!rest number) number)
(() (fixnum) '0)
((fixnum) (fixnum) #(1))
((float) (float) #(1))
@@ -274,7 +283,7 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2))))
-(- (#(procedure #:clean #:enforce) - (number #!rest number) number)
+(- (#(procedure #:clean #:enforce #:foldable) - (number #!rest number) number)
((fixnum) (fixnum)
(##core#inline "C_u_fixnum_negate" #(1)))
((float fixnum) (float)
@@ -292,7 +301,7 @@
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1))))
-(* (#(procedure #:clean #:enforce) * (#!rest number) number)
+(* (#(procedure #:clean #:enforce #:foldable) * (#!rest number) number)
(() (fixnum) '1)
((fixnum) (fixnum) #(1))
((float) (float) #(1))
@@ -310,7 +319,7 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2))))
-(/ (#(procedure #:clean #:enforce) / (number #!rest number) number)
+(/ (#(procedure #:clean #:enforce #:foldable) / (number #!rest number) number)
((float fixnum) (float)
(##core#inline_allocate
("C_a_i_flonum_quotient_checked" 4)
@@ -324,7 +333,7 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_quotient_checked" 4) #(1) #(2))))
-(= (#(procedure #:clean #:enforce) = (#!rest number) boolean)
+(= (#(procedure #:clean #:enforce #:foldable) = (#!rest number) boolean)
(() '#t)
((number) (let ((#(tmp) #(1))) '#t))
((fixnum fixnum) (eq? #(1) #(2)))
@@ -338,7 +347,7 @@
#(2)))
((float float) (##core#inline "C_flonum_equalp" #(1) #(2))))
-(> (#(procedure #:clean #:enforce) > (#!rest number) boolean)
+(> (#(procedure #:clean #:enforce #:foldable) > (#!rest number) boolean)
(() '#t)
((number) (let ((#(tmp) #(1))) '#t))
((fixnum fixnum) (fx> #(1) #(2)))
@@ -352,7 +361,7 @@
#(2)))
((float float) (##core#inline "C_flonum_greaterp" #(1) #(2))))
-(< (#(procedure #:clean #:enforce) < (#!rest number) boolean)
+(< (#(procedure #:clean #:enforce #:foldable) < (#!rest number) boolean)
(() '#t)
((number) (let ((#(tmp) #(1))) '#t))
((fixnum fixnum) (fx< #(1) #(2)))
@@ -366,7 +375,7 @@
#(2)))
((float float) (##core#inline "C_flonum_lessp" #(1) #(2))))
-(>= (#(procedure #:clean #:enforce) >= (#!rest number) boolean)
+(>= (#(procedure #:clean #:enforce #:foldable) >= (#!rest number) boolean)
(() '#t)
((number) (let ((#(tmp) #(1))) '#t))
((fixnum fixnum) (fx>= #(1) #(2)))
@@ -380,7 +389,7 @@
#(2)))
((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2))))
-(<= (#(procedure #:clean #:enforce) <= (#!rest number) boolean)
+(<= (#(procedure #:clean #:enforce #:foldable) <= (#!rest number) boolean)
(() '#t)
((number) (let ((#(tmp) #(1))) '#t))
((fixnum fixnum) (fx<= #(1) #(2)))
@@ -394,60 +403,67 @@
#(2)))
((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2))))
-(quotient (#(procedure #:clean #:enforce) quotient (number number) number)
+(quotient (#(procedure #:clean #:enforce #:foldable) quotient (number number)
number)
;;XXX flonum/mixed case
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_divide" #(1) #(2))))
-(remainder (#(procedure #:clean #:enforce) remainder (number number) number)
+(remainder (#(procedure #:clean #:enforce #:foldable) remainder (number
number) number)
;;XXX flonum/mixed case
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_modulo" #(1) #(2))))
-(modulo (#(procedure #:clean #:enforce) modulo (number number) number))
+(modulo (#(procedure #:clean #:enforce #:foldable) modulo (number number)
number))
-(gcd (#(procedure #:clean #:enforce) gcd (#!rest number) number) ((* *)
(##sys#gcd #(1) #(2))))
-(lcm (#(procedure #:clean #:enforce) lcm (#!rest number) number) ((* *)
(##sys#lcm #(1) #(2))))
+(gcd (#(procedure #:clean #:enforce #:foldable) gcd (#!rest number) number)
+ ((number number) (##sys#gcd #(1) #(2))))
-(abs (#(procedure #:clean #:enforce) abs (number) number)
+(##sys#gcd (#(procedure #:clean #:enforce #:foldable) gcd (number number)
number))
+
+(lcm (#(procedure #:clean #:enforce #:foldable) lcm (#!rest number) number)
+ ((number number) (##sys#lcm #(1) #(2))))
+
+(##sys#lcm (#(procedure #:clean #:enforce #:foldable) lcm (number number)
number))
+
+(abs (#(procedure #:clean #:enforce #:foldable) abs (number) number)
((fixnum) (fixnum)
(##core#inline "C_fixnum_abs" #(1)))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1))))
-(floor (#(procedure #:clean #:enforce) floor (number) number)
+(floor (#(procedure #:clean #:enforce #:foldable) floor (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1))))
-(ceiling (#(procedure #:clean #:enforce) ceiling (number) number)
+(ceiling (#(procedure #:clean #:enforce #:foldable) ceiling (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1))))
-(truncate (#(procedure #:clean #:enforce) truncate (number) number)
+(truncate (#(procedure #:clean #:enforce #:foldable) truncate (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1))))
-(round (#(procedure #:clean #:enforce) round (number) number)
+(round (#(procedure #:clean #:enforce #:foldable) round (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_round_proper" 4) #(1))))
-(exact->inexact (#(procedure #:clean #:enforce) exact->inexact (number) float)
+(exact->inexact (#(procedure #:clean #:enforce #:foldable) exact->inexact
(number) float)
((float) #(1))
((fixnum) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))))
-(inexact->exact (#(procedure #:clean #:enforce) inexact->exact (number)
fixnum) ((fixnum) #(1)))
+(inexact->exact (#(procedure #:clean #:enforce #:foldable) inexact->exact
(number) fixnum) ((fixnum) #(1)))
-(exp (#(procedure #:clean #:enforce) exp (number) float)
+(exp (#(procedure #:clean #:enforce #:foldable) exp (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1))))
-(log (#(procedure #:clean #:enforce) log (number) float)
+(log (#(procedure #:clean #:enforce #:foldable) log (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1))))
-(expt (#(procedure #:clean #:enforce) expt (number number) number)
+(expt (#(procedure #:clean #:enforce #:foldable) expt (number number) number)
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_expt" 4) #(1) #(2)))
((float fixnum) (float)
@@ -459,25 +475,25 @@
(##core#inline_allocate ("C_a_i_fix_to_flo" 4)
#(1))
#(2))))
-(sqrt (#(procedure #:clean #:enforce) sqrt (number) float)
+(sqrt (#(procedure #:clean #:enforce #:foldable) sqrt (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1))))
-(sin (#(procedure #:clean #:enforce) sin (number) float)
+(sin (#(procedure #:clean #:enforce #:foldable) sin (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1))))
-(cos (#(procedure #:clean #:enforce) cos (number) float)
+(cos (#(procedure #:clean #:enforce #:foldable) cos (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1))))
-(tan (#(procedure #:clean #:enforce) tan (number) float)
+(tan (#(procedure #:clean #:enforce #:foldable) tan (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1))))
-(asin (#(procedure #:clean #:enforce) asin (number) float)
+(asin (#(procedure #:clean #:enforce #:foldable) asin (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1))))
-(acos (#(procedure #:clean #:enforce) acos (number) float)
+(acos (#(procedure #:clean #:enforce #:foldable) acos (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1))))
-(atan (#(procedure #:clean #:enforce) atan (number #!optional number) float)
+(atan (#(procedure #:clean #:enforce #:foldable) atan (number #!optional
number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1)))
((float fixnum)
(##core#inline_allocate ("C_a_i_flonum_atan2" 4)
@@ -489,60 +505,62 @@
#(2)))
((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1)
#(2))))
-(number->string (#(procedure #:clean #:enforce) number->string (number
#!optional fixnum) string)
+(number->string (#(procedure #:clean #:enforce #:foldable) number->string
(number #!optional fixnum) string)
((fixnum) (##sys#fixnum->string #(1))))
-(string->number (#(procedure #:clean #:enforce) string->number (string
#!optional fixnum)
+(##sys#fixnum->string (#(procedure #:clean #:enforce #:foldable)
##sys#fixnum->string (fixnum) string))
+
+(string->number (#(procedure #:clean #:enforce #:foldable) string->number
(string #!optional fixnum)
(or number false)))
(char? (#(procedure #:pure #:predicate char) char? (*) boolean))
;; we could rewrite these, but this is done by the optimizer anyway (safe)
-(char=? (#(procedure #:clean #:enforce) char=? (char char) boolean))
-(char>? (#(procedure #:clean #:enforce) char>? (char char) boolean))
-(char<? (#(procedure #:clean #:enforce) char<? (char char) boolean))
-(char>=? (#(procedure #:clean #:enforce) char>=? (char char) boolean))
-(char<=? (#(procedure #:clean #:enforce) char<=? (char char) boolean))
-
-(char-ci=? (#(procedure #:clean #:enforce) char-ci=? (char char) boolean))
-(char-ci<? (#(procedure #:clean #:enforce) char-ci<? (char char) boolean))
-(char-ci>? (#(procedure #:clean #:enforce) char-ci>? (char char) boolean))
-(char-ci>=? (#(procedure #:clean #:enforce) char-ci>=? (char char) boolean))
-(char-ci<=? (#(procedure #:clean #:enforce) char-ci<=? (char char) boolean))
-(char-alphabetic? (#(procedure #:clean #:enforce) char-alphabetic? (char)
boolean))
-(char-whitespace? (#(procedure #:clean #:enforce) char-whitespace? (char)
boolean))
-(char-numeric? (#(procedure #:clean #:enforce) char-numeric? (char) boolean))
-(char-upper-case? (#(procedure #:clean #:enforce) char-upper-case? (char)
boolean))
-(char-lower-case? (#(procedure #:clean #:enforce) char-lower-case? (char)
boolean))
-(char-upcase (#(procedure #:clean #:enforce) char-upcase (char) char))
-(char-downcase (#(procedure #:clean #:enforce) char-downcase (char) char))
-
-(char->integer (#(procedure #:clean #:enforce) char->integer (char) fixnum))
-(integer->char (#(procedure #:clean #:enforce) integer->char (fixnum) char))
+(char=? (#(procedure #:clean #:enforce #:foldable) char=? (char char) boolean))
+(char>? (#(procedure #:clean #:enforce #:foldable) char>? (char char) boolean))
+(char<? (#(procedure #:clean #:enforce #:foldable) char<? (char char) boolean))
+(char>=? (#(procedure #:clean #:enforce #:foldable) char>=? (char char)
boolean))
+(char<=? (#(procedure #:clean #:enforce #:foldable) char<=? (char char)
boolean))
+
+(char-ci=? (#(procedure #:clean #:enforce #:foldable) char-ci=? (char char)
boolean))
+(char-ci<? (#(procedure #:clean #:enforce #:foldable) char-ci<? (char char)
boolean))
+(char-ci>? (#(procedure #:clean #:enforce #:foldable) char-ci>? (char char)
boolean))
+(char-ci>=? (#(procedure #:clean #:enforce #:foldable) char-ci>=? (char char)
boolean))
+(char-ci<=? (#(procedure #:clean #:enforce #:foldable) char-ci<=? (char char)
boolean))
+(char-alphabetic? (#(procedure #:clean #:enforce #:foldable) char-alphabetic?
(char) boolean))
+(char-whitespace? (#(procedure #:clean #:enforce #:foldable) char-whitespace?
(char) boolean))
+(char-numeric? (#(procedure #:clean #:enforce #:foldable) char-numeric? (char)
boolean))
+(char-upper-case? (#(procedure #:clean #:enforce #:foldable) char-upper-case?
(char) boolean))
+(char-lower-case? (#(procedure #:clean #:enforce #:foldable) char-lower-case?
(char) boolean))
+(char-upcase (#(procedure #:clean #:enforce #:foldable) char-upcase (char)
char))
+(char-downcase (#(procedure #:clean #:enforce #:foldable) char-downcase (char)
char))
+
+(char->integer (#(procedure #:clean #:enforce #:foldable) char->integer (char)
fixnum))
+(integer->char (#(procedure #:clean #:enforce #:foldable) integer->char
(fixnum) char))
(string? (#(procedure #:pure #:predicate string) string? (*) boolean))
-(string=? (#(procedure #:clean #:enforce) string=? (string string) boolean)
+(string=? (#(procedure #:clean #:enforce #:foldable) string=? (string string)
boolean)
((string string) (##core#inline "C_u_i_string_equal_p" #(1) #(2))))
-(string>? (#(procedure #:clean #:enforce) string>? (string string) boolean))
-(string<? (#(procedure #:clean #:enforce) string<? (string string) boolean))
-(string>=? (#(procedure #:clean #:enforce) string>=? (string string) boolean))
-(string<=? (#(procedure #:clean #:enforce) string<=? (string string) boolean))
-(string-ci=? (#(procedure #:clean #:enforce) string-ci=? (string string)
boolean))
-(string-ci<? (#(procedure #:clean #:enforce) string-ci<? (string string)
boolean))
-(string-ci>? (#(procedure #:clean #:enforce) string-ci>? (string string)
boolean))
-(string-ci>=? (#(procedure #:clean #:enforce) string-ci>=? (string string)
boolean))
-(string-ci<=? (#(procedure #:clean #:enforce) string-ci<=? (string string)
boolean))
+(string>? (#(procedure #:clean #:enforce #:foldable) string>? (string string)
boolean))
+(string<? (#(procedure #:clean #:enforce #:foldable) string<? (string string)
boolean))
+(string>=? (#(procedure #:clean #:enforce #:foldable) string>=? (string
string) boolean))
+(string<=? (#(procedure #:clean #:enforce #:foldable) string<=? (string
string) boolean))
+(string-ci=? (#(procedure #:clean #:enforce #:foldable) string-ci=? (string
string) boolean))
+(string-ci<? (#(procedure #:clean #:enforce #:foldable) string-ci<? (string
string) boolean))
+(string-ci>? (#(procedure #:clean #:enforce #:foldable) string-ci>? (string
string) boolean))
+(string-ci>=? (#(procedure #:clean #:enforce #:foldable) string-ci>=? (string
string) boolean))
+(string-ci<=? (#(procedure #:clean #:enforce #:foldable) string-ci<=? (string
string) boolean))
(make-string (#(procedure #:clean #:enforce) make-string (fixnum #!optional
char) string)
((fixnum char) (##sys#make-string #(1) #(2)))
((fixnum) (##sys#make-string #(1) '#\space)))
-(string-length (#(procedure #:clean #:enforce) string-length (string) fixnum)
+(string-length (#(procedure #:clean #:enforce #:foldable) string-length
(string) fixnum)
((string) (##sys#size #(1))))
-(string-ref (#(procedure #:clean #:enforce) string-ref (string fixnum) char)
+(string-ref (#(procedure #:clean #:enforce #:foldable) string-ref (string
fixnum) char)
((string fixnum) (##core#inline "C_subchar" #(1) #(2))))
(string-set! (#(procedure #:enforce) string-set! (string fixnum char)
undefined)
@@ -565,8 +583,8 @@
(vector-of a))))
;; these are special cased (see scrutinizer.scm)
-(vector-ref (forall (a) (#(procedure #:clean #:enforce) vector-ref ((vector-of
a) fixnum) a)))
-(##sys#vector-ref (forall (a) (#(procedure #:clean #:enforce) ##sys#vector-ref
((vector-of a) fixnum) a)))
+(vector-ref (forall (a) (#(procedure #:clean #:enforce #:foldable) vector-ref
((vector-of a) fixnum) a)))
+(##sys#vector-ref (forall (a) (#(procedure #:clean #:enforce #:foldable)
##sys#vector-ref ((vector-of a) fixnum) a)))
(vector-set! (#(procedure #:enforce) vector-set! (vector fixnum *) undefined))
@@ -574,9 +592,9 @@
(vector (#(procedure #:pure) vector (#!rest) vector))
(##sys#vector (#(procedure #:pure) ##sys#vector (#!rest) vector))
-(vector-length (#(procedure #:clean #:enforce) vector-length (vector) fixnum)
+(vector-length (#(procedure #:clean #:enforce #:foldable) vector-length
(vector) fixnum)
((vector) (##sys#size #(1))))
-(##sys#vector-length (#(procedure #:clean #:enforce) ##sys#vector-length
(vector) fixnum)
+(##sys#vector-length (#(procedure #:clean #:enforce #:foldable)
##sys#vector-length (vector) fixnum)
((vector) (##sys#size #(1))))
(vector->list (forall (a) (#(procedure #:clean #:enforce) vector->list
((vector-of a)) (list-of a))))
@@ -677,10 +695,10 @@
(eval (procedure eval (* #!optional (struct environment)) . *))
(char-ready? (#(procedure #:enforce) char-ready? (#!optional input-port)
boolean))
-(imag-part (#(procedure #:clean #:enforce) imag-part (number) number)
+(imag-part (#(procedure #:clean #:enforce #:foldable) imag-part (number)
number)
(((or fixnum float number)) (let ((#(tmp) #(1))) '0)))
-(real-part (#(procedure #:clean #:enforce) real-part (number) number)
+(real-part (#(procedure #:clean #:enforce #:foldable) real-part (number)
number)
(((or fixnum float number)) #(1)))
(magnitude (#(procedure #:clean #:enforce) magnitude (number) number)
@@ -691,7 +709,7 @@
(numerator (#(procedure #:clean #:enforce) numerator (number) number)
((fixnum) (fixnum) #(1)))
-
+
(denominator (#(procedure #:clean #:enforce) denominator (number) number)
((fixnum) (fixnum) (let ((#(tmp) #(1))) '1)))
@@ -713,39 +731,39 @@
(abort (procedure abort (*) noreturn))
(##sys#abort (procedure abort (*) noreturn))
-(add1 (#(procedure #:clean #:enforce) add1 (number) number)
+(add1 (#(procedure #:clean #:enforce #:foldable) add1 (number) number)
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0)))
(argc+argv (#(procedure #:clean) argc+argv () fixnum (list-of string) fixnum))
(argv (#(procedure #:clean) argv () (list-of string)))
-(arithmetic-shift (#(procedure #:clean #:enforce) arithmetic-shift (number
number) number))
+(arithmetic-shift (#(procedure #:clean #:enforce #:foldable) arithmetic-shift
(number number) number))
-(bit-set? (#(procedure #:clean #:enforce) bit-set? (number fixnum) boolean)
+(bit-set? (#(procedure #:clean #:enforce #:foldable) bit-set? (number fixnum)
boolean)
((fixnum fixnum) (##core#inline "C_u_i_bit_setp" #(1) #(2))))
-(bitwise-and (#(procedure #:clean #:enforce) bitwise-and (#!rest number)
number)
+(bitwise-and (#(procedure #:clean #:enforce #:foldable) bitwise-and (#!rest
number) number)
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_and" #(1) #(2))))
-(bitwise-ior (#(procedure #:clean #:enforce) bitwise-ior (#!rest number)
number)
+(bitwise-ior (#(procedure #:clean #:enforce #:foldable) bitwise-ior (#!rest
number) number)
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_or" #(1) #(2))))
-(bitwise-not (#(procedure #:clean #:enforce) bitwise-not (number) number))
+(bitwise-not (#(procedure #:clean #:enforce #:foldable) bitwise-not (number)
number))
-(bitwise-xor (#(procedure #:clean #:enforce) bitwise-xor (#!rest number)
number)
+(bitwise-xor (#(procedure #:clean #:enforce #:foldable) bitwise-xor (#!rest
number) number)
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_xor" #(1) #(2))))
(blob->string (#(procedure #:clean #:enforce) blob->string (blob) string))
-(blob-size (#(procedure #:clean #:enforce) blob-size (blob) fixnum)
+(blob-size (#(procedure #:clean #:enforce #:foldable) blob-size (blob) fixnum)
((blob) (##sys#size #(1))))
(blob? (#(procedure #:pure #:predicate blob) blob? (*) boolean))
-(blob=? (#(procedure #:clean #:enforce) blob=? (blob blob) boolean))
+(blob=? (#(procedure #:clean #:enforce #:foldable) blob=? (blob blob) boolean))
(build-platform (#(procedure #:pure) build-platform () symbol))
(call/cc (#(procedure #:enforce) call/cc ((procedure (*) . *)) . *))
(case-sensitive (#(procedure #:clean) case-sensitive (#!optional *) *))
@@ -793,7 +811,7 @@
(delete-file (#(procedure #:clean #:enforce) delete-file (string) string))
(enable-warnings (#(procedure #:clean) enable-warnings (#!optional *) *))
-(equal=? (#(procedure #:clean) equal=? (* *) boolean)
+(equal=? (#(procedure #:clean #:foldable) equal=? (* *) boolean)
((fixnum fixnum) (eq? #(1) #(2)))
(((or symbol char eof null) *) (eq? #(1) #(2)))
((* (or symbol char eof null undefined)) (eq? #(1) #(2)))
@@ -818,7 +836,7 @@
(file-exists? (#(procedure #:clean #:enforce) file-exists? (string) (or false
string)))
(directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string)
(or false string)))
-(finite? (#(procedure #:clean #:enforce) finite? (number) boolean)
+(finite? (#(procedure #:clean #:enforce #:foldable) finite? (number) boolean)
((fixnum) (let ((#(tmp) #(1))) '#t))
(((or float number)) (##core#inline "C_i_finitep" #(1))))
@@ -846,116 +864,116 @@
(force-finalizers (procedure force-finalizers () undefined))
-(fp- (#(procedure #:clean #:enforce) fp- (float float) float)
+(fp- (#(procedure #:clean #:enforce #:foldable) fp- (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1)
#(2)) ))
-(fp* (#(procedure #:clean #:enforce) fp* (float float) float)
+(fp* (#(procedure #:clean #:enforce #:foldable) fp* (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1)
#(2)) ))
-(fp/ (#(procedure #:clean #:enforce) fp/ (float float) float)
+(fp/ (#(procedure #:clean #:enforce #:foldable) fp/ (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1)
#(2)) ))
-(fp+ (#(procedure #:clean #:enforce) fp+ (float float) float)
+(fp+ (#(procedure #:clean #:enforce #:foldable) fp+ (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2))
))
-(fp< (#(procedure #:clean #:enforce) fp< (float float) boolean)
+(fp< (#(procedure #:clean #:enforce #:foldable) fp< (float float) boolean)
((float float) (##core#inline "C_flonum_lessp" #(1) #(2)) ))
-(fp<= (#(procedure #:clean #:enforce) fp<= (float float) boolean)
+(fp<= (#(procedure #:clean #:enforce #:foldable) fp<= (float float) boolean)
((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2)) ))
-(fp= (#(procedure #:clean #:enforce) fp= (float float) boolean)
+(fp= (#(procedure #:clean #:enforce #:foldable) fp= (float float) boolean)
((float float) (##core#inline "C_flonum_equalp" #(1) #(2)) ))
-(fp> (#(procedure #:clean #:enforce) fp> (float float) boolean)
+(fp> (#(procedure #:clean #:enforce #:foldable) fp> (float float) boolean)
((float float) (##core#inline "C_flonum_greaterp" #(1) #(2)) ))
-(fp>= (#(procedure #:clean #:enforce) fp>= (float float) boolean)
+(fp>= (#(procedure #:clean #:enforce #:foldable) fp>= (float float) boolean)
((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2)) ))
-(fpabs (#(procedure #:clean #:enforce) fpabs (float) float)
+(fpabs (#(procedure #:clean #:enforce #:foldable) fpabs (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1) )))
-(fpacos (#(procedure #:clean #:enforce) fpacos (float) float)
+(fpacos (#(procedure #:clean #:enforce #:foldable) fpacos (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1) )))
-(fpasin (#(procedure #:clean #:enforce) fpasin (float) float)
+(fpasin (#(procedure #:clean #:enforce #:foldable) fpasin (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1) )))
-(fpatan (#(procedure #:clean #:enforce) fpatan (float) float)
+(fpatan (#(procedure #:clean #:enforce #:foldable) fpatan (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1) )))
-(fpatan2 (#(procedure #:clean #:enforce) fpatan2 (float float) float)
+(fpatan2 (#(procedure #:clean #:enforce #:foldable) fpatan2 (float float)
float)
((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4)
#(1) #(2))))
-(fpceiling (#(procedure #:clean #:enforce) fpceiling (float) float)
+(fpceiling (#(procedure #:clean #:enforce #:foldable) fpceiling (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1) )))
-(fpcos (#(procedure #:clean #:enforce) fpcos (float) float)
+(fpcos (#(procedure #:clean #:enforce #:foldable) fpcos (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1) )))
-(fpexp (#(procedure #:clean #:enforce) fpexp (float) float)
+(fpexp (#(procedure #:clean #:enforce #:foldable) fpexp (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1) )))
-(fpexpt (#(procedure #:clean #:enforce) fpexpt (float float) float)
+(fpexpt (#(procedure #:clean #:enforce #:foldable) fpexpt (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_expt" 4)
#(1) #(2))))
-(fpfloor (#(procedure #:clean #:enforce) fpfloor (float) float)
+(fpfloor (#(procedure #:clean #:enforce #:foldable) fpfloor (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1) )))
-(fpinteger? (#(procedure #:clean #:enforce) fpinteger? (float) boolean)
+(fpinteger? (#(procedure #:clean #:enforce #:foldable) fpinteger? (float)
boolean)
((float) (##core#inline "C_u_i_fpintegerp" #(1) )))
-(fplog (#(procedure #:clean #:enforce) fplog (float) float)
+(fplog (#(procedure #:clean #:enforce #:foldable) fplog (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1) )))
-(fpmax (#(procedure #:clean #:enforce) fpmax (float float) float)
+(fpmax (#(procedure #:clean #:enforce #:foldable) fpmax (float float) float)
((float float) (##core#inline "C_i_flonum_max" #(1) #(2))))
-(fpmin (#(procedure #:clean #:enforce) fpmin (float float) float)
+(fpmin (#(procedure #:clean #:enforce #:foldable) fpmin (float float) float)
((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
-(fpneg (#(procedure #:clean #:enforce) fpneg (float) float)
+(fpneg (#(procedure #:clean #:enforce #:foldable) fpneg (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1) )))
-(fpround (#(procedure #:clean #:enforce) fpround (float) float)
+(fpround (#(procedure #:clean #:enforce #:foldable) fpround (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1) )))
-(fpsin (#(procedure #:clean #:enforce) fpsin (float) float)
+(fpsin (#(procedure #:clean #:enforce #:foldable) fpsin (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1) )))
-(fpsqrt (#(procedure #:clean #:enforce) fpsqrt (float) float)
+(fpsqrt (#(procedure #:clean #:enforce #:foldable) fpsqrt (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1) )))
-(fptan (#(procedure #:clean #:enforce) fptan (float) float)
+(fptan (#(procedure #:clean #:enforce #:foldable) fptan (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1) )))
-(fptruncate (#(procedure #:clean #:enforce) fptruncate (float) float)
+(fptruncate (#(procedure #:clean #:enforce #:foldable) fptruncate (float)
float)
((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1)
)))
;;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))
+(fx- (#(procedure #:clean #:foldable) fx- (fixnum fixnum) fixnum))
+(fx* (#(procedure #:clean #:foldable) fx* (fixnum fixnum) fixnum))
+(fx/ (#(procedure #:clean #:foldable) fx/ (fixnum fixnum) fixnum))
+(fx+ (#(procedure #:clean #:foldable) fx+ (fixnum fixnum) fixnum))
+(fx< (#(procedure #:clean #:foldable) fx< (fixnum fixnum) boolean))
+(fx<= (#(procedure #:clean #:foldable) fx<= (fixnum fixnum) boolean))
+(fx= (#(procedure #:clean #:foldable) fx= (fixnum fixnum) boolean))
+(fx> (#(procedure #:clean #:foldable) fx> (fixnum fixnum) boolean))
+(fx>= (#(procedure #:clean #:foldable) fx>= (fixnum fixnum) boolean))
+(fxand (#(procedure #:clean #:foldable) fxand (fixnum fixnum) fixnum))
+(fxeven? (#(procedure #:clean #:foldable) fxeven? (fixnum) boolean))
+(fxior (#(procedure #:clean #:foldable) fxior (fixnum fixnum) fixnum))
+(fxmax (#(procedure #:clean #:foldable) fxmax (fixnum fixnum) fixnum))
+(fxmin (#(procedure #:clean #:foldable) fxmin (fixnum fixnum) fixnum))
+(fxmod (#(procedure #:clean #:foldable) fxmod (fixnum fixnum) fixnum))
+(fxneg (#(procedure #:clean #:foldable) fxneg (fixnum) fixnum))
+(fxnot (#(procedure #:clean #:foldable) fxnot (fixnum) fixnum))
+(fxodd? (#(procedure #:clean #:foldable) fxodd? (fixnum) boolean))
+(fxshl (#(procedure #:clean #:foldable) fxshl (fixnum fixnum) fixnum))
+(fxshr (#(procedure #:clean #:foldable) fxshr (fixnum fixnum) fixnum))
+(fxxor (#(procedure #:clean #:foldable) fxxor (fixnum fixnum) fixnum))
(gc (#(procedure #:clean) gc (#!optional *) fixnum))
(gensym (#(procedure #:clean) gensym (#!optional (or string symbol)) symbol))
@@ -1074,7 +1092,7 @@
(string->uninterned-symbol (#(procedure #:clean #:enforce)
string->uninterned-symbol (string) symbol))
(strip-syntax (#(procedure #:clean) strip-syntax (*) *))
-(sub1 (#(procedure #:clean #:enforce) sub1 (number) number)
+(sub1 (#(procedure #:clean #:enforce #:foldable) sub1 (number) number)
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) '1.0)))
@@ -1174,9 +1192,12 @@
((*) (##core#inline "C_i_check_port" #(1) '0 '#t))
((* *) (##core#inline "C_i_check_port_2" #(1) '0 '#t #(2))))
+(##sys#slot (#(procedure #:enforce) ##sys#slot (* fixnum) *))
+
(##sys#setslot (#(procedure #:enforce) ##sys#setslot (* fixnum *) *)
#;((* fixnum immediate) (##sys#setislot #(1) #(2) #(3)))) ; too
dangerous
-(##sys#size (#(procedure #:pure) ##sys#size (*) fixnum))
+
+(##sys#size (#(procedure #:pure #:foldable) ##sys#size (*) fixnum))
(##sys#standard-input input-port)
(##sys#standard-output output-port)
@@ -1188,11 +1209,11 @@
(->string (procedure ->string (*) string)
((string) #(1)))
-(alist-ref (#(procedure #:clean #:enforce) alist-ref (* (list-of pair)
#!optional (procedure (* *) *) *) *))
+(alist-ref (#(procedure #:clean #:enforce #:foldable) alist-ref (* (list-of
pair) #!optional (procedure (* *) *) *) *))
(alist-update! (#(procedure #:enforce) alist-update! (* * (list-of pair)
#!optional (procedure (* *) *)) *))
-(alist-update (#(procedure #:clean #:enforce) alist-update (* * (list-of pair)
#!optional (procedure (* *) *) *) *))
+(alist-update (#(procedure #:clean #:enforce #:foldable) alist-update (* *
(list-of pair) #!optional (procedure (* *) *) *) *))
-(any? (#(procedure #:pure) any? (*) boolean)
+(any? (#(procedure #:pure #:foldable) any? (*) boolean)
((*) (let ((#(tmp) #(1))) '#t)))
(atom? (#(procedure #:pure) atom? (*) boolean)
@@ -1211,7 +1232,7 @@
(each (#(procedure #:clean #:enforce) each (#!rest procedure) procedure))
(flatten (#(procedure #:clean #:enforce) flatten (#!rest *) list))
(flip (#(procedure #:clean #:enforce) flip ((procedure (* *) . *)) (procedure
(* *) . *)))
-(identity (forall (a) (#(procedure #:pure) identity (a) a)))
+(identity (forall (a) (#(procedure #:pure #:foldable) identity (a) a)))
(intersperse (#(procedure #:clean #:enforce) intersperse (list *) list))
(join (#(procedure #:clean #:enforce) join ((list-of list) #!optional list)
list))
(list-of? (#(procedure #:clean #:enforce) list-of? ((procedure (*) *))
(procedure (list) boolean)))
@@ -1226,7 +1247,7 @@
(o (#(procedure #:clean #:enforce) o (#!rest (procedure (*) *)) (procedure (*)
*)))
-(rassoc (#(procedure #:clean #:enforce) rassoc (* (list-of pair) #!optional
(procedure (* *) *)) *))
+(rassoc (#(procedure #:clean #:enforce #:foldable) rassoc (* (list-of pair)
#!optional (procedure (* *) *)) *))
(reverse-string-append (#(procedure #:clean #:enforce) reverse-string-append
((list-of string)) string))
(sort
@@ -1253,17 +1274,27 @@
(string-split (#(procedure #:clean #:enforce) string-split (string #!optional
string *) (list-of string)))
(string-translate (#(procedure #:clean #:enforce) string-translate (string *
#!optional *) string))
(string-translate* (#(procedure #:clean #:enforce) string-translate* (string
(list-of (pair string string))) string))
-(substring-ci=? (#(procedure #:clean #:enforce) substring-ci=? (string string
#!optional fixnum fixnum fixnum) boolean))
+(substring-ci=? (#(procedure #:clean #:enforce #:foldable) substring-ci=?
(string string #!optional fixnum fixnum fixnum) boolean))
-(substring-index (#(procedure #:clean #:enforce) substring-index (string
string #!optional fixnum) (or false fixnum))
+(substring-index (#(procedure #:clean #:enforce #:foldable) substring-index
(string string #!optional fixnum) (or false fixnum))
((* *) (##sys#substring-index #(1) #(2) '0))
((* * *) (##sys#substring-index #(1) #(2) #(3))))
-(substring-index-ci (#(procedure #:clean #:enforce) substring-index-ci (string
string #!optional fixnum) (or false fixnum))
+(##sys#substring-index
+ (#(procedure #:clean #:enforce #:foldable) ##sys#substring-index
+ (string string fixnum)
+ (or false fixnum)))
+
+(substring-index-ci (#(procedure #:clean #:enforce #:foldable)
substring-index-ci (string string #!optional fixnum) (or false fixnum))
((* *) (##sys#substring-index-ci #(1) #(2) '0))
((* * *) (##sys#substring-index-ci #(1) #(2) #(3))))
-(substring=? (#(procedure #:clean #:enforce) substring=? (string string
#!optional fixnum fixnum fixnum) boolean))
+(##sys#substring-index-ci
+ (#(procedure #:clean #:enforce #:foldable) ##sys#substring-index-ci
+ (string string fixnum)
+ (or false fixnum)))
+
+(substring=? (#(procedure #:clean #:enforce #:foldable) substring=? (string
string #!optional fixnum fixnum fixnum) boolean))
(tail? (#(procedure #:clean) tail? (* *) boolean))
@@ -1285,7 +1316,7 @@
(read-string (#(procedure #:enforce) read-string (#!optional * input-port)
string))
(read-string! (#(procedure #:enforce) read-string! ((or fixnum false) string
#!optional input-port fixnum) fixnum))
(read-token (#(procedure #:enforce) read-token ((procedure (char) *)
#!optional input-port) string))
-(sprintf (#(procedure #:enforce) sprintf (string #!rest) string))
+(sprintf (#(procedure #:enforce #:foldable) sprintf (string #!rest) string))
(write-byte (#(procedure #:enforce) write-byte (fixnum #!optional output-port)
undefined))
(write-line (#(procedure #:enforce) write-line (string #!optional output-port)
undefined))
(write-string (#(procedure #:enforce) write-string (string #!optional *
output-port) undefined))
@@ -1484,7 +1515,7 @@
;; "(struct *)" (yet)
(##core#inline "C_bytes" (##sys#size #(1)))))
-(number-of-slots (#(procedure #:clean) number-of-slots (*) fixnum)
+(number-of-slots (#(procedure #:clean #:foldable) number-of-slots (*) fixnum)
(((or vector symbol pair)) (##sys#size #(1))))
(object->pointer (#(procedure #:clean) object->pointer (*) *))
@@ -1855,12 +1886,12 @@
(drop-right (forall (a) (#(procedure #:enforce) drop-right ((list-of a)
fixnum) (list-of a))))
(drop-right! (forall (a) (#(procedure #:enforce) drop-right! ((list-of a)
fixnum) (list-of a))))
(drop-while (forall (a) (#(procedure #:enforce) drop-while ((procedure (a) *)
(list-of a)) (list-of a))))
-(eighth (#(procedure #:clean #:enforce) eighth (pair) *))
+(eighth (#(procedure #:clean #:enforce #:foldable) eighth (pair) *))
(every
(forall (a) (#(procedure #:enforce) every ((procedure (a #!rest) *) (list-of
a) #!rest list) *)))
-(fifth (#(procedure #:clean #:enforce) fifth (pair) *))
+(fifth (#(procedure #:clean #:enforce #:foldable) fifth (pair) *))
(filter (forall (a) (#(procedure #:enforce) filter ((procedure (a) *) (list-of
a)) (list-of a))))
(filter! (forall (a) (#(procedure #:enforce) filter! ((procedure (a) *)
(list-of a)) (list-of a))))
@@ -1870,13 +1901,13 @@
(find (forall (a) (#(procedure #:enforce) find ((procedure (a) *) (list-of a))
*)))
(find-tail (forall (a) (#(procedure #:enforce) find-tail ((procedure (a) *)
(list-of a)) *)))
-(first (forall (a) (#(procedure #:clean #:enforce) first ((pair a *)) a))
+(first (forall (a) (#(procedure #:clean #:enforce #:foldable) first ((pair a
*)) a))
((pair) (##core#inline "C_u_i_car" #(1))))
(fold (#(procedure #:enforce) fold ((procedure (* #!rest) *) * #!rest list)
*)) ;XXX
(fold-right (#(procedure #:enforce) fold-right ((procedure (* #!rest) *) *
#!rest list) *)) ;XXX
-(fourth (forall (a) (#(procedure #:clean #:enforce) fourth ((pair * (pair *
(pair * (pair a *))))) a))
+(fourth (forall (a) (#(procedure #:clean #:enforce #:foldable) fourth ((pair *
(pair * (pair * (pair a *))))) a))
(((pair * (pair * (pair * (pair * *)))))
(##core#inline "C_u_i_car"
(##core#inline "C_u_i_cdr"
@@ -1884,9 +1915,9 @@
(##core#inline
"C_u_i_cdr" #(1)))))))
(iota (#(procedure #:clean #:enforce) iota (fixnum #!optional fixnum fixnum)
(list-of number)))
-(last (#(procedure #:clean #:enforce) last (pair) *))
-(last-pair (#(procedure #:clean #:enforce) last-pair (pair) *))
-(length+ (#(procedure #:clean #:enforce) length+ (list) *))
+(last (#(procedure #:clean #:enforce #:foldable) last (pair) *))
+(last-pair (#(procedure #:clean #:enforce #:foldable) last-pair (pair) *))
+(length+ (#(procedure #:clean #:enforce #:foldable) length+ (list) *))
(list-copy (forall (a) (#(procedure #:clean #:enforce) list-copy ((list-of a))
(list-of a))))
(list-index (forall (a) (#(procedure #:enforce) list-index ((procedure (a
#!rest) *) (list-of a) #!rest list) *)))
(list-tabulate (forall (a) (#(procedure #:enforce) list-tabulate (fixnum
(procedure (fixnum) a)) (list-of a))))
@@ -1966,13 +1997,13 @@
(a b)
(#(procedure #:enforce) map-in-order ((procedure (a #!rest) b) (list-of a)
#!rest list) (list-of b))))
-(ninth (#(procedure #:clean #:enforce) ninth (pair) *))
+(ninth (#(procedure #:clean #:enforce #:foldable) ninth (pair) *))
-(not-pair? (#(procedure #:clean) not-pair? (*) boolean)
+(not-pair? (#(procedure #:clean #:foldable) not-pair? (*) boolean)
((pair) (let ((#(tmp) #(1))) '#f))
(((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
-(null-list? (#(procedure #:clean #:enforce) null-list? (list) boolean)
+(null-list? (#(procedure #:clean #:enforce #:foldable) null-list? (list)
boolean)
((pair) (let ((#(tmp) #(1))) '#f))
((list) (let ((#(tmp) #(1))) '#f))
((null) (let ((#(tmp) #(1))) '#t)))
@@ -1983,7 +2014,7 @@
(partition (forall (a) (#(procedure #:enforce) partition ((procedure (a) *)
(list-of a)) (list-of a) (list-of a))))
(partition! (forall (a) (#(procedure #:enforce) partition! ((procedure (a) *)
(list-of a)) (list-of a) (list-of a))))
-(proper-list? (#(procedure #:clean) proper-list? (*) boolean)
+(proper-list? (#(procedure #:clean #:foldable) proper-list? (*) boolean)
((null) (let ((#(tmp) #(1))) '#t)))
(reduce (#(procedure #:enforce) reduce ((procedure (* *) *) * list) *)) ;XXX
@@ -1992,11 +2023,11 @@
(remove! (forall (a) (#(procedure #:enforce) remove! ((procedure (a) *)
(list-of a)) (list-of a))))
(reverse! (forall (a) (#(procedure #:enforce) reverse! ((list-of a)) (list-of
a))))
-(second (forall (a) (#(procedure #:clean #:enforce) second ((pair * (pair a
*))) a))
+(second (forall (a) (#(procedure #:clean #:enforce #:foldable) second ((pair *
(pair a *))) a))
(((pair * (pair * *))) (##core#inline "C_u_i_car" (##core#inline
"C_u_i_cdr" #(1)))))
-(seventh (#(procedure #:clean #:enforce) seventh (pair) *))
-(sixth (#(procedure #:clean #:enforce) sixth (pair) *))
+(seventh (#(procedure #:clean #:enforce #:foldable) seventh (pair) *))
+(sixth (#(procedure #:clean #:enforce #:foldable) sixth (pair) *))
(span (forall (a) (#(procedure #:enforce) span ((procedure (a) *) (list-of a))
(list-of a) (list-of a))))
(span! (forall (a) (#(procedure #:enforce) span! ((procedure (a) *) (list-of
a)) (list-of a) (list-of a))))
(split-at (forall (a) (#(procedure #:enforce) split-at ((list-of a) fixnum)
(list-of a) (list-of a))))
@@ -2006,9 +2037,9 @@
(take-right (forall (a) (#(procedure #:enforce) take-right ((list-of a)
fixnum) (list-of a))))
(take-while (forall (a) (#(procedure #:enforce) take-while ((procedure (a) *)
(list-of a)) (list-of a))))
(take-while! (forall (a) (#(procedure #:enforce) take-while! ((procedure (a)
*) (list-of a)) (list-of a))))
-(tenth (#(procedure #:clean #:enforce) tenth (pair) *))
+(tenth (#(procedure #:clean #:enforce #:foldable) tenth (pair) *))
-(third (forall (a) (#(procedure #:clean #:enforce) third ((pair * (pair *
(pair a *)))) a))
+(third (forall (a) (#(procedure #:clean #:enforce #:foldable) third ((pair *
(pair * (pair a *)))) a))
(((pair * (pair * (pair * *))))
(##core#inline "C_u_i_car"
(##core#inline "C_u_i_cdr" (##core#inline "C_u_i_cdr"
#(1))))))
--
1.7.10.4
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
