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