~ chicken-core (chicken-5) 7e66907fe883908836959131ed3f1473d7a441f0
commit 7e66907fe883908836959131ed3f1473d7a441f0
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Aug 26 23:53:51 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri Aug 26 23:53:51 2011 +0200
mark procedures as clean/pure
diff --git a/compiler.scm b/compiler.scm
index a73202e8..0ac5a0f7 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -82,14 +82,15 @@
; ##compiler#always-bound-to-procedure -> BOOL
; ##compiler#local -> BOOL
; ##compiler#visibility -> #f | 'hidden | 'exported
-; ##compiler#constant -> BOOL
+; ##compiler#constant -> BOOL defined as constant
; ##compiler#intrinsic -> #f | 'standard | 'extended
; ##compiler#inline -> 'no | 'yes
; ##compiler#inline-global -> 'yes | 'no | <node>
; ##compiler#profile -> BOOL
; ##compiler#unused -> BOOL
; ##compiler#foldable -> BOOL
-; ##compiler#pure -> 'standard | 'extended | BOOL
+; ##compiler#pure -> BOOL referentially transparent
+; ##compiler#clean -> BOOL does not modify local state
; ##compiler#type -> TYPE
; ##compiler#declared-type -> BOOL
diff --git a/scrutinizer.scm b/scrutinizer.scm
index ea53599d..9a79873f 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -661,7 +661,9 @@
(define (smash)
(when (and (not strict-variable-types)
(or (not pn)
- (not (variable-mark pn '##compiler#pure))))
+ (and
+ (not (variable-mark pn '##compiler#pure))
+ (not (variable-mark pn '##compiler#clean)))))
(smash-component-types! e "env")
(smash-component-types! blist "blist")))
(cond (specialized?
@@ -1529,6 +1531,9 @@
;;; type-db processing
(define (load-type-database name #!optional (path (repository-path)))
+ (define (clean! name)
+ (when enable-specialization
+ (mark-variable name '##compiler#clean #t)))
(define (pure! name)
(when enable-specialization
(mark-variable name '##compiler#pure #t)))
@@ -1552,6 +1557,9 @@
((#:pure)
(pure! name)
(loop (cdr props)))
+ ((#:clean)
+ (clean! name)
+ (loop (cdr props)))
((#:enforce)
(mark-variable name '##compiler#enforce #t)
(loop (cdr props)))
@@ -1608,6 +1616,7 @@
(type (variable-mark sym '##compiler#type))
(pred (variable-mark sym '##compiler#predicate))
(pure (variable-mark sym '##compiler#pure))
+ (clean (variable-mark sym '##compiler#clean))
(enforce (variable-mark sym '##compiler#enforce)))
(pp (cons*
sym
@@ -1618,7 +1627,8 @@
`(#(procedure
,@(if enforce '(#:enforce) '())
,@(if pred `(#:predicate ,pred) '())
- ,@(if pure '(#:pure) '()))
+ ,@(if pure '(#:pure) '())
+ ,@(if clean '(#:clean) '()))
,@(cdr type)))
((forall)
`(forall ,(second type) ,(wrap (third type))))
@@ -1668,12 +1678,12 @@
;; - converts some typenames to struct types (u32vector, etc.)
;; - drops "#!key ..." args by converting to #!rest
;; - handles "(T1 -> T2 : T3)" (predicate)
- ;; - handles "(T1 --> T2 [: T3])" (pure)
+ ;; - handles "(T1 --> T2 [: T3])" (clean)
;; - simplifies result
;; - coalesces all "forall" forms into one (remove "forall" if typevar-set is empty)
;; - renames type-variables
(let ((ptype #f) ; (T . PT) | #f
- (pure #f)
+ (clean #f)
(usedvars '())
(typevars '()))
(define (upto lst p)
@@ -1739,9 +1749,9 @@
(and (= 2 (length t)) (symbol? (second t))))
((or (memq '--> t) (memq '-> t)) =>
(lambda (p)
- (let* ((puref (eq? '--> (car p)))
- (ok (or (not rec) (not puref))))
- (set! pure puref)
+ (let* ((cleanf (eq? '--> (car p)))
+ (ok (or (not rec) (not cleanf))))
+ (set! clean cleanf)
(let ((cp (memq ': (cdr p))))
(cond ((not cp)
(and ok
@@ -1801,7 +1811,7 @@
(values
type
(and ptype (eq? (car ptype) type) (cdr ptype))
- pure))))
+ clean))))
(else (values #f #f #f)))))
(define (install-specializations name specs)
diff --git a/types.db b/types.db
index c7c91ef3..865e3cb3 100644
--- a/types.db
+++ b/types.db
@@ -34,99 +34,102 @@
; all remaining arguments
; - in templates "#(SYMBOL)" binds X to a temporary gensym'd variable, further references
; to "#(SYMBOL)" allow backreferences to this generated identifier
+; - "#: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
+; port handlers)
;; scheme
-(not (procedure not (*) boolean)
+(not (#(procedure #:pure) not (*) boolean)
(((not boolean)) (let ((#(tmp) #(1))) '#t)))
-(boolean? (#(procedure #:predicate boolean) boolean? (*) boolean))
+(boolean? (#(procedure #:pure #:predicate boolean) boolean? (*) boolean))
-(eq? (procedure eq? (* *) boolean))
+(eq? (#(procedure #:pure) eq? (* *) boolean))
-(eqv? (procedure eqv? (* *) boolean)
+(eqv? (#(procedure #:pure) eqv? (* *) boolean)
(((not float) *) (eq? #(1) #(2)))
((* (not float)) (eq? #(1) #(2))))
-(equal? (procedure equal? (* *) boolean)
+(equal? (#(procedure #:pure) equal? (* *) boolean)
(((or fixnum symbol char eof null) *) (eq? #(1) #(2)))
((* (or fixnum symbol char eof null)) (eq? #(1) #(2))))
-(pair? (#(procedure #:predicate pair) pair? (*) boolean))
+(pair? (#(procedure #:pure #:predicate pair) pair? (*) boolean))
-(cons (forall (a b) (#(procedure #:pure #:enforce) cons (a b) (pair a b))))
+(cons (forall (a b) (#(procedure #:pure) cons (a b) (pair a b))))
-(##sys#cons (forall (a b) (procedure ##sys#cons (a b) (pair a b))))
+(##sys#cons (forall (a b) (#(procedure #:pure) ##sys#cons (a b) (pair a b))))
-(car (forall (a) (#(procedure #:enforce) car ((pair a *)) a)) ((pair) (##core#inline "C_u_i_car" #(1))))
-(cdr (forall (a) (#(procedure #:enforce) cdr ((pair * a)) a)) ((pair) (##core#inline "C_u_i_cdr" #(1))))
+(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))))
-(caar (forall (a) (#(procedure #:enforce) caar ((pair (pair a *) *)) a))
+(caar (forall (a) (#(procedure #:clean #:enforce) caar ((pair (pair a *) *)) a))
(((pair (pair * *) *)) (##core#inline "C_u_i_car" (##core#inline "C_u_i_car" #(1)))))
-(cadr (forall (a) (#(procedure #:enforce) cadr ((pair * (pair a *))) a))
+(cadr (forall (a) (#(procedure #:clean #:enforce) cadr ((pair * (pair a *))) a))
(((pair * (pair * *))) (##core#inline "C_u_i_car" (##core#inline "C_u_i_cdr" #(1)))))
-(cdar (forall (a) (#(procedure #:enforce) cdar ((pair (pair * a) *)) a))
+(cdar (forall (a) (#(procedure #:clean #:enforce) cdar ((pair (pair * a) *)) a))
(((pair (pair * *) *)) (##core#inline "C_u_i_cdr" (##core#inline "C_u_i_car" #(1)))))
-(cddr (forall (a) (#(procedure #:enforce) cddr ((pair * (pair * a))) a))
+(cddr (forall (a) (#(procedure #:clean #:enforce) cddr ((pair * (pair * a))) a))
(((pair * (pair * *))) (##core#inline "C_u_i_cdr" (##core#inline "C_u_i_cdr" #(1)))))
-(caaar (forall (a) (#(procedure #:enforce) caaar ((pair (pair (pair a *) *) *)) a))
+(caaar (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) caadr ((pair * (pair (pair a *) *))) a))
+(caadr (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) cadar ((pair (pair * (pair a *)) *)) a))
+(cadar (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) caddr ((pair * (pair * (pair a *)))) a))
+(caddr (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) cdaar ((pair (pair (pair * a) *) *)) a))
+(cdaar (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) cdadr ((pair * (pair (pair * a) *))) a))
+(cdadr (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) cddar ((pair (pair * (pair * a)) *)) a))
+(cddar (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) cdddr ((pair * (pair * (pair * a)))) a))
+(cdddr (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) caaaar ((pair (pair (pair (pair a *) *) *) *)) a)))
-(caaadr (forall (a) (#(procedure #:enforce) caaadr ((pair * (pair (pair (pair a *) *) *))) a)))
-(caadar (forall (a) (#(procedure #:enforce) caadar ((pair (pair * (pair (pair a *) *)) *)) a)))
-(caaddr (forall (a) (#(procedure #:enforce) caaddr ((pair * (pair * (pair (pair a *) *)))) a)))
-(cadaar (forall (a) (#(procedure #:enforce) cadaar ((pair (pair (pair * (pair a *)) *) *)) a)))
-(cadadr (forall (a) (#(procedure #:enforce) cadadr ((pair * (pair (pair * (pair a *)) *))) a)))
-(caddar (forall (a) (#(procedure #:enforce) caddar ((pair (pair * (pair * (pair a *))) *)) a)))
-(cadddr (forall (a) (#(procedure #:enforce) cadddr ((pair * (pair * (pair * (pair a *))))) a)))
-(cdaaar (forall (a) (#(procedure #:enforce) cdaaar ((pair (pair (pair (pair * a) *) *) *)) a)))
-(cdaadr (forall (a) (#(procedure #:enforce) cdaadr ((pair * (pair (pair (pair * a) *) *))) a)))
-(cdadar (forall (a) (#(procedure #:enforce) cdadar ((pair (pair * (pair (pair * a) *)) *)) a)))
-(cdaddr (forall (a) (#(procedure #:enforce) cdaddr ((pair * (pair * (pair (pair * a) *)))) a)))
-(cddaar (forall (a) (#(procedure #:enforce) cddaar ((pair (pair (pair * (pair * a)) *) *)) a)))
-(cddadr (forall (a) (#(procedure #:enforce) cddadr ((pair * (pair (pair * (pair * a)) *))) a)))
-(cdddar (forall (a) (#(procedure #:enforce) cdddar ((pair (pair * (pair * (pair * a))) *)) a)))
-(cddddr (forall (a) (#(procedure #:enforce) cddddr ((pair * (pair * (pair * (pair * a))))) a)))
+(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)))
(set-car! (#(procedure #:enforce) set-car! (pair *) undefined)
((pair (or fixnum char boolean eof null undefined)) (##sys#setislot #(1) '0 #(2)))
@@ -136,101 +139,101 @@
((pair (or fixnum char boolean eof null undefined)) (##sys#setislot #(1) '1 #(2)))
((pair *) (##sys#setslot #(1) '1 #(2))))
-(null? (#(procedure #:predicate null) null? (*) boolean))
-(list? (#(procedure #:predicate list) list? (*) boolean))
+(null? (#(procedure #:pure #:predicate null) null? (*) boolean))
+(list? (#(procedure #:pure #:predicate list) list? (*) boolean))
-(list (procedure list (#!rest) list)
+(list (#(procedure #:pure) list (#!rest) list)
(() (null) '()))
-(##sys#list (procedure ##sys#list (#!rest) list)
+(##sys#list (#(procedure #:pure) ##sys#list (#!rest) list)
(() (null) '()))
-(length (#(procedure #:enforce) length (list) fixnum)
+(length (#(procedure #:clean #:enforce) length (list) fixnum) ; may loop
((null) '0)
((list) (##core#inline "C_u_i_length" #(1))))
-(##sys#length (#(procedure #:enforce) ##sys#length (list) fixnum)
+(##sys#length (#(procedure #:clean #:enforce) ##sys#length (list) fixnum)
((null) '0)
((list) (##core#inline "C_u_i_length" #(1))))
-(list-tail (forall (a) (#(procedure #:enforce) list-tail ((list a) fixnum) (list a))))
-(list-ref (forall (a) (#(procedure #:enforce) list-ref ((list a) fixnum) a)))
-(append (procedure append (list #!rest) *))
-(##sys#append (procedure ##sys#append (list #!rest) *))
-(reverse (forall (a) (#(procedure #:enforce) reverse ((list a)) (list a))))
-(memq (procedure memq (* list) *) ((* list) (##core#inline "C_u_i_memq" #(1) #(2))))
+(list-tail (forall (a) (#(procedure #:clean #:enforce) list-tail ((list a) fixnum) (list a))))
+(list-ref (forall (a) (#(procedure #:clean #:enforce) list-ref ((list a) fixnum) a)))
+(append (#(procedure #:clean) append (list #!rest) *))
+(##sys#append (#(procedure #:clean) ##sys#append (list #!rest) *))
+(reverse (forall (a) (#(procedure #:clean #:enforce) reverse ((list a)) (list a))))
+(memq (#(procedure #:clean) memq (* list) *) ((* list) (##core#inline "C_u_i_memq" #(1) #(2))))
-(memv (procedure memv (* list) *)
+(memv (#(procedure #:clean) memv (* list) *)
(((or fixnum boolean char eof undefined null) list)
(##core#inline "C_u_i_memq" #(1) #(2))))
;; this may be a bit much...
-(member (forall (a) (procedure member (* list #!optional (procedure (* *) *)) *))
+(member (forall (a) (#(procedure #:clean) member (* list #!optional (procedure (* *) *)) *))
(((or fixnum boolean char eof undefined null) list)
(##core#inline "C_u_i_memq" #(1) #(2)))
((* (list (or fixnum boolean char eof undefined null)))
(##core#inline "C_u_i_memq" #(1) #(2))))
-(assq (procedure assq (* list) *) ((* list) (##core#inline "C_u_i_assq" #(1) #(2))))
+(assq (#(procedure #:clean) assq (* list) *) ((* list) (##core#inline "C_u_i_assq" #(1) #(2))))
-(assv (procedure assv (* list) *)
+(assv (#(procedure #:clean) assv (* list) *)
(((or fixnum boolean char eof undefined null) list)
(##core#inline "C_u_i_assq" #(1) #(2)))
((* (list (or fixnum boolean char eof undefined null)))
(##core#inline "C_u_i_assq" #(1) #(2))))
-(assoc (procedure assoc (* list #!optional (procedure (* *) *)) *)
+(assoc (#(procedure #:clean) assoc (* list #!optional (procedure (* *) *)) *)
(((or fixnum boolean char eof undefined null) list)
(##core#inline "C_u_i_assq" #(1) #(2)))
((* (list (or fixnum boolean char eof undefined null)))
(##core#inline "C_u_i_assq" #(1) #(2))))
-(symbol? (#(procedure #:predicate symbol) symbol? (*) boolean))
+(symbol? (#(procedure #:pure #:predicate symbol) symbol? (*) boolean))
-(symbol-append (#(procedure #:enforce) symbol-append (#!rest symbol) symbol))
-(symbol->string (#(procedure #:enforce) symbol->string (symbol) string))
-(string->symbol (#(procedure #:enforce) string->symbol (string) symbol))
+(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))
-(number? (#(procedure #:predicate number) number? (*) boolean))
+(number? (#(procedure #:pure #:predicate number) number? (*) boolean))
;;XXX predicate?
-(integer? (procedure integer? (*) boolean)
+(integer? (#(procedure #:pure) integer? (*) boolean)
((fixnum) (let ((#(tmp) #(1))) '#t))
((float) (##core#inline "C_u_i_fpintegerp" #(1))))
-(exact? (#(procedure #:predicate fixnum) exact? (*) boolean))
-(real? (#(procedure #:predicate number) real? (*) boolean))
-(complex? (#(procedure #:predicate number) complex? (*) boolean))
-(inexact? (#(procedure #:predicate float) inexact? (*) boolean))
+(exact? (#(procedure #:pure #:predicate fixnum) exact? (*) boolean))
+(real? (#(procedure #:pure #:predicate number) real? (*) boolean))
+(complex? (#(procedure #:pure #:predicate number) complex? (*) boolean))
+(inexact? (#(procedure #:pure #:predicate float) inexact? (*) boolean))
;;XXX predicate?
-(rational? (procedure rational? (*) boolean)
+(rational? (#(procedure #:pure) rational? (*) boolean)
((fixnum) (let ((#(tmp) #(1))) '#t)))
-(zero? (#(procedure #:enforce) zero? (number) boolean)
+(zero? (#(procedure #:clean #:enforce) zero? (number) boolean)
((fixnum) (eq? #(1) '0))
((number) (##core#inline "C_u_i_zerop" #(1))))
-(odd? (#(procedure #:enforce) odd? (number) boolean) ((fixnum) (fxodd? #(1))))
-(even? (#(procedure #:enforce) even? (number) boolean) ((fixnum) (fxeven? #(1))))
+(odd? (#(procedure #:clean #:enforce) odd? (number) boolean) ((fixnum) (fxodd? #(1))))
+(even? (#(procedure #:clean #:enforce) even? (number) boolean) ((fixnum) (fxeven? #(1))))
-(positive? (#(procedure #:enforce) positive? (number) boolean)
+(positive? (#(procedure #:clean #:enforce) positive? (number) boolean)
((fixnum) (##core#inline "C_fixnum_greaterp" #(1) '0))
((number) (##core#inline "C_u_i_positivep" #(1))))
-(negative? (#(procedure #:enforce) negative? (number) boolean)
+(negative? (#(procedure #:clean #:enforce) negative? (number) boolean)
((fixnum) (##core#inline "C_fixnum_lessp" #(1) '0))
((number) (##core#inline "C_u_i_negativep" #(1))))
-(max (#(procedure #:enforce) max (#!rest number) number)
+(max (#(procedure #:clean #:enforce) max (#!rest number) number)
((fixnum fixnum) (fxmax #(1) #(2)))
((float float) (##core#inline "C_i_flonum_max" #(1) #(2))))
-(min (#(procedure #:enforce) min (#!rest number) number)
+(min (#(procedure #:clean #:enforce) min (#!rest number) number)
((fixnum fixnum) (fxmin #(1) #(2)))
((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
-(+ (#(procedure #:enforce) + (#!rest number) number)
+(+ (#(procedure #:clean #:enforce) + (#!rest number) number)
(() (fixnum) '0)
((fixnum) (fixnum) #(1))
((float) (float) #(1))
@@ -249,7 +252,7 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2))))
-(- (#(procedure #:enforce) - (number #!rest number) number)
+(- (#(procedure #:clean #:enforce) - (number #!rest number) number)
((fixnum) (fixnum)
(##core#inline "C_u_fixnum_negate" #(1)))
((float fixnum) (float)
@@ -267,7 +270,7 @@
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1))))
-(* (#(procedure #:enforce) * (#!rest number) number)
+(* (#(procedure #:clean #:enforce) * (#!rest number) number)
(() (fixnum) '1)
((fixnum) (fixnum) #(1))
((float) (float) #(1))
@@ -285,7 +288,7 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2))))
-(/ (#(procedure #:enforce) / (number #!rest number) number)
+(/ (#(procedure #:clean #:enforce) / (number #!rest number) number)
((float fixnum) (float)
(##core#inline_allocate
("C_a_i_flonum_quotient_checked" 4)
@@ -299,7 +302,7 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_quotient_checked" 4) #(1) #(2))))
-(= (#(procedure #:enforce) = (#!rest number) boolean)
+(= (#(procedure #:clean #:enforce) = (#!rest number) boolean)
((fixnum fixnum) (eq? #(1) #(2)))
((float fixnum) (##core#inline
"C_flonum_equalp"
@@ -311,7 +314,7 @@
#(2)))
((float float) (##core#inline "C_flonum_equalp" #(1) #(2))))
-(> (#(procedure #:enforce) > (#!rest number) boolean)
+(> (#(procedure #:clean #:enforce) > (#!rest number) boolean)
((fixnum fixnum) (fx> #(1) #(2)))
((float fixnum) (##core#inline
"C_flonum_greaterp"
@@ -323,7 +326,7 @@
#(2)))
((float float) (##core#inline "C_flonum_greaterp" #(1) #(2))))
-(< (#(procedure #:enforce) < (#!rest number) boolean)
+(< (#(procedure #:clean #:enforce) < (#!rest number) boolean)
((fixnum fixnum) (fx< #(1) #(2)))
((float fixnum) (##core#inline
"C_flonum_lessp"
@@ -335,7 +338,7 @@
#(2)))
((float float) (##core#inline "C_flonum_lessp" #(1) #(2))))
-(>= (#(procedure #:enforce) >= (#!rest number) boolean)
+(>= (#(procedure #:clean #:enforce) >= (#!rest number) boolean)
((fixnum fixnum) (fx>= #(1) #(2)))
((float fixnum) (##core#inline
"C_flonum_greater_or_equal_p"
@@ -347,7 +350,7 @@
#(2)))
((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2))))
-(<= (#(procedure #:enforce) <= (#!rest number) boolean)
+(<= (#(procedure #:clean #:enforce) <= (#!rest number) boolean)
((fixnum fixnum) (fx<= #(1) #(2)))
((float fixnum) (##core#inline
"C_flonum_less_or_equal_p"
@@ -359,180 +362,181 @@
#(2)))
((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2))))
-(quotient (#(procedure #:enforce) quotient (number number) number)
+(quotient (#(procedure #:clean #:enforce) quotient (number number) number)
;;XXX flonum/mixed case
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_divide" #(1) #(2))))
-(remainder (#(procedure #:enforce) remainder (number number) number)
+(remainder (#(procedure #:clean #:enforce) remainder (number number) number)
;;XXX flonum/mixed case
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_modulo" #(1) #(2))))
-(modulo (#(procedure #:enforce) modulo (number number) number))
+(modulo (#(procedure #:clean #:enforce) modulo (number number) number))
-(gcd (#(procedure #:enforce) gcd (#!rest number) number) ((* *) (##sys#gcd #(1) #(2))))
-(lcm (#(procedure #:enforce) lcm (#!rest number) number) ((* *) (##sys#lcm #(1) #(2))))
+(gcd (#(procedure #:clean #:enforce) gcd (#!rest number) number) ((* *) (##sys#gcd #(1) #(2))))
+(lcm (#(procedure #:clean #:enforce) lcm (#!rest number) number) ((* *) (##sys#lcm #(1) #(2))))
-(abs (#(procedure #:enforce) abs (number) number)
+(abs (#(procedure #:clean #:enforce) 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 #:enforce) floor (number) number)
+(floor (#(procedure #:clean #:enforce) floor (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1))))
-(ceiling (#(procedure #:enforce) ceiling (number) number)
+(ceiling (#(procedure #:clean #:enforce) ceiling (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1))))
-(truncate (#(procedure #:enforce) truncate (number) number)
+(truncate (#(procedure #:clean #:enforce) truncate (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1))))
-(round (#(procedure #:enforce) round (number) number)
+(round (#(procedure #:clean #:enforce) round (number) number)
((fixnum) (fixnum) #(1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_round" 4) #(1))))
-(exact->inexact (#(procedure #:enforce) exact->inexact (number) float)
+(exact->inexact (#(procedure #:clean #:enforce) exact->inexact (number) float)
((float) #(1))
((fixnum) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))))
-(inexact->exact (#(procedure #:enforce) inexact->exact (number) fixnum) ((fixnum) #(1)))
+(inexact->exact (#(procedure #:clean #:enforce) inexact->exact (number) fixnum) ((fixnum) #(1)))
-(exp (#(procedure #:enforce) exp (number) float)
+(exp (#(procedure #:clean #:enforce) exp (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1))))
-(log (#(procedure #:enforce) log (number) float)
+(log (#(procedure #:clean #:enforce) log (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1))))
-(expt (#(procedure #:enforce) expt (number number) number)
+(expt (#(procedure #:clean #:enforce) expt (number number) number)
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_expt" 4) #(1) #(2))))
-(sqrt (#(procedure #:enforce) sqrt (number) float)
+(sqrt (#(procedure #:clean #:enforce) sqrt (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1))))
-(sin (#(procedure #:enforce) sin (number) float)
+(sin (#(procedure #:clean #:enforce) sin (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1))))
-(cos (#(procedure #:enforce) cos (number) float)
+(cos (#(procedure #:clean #:enforce) cos (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1))))
-(tan (#(procedure #:enforce) tan (number) float)
+(tan (#(procedure #:clean #:enforce) tan (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1))))
-(asin (#(procedure #:enforce) asin (number) float)
+(asin (#(procedure #:clean #:enforce) asin (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1))))
-(acos (#(procedure #:enforce) acos (number) float)
+(acos (#(procedure #:clean #:enforce) acos (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1))))
-(atan (#(procedure #:enforce) atan (number #!optional number) float)
+(atan (#(procedure #:clean #:enforce) atan (number #!optional number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1)))
((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1))))
-(number->string (#(procedure #:enforce) number->string (number #!optional number) string)
+(number->string (#(procedure #:clean #:enforce) number->string (number #!optional number) string)
((fixnum) (##sys#fixnum->string #(1))))
-(string->number (#(procedure #:enforce) string->number (string #!optional number)
+(string->number (#(procedure #:clean #:enforce) string->number (string #!optional number)
(or number boolean)))
-(char? (#(procedure #:predicate char) char? (*) boolean))
+(char? (#(procedure #:pure #:predicate char) char? (*) boolean))
;; we could rewrite these, but this is done by the optimizer anyway (safe)
-(char=? (#(procedure #:enforce) char=? (char char) boolean))
-(char>? (#(procedure #:enforce) char>? (char char) boolean))
-(char<? (#(procedure #:enforce) char<? (char char) boolean))
-(char>=? (#(procedure #:enforce) char>=? (char char) boolean))
-(char<=? (#(procedure #:enforce) char<=? (char char) boolean))
-
-(char-ci=? (#(procedure #:enforce) char-ci=? (char char) boolean))
-(char-ci<? (#(procedure #:enforce) char-ci<? (char char) boolean))
-(char-ci>? (#(procedure #:enforce) char-ci>? (char char) boolean))
-(char-ci>=? (#(procedure #:enforce) char-ci>=? (char char) boolean))
-(char-ci<=? (#(procedure #:enforce) char-ci<=? (char char) boolean))
-(char-alphabetic? (#(procedure #:enforce) char-alphabetic? (char) boolean))
-(char-whitespace? (#(procedure #:enforce) char-whitespace? (char) boolean))
-(char-numeric? (#(procedure #:enforce) char-numeric? (char) boolean))
-(char-upper-case? (#(procedure #:enforce) char-upper-case? (char) boolean))
-(char-lower-case? (#(procedure #:enforce) char-lower-case? (char) boolean))
-(char-upcase (#(procedure #:enforce) char-upcase (char) char))
-(char-downcase (#(procedure #:enforce) char-downcase (char) char))
-
-(char->integer (#(procedure #:enforce) char->integer (char) fixnum))
-(integer->char (#(procedure #:enforce) integer->char (fixnum) char))
-
-(string? (#(procedure #:predicate string) string? (*) boolean))
-
-(string=? (#(procedure #:enforce) string=? (string string) 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<=? (#(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))
+
+(string? (#(procedure #:pure #:predicate string) string? (*) boolean))
+
+(string=? (#(procedure #:clean #:enforce) string=? (string string) boolean)
((string string) (##core#inline "C_u_i_string_equal_p" #(1) #(2))))
-(string>? (#(procedure #:enforce) string>? (string string) boolean))
-(string<? (#(procedure #:enforce) string<? (string string) boolean))
-(string>=? (#(procedure #:enforce) string>=? (string string) boolean))
-(string<=? (#(procedure #:enforce) string<=? (string string) boolean))
-(string-ci=? (#(procedure #:enforce) string-ci=? (string string) boolean))
-(string-ci<? (#(procedure #:enforce) string-ci<? (string string) boolean))
-(string-ci>? (#(procedure #:enforce) string-ci>? (string string) boolean))
-(string-ci>=? (#(procedure #:enforce) string-ci>=? (string string) boolean))
-(string-ci<=? (#(procedure #:enforce) string-ci<=? (string string) boolean))
-
-(make-string (#(procedure #:enforce) make-string (fixnum #!optional char) string)
+(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))
+
+(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 #:enforce) string-length (string) fixnum)
+(string-length (#(procedure #:clean #:enforce) string-length (string) fixnum)
((string) (##sys#size #(1))))
-(string-ref (#(procedure #:enforce) string-ref (string fixnum) char)
+(string-ref (#(procedure #:clean #:enforce) string-ref (string fixnum) char)
((string fixnum) (##core#inline "C_subchar" #(1) #(2))))
(string-set! (#(procedure #:enforce) string-set! (string fixnum char) undefined)
((string fixnum char) (##core#inline "C_setsubchar" #(1) #(2) #(3))))
-(string-append (#(procedure #:enforce) string-append (#!rest string) string)
+(string-append (#(procedure #:clean #:enforce) string-append (#!rest string) string)
((string string) (##sys#string-append #(1) #(2))))
-;(string-copy (#(procedure #:enforce) string-copy (string) string)) - we use the more general version from srfi-13
+;(string-copy (#(procedure #:clean #:enforce) string-copy (string) string)) - we use the more general version from srfi-13
-(string->list (#(procedure #:enforce) string->list (string) (list char)))
-(list->string (#(procedure #:enforce) list->string ((list char)) string))
-(substring (#(procedure #:enforce) substring (string fixnum #!optional fixnum) string))
-;(string-fill! (#(procedure #:enforce) string-fill! (string char) string)) - s.a.
-(string (#(procedure #:enforce) string (#!rest char) string))
+(string->list (#(procedure #:clean #:enforce) string->list (string) (list char)))
+(list->string (#(procedure #:clean #:enforce) list->string ((list char)) string))
+(substring (#(procedure #:clean #:enforce) substring (string fixnum #!optional fixnum) string))
+;(string-fill! (#(procedure #:clean #:enforce) string-fill! (string char) string)) - s.a.
+(string (#(procedure #:clean #:enforce) string (#!rest char) string))
-(vector? (#(procedure #:predicate vector) vector? (*) boolean))
+(vector? (#(procedure #:pure #:predicate vector) vector? (*) boolean))
;; not result type "(vector a)", since it may be mutated!
-(make-vector (forall (a) (#(procedure #:enforce) make-vector (fixnum #!optional a) vector)))
+(make-vector (forall (a) (#(procedure #:clean #:enforce) make-vector (fixnum #!optional a) vector)))
-(vector-ref (forall (a) (#(procedure #:enforce) vector-ref ((vector a) fixnum) a)))
-(##sys#vector-ref (forall (a) (#(procedure #:enforce) ##sys#vector-ref ((vector a) fixnum) a)))
+(vector-ref (forall (a) (#(procedure #:clean #:enforce) vector-ref ((vector a) fixnum) a)))
+(##sys#vector-ref (forall (a) (#(procedure #:clean #:enforce) ##sys#vector-ref ((vector a) fixnum) a)))
(vector-set! (#(procedure #:enforce) vector-set! (vector fixnum *) undefined))
-(vector (procedure vector (#!rest) vector))
-(##sys#vector (procedure ##sys#vector (#!rest) vector))
+(vector (#(procedure #:clean #:clean) vector (#!rest) vector))
+(##sys#vector (#(procedure #:clean #:clean) ##sys#vector (#!rest) vector))
-(vector-length (#(procedure #:enforce) vector-length (vector) fixnum)
+(vector-length (#(procedure #:clean #:enforce) vector-length (vector) fixnum)
((vector) (##sys#size #(1))))
-(##sys#vector-length (#(procedure #:enforce) ##sys#vector-length (vector) fixnum)
+(##sys#vector-length (#(procedure #:clean #:enforce) ##sys#vector-length (vector) fixnum)
((vector) (##sys#size #(1))))
-(vector->list (forall (a) (#(procedure #:enforce) vector->list ((vector a)) (list a))))
-(##sys#vector->list (forall (a) (#(procedure #:enforce) ##sys#vector->list ((vector a)) (list a))))
-(list->vector (forall (a) (#(procedure #:enforce) list->vector ((list a)) (vector a))))
-(##sys#list->vector (forall (a) (#(procedure #:enforce) ##sys#list->vector ((list a)) (vector a))))
+(vector->list (forall (a) (#(procedure #:clean #:enforce) vector->list ((vector a)) (list a))))
+(##sys#vector->list (forall (a) (#(procedure #:clean #:enforce) ##sys#vector->list ((vector a)) (list a))))
+(list->vector (forall (a) (#(procedure #:clean #:enforce) list->vector ((list a)) (vector a))))
+(##sys#list->vector (forall (a) (#(procedure #:clean #:enforce) ##sys#list->vector ((list a)) (vector a))))
(vector-fill! (#(procedure #:enforce) vector-fill! (vector *) undefined))
-(procedure? (#(procedure #:predicate procedure) procedure? (*) boolean))
+(procedure? (#(procedure #:pure #:predicate procedure) procedure? (*) boolean))
(vector-copy! (#(procedure #:enforce) vector-copy! (vector vector #!optional fixnum) undefined))
+
(map (forall (a b) (#(procedure #:enforce) map ((procedure (a #!rest) b) (list a) #!rest list) (list b))))
(for-each
@@ -547,18 +551,18 @@
(call-with-current-continuation
(#(procedure #:enforce) call-with-current-continuation ((procedure (procedure) . *)) . *))
-(input-port? (procedure input-port? (*) boolean))
-(output-port? (procedure output-port? (*) boolean))
+(input-port? (#(procedure #:pure) input-port? (*) boolean))
+(output-port? (#(procedure #:pure) output-port? (*) boolean))
(current-input-port
- (#(procedure #:enforce) current-input-port (#!optional port) port)
+ (#(procedure #:clean #:enforce) current-input-port (#!optional port) port)
((port) (let ((#(tmp1) #(1)))
(let ((#(tmp2) (set! ##sys#standard-input #(tmp1))))
#(tmp1))))
(() ##sys#standard-input))
(current-output-port
- (#(procedure #:enforce) current-output-port (#!optional port) port)
+ (#(procedure #:clean #:enforce) current-output-port (#!optional port) port)
((port) (let ((#(tmp1) #(1)))
(let ((#(tmp2) (set! ##sys#standard-output #(tmp1))))
#(tmp1))))
@@ -570,14 +574,14 @@
(call-with-output-file
(procedure call-with-output-file (string (procedure (port) . *) #!rest) . *))
-(open-input-file (#(procedure #:enforce) open-input-file (string #!rest symbol) port))
-(open-output-file (#(procedure #:enforce) open-output-file (string #!rest symbol) port))
+(open-input-file (#(procedure #:clean #:enforce) open-input-file (string #!rest symbol) port))
+(open-output-file (#(procedure #:clean #:enforce) open-output-file (string #!rest symbol) port))
(close-input-port (#(procedure #:enforce) close-input-port (port) undefined))
(close-output-port (#(procedure #:enforce) close-output-port (port) undefined))
(load (procedure load (string #!optional (procedure (*) . *)) undefined))
(read (#(procedure #:enforce) read (#!optional port) *))
-(eof-object? (#(procedure #:predicate eof) eof-object? (*) boolean))
+(eof-object? (#(procedure #:pure #:predicate eof) eof-object? (*) boolean))
;;XXX if we had input/output port distinction, we could specialize these:
(read-char (#(procedure #:enforce) read-char (#!optional port) *)) ;XXX result (or eof char) ?
@@ -597,8 +601,8 @@
(dynamic-wind
(#(procedure #:enforce) dynamic-wind ((procedure () . *) (procedure () . *) (procedure () . *)) . *))
-(values (procedure values (#!rest values) . *))
-(##sys#values (procedure ##sys#values (#!rest values) . *))
+(values (#(procedure #:clean) values (#!rest values) . *))
+(##sys#values (#(procedure #:clean) ##sys#values (#!rest values) . *))
(call-with-values (#(procedure #:enforce) call-with-values ((procedure () . *) procedure) . *)
(((procedure () *) *) (let ((#(tmp1) #(1)))
@@ -614,147 +618,148 @@
(eval (procedure eval (* #!optional (struct environment)) *))
(char-ready? (#(procedure #:enforce) char-ready? (#!optional port) boolean))
-(imag-part (#(procedure #:enforce) imag-part (number) number)
+(imag-part (#(procedure #:clean #:enforce) imag-part (number) number)
(((or fixnum float number)) (let ((#(tmp) #(1))) '0)))
-(real-part (#(procedure #:enforce) real-part (number) number)
+(real-part (#(procedure #:clean #:enforce) real-part (number) number)
(((or fixnum float number)) #(1)))
-(magnitude (#(procedure #:enforce) magnitude (number) number)
+(magnitude (#(procedure #:clean #:enforce) magnitude (number) number)
((fixnum) (fixnum)
(##core#inline "C_fixnum_abs" #(1)))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1))))
-(numerator (#(procedure #:enforce) numerator (number) number)
+(numerator (#(procedure #:clean #:enforce) numerator (number) number)
((fixnum) (fixnum) #(1)))
-(denominator (#(procedure #:enforce) denominator (number) number)
+(denominator (#(procedure #:clean #:enforce) denominator (number) number)
((fixnum) (fixnum) (let ((#(tmp) #(1))) '1)))
(scheme-report-environment
- (#(procedure #:enforce) scheme-report-environment (#!optional fixnum) (struct environment)))
+ (#(procedure #:clean #:enforce) scheme-report-environment (#!optional fixnum) (struct environment)))
(null-environment
- (#(procedure #:enforce) null-environment (#!optional fixnum) (struct environment)))
+ (#(procedure #:clean #:enforce) null-environment (#!optional fixnum) (struct environment)))
(interaction-environment
- (procedure interaction-environment () (struct environment)))
+ (#(procedure #:clean) interaction-environment () (struct environment)))
-(port-closed? (#(procedure #:enforce) port-closed? (port) boolean)
+(port-closed? (#(procedure #:clean #:enforce) port-closed? (port) boolean)
((port) (##sys#slot #(1) '8)))
+
;; chicken
(abort (procedure abort (*) noreturn))
-(add1 (#(procedure #:enforce) add1 (number) number)
+(add1 (#(procedure #:clean #:enforce) add1 (number) number)
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0)))
-(argc+argv (procedure argc+argv () fixnum (list string) fixnum))
-(argv (procedure argv () (list string)))
-(arithmetic-shift (#(procedure #:enforce) arithmetic-shift (number number) number))
+(argc+argv (#(procedure #:clean) argc+argv () fixnum (list string) fixnum))
+(argv (#(procedure #:clean) argv () (list string)))
+(arithmetic-shift (#(procedure #:clean #:enforce) arithmetic-shift (number number) number))
-(bit-set? (#(procedure #:enforce) bit-set? (number fixnum) boolean)
+(bit-set? (#(procedure #:clean #:enforce) bit-set? (number fixnum) boolean)
((fixnum fixnum) (##core#inline "C_u_i_bit_setp" #(1) #(2))))
-(bitwise-and (#(procedure #:enforce) bitwise-and (#!rest number) number)
+(bitwise-and (#(procedure #:clean #:enforce) bitwise-and (#!rest number) number)
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_and" #(1) #(2))))
-(bitwise-ior (#(procedure #:enforce) bitwise-ior (#!rest number) number)
+(bitwise-ior (#(procedure #:clean #:enforce) bitwise-ior (#!rest number) number)
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_or" #(1) #(2))))
-(bitwise-not (#(procedure #:enforce) bitwise-not (number) number))
+(bitwise-not (#(procedure #:clean #:enforce) bitwise-not (number) number))
-(bitwise-xor (#(procedure #:enforce) bitwise-xor (#!rest number) number)
+(bitwise-xor (#(procedure #:clean #:enforce) bitwise-xor (#!rest number) number)
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_xor" #(1) #(2))))
-(blob->string (#(procedure #:enforce) blob->string (blob) string))
+(blob->string (#(procedure #:clean #:enforce) blob->string (blob) string))
-(blob-size (#(procedure #:enforce) blob-size (blob) fixnum)
+(blob-size (#(procedure #:clean #:enforce) blob-size (blob) fixnum)
((blob) (##sys#size #(1))))
-(blob? (#(procedure #:predicate blob) blob? (*) boolean))
+(blob? (#(procedure #:pure #:predicate blob) blob? (*) boolean))
-(blob=? (#(procedure #:enforce) blob=? (blob blob) boolean))
-(build-platform (procedure build-platform () symbol))
+(blob=? (#(procedure #:clean #:enforce) blob=? (blob blob) boolean))
+(build-platform (#(procedure #:pure) build-platform () symbol))
(call/cc (#(procedure #:enforce) call/cc ((procedure (*) . *)) . *))
-(case-sensitive (procedure case-sensitive (#!optional *) *))
-(char-name (#(procedure #:enforce) char-name ((or char symbol) #!optional char) *)) ;XXX -> (or char symbol) ?
-(chicken-home (procedure chicken-home () string))
-(chicken-version (procedure chicken-version (#!optional *) string))
-(command-line-arguments (procedure command-line-arguments (#!optional (list string)) (list string)))
-(condition-predicate (#(procedure #:enforce) condition-predicate (symbol) (procedure ((struct condition)) boolean)))
-(condition-property-accessor (#(procedure #:enforce) condition-property-accessor (symbol symbol #!optional *) (procedure ((struct condition)) *)))
+(case-sensitive (#(procedure #:clean) case-sensitive (#!optional *) *))
+(char-name (#(procedure #:clean #:enforce) char-name ((or char symbol) #!optional char) *)) ;XXX -> (or char symbol) ?
+(chicken-home (#(procedure #:clean) chicken-home () string))
+(chicken-version (#(procedure #:pure) chicken-version (#!optional *) string))
+(command-line-arguments (#(procedure #:clean) command-line-arguments (#!optional (list string)) (list string)))
+(condition-predicate (#(procedure #:clean #:enforce) condition-predicate (symbol) (procedure ((struct condition)) boolean)))
+(condition-property-accessor (#(procedure #:clean #:enforce) condition-property-accessor (symbol symbol #!optional *) (procedure ((struct condition)) *)))
-(condition? (#(procedure #:predicate (struct condition)) condition? (*) boolean))
+(condition? (#(procedure #:pure #:predicate (struct condition)) condition? (*) boolean))
-(condition->list (#(procedure #:enforce) condition->list ((struct condition)) (list (pair symbol *))))
+(condition->list (#(procedure #:clean #:enforce) condition->list ((struct condition)) (list (pair symbol *))))
(continuation-capture (#(procedure #:enforce) continuation-capture ((procedure ((struct continuation)) . *)) *))
-(continuation-graft (#(procedure #:enforce) continuation-graft ((struct continuation) (procedure () . *)) *))
+(continuation-graft (#(procedure #:clean #:enforce) continuation-graft ((struct continuation) (procedure () . *)) *))
(continuation-return (#(procedure #:enforce) continuation-return (procedure #!rest) . *)) ;XXX make return type more specific?
-(continuation? (#(procedure #:predicate (struct continuation)) continuation? (*) boolean))
+(continuation? (#(procedure #:pure #:predicate (struct continuation)) continuation? (*) boolean))
-(copy-read-table (#(procedure #:enforce) copy-read-table ((struct read-table)) (struct read-table)))
-(cpu-time (procedure cpu-time () fixnum fixnum))
+(copy-read-table (#(procedure #:clean #:enforce) copy-read-table ((struct read-table)) (struct read-table)))
+(cpu-time (#(procedure #:clean) cpu-time () fixnum fixnum))
(current-error-port
- (#(procedure #:enforce) current-error-port (#!optional port) port)
+ (#(procedure #:clean #:enforce) current-error-port (#!optional port) port)
((port) (let ((#(tmp1) #(1)))
(let ((#(tmp2) (set! ##sys#standard-error #(tmp1))))
#(tmp1))))
(() ##sys#standard-error))
(current-exception-handler
- (#(procedure #:enforce) current-exception-handler (#!optional (procedure (*) noreturn)) procedure)
+ (#(procedure #:clean #:enforce) current-exception-handler (#!optional (procedure (*) noreturn)) procedure)
((procedure) (let ((#(tmp1) #(1)))
(let ((#(tmp2) (set! ##sys#current-exception-handler #(tmp1))))
#(tmp1))))
(() ##sys#current-exception-handler))
-(current-gc-milliseconds (procedure current-gc-milliseconds () fixnum))
-(current-milliseconds (procedure current-milliseconds () float))
+(current-gc-milliseconds (#(procedure #:clean) current-gc-milliseconds () fixnum))
+(current-milliseconds (#(procedure #:clean) current-milliseconds () float))
(current-read-table
- (procedure current-read-table (#!optional (struct read-table)) (struct read-table)))
+ (#(procedure #:clean) current-read-table (#!optional (struct read-table)) (struct read-table)))
-(current-seconds (procedure current-seconds () float))
-(define-reader-ctor (#(procedure #:enforce) define-reader-ctor (symbol procedure) undefined))
-(delete-file (#(procedure #:enforce) delete-file (string) string))
-(enable-warnings (procedure enable-warnings (#!optional *) *))
+(current-seconds (#(procedure #:clean) current-seconds () float))
+(define-reader-ctor (#(procedure #:clean #:enforce) define-reader-ctor (symbol procedure) undefined))
+(delete-file (#(procedure #:clean #:enforce) delete-file (string) string))
+(enable-warnings (#(procedure #:clean) enable-warnings (#!optional *) *))
-(equal=? (procedure equal=? (* *) boolean)
+(equal=? (#(procedure #:clean) equal=? (* *) boolean)
(((or fixnum symbol char eof null undefined) *) (eq? #(1) #(2)))
((* (or fixnum symbol char eof null undefined)) (eq? #(1) #(2)))
(((or float number) (or float number)) (= #(1) #(2))))
(er-macro-transformer
- (#(procedure #:enforce)
+ (#(procedure #:clean #:enforce)
er-macro-transformer
((procedure (* (procedure (*) *) (procedure (* *) *)) *))
(struct transformer)))
-(errno (procedure errno () fixnum))
+(errno (#(procedure #:clean) errno () fixnum))
(error (procedure error (* #!rest) noreturn))
(##sys#error (procedure ##sys#error (* #!rest) noreturn))
(##sys#signal-hook (procedure ##sys#signal-hook (* #!rest) noreturn))
(exit (procedure exit (#!optional fixnum) noreturn))
-(exit-handler (#(procedure #:enforce) exit-handler (#!optional (procedure (fixnum) . *)) procedure))
+(exit-handler (#(procedure #:clean #:enforce) exit-handler (#!optional (procedure (fixnum) . *)) procedure))
(expand (procedure expand (* #!optional list) *))
-(extension-information (procedure extension-information (symbol) *))
-(feature? (procedure feature? (symbol) boolean))
-(features (procedure features () (list symbol)))
-(file-exists? (#(procedure #:enforce) file-exists? (string) *))
-(directory-exists? (#(procedure #:enforce) directory-exists? (string) *))
+(extension-information (#(procedure #:clean) extension-information (symbol) *))
+(feature? (#(procedure #:clean) feature? (symbol) boolean))
+(features (#(procedure #:clean) features () (list symbol)))
+(file-exists? (#(procedure #:clean #:enforce) file-exists? (string) *))
+(directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string) *))
(fixnum-bits fixnum)
(fixnum-precision fixnum)
-(fixnum? (#(procedure #:predicate fixnum) fixnum? (*) boolean))
+(fixnum? (#(procedure #:pure #:predicate fixnum) fixnum? (*) boolean))
(flonum-decimal-precision fixnum)
(flonum-epsilon float)
@@ -763,10 +768,10 @@
(flonum-minimum-decimal-exponent fixnum)
(flonum-minimum-exponent fixnum)
(flonum-precision fixnum)
-(flonum-print-precision (#(procedure #:enforce) (#!optional fixnum) fixnum))
+(flonum-print-precision (#(procedure #:clean #:enforce) (#!optional fixnum) fixnum))
(flonum-radix fixnum)
-(flonum? (#(procedure #:predicate float) flonum? (*) boolean))
+(flonum? (#(procedure #:pure #:predicate float) flonum? (*) boolean))
(flush-output (#(procedure #:enforce) flush-output (#!optional port) undefined))
@@ -775,235 +780,237 @@
(force-finalizers (procedure force-finalizers () undefined))
-(fp- (#(procedure #:enforce) fp- (float float) float)
+(fp- (#(procedure #:clean #:enforce) fp- (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) #(2)) ))
-(fp* (#(procedure #:enforce) fp* (float float) float)
+(fp* (#(procedure #:clean #:enforce) fp* (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2)) ))
-(fp/ (#(procedure #:enforce) fp/ (float float) float)
+(fp/ (#(procedure #:clean #:enforce) fp/ (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1) #(2)) ))
-(fp+ (#(procedure #:enforce) fp+ (float float) float)
+(fp+ (#(procedure #:clean #:enforce) fp+ (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2)) ))
-(fp< (#(procedure #:enforce) fp< (float float) boolean)
+(fp< (#(procedure #:clean #:enforce) fp< (float float) boolean)
((float float) (##core#inline "C_flonum_lessp" #(1) #(2)) ))
-(fp<= (#(procedure #:enforce) fp<= (float float) boolean)
+(fp<= (#(procedure #:clean #:enforce) fp<= (float float) boolean)
((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2)) ))
-(fp= (#(procedure #:enforce) fp= (float float) boolean)
+(fp= (#(procedure #:clean #:enforce) fp= (float float) boolean)
((float float) (##core#inline "C_flonum_equalp" #(1) #(2)) ))
-(fp> (#(procedure #:enforce) fp> (float float) boolean)
+(fp> (#(procedure #:clean #:enforce) fp> (float float) boolean)
((float float) (##core#inline "C_flonum_greaterp" #(1) #(2)) ))
-(fp>= (#(procedure #:enforce) fp>= (float float) boolean)
+(fp>= (#(procedure #:clean #:enforce) fp>= (float float) boolean)
((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2)) ))
-(fpabs (#(procedure #:enforce) fpabs (float) float)
+(fpabs (#(procedure #:clean #:enforce) fpabs (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1) )))
-(fpacos (#(procedure #:enforce) fpacos (float) float)
+(fpacos (#(procedure #:clean #:enforce) fpacos (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1) )))
-(fpasin (#(procedure #:enforce) fpasin (float) float)
+(fpasin (#(procedure #:clean #:enforce) fpasin (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1) )))
-(fpatan (#(procedure #:enforce) fpatan (float) float)
+(fpatan (#(procedure #:clean #:enforce) fpatan (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1) )))
-(fpatan2 (#(procedure #:enforce) fpatan2 (float float) float)
+(fpatan2 (#(procedure #:clean #:enforce) fpatan2 (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4)
#(1) #(2))))
-(fpceiling (#(procedure #:enforce) fpceiling (float) float)
+(fpceiling (#(procedure #:clean #:enforce) fpceiling (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1) )))
-(fpcos (#(procedure #:enforce) fpcos (float) float)
+(fpcos (#(procedure #:clean #:enforce) fpcos (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1) )))
-(fpexp (#(procedure #:enforce) fpexp (float) float)
+(fpexp (#(procedure #:clean #:enforce) fpexp (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1) )))
-(fpexpt (#(procedure #:enforce) fpexpt (float float) float)
+(fpexpt (#(procedure #:clean #:enforce) fpexpt (float float) float)
((float float) (##core#inline_allocate ("C_a_i_flonum_expt" 4)
#(1) #(2))))
-(fpfloor (#(procedure #:enforce) fpfloor (float) float)
+(fpfloor (#(procedure #:clean #:enforce) fpfloor (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1) )))
-(fpinteger? (#(procedure #:enforce) fpinteger? (float) boolean)
+(fpinteger? (#(procedure #:clean #:enforce) fpinteger? (float) boolean)
((float) (##core#inline "C_u_i_flonum_intergerp" #(1) )))
-(fplog (#(procedure #:enforce) fplog (float) float)
+(fplog (#(procedure #:clean #:enforce) fplog (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1) )))
-(fpmax (#(procedure #:enforce) fpmax (float float) float)
+(fpmax (#(procedure #:clean #:enforce) fpmax (float float) float)
((float float) (##core#inline "C_i_flonum_max" #(1) #(2))))
-(fpmin (#(procedure #:enforce) fpmin (float float) float)
+(fpmin (#(procedure #:clean #:enforce) fpmin (float float) float)
((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
-(fpneg (#(procedure #:enforce) fpneg (float) float)
+(fpneg (#(procedure #:clean #:enforce) fpneg (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1) )))
-(fpround (#(procedure #:enforce) fpround (float) float)
+(fpround (#(procedure #:clean #:enforce) fpround (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1) )))
-(fpsin (#(procedure #:enforce) fpsin (float) float)
+(fpsin (#(procedure #:clean #:enforce) fpsin (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1) )))
-(fpsqrt (#(procedure #:enforce) fpsqrt (float) float)
+(fpsqrt (#(procedure #:clean #:enforce) fpsqrt (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1) )))
-(fptan (#(procedure #:enforce) fptan (float) float)
+(fptan (#(procedure #:clean #:enforce) fptan (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1) )))
-(fptruncate (#(procedure #:enforce) fptruncate (float) float)
+(fptruncate (#(procedure #:clean #:enforce) fptruncate (float) float)
((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1) )))
-(fx- (procedure fx- (fixnum fixnum) fixnum))
-(fx* (procedure fx* (fixnum fixnum) fixnum))
-(fx/ (procedure fx/ (fixnum fixnum) fixnum))
-(fx+ (procedure fx+ (fixnum fixnum) fixnum))
-(fx< (procedure fx< (fixnum fixnum) boolean))
-(fx<= (procedure fx<= (fixnum fixnum) boolean))
-(fx= (procedure fx= (fixnum fixnum) boolean))
-(fx> (procedure fx> (fixnum fixnum) boolean))
-(fx>= (procedure fx>= (fixnum fixnum) boolean))
-(fxand (procedure fxand (fixnum fixnum) fixnum))
-(fxeven? (procedure fxeven? (fixnum) boolean))
-(fxior (procedure fxior (fixnum fixnum) fixnum))
-(fxmax (procedure fxmax (fixnum fixnum) fixnum))
-(fxmin (procedure fxmin (fixnum fixnum) fixnum))
-(fxmod (procedure fxmod (fixnum fixnum) fixnum))
-(fxneg (procedure fxneg (fixnum) fixnum))
-(fxnot (procedure fxnot (fixnum) fixnum))
-(fxodd? (procedure fxodd? (fixnum) boolean))
-(fxshl (procedure fxshl (fixnum fixnum) fixnum))
-(fxshr (procedure fxshr (fixnum fixnum) fixnum))
-(fxxor (procedure fxxor (fixnum fixnum) fixnum))
-(gc (procedure gc (#!optional *) fixnum))
-(gensym (procedure gensym (#!optional (or string symbol)) symbol))
-
-(get (#(procedure #:enforce) get (symbol symbol #!optional *) *)
+;;XXX should these be enforcing?
+(fx- (#(procedure #:clean) fx- (fixnum fixnum) fixnum))
+(fx* (#(procedure #:clean) fx* (fixnum fixnum) fixnum))
+(fx/ (#(procedure #:clean) fx/ (fixnum fixnum) fixnum))
+(fx+ (#(procedure #:clean) fx+ (fixnum fixnum) fixnum))
+(fx< (#(procedure #:clean) fx< (fixnum fixnum) boolean))
+(fx<= (#(procedure #:clean) fx<= (fixnum fixnum) boolean))
+(fx= (#(procedure #:clean) fx= (fixnum fixnum) boolean))
+(fx> (#(procedure #:clean) fx> (fixnum fixnum) boolean))
+(fx>= (#(procedure #:clean) fx>= (fixnum fixnum) boolean))
+(fxand (#(procedure #:clean) fxand (fixnum fixnum) fixnum))
+(fxeven? (#(procedure #:clean) fxeven? (fixnum) boolean))
+(fxior (#(procedure #:clean) fxior (fixnum fixnum) fixnum))
+(fxmax (#(procedure #:clean) fxmax (fixnum fixnum) fixnum))
+(fxmin (#(procedure #:clean) fxmin (fixnum fixnum) fixnum))
+(fxmod (#(procedure #:clean) fxmod (fixnum fixnum) fixnum))
+(fxneg (#(procedure #:clean) fxneg (fixnum) fixnum))
+(fxnot (#(procedure #:clean) fxnot (fixnum) fixnum))
+(fxodd? (#(procedure #:clean) fxodd? (fixnum) boolean))
+(fxshl (#(procedure #:clean) fxshl (fixnum fixnum) fixnum))
+(fxshr (#(procedure #:clean) fxshr (fixnum fixnum) fixnum))
+(fxxor (#(procedure #:clean) fxxor (fixnum fixnum) fixnum))
+(gc (#(procedure #:clean) gc (#!optional *) fixnum))
+(gensym (#(procedure #:clean) gensym (#!optional (or string symbol)) symbol))
+
+(get (#(procedure #:clean #:enforce) get (symbol symbol #!optional *) *)
((symbol symbol *) (##core#inline "C_i_getprop" #(1) #(2) #(3))))
-(get-call-chain (#(procedure #:enforce) get-call-chain (#!optional fixnum (struct thread)) (list vector)))
-(get-condition-property (#(procedure #:enforce) get-condition-property ((struct condition) symbol symbol #!optional *) *))
-(get-environment-variable (#(procedure #:enforce) get-environment-variable (string) *))
-(get-keyword (#(procedure #:enforce) get-keyword (symbol list #!optional *) *))
-(get-output-string (#(procedure #:enforce) get-output-string (port) string))
-(get-properties (#(procedure #:enforce) get-properties (symbol list) symbol * list))
+(get-call-chain (#(procedure #:clean #:enforce) get-call-chain (#!optional fixnum (struct thread)) (list vector)))
+(get-condition-property (#(procedure #:clean #:enforce) get-condition-property ((struct condition) symbol symbol #!optional *) *))
+(get-environment-variable (#(procedure #:clean #:enforce) get-environment-variable (string) *))
+(get-keyword (#(procedure #:clean #:enforce) get-keyword (symbol list #!optional *) *))
+(get-output-string (#(procedure #:clean #:enforce) get-output-string (port) string))
+(get-properties (#(procedure #:clean #:enforce) get-properties (symbol list) symbol * list))
(getter-with-setter
- (#(procedure #:enforce)
+ (#(procedure #:clean #:enforce)
getter-with-setter
((procedure (#!rest) *) (procedure (* #!rest) . *) #!optional string)
procedure))
(implicit-exit-handler
- (#(procedure #:enforce) implicit-exit-handler (#!optional (procedure () . *)) procedure))
+ (#(procedure #:clean #:enforce) implicit-exit-handler (#!optional (procedure () . *)) procedure))
(ir-macro-transformer
- (procedure
+ (#(procedure #:clean #:enforce)
ir-macro-transformer
((procedure (* (procedure (*) *) (procedure (* *) *)) *))
(struct transformer)))
-(keyword->string (#(procedure #:enforce) keyword->string (symbol) string))
-(keyword-style (procedure keyword-style (#!optional symbol) symbol))
-(keyword? (procedure keyword? (*) boolean))
+(keyword->string (#(procedure #:clean #:enforce) keyword->string (symbol) string))
+(keyword-style (#(procedure #:clean) keyword-style (#!optional symbol) symbol))
+(keyword? (#(procedure #:pure) keyword? (*) boolean))
(load-library (#(procedure #:enforce) load-library (symbol #!optional string) undefined))
(load-relative (#(procedure #:enforce) load-relative (string #!optional (procedure (*) . *)) undefined))
-(load-verbose (procedure load-verbose (#!optional *) *))
-(machine-byte-order (procedure machine-byte-order () symbol))
-(machine-type (procedure machine-type () symbol))
+(load-verbose (#(procedure #:clean) load-verbose (#!optional *) *))
+(machine-byte-order (#(procedure #:pure) machine-byte-order () symbol))
+(machine-type (#(procedure #:pure) machine-type () symbol))
-(make-blob (#(procedure #:enforce) make-blob (fixnum) blob)
+(make-blob (#(procedure #:clean #:enforce) make-blob (fixnum) blob)
((fixnum) (##sys#make-blob #(1))))
-(make-composite-condition (#(procedure #:enforce) make-composite-condition (#!rest (struct condition)) (struct condition)))
-(make-parameter (#(procedure #:enforce) make-parameter (* #!optional procedure) procedure))
-(make-property-condition (#(procedure #:enforce) make-property-condition (symbol #!rest *) (struct condition)))
+(make-composite-condition (#(procedure #:clean #:enforce) make-composite-condition (#!rest (struct condition)) (struct condition)))
+(make-parameter (#(procedure #:clean #:enforce) make-parameter (* #!optional procedure) procedure))
+(make-property-condition (#(procedure #:clean #:enforce) make-property-condition (symbol #!rest *) (struct condition)))
(maximum-flonum float)
-(memory-statistics (procedure memory-statistics () (vector fixnum)))
+(memory-statistics (#(procedure #:clean) memory-statistics () (vector fixnum)))
(minimum-flonum float)
(most-negative-fixnum fixnum)
(most-positive-fixnum fixnum)
-(on-exit (#(procedure #:enforce) on-exit ((procedure () . *)) undefined))
-(open-input-string (#(procedure #:enforce) open-input-string (string #!rest) port))
-(open-output-string (procedure open-output-string (#!rest) port))
-(parentheses-synonyms (procedure parentheses-synonyms (#!optional *) *))
+(on-exit (#(procedure #:clean #:enforce) on-exit ((procedure () . *)) undefined))
+(open-input-string (#(procedure #:clean #:enforce) open-input-string (string #!rest) port))
+(open-output-string (#(procedure #:clean) open-output-string (#!rest) port))
+(parentheses-synonyms (#(procedure #:clean) parentheses-synonyms (#!optional *) *))
-(port-name (#(procedure #:enforce) port-name (#!optional port) *)
+(port-name (#(procedure #:clean #:enforce) port-name (#!optional port) *)
((port) (##sys#slot #(1) '3)))
-(port-position (#(procedure #:enforce) port-position (#!optional port) fixnum))
+(port-position (#(procedure #:clean #:enforce) port-position (#!optional port) fixnum))
-(port? (#(procedure #:predicate port) port? (*) boolean))
+(port? (#(procedure #:pure #:predicate port) port? (*) boolean))
(print (procedure print (#!rest *) undefined))
-(print-call-chain (#(procedure #:enforce) print-call-chain (#!optional port fixnum * string) undefined))
-(print-error-message (#(procedure #:enforce) print-error-message (* #!optional port string) undefined))
+(print-call-chain (#(procedure #:clean #:enforce) print-call-chain (#!optional port fixnum * string) undefined))
+(print-error-message (#(procedure #:clean #:enforce) print-error-message (* #!optional port string) undefined))
(print* (procedure print* (#!rest) undefined))
-(procedure-information (#(procedure #:enforce) procedure-information (procedure) *))
-(program-name (#(procedure #:enforce) program-name (#!optional string) string))
-(promise? (#(procedure #:predicate (struct promise)) promise? (*) boolean))
+(procedure-information (#(procedure #:clean #:enforce) procedure-information (procedure) *))
+(program-name (#(procedure #:clean #:enforce) program-name (#!optional string) string))
+(promise? (#(procedure #:pure #:predicate (struct promise)) promise? (*) boolean))
-(put! (#(procedure #:enforce) put! (symbol symbol *) undefined)
+(put! (#(procedure #:clean #:enforce) put! (symbol symbol *) undefined)
((symbol symbol *)
(##core#inline_allocate ("C_a_i_putprop" 8) #(1) #(2) #(3))))
(quit (procedure quit (#!optional *) noreturn))
-(register-feature! (#(procedure #:enforce) register-feature! (#!rest symbol) undefined))
-(remprop! (#(procedure #:enforce) remprop! (symbol symbol) undefined))
-(rename-file (#(procedure #:enforce) rename-file (string string) string))
+(register-feature! (#(procedure #:clean #:enforce) register-feature! (#!rest symbol) undefined))
+(remprop! (#(procedure #:clean #:enforce) remprop! (symbol symbol) undefined))
+(rename-file (#(procedure #:clean #:enforce) rename-file (string string) string))
(repl (#(procedure #:enforce) repl (#!optional (procedure (*) . *)) undefined))
-(repl-prompt (#(procedure #:enforce) repl-prompt (#!optional (procedure () string)) procedure))
-(repository-path (procedure repository-path (#!optional *) *))
-(require (procedure require (#!rest (or string symbol)) undefined))
+(repl-prompt (#(procedure #:clean #:enforce) repl-prompt (#!optional (procedure () string)) procedure))
+(repository-path (#(procedure #:clean) repository-path (#!optional *) *))
+(require (#(procedure #:clean) require (#!rest (or string symbol)) undefined))
(reset (procedure reset () noreturn))
-(reset-handler (#(procedure #:enforce) reset-handler (#!optional (procedure () . *)) procedure))
+(reset-handler (#(procedure #:clean #:enforce) reset-handler (#!optional (procedure () . *)) procedure))
(return-to-host (procedure return-to-host () . *))
-(reverse-list->string (#(procedure #:enforce) reverse-list->string ((list char)) string))
-(set-finalizer! (#(procedure #:enforce) set-finalizer! (* (procedure (*) . *)) *))
-(set-gc-report! (procedure set-gc-report! (*) undefined))
+(reverse-list->string (#(procedure #:clean #:enforce) reverse-list->string ((list char)) string))
+(set-finalizer! (#(procedure #:clean #:enforce) set-finalizer! (* (procedure (*) . *)) *))
+(set-gc-report! (#(procedure #:clean) set-gc-report! (*) undefined))
(set-parameterized-read-syntax!
- (#(procedure #:enforce) set-parameterized-read-syntax! (char (procedure (port fixnum) . *)) undefined))
+ (#(procedure #:clean #:enforce) set-parameterized-read-syntax! (char (procedure (port fixnum) . *)) undefined))
-(set-port-name! (#(procedure #:enforce) set-port-name! (port string) undefined)
+(set-port-name! (#(procedure #:clean #:enforce) set-port-name! (port string) undefined)
((port string) (##sys#setslot #(1) '3 #(2))))
-(set-read-syntax! (#(procedure #:enforce) set-read-syntax! (char (procedure (port) . *)) undefined))
-(set-sharp-read-syntax! (#(procedure #:enforce) set-sharp-read-syntax! (char (procedure (port) . *)) undefined))
-(setter (#(procedure #:enforce) setter (procedure) procedure))
+(set-read-syntax! (#(procedure #:clean #:enforce) set-read-syntax! (char (procedure (port) . *)) undefined))
+(set-sharp-read-syntax! (#(procedure #:clean #:enforce) set-sharp-read-syntax! (char (procedure (port) . *)) undefined))
+(setter (#(procedure #:clean #:enforce) setter (procedure) procedure))
(signal (procedure signal (*) . *))
-(signum (#(procedure #:enforce) signum (number) number))
-(software-type (procedure software-type () symbol))
-(software-version (procedure software-version () symbol))
-(string->blob (#(procedure #:enforce) string->blob (string) blob))
-(string->keyword (#(procedure #:enforce) string->keyword (string) symbol))
-(string->uninterned-symbol (#(procedure #:enforce) string->uninterned-symbol (string) symbol))
-(strip-syntax (procedure strip-syntax (*) *))
-
-(sub1 (#(procedure #:enforce) sub1 (number) number)
+(signum (#(procedure #:clean #:enforce) signum (number) number))
+(software-type (#(procedure #:pure) software-type () symbol))
+(software-version (#(procedure #:pure) software-version () symbol))
+(string->blob (#(procedure #:clean #:enforce) string->blob (string) blob))
+(string->keyword (#(procedure #:clean #:enforce) string->keyword (string) symbol))
+(string->uninterned-symbol (#(procedure #:clean #:enforce) string->uninterned-symbol (string) symbol))
+(strip-syntax (#(procedure #:clean) strip-syntax (*) *))
+
+(sub1 (#(procedure #:clean #:enforce) sub1 (number) number)
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) '1.0)))
-(subvector (forall (a) (#(procedure #:enforce) subvector ((vector a) fixnum #!optional fixnum) (vector a))))
-(symbol-escape (procedure symbol-escape (#!optional *) *))
+(subvector (forall (a) (#(procedure #:clean #:enforce) subvector ((vector a) fixnum #!optional fixnum) (vector a))))
+(symbol-escape (#(procedure #:clean) symbol-escape (#!optional *) *))
-(symbol-plist (#(procedure #:enforce) symbol-plist (symbol) list)
+(symbol-plist (#(procedure #:clean #:enforce) symbol-plist (symbol) list)
((symbol) (##sys#slot #(1) '2)))
(syntax-error (procedure syntax-error (* #!rest) noreturn))
-(system (#(procedure #:enforce) system (string) fixnum))
-(unregister-feature! (#(procedure #:enforce) unregister-feature! (#!rest symbol) undefined))
-(vector-resize (forall (a) (#(procedure #:enforce) vector-resize ((vector a) fixnum) (vector a))))
-(void (procedure void (#!rest) undefined))
+(system (#(procedure #:clean #:enforce) system (string) fixnum))
+(unregister-feature! (#(procedure #:clean #:enforce) unregister-feature! (#!rest symbol) undefined))
+(vector-resize (forall (a) (#(procedure #:clean #:enforce) vector-resize ((vector a) fixnum) (vector a))))
+(void (#(procedure #:pure) void (#!rest) undefined))
+(##sys#void (#(procedure #:pure) void (#!rest) undefined))
(warning (procedure warning (* #!rest) undefined))
(with-exception-handler
@@ -1012,56 +1019,56 @@
;; chicken (internal)
-(##sys#foreign-char-argument (#(procedure #:enforce) ##sys#foreign-char-argument (char) char)
+(##sys#foreign-char-argument (#(procedure #:clean #:enforce) ##sys#foreign-char-argument (char) char)
((char) #(1)))
-(##sys#foreign-fixnum-argument (#(procedure #:enforce) ##sys#foreign-fixnum-argument (fixnum) fixnum)
+(##sys#foreign-fixnum-argument (#(procedure #:clean #:enforce) ##sys#foreign-fixnum-argument (fixnum) fixnum)
((fixnum) #(1)))
-(##sys#foreign-flonum-argument (#(procedure #:enforce) ##sys#foreign-flonum-argument (number) number)
+(##sys#foreign-flonum-argument (#(procedure #:clean #:enforce) ##sys#foreign-flonum-argument (number) number)
((float) #(1)))
-(##sys#foreign-string-argument (#(procedure #:enforce) ##sys#foreign-string-argument (string) string)
+(##sys#foreign-string-argument (#(procedure #:clean #:enforce) ##sys#foreign-string-argument (string) string)
((string) #(1)))
-(##sys#foreign-symbol-argument (#(procedure #:enforce) ##sys#foreign-symbol-argument (symbol) symbol)
+(##sys#foreign-symbol-argument (#(procedure #:clean #:enforce) ##sys#foreign-symbol-argument (symbol) symbol)
((symbol) #(1)))
-(##sys#foreign-pointer-argument (#(procedure #:enforce) ##sys#foreign-pointer-argument (pointer) pointer)
+(##sys#foreign-pointer-argument (#(procedure #:clean #:enforce) ##sys#foreign-pointer-argument (pointer) pointer)
((pointer) #(1)))
-(##sys#check-blob (#(procedure #:enforce) ##sys#check-blob (blob #!optional *) *)
+(##sys#check-blob (#(procedure #:clean #:enforce) ##sys#check-blob (blob #!optional *) *)
((blob) (let ((#(tmp) #(1))) '#t))
((blob *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-pair (#(procedure #:enforce) ##sys#check-pair (pair #!optional *) *)
+(##sys#check-pair (#(procedure #:clean #:enforce) ##sys#check-pair (pair #!optional *) *)
((pair) (let ((#(tmp) #(1))) '#t))
((pair *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-list (#(procedure #:enforce) ##sys#check-list (list #!optional *) *)
+(##sys#check-list (#(procedure #:clean #:enforce) ##sys#check-list (list #!optional *) *)
(((or null pair list)) (let ((#(tmp) #(1))) '#t))
(((or null pair list) *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-string (#(procedure #:enforce) ##sys#check-string (string #!optional *) *)
+(##sys#check-string (#(procedure #:clean #:enforce) ##sys#check-string (string #!optional *) *)
((string) (let ((#(tmp) #(1))) '#t))
((string) * (let ((#(tmp) #(1))) '#t)))
-(##sys#check-number (#(procedure #:enforce) ##sys#check-number (number #!optional *) *)
+(##sys#check-number (#(procedure #:clean #:enforce) ##sys#check-number (number #!optional *) *)
((number) (let ((#(tmp) #(1))) '#t))
((number *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-exact (#(procedure #:enforce) ##sys#check-exact (fixnum #!optional *) *)
+(##sys#check-exact (#(procedure #:clean #:enforce) ##sys#check-exact (fixnum #!optional *) *)
((fixnum) (let ((#(tmp) #(1))) '#t))
((fixnum *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-inexact (#(procedure #:enforce) ##sys#check-inexact (float #!optional *) *)
+(##sys#check-inexact (#(procedure #:clean #:enforce) ##sys#check-inexact (float #!optional *) *)
((float) (let ((#(tmp) #(1))) '#t))
((float *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-symbol (#(procedure #:enforce) ##sys#check-symbol (symbol #!optional *) *)
+(##sys#check-symbol (#(procedure #:clean #:enforce) ##sys#check-symbol (symbol #!optional *) *)
((symbol) (let ((#(tmp) #(1))) '#t))
((symbol *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-vector (#(procedure #:enforce) ##sys#check-vector (vector #!optional *) *)
+(##sys#check-vector (#(procedure #:clean #:enforce) ##sys#check-vector (vector #!optional *) *)
((vector) (let ((#(tmp) #(1))) '#t))
((vector *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-char (#(procedure #:enforce) ##sys#check-char (char #!optional *) *)
+(##sys#check-char (#(procedure #:clean #:enforce) ##sys#check-char (char #!optional *) *)
((char) (let ((#(tmp) #(1))) '#t))
((char *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-boolean (#(procedure #:enforce) ##sys#check-boolean (boolean #!optional *) *)
+(##sys#check-boolean (#(procedure #:clean #:enforce) ##sys#check-boolean (boolean #!optional *) *)
((boolean) (let ((#(tmp) #(1))) '#t))
((boolean *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-locative (#(procedure #:enforce) ##sys#check-locative (locative #!optional *) *)
+(##sys#check-locative (#(procedure #:clean #:enforce) ##sys#check-locative (locative #!optional *) *)
((locative) (let ((#(tmp) #(1))) '#t))
((locative *) (let ((#(tmp) #(1))) '#t)))
-(##sys#check-closure (#(procedure #:enforce) ##sys#check-closure (procedure #!optional *) *)
+(##sys#check-closure (#(procedure #:clean #:enforce) ##sys#check-closure (procedure #!optional *) *)
((procedure) (let ((#(tmp) #(1))) '#t))
((procedure *) (let ((#(tmp) #(1))) '#t)))
(##sys#setslot (#(procedure #:enforce) ##sys#setslot (* fixnum *) *)
@@ -1073,85 +1080,85 @@
(->string (procedure ->string (*) string)
((string) #(1)))
-(alist-ref (#(procedure #:enforce) alist-ref (* (list pair) #!optional (procedure (* *) *) *) *))
+(alist-ref (#(procedure #:clean #:enforce) alist-ref (* (list pair) #!optional (procedure (* *) *) *) *))
(alist-update! (#(procedure #:enforce) alist-update! (* * (list pair) #!optional (procedure (* *) *)) *))
(always? deprecated)
-(any? (procedure any? (*) boolean)
+(any? (#(procedure #:pure) any? (*) boolean)
((*) (let ((#(tmp) #(1))) '#t)))
-(atom? (procedure atom? (*) boolean)
+(atom? (#(procedure #:pure) atom? (*) boolean)
((pair) (let ((#(tmp) #(1))) '#f))
(((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
(binary-search (forall (a) (#(procedure #:enforce) binary-search ((vector a) (procedure (a) *)) *)))
-(butlast (forall (a) (#(procedure #:enforce) butlast ((pair a *)) (list a))))
-(chop (forall (a) (#(procedure #:enforce) chop ((list a) fixnum) (list a))))
-(complement (#(procedure #:enforce) complement ((procedure (#!rest) *)) (procedure (#!rest) boolean)))
-(compose (#(procedure #:enforce) compose (#!rest procedure) procedure))
-(compress (forall (a) (#(procedure #:enforce) compress (list (list a)) (list a))))
+(butlast (forall (a) (#(procedure #:clean #:enforce) butlast ((pair a *)) (list a))))
+(chop (forall (a) (#(procedure #:clean #:enforce) chop ((list a) fixnum) (list a))))
+(complement (#(procedure #:clean #:enforce) complement ((procedure (#!rest) *)) (procedure (#!rest) boolean)))
+(compose (#(procedure #:clean #:enforce) compose (#!rest procedure) procedure))
+(compress (forall (a) (#(procedure #:clean #:enforce) compress (list (list a)) (list a))))
(conc (procedure conc (#!rest) string))
-(conjoin (#(procedure #:enforce) conjoin (#!rest (procedure (*) *)) (procedure (*) *)))
-(constantly (forall (a) (procedure constantly (a) (procedure (#!rest) a))))
-(disjoin (#(procedure #:enforce) disjoin (#!rest (procedure (*) *)) (procedure (*) *)))
-(each (#(procedure #:enforce) each (#!rest procedure) procedure))
-(flatten (#(procedure #:enforce) flatten (pair) list))
-(flip (#(procedure #:enforce) flip ((procedure (* *) . *)) (procedure (* *) . *)))
-(identity (forall (a) (procedure identity (a) a)))
-(intersperse (#(procedure #:enforce) intersperse (list *) list))
-(join (#(procedure #:enforce) join (list list) list))
-(list->queue (#(procedure #:enforce) list->queue (list) (struct queue)))
-(list-of? (#(procedure #:enforce) list-of? ((procedure (*) *)) (procedure (list) boolean)))
-(make-queue (procedure make-queue () (struct queue)))
+(conjoin (#(procedure #:clean #:enforce) conjoin (#!rest (procedure (*) *)) (procedure (*) *)))
+(constantly (forall (a) (#(procedure #:pure) constantly (a) (procedure (#!rest) a))))
+(disjoin (#(procedure #:clean #:enforce) disjoin (#!rest (procedure (*) *)) (procedure (*) *)))
+(each (#(procedure #:clean #:enforce) each (#!rest procedure) procedure))
+(flatten (#(procedure #:clean #:enforce) flatten (pair) list))
+(flip (#(procedure #:clean #:enforce) flip ((procedure (* *) . *)) (procedure (* *) . *)))
+(identity (forall (a) (#(procedure #:pure) identity (a) a)))
+(intersperse (#(procedure #:clean #:enforce) intersperse (list *) list))
+(join (#(procedure #:clean #:enforce) join (list list) list))
+(list->queue (#(procedure #:clean #:enforce) list->queue (list) (struct queue)))
+(list-of? (#(procedure #:clean #:enforce) list-of? ((procedure (*) *)) (procedure (list) boolean)))
+(make-queue (#(procedure #:pure) make-queue () (struct queue)))
(merge (#(procedure #:enforce) merge (list list (procedure (* *) *)) list))
(merge! (#(procedure #:enforce) merge! (list list (procedure (* *) *)) list))
(never? deprecated)
(none? deprecated)
-(o (#(procedure #:enforce) o (#!rest (procedure (*) *)) (procedure (*) *)))
-(queue->list (#(procedure #:enforce) queue->list ((struct queue)) list))
-(queue-add! (#(procedure #:enforce) queue-add! ((struct queue) *) undefined))
+(o (#(procedure #:clean #:enforce) o (#!rest (procedure (*) *)) (procedure (*) *)))
+(queue->list (#(procedure #:clean #:enforce) queue->list ((struct queue)) list))
+(queue-add! (#(procedure #:clean #:enforce) queue-add! ((struct queue) *) undefined))
-(queue-empty? (#(procedure #:enforce) queue-empty? ((struct queue)) boolean)
+(queue-empty? (#(procedure #:clean #:enforce) queue-empty? ((struct queue)) boolean)
(((struct queue)) (##core#inline "C_i_nullp" (##sys#slot #(1) '1))))
-(queue-first (#(procedure #:enforce) queue-first ((struct queue)) *))
-(queue-last (#(procedure #:enforce) queue-last ((struct queue)) *))
+(queue-first (#(procedure #:clean #:enforce) queue-first ((struct queue)) *))
+(queue-last (#(procedure #:clean #:enforce) queue-last ((struct queue)) *))
-(queue-length (#(procedure #:enforce) queue-length ((struct queue)) fixnum)
+(queue-length (#(procedure #:clean #:enforce) queue-length ((struct queue)) fixnum)
(((struct queue)) (##sys#slot #(1) '3)))
-(queue-push-back! (#(procedure #:enforce) queue-push-back! ((struct queue) *) undefined))
-(queue-push-back-list! (#(procedure #:enforce) queue-push-back-list! ((struct queue) list) undefined))
-(queue-remove! (#(procedure #:enforce) queue-remove! ((struct queue)) *))
-(queue? (#(procedure #:predicate (struct queue)) queue? (*) boolean))
+(queue-push-back! (#(procedure #:clean #:enforce) queue-push-back! ((struct queue) *) undefined))
+(queue-push-back-list! (#(procedure #:clean #:enforce) queue-push-back-list! ((struct queue) list) undefined))
+(queue-remove! (#(procedure #:clean #:enforce) queue-remove! ((struct queue)) *))
+(queue? (#(procedure #:pure #:predicate (struct queue)) queue? (*) boolean))
-(rassoc (#(procedure #:enforce) rassoc (* (list pair) #!optional (procedure (* *) *)) *))
-(reverse-string-append (#(procedure #:enforce) reverse-string-append ((list string)) string))
+(rassoc (#(procedure #:clean #:enforce) rassoc (* (list pair) #!optional (procedure (* *) *)) *))
+(reverse-string-append (#(procedure #:clean #:enforce) reverse-string-append ((list string)) string))
(shuffle deprecated)
(sort (#(procedure #:enforce) sort ((or list vector) (procedure (* *) *)) (or list vector)))
(sort! (#(procedure #:enforce) sort! ((or list vector) (procedure (* *) *)) (or list vector)))
(sorted? (#(procedure #:enforce) sorted? ((or list vector) (procedure (* *) *)) boolean))
(topological-sort (#(procedure #:enforce) topological-sort ((list list) (procedure (* *) *)) list))
-(string-chomp (#(procedure #:enforce) string-chomp (string #!optional string) string))
-(string-chop (#(procedure #:enforce) string-chop (string fixnum) (list string)))
-(string-compare3 (#(procedure #:enforce) string-compare3 (string string) fixnum))
-(string-compare3-ci (#(procedure #:enforce) string-compare3-ci (string string) fixnum))
-(string-intersperse (#(procedure #:enforce) string-intersperse ((list string) #!optional string) string))
-(string-split (#(procedure #:enforce) string-split (string #!optional string *) (list string)))
-(string-translate (#(procedure #:enforce) string-translate (string * #!optional *) string))
-(string-translate* (#(procedure #:enforce) string-translate* (string (list (pair string string))) string))
-(substring-ci=? (#(procedure #:enforce) substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean))
-
-(substring-index (#(procedure #:enforce) substring-index (string string #!optional fixnum) *)
+(string-chomp (#(procedure #:clean #:enforce) string-chomp (string #!optional string) string))
+(string-chop (#(procedure #:clean #:enforce) string-chop (string fixnum) (list string)))
+(string-compare3 (#(procedure #:clean #:enforce) string-compare3 (string string) fixnum))
+(string-compare3-ci (#(procedure #:clean #:enforce) string-compare3-ci (string string) fixnum))
+(string-intersperse (#(procedure #:clean #:enforce) string-intersperse ((list string) #!optional string) string))
+(string-split (#(procedure #:clean #:enforce) string-split (string #!optional string *) (list string)))
+(string-translate (#(procedure #:clean #:enforce) string-translate (string * #!optional *) string))
+(string-translate* (#(procedure #:clean #:enforce) string-translate* (string (list (pair string string))) string))
+(substring-ci=? (#(procedure #:clean #:enforce) substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean))
+
+(substring-index (#(procedure #:clean #:enforce) substring-index (string string #!optional fixnum) *)
((* *) (##sys#substring-index #(1) #(2) '0))
((* * *) (##sys#substring-index #(1) #(2) #(3))))
-(substring-index-ci (#(procedure #:enforce) substring-index-ci (string string #!optional fixnum) *)
+(substring-index-ci (#(procedure #:clean #:enforce) substring-index-ci (string string #!optional fixnum) *)
((* *) (##sys#substring-index-ci #(1) #(2) '0))
((* * *) (##sys#substring-index-ci #(1) #(2) #(3))))
-(substring=? (#(procedure #:enforce) substring=? (string string #!optional fixnum fixnum fixnum) boolean))
-(tail? (procedure tail? (* *) boolean))
+(substring=? (#(procedure #:clean #:enforce) substring=? (string string #!optional fixnum fixnum fixnum) boolean))
+(tail? (#(procedure #:clean) tail? (* *) boolean))
;; extras
@@ -1160,10 +1167,10 @@
(fprintf (#(procedure #:enforce) fprintf (port string #!rest) undefined))
(pp (#(procedure #:enforce) pp (* #!optional port) undefined))
(pretty-print (#(procedure #:enforce) pretty-print (* #!optional port) undefined))
-(pretty-print-width (procedure pretty-print-width (#!optional fixnum) *))
+(pretty-print-width (#(procedure #:clean) pretty-print-width (#!optional fixnum) *))
(printf (#(procedure #:enforce) printf (string #!rest) undefined))
-(random (#(procedure #:enforce) random (fixnum) fixnum))
-(randomize (#(procedure #:enforce) randomize (#!optional fixnum) undefined))
+(random (#(procedure #:clean #:enforce) random (fixnum) fixnum))
+(randomize (#(procedure #:clean #:enforce) randomize (#!optional fixnum) undefined))
(read-buffered (#(procedure #:enforce) read-buffered (#!optional port) string))
(read-byte (#(procedure #:enforce) read-byte (#!optional port) *))
(read-file (#(procedure #:enforce) read-file (#!optional (or port string) (procedure (port) *) fixnum) list))
@@ -1184,61 +1191,63 @@
;; files
-(delete-file* (#(procedure #:enforce) delete-file* (string) *))
-(file-copy (#(procedure #:enforce) file-copy (string string #!optional * fixnum) fixnum))
-(file-move (#(procedure #:enforce) file-move (string string #!optional * fixnum) fixnum))
-(make-pathname (#(procedure #:enforce) make-pathname (* #!optional string string) string))
-(directory-null? (#(procedure #:enforce) directory-null? (string) boolean))
-(make-absolute-pathname (#(procedure #:enforce) make-absolute-pathname (* #!optional string string) string))
-(create-temporary-directory (#(procedure #:enforce) create-temporary-directory () string))
-(create-temporary-file (#(procedure #:enforce) create-temporary-file (#!optional string) string))
-(decompose-directory (#(procedure #:enforce) decompose-directory (string) * * *))
-(decompose-pathname (#(procedure #:enforce) decompose-pathname (string) * * *))
-(absolute-pathname? (#(procedure #:enforce) absolute-pathname? (string) boolean))
-(pathname-directory (#(procedure #:enforce) pathname-directory (string) *))
-(pathname-extension (#(procedure #:enforce) pathname-extension (string) *))
-(pathname-file (#(procedure #:enforce) pathname-file (string) *))
-(pathname-replace-directory (#(procedure #:enforce) pathname-replace-directory (string string) string))
-(pathname-replace-extension (#(procedure #:enforce) pathname-replace-extension (string string) string))
-(pathname-replace-file (#(procedure #:enforce) pathname-replace-file (string string) string))
-(pathname-strip-directory (#(procedure #:enforce) pathname-strip-directory (string) string))
-(pathname-strip-extension (#(procedure #:enforce) pathname-strip-extension (string) string))
-(normalize-pathname (#(procedure #:enforce) normalize-pathname (string #!optional symbol) string))
+(delete-file* (#(procedure #:clean #:enforce) delete-file* (string) *))
+(file-copy (#(procedure #:clean #:enforce) file-copy (string string #!optional * fixnum) fixnum))
+(file-move (#(procedure #:clean #:enforce) file-move (string string #!optional * fixnum) fixnum))
+(make-pathname (#(procedure #:clean #:enforce) make-pathname (* #!optional string string) string))
+(directory-null? (#(procedure #:clean #:enforce) directory-null? (string) boolean))
+(make-absolute-pathname (#(procedure #:clean #:enforce) make-absolute-pathname (* #!optional string string) string))
+(create-temporary-directory (#(procedure #:clean #:enforce) create-temporary-directory () string))
+(create-temporary-file (#(procedure #:clean #:enforce) create-temporary-file (#!optional string) string))
+(decompose-directory (#(procedure #:clean #:enforce) decompose-directory (string) * * *))
+(decompose-pathname (#(procedure #:clean #:enforce) decompose-pathname (string) * * *))
+(absolute-pathname? (#(procedure #:clean #:enforce) absolute-pathname? (string) boolean))
+(pathname-directory (#(procedure #:clean #:enforce) pathname-directory (string) *))
+(pathname-extension (#(procedure #:clean #:enforce) pathname-extension (string) *))
+(pathname-file (#(procedure #:clean #:enforce) pathname-file (string) *))
+(pathname-replace-directory (#(procedure #:clean #:enforce) pathname-replace-directory (string string) string))
+(pathname-replace-extension (#(procedure #:clean #:enforce) pathname-replace-extension (string string) string))
+(pathname-replace-file (#(procedure #:clean #:enforce) pathname-replace-file (string string) string))
+(pathname-strip-directory (#(procedure #:clean #:enforce) pathname-strip-directory (string) string))
+(pathname-strip-extension (#(procedure #:clean #:enforce) pathname-strip-extension (string) string))
+(normalize-pathname (#(procedure #:clean #:enforce) normalize-pathname (string #!optional symbol) string))
;; irregex
;;XXX these need to be reviewed by Alex and/or sjamaan
-(irregex (procedure irregex (#!rest) *))
+;;XXX which do not invoke stored procedures that may modify local state? (clean)
+
+(irregex (#(procedure #:clean) irregex (#!rest) *))
;irregex-apply-match
-(irregex-dfa (#(procedure #:enforce) irregex-dfa ((struct regexp)) *)
+(irregex-dfa (#(procedure #:clean #:enforce) irregex-dfa ((struct regexp)) *)
(((struct regexp)) (##sys#slot #(1) '1)))
-(irregex-dfa/extract (#(procedure #:enforce) irregex-dfa/extract ((struct regexp)) *)
+(irregex-dfa/extract (#(procedure #:clean #:enforce) irregex-dfa/extract ((struct regexp)) *)
(((struct regexp)) (##sys#slot #(1) '3)))
-(irregex-dfa/search (#(procedure #:enforce) irregex-dfa/search ((struct regexp)) *)
+(irregex-dfa/search (#(procedure #:clean #:enforce) irregex-dfa/search ((struct regexp)) *)
(((struct regexp)) (##sys#slot #(1) '2)))
-(irregex-extract (#(procedure #:enforce) irregex-extract (* string #!optional fixnum fixnum) list))
-(irregex-flags (#(procedure #:enforce) irregex-flags ((struct regexp)) *)
+(irregex-extract (#(procedure #:enforce) irregex-extract (* string #!optional fixnum fixnum) list)) ;XXX specialize?
+(irregex-flags (#(procedure #:clean #:enforce) irregex-flags ((struct regexp)) *)
(((struct regexp)) (##sys#slot #(1) '5)))
(irregex-fold (#(procedure #:enforce) irregex-fold (* (procedure (fixnum (struct regexp-match) *) *) * string #!optional (procedure (fixnum *) *) fixnum fixnum) *))
(irregex-fold/chunked (#(procedure #:enforce) irregex-fold/chunked (* (procedure (* fixnum (struct regexp-match) *) *) * procedure * #!optional (procedure (* fixnum *) *) fixnum fixnum) *))
-(irregex-lengths (#(procedure #:enforce) irregex-lengths ((struct regexp)) *)
+(irregex-lengths (#(procedure #:clean #:enforce) irregex-lengths ((struct regexp)) *)
(((struct regexp)) (##sys#slot #(1) '7)))
(irregex-match (#(procedure #:enforce) irregex-match (* string) *))
;irregex-match?
-(irregex-match-data? (#(procedure #:predicate (struct regexp-match)) irregex-match-data? (*) boolean))
+(irregex-match-data? (#(procedure #:pure #:predicate (struct regexp-match)) irregex-match-data? (*) boolean))
-(irregex-match-end (procedure irregex-match-end (* #!optional *) *))
+(irregex-match-end (#(procedure) irregex-match-end (* #!optional *) *))
;irregex-match-end-chunk
(irregex-match-end-index (#(procedure #:enforce) irregex-match-end-index ((struct regexp-match) #!optional *) fixnum))
@@ -1246,23 +1255,23 @@
(((struct regexp-match)) (##sys#slot #(1) '2)))
(irregex-match-num-submatches (#(procedure #:enforce) irregex-match-num-submatches ((struct regexp-match)) fixnum))
-(irregex-match-start (procedure irregex-match-start (* #!optional *) *))
+(irregex-match-start (#(procedure) irregex-match-start (* #!optional *) *))
;irregex-match-start-chunk
(irregex-match-start-index (#(procedure #:enforce) irregex-match-start-index ((struct regexp-match) #!optional *) fixnum))
-(irregex-match-string (procedure irregex-match-string (*) *))
+(irregex-match-string (#(procedure) irregex-match-string (*) *))
(irregex-match-subchunk (#(procedure #:enforce) irregex-match-subchunk ((struct regexp-match) #!optional *) *))
-(irregex-match-substring (procedure irregex-match-substring (* #!optional *) *))
+(irregex-match-substring (#(procedure) irregex-match-substring (* #!optional *) *))
(irregex-match/chunked (#(procedure #:enforce) irregex-match/chunked (* * * #!optional fixnum) *))
-(irregex-names (#(procedure #:enforce) irregex-names ((struct regexp)) *)
+(irregex-names (#(procedure #:clean #:enforce) irregex-names ((struct regexp)) *)
(((struct regexp)) (##sys#slot #(1) '8)))
(irregex-new-matches (procedure irregex-new-matches (*) *))
-(irregex-nfa (#(procedure #:enforce) irregex-nfa ((struct regexp)) *)
+(irregex-nfa (#(procedure #:clean #:enforce) irregex-nfa ((struct regexp)) *)
(((struct regexp)) (##sys#slot #(1) '4)))
-(irregex-num-submatches (#(procedure #:enforce) irregex-num-submatches ((struct regexp))
+(irregex-num-submatches (#(procedure #:clean #:enforce) irregex-num-submatches ((struct regexp))
fixnum)
(((struct regexp)) (##sys#slot #(1) '6)))
@@ -1276,9 +1285,9 @@
(irregex-split (#(procedure #:enforce) irregex-split (* string #!optional fixnum fixnum) list))
(irregex-search/chunked (#(procedure #:enforce) irregex-search/chunked (* procedure * #!optional fixnum fixnum *) *))
(irregex-match-valid-index?
- (#(procedure #:enforce) irregex-match-valid-index? ((struct regexp-match) *) boolean))
+ (#(procedure #:clean #:enforce) irregex-match-valid-index? ((struct regexp-match) *) boolean))
-(irregex? (#(procedure #:predicate (struct regexp)) irregex? (*) boolean))
+(irregex? (#(procedure #:pure #:predicate (struct regexp)) irregex? (*) boolean))
(make-irregex-chunker
(#(procedure #:enforce) make-irregex-chunker
@@ -1290,37 +1299,37 @@
(procedure (* fixnum * fixnum) string)
(procedure (* fixnum * fixnum) *))
*))
-(maybe-string->sre (procedure maybe-string->sre (*) *))
-(sre->irregex (procedure sre->irregex (#!rest) *))
-(string->irregex (#(procedure #:enforce) string->irregex (string #!rest) *))
-(string->sre (#(procedure #:enforce) string->sre (string #!rest) *))
+(maybe-string->sre (#(procedure #:clean) maybe-string->sre (*) *))
+(sre->irregex (#(procedure #:clean) sre->irregex (#!rest) *))
+(string->irregex (#(procedure #:clean #:enforce) string->irregex (string #!rest) *))
+(string->sre (#(procedure #:clean #:enforce) string->sre (string #!rest) *))
;; lolevel
-(address->pointer (#(procedure #:enforce) address->pointer (fixnum) pointer)
+(address->pointer (#(procedure #:clean #:enforce) address->pointer (fixnum) pointer)
((fixnum) (##sys#address->pointer #(1))))
(align-to-word
- (procedure
+ (#(procedure #:clean)
align-to-word
((or number pointer locative procedure port))
(or pointer number)))
-(allocate (#(procedure #:enforce) allocate (fixnum) (or boolean pointer)))
-(block-ref (#(procedure #:enforce) block-ref (* fixnum) *))
+(allocate (#(procedure #:clean #:enforce) allocate (fixnum) (or boolean pointer)))
+(block-ref (#(procedure #:clean #:enforce) block-ref (* fixnum) *))
(block-set! (#(procedure #:enforce) block-set! (* fixnum *) *))
-(extend-procedure (#(procedure #:enforce) extend-procedure (procedure *) procedure))
-(extended-procedure? (procedure extended-procedure (*) boolean))
-(free (#(procedure #:enforce) free (pointer) undefined))
-(locative->object (#(procedure #:enforce) locative->object (locative) *))
-(locative-ref (#(procedure #:enforce) locative-ref (locative) *))
+(extend-procedure (#(procedure #:clean #:enforce) extend-procedure (procedure *) procedure))
+(extended-procedure? (#(procedure #:clean) extended-procedure (*) boolean))
+(free (#(procedure #:clean #:enforce) free (pointer) undefined))
+(locative->object (#(procedure #:clean #:enforce) locative->object (locative) *))
+(locative-ref (#(procedure #:clean #:enforce) locative-ref (locative) *))
(locative-set! (#(procedure #:enforce) locative-set! (locative *) *))
-(locative? (#(procedure #:predicate locative) locative? (*) boolean))
-(make-locative (#(procedure #:enforce) make-locative (* #!optional fixnum) locative))
-(make-pointer-vector (#(procedure #:enforce) make-pointer-vector (fixnum #!optional pointer) pointer-vector))
-(make-record-instance (procedure make-record-instance (symbol #!rest) *))
-(make-weak-locative (#(procedure #:enforce) make-weak-locative (* #!optional fixnum) locative))
+(locative? (#(procedure #:pure #:predicate locative) locative? (*) boolean))
+(make-locative (#(procedure #:clean #:enforce) make-locative (* #!optional fixnum) locative))
+(make-pointer-vector (#(procedure #:clean #:enforce) make-pointer-vector (fixnum #!optional pointer) pointer-vector))
+(make-record-instance (#(procedure #:clean) make-record-instance (symbol #!rest) *))
+(make-weak-locative (#(procedure #:clean #:enforce) make-weak-locative (* #!optional fixnum) locative))
(move-memory! (#(procedure #:enforce) move-memory! (* * #!optional fixnum fixnum fixnum) *)
((pointer pointer fixnum)
@@ -1343,84 +1352,84 @@
(null-pointer deprecated)
(null-pointer? deprecated)
-(number-of-bytes (procedure number-of-bytes (*) fixnum)
+(number-of-bytes (#(procedure #:clean) number-of-bytes (*) fixnum)
(((or blob string)) (##sys#size #(1)))
(((or port procedure symbol pair vector locative float pointer-vector))
;; would be applicable to all structure types, but we can't specify
;; "(struct *)" (yet)
(##core#inline "C_w2b" (##sys#size #(1)))))
-(number-of-slots (procedure number-of-slots (*) fixnum)
+(number-of-slots (#(procedure #:clean) number-of-slots (*) fixnum)
(((or vector symbol pair)) (##sys#size #(1))))
-(object->pointer (procedure object->pointer (*) *))
+(object->pointer (#(procedure #:clean) object->pointer (*) *))
(object-become! (procedure object-become! (list) *))
-(object-copy (procedure object-copy (*) *))
-(object-evict (#(procedure #:enforce) object-evict (* #!optional (procedure (fixnum) pointer)) *))
-(object-evict-to-location (#(procedure #:enforce) object-evict-to-location (* (or pointer locative procedure port) #!optional fixnum) * pointer))
-(object-evicted? (procedure object-evicted? (*) boolean))
+(object-copy (#(procedure #:clean) object-copy (*) *))
+(object-evict (#(procedure #:clean #:enforce) object-evict (* #!optional (procedure (fixnum) pointer)) *))
+(object-evict-to-location (#(procedure #:clean #:enforce) object-evict-to-location (* (or pointer locative procedure port) #!optional fixnum) * pointer))
+(object-evicted? (#(procedure #:pure) object-evicted? (*) boolean))
(object-release (#(procedure #:enforce) object-release (* #!optional (procedure (pointer) *)) *))
-(object-size (procedure object-size (*) fixnum))
+(object-size (#(procedure #:clean) object-size (*) fixnum))
(object-unevict (procedure object-unevict (* #!optional *) *))
-(pointer+ (#(procedure #:enforce) pointer+ ((or pointer procedure port locative) fixnum) pointer))
+(pointer+ (#(procedure #:clean #:enforce) pointer+ ((or pointer procedure port locative) fixnum) pointer))
-(pointer->address (#(procedure #:enforce) pointer->address ((or pointer procedure port locative)) number)
+(pointer->address (#(procedure #:clean #:enforce) pointer->address ((or pointer procedure port locative)) number)
((pointer) (##sys#pointer->address #(1))))
-(pointer->object (#(procedure #:enforce) pointer->object (pointer) *)
+(pointer->object (#(procedure #:clean #:enforce) pointer->object (pointer) *)
((pointer) (##core#inline "C_pointer_to_object" #(1))))
-(pointer-like? (procedure pointer-like? (*) boolean)
+(pointer-like? (#(procedure #:pure) pointer-like? (*) boolean) ;XXX predicate?
(((or pointer locative procedure port)) (let ((#(tmp) #(1))) '#t)))
-(pointer-f32-ref (#(procedure #:enforce) pointer-f32-ref (pointer) number))
-(pointer-f32-set! (#(procedure #:enforce) pointer-f32-set! (pointer number) undefined))
-(pointer-f64-ref (#(procedure #:enforce) pointer-f64-ref (pointer) number))
-(pointer-f64-set! (#(procedure #:enforce) pointer-f64-set! (pointer number) undefined))
-(pointer-vector (#(procedure #:enforce) pointer-vector (#!rest pointer-vector) boolean))
+(pointer-f32-ref (#(procedure #:clean #:enforce) pointer-f32-ref (pointer) number))
+(pointer-f32-set! (#(procedure #:clean #:enforce) pointer-f32-set! (pointer number) undefined))
+(pointer-f64-ref (#(procedure #:clean #:enforce) pointer-f64-ref (pointer) number))
+(pointer-f64-set! (#(procedure #:clean #:enforce) pointer-f64-set! (pointer number) undefined))
+(pointer-vector (#(procedure #:clean #:enforce) pointer-vector (#!rest pointer-vector) boolean))
-(pointer-vector? (#(procedure #:predicate pointer-vector) pointer-vector? (*) boolean))
+(pointer-vector? (#(procedure #:pure #:predicate pointer-vector) pointer-vector? (*) boolean))
-(pointer-vector-fill! (#(procedure #:enforce) pointer-vector-fill! (pointer-vector pointer) undefined))
+(pointer-vector-fill! (#(procedure #:clean #:enforce) pointer-vector-fill! (pointer-vector pointer) undefined))
-(pointer-vector-length (#(procedure #:enforce) pointer-vector-length (pointer-vector) fixnum)
+(pointer-vector-length (#(procedure #:clean #:enforce) pointer-vector-length (pointer-vector) fixnum)
((pointer-vector) (##sys#slot #(1) '1)))
-(pointer-vector-ref (#(procedure #:enforce) pointer-vector-ref (pointer-vector fixnum) pointer))
-(pointer-vector-set! (#(procedure #:enforce) pointer-vector-set! (pointer-vector fixnum pointer) undefined))
-(pointer-s16-ref (#(procedure #:enforce) pointer-s16-ref (pointer) fixnum))
-(pointer-s16-set! (#(procedure #:enforce) pointer-s16-set! (pointer fixnum) undefined))
-(pointer-s32-ref (#(procedure #:enforce) pointer-s32-ref (pointer) number))
-(pointer-s32-set! (#(procedure #:enforce) pointer-s32-set! (pointer number) undefined))
-(pointer-s8-ref (#(procedure #:enforce) pointer-s8-ref (pointer) fixnum))
-(pointer-s8-set! (#(procedure #:enforce) pointer-s8-set! (pointer fixnum) undefined))
+(pointer-vector-ref (#(procedure #:clean #:enforce) pointer-vector-ref (pointer-vector fixnum) pointer))
+(pointer-vector-set! (#(procedure #:clean #:enforce) pointer-vector-set! (pointer-vector fixnum pointer) undefined))
+(pointer-s16-ref (#(procedure #:clean #:enforce) pointer-s16-ref (pointer) fixnum))
+(pointer-s16-set! (#(procedure #:clean #:enforce) pointer-s16-set! (pointer fixnum) undefined))
+(pointer-s32-ref (#(procedure #:clean #:enforce) pointer-s32-ref (pointer) number))
+(pointer-s32-set! (#(procedure #:clean #:enforce) pointer-s32-set! (pointer number) undefined))
+(pointer-s8-ref (#(procedure #:clean #:enforce) pointer-s8-ref (pointer) fixnum))
+(pointer-s8-set! (#(procedure #:clean #:enforce) pointer-s8-set! (pointer fixnum) undefined))
-(pointer-tag (#(procedure #:enforce) pointer-tag ((or pointer locative procedure port)) (or boolean number))
+(pointer-tag (#(procedure #:clean #:enforce) pointer-tag ((or pointer locative procedure port)) (or boolean number))
(((or locative procedure port)) (let ((#(tmp) #(1))) '#f)))
-(pointer-u16-ref (#(procedure #:enforce) pointer-u16-ref (pointer) fixnum))
-(pointer-u16-set! (#(procedure #:enforce) pointer-u16-set! (pointer fixnum) undefined))
-(pointer-u32-ref (#(procedure #:enforce) pointer-u32-ref (pointer) number))
-(pointer-u32-set! (#(procedure #:enforce) pointer-u32-set! (pointer number) undefined))
-(pointer-u8-ref (#(procedure #:enforce) pointer-u8-ref (pointer) fixnum))
-(pointer-u8-set! (#(procedure #:enforce) pointer-u8-set! (pointer fixnum) undefined))
+(pointer-u16-ref (#(procedure #:clean #:enforce) pointer-u16-ref (pointer) fixnum))
+(pointer-u16-set! (#(procedure #:clean #:enforce) pointer-u16-set! (pointer fixnum) undefined))
+(pointer-u32-ref (#(procedure #:clean #:enforce) pointer-u32-ref (pointer) number))
+(pointer-u32-set! (#(procedure #:clean #:enforce) pointer-u32-set! (pointer number) undefined))
+(pointer-u8-ref (#(procedure #:clean #:enforce) pointer-u8-ref (pointer) fixnum))
+(pointer-u8-set! (#(procedure #:clean #:enforce) pointer-u8-set! (pointer fixnum) undefined))
-(pointer=? (#(procedure #:enforce) pointer=? ((or pointer locative procedure port)
+(pointer=? (#(procedure #:clean #:enforce) pointer=? ((or pointer locative procedure port)
(or pointer locative procedure port)) boolean)
((pointer pointer) (##core#inline "C_pointer_eqp" #(1) #(2))))
-(pointer? (#(procedure #:predicate pointer) pointer? (*) boolean))
+(pointer? (#(procedure #:clean #:predicate pointer) pointer? (*) boolean))
-(procedure-data (#(procedure #:enforce) procedure-data (procedure) *))
-(record->vector (procedure record->vector (*) vector))
-(record-instance? (procedure record-instance? (*) boolean))
-(record-instance-length (procedure record-instance-length (*) fixnum))
-(record-instance-slot (#(procedure #:enforce) record-instance-slot (* fixnum) *))
-(record-instance-slot-set! (#(procedure #:enforce) record-instance-slot-set! (* fixnum *) undefined))
-(record-instance-type (procedure record-instance-type (*) *))
-(set-procedure-data! (#(procedure #:enforce) set-procedure-data! (procedure *) undefined))
-(tag-pointer (#(procedure #:enforce) tag-pointer (pointer *) pointer))
-(tagged-pointer? (#(procedure #:enforce) tagged-pointer? (* #!optional *) boolean))
+(procedure-data (#(procedure #:clean #:enforce) procedure-data (procedure) *))
+(record->vector (#(procedure #:clean) record->vector (*) vector))
+(record-instance? (#(procedure #:clean) record-instance? (*) boolean))
+(record-instance-length (#(procedure #:clean) record-instance-length (*) fixnum))
+(record-instance-slot (#(procedure #:clean #:enforce) record-instance-slot (* fixnum) *))
+(record-instance-slot-set! (#(procedure #:clean #:enforce) record-instance-slot-set! (* fixnum *) undefined))
+(record-instance-type (#(procedure #:clean) record-instance-type (*) *))
+(set-procedure-data! (#(procedure #:clean #:enforce) set-procedure-data! (procedure *) undefined))
+(tag-pointer (#(procedure #:clean #:enforce) tag-pointer (pointer *) pointer))
+(tagged-pointer? (#(procedure #:clean #:enforce) tagged-pointer? (* #!optional *) boolean))
;; ports
@@ -1428,16 +1437,16 @@
(call-with-input-string (#(procedure #:enforce) call-with-input-string (string (procedure (port) . *)) . *))
(call-with-output-string (#(procedure #:enforce) call-with-output-string ((procedure (port) . *)) string))
(copy-port (#(procedure #:enforce) copy-port (* * #!optional (procedure (*) *) (procedure (* port) *)) undefined))
-(make-input-port (#(procedure #:enforce) make-input-port ((procedure () char) (procedure () *) (procedure () . *) #!optional * * * *) port))
-(make-output-port (#(procedure #:enforce) make-output-port ((procedure (string) . *) (procedure () . *) #!optional (procedure () . *)) port))
+(make-input-port (#(procedure #:clean #:enforce) make-input-port ((procedure () char) (procedure () *) (procedure () . *) #!optional * * * *) port))
+(make-output-port (#(procedure #:clean #:enforce) make-output-port ((procedure (string) . *) (procedure () . *) #!optional (procedure () . *)) port))
(port-for-each (#(procedure #:enforce) port-for-each ((procedure (*) *) (procedure () . *)) undefined))
(port-map
(forall (a b) (#(procedure #:enforce) port-map ((procedure (a) b) (procedure () a)) (list b))))
(port-fold (#(procedure #:enforce) port-fold ((procedure (* *) *) * (procedure () *)) *))
-(make-broadcast-port (#(procedure #:enforce) make-broadcast-port (#!rest port) port))
-(make-concatenated-port (#(procedure #:enforce) make-concatenated-port (port #!rest port) port))
+(make-broadcast-port (#(procedure #:clean #:enforce) make-broadcast-port (#!rest port) port))
+(make-concatenated-port (#(procedure #:clean #:enforce) make-concatenated-port (port #!rest port) port))
(with-error-output-to-port (#(procedure #:enforce) with-error-output-to-port (port (procedure () . *)) . *))
(with-input-from-port (#(procedure #:enforce) with-input-from-port (port (procedure () . *)) . *))
(with-input-from-string (#(procedure #:enforce) with-input-from-string (string (procedure () . *)) . *))
@@ -1450,33 +1459,33 @@
(_exit (procedure _exit (fixnum) noreturn))
(call-with-input-pipe (#(procedure #:enforce) call-with-input-pipe (string (procedure (port) . *) #!optional symbol) . *))
(call-with-output-pipe (#(procedure #:enforce) call-with-output-pipe (string (procedure (port) . *) #!optional symbol) . *))
-(change-directory (#(procedure #:enforce) change-directory (string) string))
-(change-file-mode (#(procedure #:enforce) change-file-mode (string fixnum) undefined))
-(change-file-owner (#(procedure #:enforce) change-file-owner (string fixnum fixnum) undefined))
-(close-input-pipe (#(procedure #:enforce) close-input-pipe (port) fixnum))
-(close-output-pipe (#(procedure #:enforce) close-output-pipe (port) fixnum))
-(create-directory (#(procedure #:enforce) create-directory (string #!optional *) string))
-(create-fifo (#(procedure #:enforce) create-fifo (string #!optional fixnum) undefined))
+(change-directory (#(procedure #:clean #:enforce) change-directory (string) string))
+(change-file-mode (#(procedure #:clean #:enforce) change-file-mode (string fixnum) undefined))
+(change-file-owner (#(procedure #:clean #:enforce) change-file-owner (string fixnum fixnum) undefined))
+(close-input-pipe (#(procedure #:clean #:enforce) close-input-pipe (port) fixnum))
+(close-output-pipe (#(procedure #:clean #:enforce) close-output-pipe (port) fixnum))
+(create-directory (#(procedure #:clean #:enforce) create-directory (string #!optional *) string))
+(create-fifo (#(procedure #:clean #:enforce) create-fifo (string #!optional fixnum) undefined))
(create-pipe (procedure create-pipe () fixnum fixnum))
-(create-session (procedure create-session () fixnum))
-(create-symbolic-link (#(procedure #:enforce) create-symbolic-link (string string) undefined))
+(create-session (#(procedure #:clean) create-session () fixnum))
+(create-symbolic-link (#(procedure #:clean #:enforce) create-symbolic-link (string string) undefined))
;; extra arg for "parameterize" - ugh, what a hack...
-(current-directory (#(procedure #:enforce) current-directory (#!optional string *) string))
+(current-directory (#(procedure #:clean #:enforce) current-directory (#!optional string *) string))
-(current-effective-group-id (procedure current-effective-group-id () fixnum))
-(current-effective-user-id (procedure current-effective-user-id () fixnum))
-(current-effective-user-name (procedure current-effective-user-name () string))
+(current-effective-group-id (#(procedure #:clean) current-effective-group-id () fixnum))
+(current-effective-user-id (#(procedure #:clean) current-effective-user-id () fixnum))
+(current-effective-user-name (#(procedure #:clean) current-effective-user-name () string))
(current-environment deprecated)
-(get-environment-variables (procedure get-environment-variables () (list string)))
-(current-group-id (procedure current-group-id () fixnum))
-(current-process-id (procedure current-process-id () fixnum))
-(current-user-id (procedure current-user-id () fixnum))
-(current-user-name (procedure current-user-name () string))
-(delete-directory (#(procedure #:enforce) delete-directory (string) string))
-(directory (#(procedure #:enforce) directory (string #!optional *) (list string)))
-(directory? (#(procedure #:enforce) directory? ((or string fixnum)) boolean))
-(duplicate-fileno (#(procedure #:enforce) duplicate-fileno (fixnum #!optional fixnum) fixnum))
+(get-environment-variables (#(procedure #:clean) get-environment-variables () (list string)))
+(current-group-id (#(procedure #:clean) current-group-id () fixnum))
+(current-process-id (#(procedure #:clean) current-process-id () fixnum))
+(current-user-id (#(procedure #:clean) current-user-id () fixnum))
+(current-user-name (#(procedure #:clean) current-user-name () string))
+(delete-directory (#(procedure #:clean #:enforce) delete-directory (string) string))
+(directory (#(procedure #:clean #:enforce) directory (string #!optional *) (list string)))
+(directory? (#(procedure #:clean #:enforce) directory? ((or string fixnum)) boolean))
+(duplicate-fileno (#(procedure #:clean #:enforce) duplicate-fileno (fixnum #!optional fixnum) fixnum))
(errno/2big fixnum)
(errno/acces fixnum)
(errno/again fixnum)
@@ -1521,55 +1530,55 @@
(fcntl/getfl fixnum)
(fcntl/setfd fixnum)
(fcntl/setfl fixnum)
-(file-access-time (#(procedure #:enforce) file-access-time ((or string fixnum)) number))
-(file-change-time (#(procedure #:enforce) file-change-time ((or string fixnum)) number))
-(file-close (#(procedure #:enforce) file-close (fixnum) undefined))
-(file-control (#(procedure #:enforce) file-control (fixnum fixnum #!optional fixnum) fixnum))
-(file-creation-mode (#(procedure #:enforce) file-creation-mode (#!optional fixnum) fixnum))
-(file-execute-access? (#(procedure #:enforce) file-execute-access? (string) boolean))
-(file-link (#(procedure #:enforce) file-link (string string) undefined))
-(file-lock (#(procedure #:enforce) file-lock (port #!optional fixnum *) (struct lock)))
-(file-lock/blocking (#(procedure #:enforce) file-lock/blocking (port #!optional fixnum *) (struct lock)))
-(file-mkstemp (#(procedure #:enforce) file-mkstemp (string) fixnum string))
-(file-modification-time (#(procedure #:enforce) file-modification-time ((or string fixnum)) number))
-(file-open (#(procedure #:enforce) file-open (string fixnum #!optional fixnum) fixnum))
-(file-owner (#(procedure #:enforce) file-owner ((or string fixnum)) fixnum))
-(file-permissions (#(procedure #:enforce) file-permissions ((or string fixnum)) fixnum))
-(file-position (#(procedure #:enforce) file-position ((or port fixnum)) fixnum))
-(file-read (#(procedure #:enforce) file-read (fixnum fixnum #!optional *) list))
-(file-read-access? (#(procedure #:enforce) file-read-access? (string) boolean))
-(file-select (#(procedure #:enforce) file-select ((list fixnum) (list fixnum) #!optional fixnum) * *))
-(file-size (#(procedure #:enforce) file-size ((or string fixnum)) number))
-(file-stat (#(procedure #:enforce) file-stat ((or string fixnum) #!optional *) (vector number)))
-(file-test-lock (#(procedure #:enforce) file-test-lock (port #!optional fixnum *) boolean))
-(file-truncate (#(procedure #:enforce) file-truncate ((or string fixnum) fixnum) undefined))
-(file-type (#(procedure #:enforce) ((or string fixnum) #!optional * *) symbol))
-(file-unlock (#(procedure #:enforce) file-unlock ((struct lock)) undefined))
-(file-write (#(procedure #:enforce) file-write (fixnum * #!optional fixnum) fixnum))
-(file-write-access? (#(procedure #:enforce) file-write-access? (string) boolean))
+(file-access-time (#(procedure #:clean #:enforce) file-access-time ((or string fixnum)) number))
+(file-change-time (#(procedure #:clean #:enforce) file-change-time ((or string fixnum)) number))
+(file-close (#(procedure #:clean #:enforce) file-close (fixnum) undefined))
+(file-control (#(procedure #:clean #:enforce) file-control (fixnum fixnum #!optional fixnum) fixnum))
+(file-creation-mode (#(procedure #:clean #:enforce) file-creation-mode (#!optional fixnum) fixnum))
+(file-execute-access? (#(procedure #:clean #:enforce) file-execute-access? (string) boolean))
+(file-link (#(procedure #:clean #:enforce) file-link (string string) undefined))
+(file-lock (#(procedure #:clean #:enforce) file-lock (port #!optional fixnum *) (struct lock)))
+(file-lock/blocking (#(procedure #:clean #:enforce) file-lock/blocking (port #!optional fixnum *) (struct lock)))
+(file-mkstemp (#(procedure #:clean #:enforce) file-mkstemp (string) fixnum string))
+(file-modification-time (#(procedure #:clean #:enforce) file-modification-time ((or string fixnum)) number))
+(file-open (#(procedure #:clean #:enforce) file-open (string fixnum #!optional fixnum) fixnum))
+(file-owner (#(procedure #:clean #:enforce) file-owner ((or string fixnum)) fixnum))
+(file-permissions (#(procedure #:clean #:enforce) file-permissions ((or string fixnum)) fixnum))
+(file-position (#(procedure #:clean #:enforce) file-position ((or port fixnum)) fixnum))
+(file-read (#(procedure #:clean #:enforce) file-read (fixnum fixnum #!optional *) list))
+(file-read-access? (#(procedure #:clean #:enforce) file-read-access? (string) boolean))
+(file-select (#(procedure #:clean #:enforce) file-select ((list fixnum) (list fixnum) #!optional fixnum) * *))
+(file-size (#(procedure #:clean #:enforce) file-size ((or string fixnum)) number))
+(file-stat (#(procedure #:clean #:enforce) file-stat ((or string fixnum) #!optional *) (vector number)))
+(file-test-lock (#(procedure #:clean #:enforce) file-test-lock (port #!optional fixnum *) boolean))
+(file-truncate (#(procedure #:clean #:enforce) file-truncate ((or string fixnum) fixnum) undefined))
+(file-type (#(procedure #:clean #:enforce) ((or string fixnum) #!optional * *) symbol))
+(file-unlock (#(procedure #:clean #:enforce) file-unlock ((struct lock)) undefined))
+(file-write (#(procedure #:clean #:enforce) file-write (fixnum * #!optional fixnum) fixnum))
+(file-write-access? (#(procedure #:clean #:enforce) file-write-access? (string) boolean))
(fileno/stderr fixnum)
(fileno/stdin fixnum)
(fileno/stdout fixnum)
(find-files (#(procedure #:enforce) find-files (string #!rest) list))
-(get-groups (procedure get-groups () list))
-(get-host-name (procedure get-host-name () string))
-(glob (#(procedure #:enforce) glob (#!rest string) list))
-(group-information (#(procedure #:enforce) group-information (fixnum #!optional *) *))
-(initialize-groups (#(procedure #:enforce) initialize-groups (string fixnum) undefined))
-(local-time->seconds (#(procedure #:enforce) local-time->seconds ((vector number)) number))
-(local-timezone-abbreviation (procedure local-timezone-abbreviation () string))
-(map-file-to-memory (#(procedure #:enforce) map-file-to-memory (* fixnum fixnum fixnum fixnum #!optional fixnum) (struct mmap)))
+(get-groups (#(procedure #:clean) get-groups () list))
+(get-host-name (#(procedure #:clean) get-host-name () string))
+(glob (#(procedure #:clean #:enforce) glob (#!rest string) list))
+(group-information (#(procedure #:clean #:enforce) group-information (fixnum #!optional *) *))
+(initialize-groups (#(procedure #:clean #:enforce) initialize-groups (string fixnum) undefined))
+(local-time->seconds (#(procedure #:clean #:enforce) local-time->seconds ((vector number)) number))
+(local-timezone-abbreviation (#(procedure #:clean) local-timezone-abbreviation () string))
+(map-file-to-memory (#(procedure #:clean #:enforce) map-file-to-memory (* fixnum fixnum fixnum fixnum #!optional fixnum) (struct mmap)))
(map/anonymous fixnum)
(map/file fixnum)
(map/fixed fixnum)
(map/private fixnum)
(map/shared fixnum)
-(memory-mapped-file-pointer (#(procedure #:enforce) memory-mapped-file-pointer ((struct mmap)) pointer))
-(memory-mapped-file? (procedure memory-mapped-file? (*) boolean))
-(open-input-file* (#(procedure #:enforce) open-input-file* (fixnum #!optional symbol) port))
-(open-input-pipe (#(procedure #:enforce) open-input-pipe (string #!optional symbol) port))
-(open-output-file* (#(procedure #:enforce) open-output-file* (fixnum #!optional symbol) port))
-(open-output-pipe (#(procedure #:enforce) open-output-pipe (string #!optional symbol) port))
+(memory-mapped-file-pointer (#(procedure #:clean #:enforce) memory-mapped-file-pointer ((struct mmap)) pointer))
+(memory-mapped-file? (#(procedure #:clean #:predicate (struct mmap)) memory-mapped-file? (*) boolean))
+(open-input-file* (#(procedure #:clean #:enforce) open-input-file* (fixnum #!optional symbol) port))
+(open-input-pipe (#(procedure #:clean #:enforce) open-input-pipe (string #!optional symbol) port))
+(open-output-file* (#(procedure #:clean #:enforce) open-output-file* (fixnum #!optional symbol) port))
+(open-output-pipe (#(procedure #:clean #:enforce) open-output-pipe (string #!optional symbol) port))
(open/append fixnum)
(open/binary fixnum)
(open/creat fixnum)
@@ -1585,7 +1594,7 @@
(open/trunc fixnum)
(open/write fixnum)
(open/wronly fixnum)
-(parent-process-id (procedure parent-process-id () fixnum))
+(parent-process-id (#(procedure #:clean) parent-process-id () fixnum))
(perm/irgrp fixnum)
(perm/iroth fixnum)
(perm/irusr fixnum)
@@ -1602,43 +1611,43 @@
(perm/ixoth fixnum)
(perm/ixusr fixnum)
(pipe/buf fixnum)
-(port->fileno (#(procedure #:enforce) port->fileno (port) fixnum))
-(process (#(procedure #:enforce) process (string #!optional (list string) (list string)) port port fixnum))
-(process* (#(procedure #:enforce) process* (string #!optional (list string) (list string)) port port fixnum *))
+(port->fileno (#(procedure #:clean #:enforce) port->fileno (port) fixnum))
+(process (#(procedure #:clean #:enforce) process (string #!optional (list string) (list string)) port port fixnum))
+(process* (#(procedure #:clean #:enforce) process* (string #!optional (list string) (list string)) port port fixnum *))
(process-execute
- (#(procedure #:enforce) process-execute (string #!optional (list string) (list string)) noreturn))
+ (#(procedure #:clean #:enforce) process-execute (string #!optional (list string) (list string)) noreturn))
(process-fork (#(procedure #:enforce) process-fork (#!optional (procedure () . *)) fixnum))
-(process-group-id (#(procedure #:enforce) process-group-id () fixnum))
-(process-run (#(procedure #:enforce) process-run (string #!optional (list string)) fixnum))
-(process-signal (#(procedure #:enforce) process-signal (fixnum #!optional fixnum) undefined))
-(process-wait (#(procedure #:enforce) process-wait (fixnum #!optional *) fixnum fixnum fixnum))
+(process-group-id (#(procedure #:clean #:enforce) process-group-id () fixnum))
+(process-run (#(procedure #:clean #:enforce) process-run (string #!optional (list string)) fixnum))
+(process-signal (#(procedure #:clean #:enforce) process-signal (fixnum #!optional fixnum) undefined))
+(process-wait (#(procedure #:clean #:enforce) process-wait (fixnum #!optional *) fixnum fixnum fixnum))
(prot/exec fixnum)
(prot/none fixnum)
(prot/read fixnum)
(prot/write fixnum)
-(read-symbolic-link (#(procedure #:enforce) read-symbolic-link (string) string))
-(regular-file? (#(procedure #:enforce) regular-file? ((or string fixnum)) boolean))
-(seconds->local-time (#(procedure #:enforce) seconds->local-time (#!optional number) (vector number)))
-(seconds->string (#(procedure #:enforce) seconds->string (#!optional number) string))
-(seconds->utc-time (#(procedure #:enforce) seconds->utc-time (#!optional number) (vector number)))
+(read-symbolic-link (#(procedure #:clean #:enforce) read-symbolic-link (string) string))
+(regular-file? (#(procedure #:clean #:enforce) regular-file? ((or string fixnum)) boolean))
+(seconds->local-time (#(procedure #:clean #:enforce) seconds->local-time (#!optional number) (vector number)))
+(seconds->string (#(procedure #:clean #:enforce) seconds->string (#!optional number) string))
+(seconds->utc-time (#(procedure #:clean #:enforce) seconds->utc-time (#!optional number) (vector number)))
(seek/cur fixnum)
(seek/end fixnum)
(seek/set fixnum)
-(set-alarm! (#(procedure #:enforce) set-alarm! (number) number))
-(set-buffering-mode! (#(procedure #:enforce) set-buffering-mode! (port symbol #!optional fixnum) undefined))
-(set-file-position! (#(procedure #:enforce) set-file-position! ((or port fixnum) fixnum #!optional fixnum) undefined))
-(set-groups! (#(procedure #:enforce) set-groups! (list) undefined))
-(set-root-directory! (#(procedure #:enforce) set-root-directory! (string) undefined))
-(set-signal-handler! (#(procedure #:enforce) set-signal-handler! (fixnum (procedure (fixnum) . *)) undefined))
-(set-signal-mask! (#(procedure #:enforce) set-signal-mask! ((list fixnum)) undefined))
-(setenv (#(procedure #:enforce) setenv (string string) undefined))
-(signal-handler (#(procedure #:enforce) signal-handler (fixnum) (procedure (fixnum) . *)))
-(signal-mask (procedure signal-mask () fixnum))
-(signal-mask! (#(procedure #:enforce) signal-mask! (fixnum) undefined))
-(signal-masked? (#(procedure #:enforce) signal-masked? (fixnum) boolean))
-(signal-unmask! (#(procedure #:enforce) signal-unmask! (fixnum) undefined))
+(set-alarm! (#(procedure #:clean #:enforce) set-alarm! (number) number))
+(set-buffering-mode! (#(procedure #:clean #:enforce) set-buffering-mode! (port symbol #!optional fixnum) undefined))
+(set-file-position! (#(procedure #:clean #:enforce) set-file-position! ((or port fixnum) fixnum #!optional fixnum) undefined))
+(set-groups! (#(procedure #:clean #:enforce) set-groups! (list) undefined))
+(set-root-directory! (#(procedure #:clean #:enforce) set-root-directory! (string) undefined))
+(set-signal-handler! (#(procedure #:clean #:enforce) set-signal-handler! (fixnum (procedure (fixnum) . *)) undefined))
+(set-signal-mask! (#(procedure #:clean #:enforce) set-signal-mask! ((list fixnum)) undefined))
+(setenv (#(procedure #:clean #:enforce) setenv (string string) undefined))
+(signal-handler (#(procedure #:clean #:enforce) signal-handler (fixnum) (procedure (fixnum) . *)))
+(signal-mask (#(procedure #:clean) signal-mask () fixnum))
+(signal-mask! (#(procedure #:clean #:enforce) signal-mask! (fixnum) undefined))
+(signal-masked? (#(procedure #:clean #:enforce) signal-masked? (fixnum) boolean))
+(signal-unmask! (#(procedure #:clean #:enforce) signal-unmask! (fixnum) undefined))
(signal/abrt fixnum)
(signal/alrm fixnum)
(signal/chld fixnum)
@@ -1665,30 +1674,30 @@
(signal/xcpu fixnum)
(signal/xfsz fixnum)
(signals-list list)
-(sleep (#(procedure #:enforce) sleep (fixnum) fixnum))
-(block-device? (#(procedure #:enforce) block-device? ((or string fixnum)) boolean))
-(character-device? (#(procedure #:enforce) character-device? ((or string fixnum)) boolean))
-(fifo? (#(procedure #:enforce) fifo? ((or string fixnum)) boolean))
-(socket? (#(procedure #:enforce) socket? ((or string fixnum)) boolean))
-(string->time (#(procedure #:enforce) string->time (string #!optional string) vector))
-(symbolic-link? (#(procedure #:enforce) symbolic-link? ((or string fixnum)) boolean))
-(system-information (procedure system-information () list))
-(terminal-name (#(procedure #:enforce) terminal-name (port) string))
-(terminal-port? (#(procedure #:enforce) terminal-port? (port) boolean))
-(terminal-size (#(procedure #:enforce) terminal-size (port) fixnum fixnum))
-(time->string (#(procedure #:enforce) time->string (vector #!optional string) string))
-(unmap-file-from-memory (#(procedure #:enforce) unmap-file-from-memory ((struct mmap) #!optional fixnum) undefined))
-(unsetenv (#(procedure #:enforce) unsetenv (string) undefined))
-(user-information (#(procedure #:enforce) user-information ((or string fixnum) #!optional *) *))
-(utc-time->seconds (#(procedure #:enforce) utc-time->seconds ((vector number)) number))
+(sleep (#(procedure #:clean #:enforce) sleep (fixnum) fixnum))
+(block-device? (#(procedure #:clean #:enforce) block-device? ((or string fixnum)) boolean))
+(character-device? (#(procedure #:clean #:enforce) character-device? ((or string fixnum)) boolean))
+(fifo? (#(procedure #:clean #:enforce) fifo? ((or string fixnum)) boolean))
+(socket? (#(procedure #:clean #:enforce) socket? ((or string fixnum)) boolean))
+(string->time (#(procedure #:clean #:enforce) string->time (string #!optional string) vector))
+(symbolic-link? (#(procedure #:clean #:enforce) symbolic-link? ((or string fixnum)) boolean))
+(system-information (#(procedure #:clean) system-information () list))
+(terminal-name (#(procedure #:clean #:enforce) terminal-name (port) string))
+(terminal-port? (#(procedure #:clean #:enforce) terminal-port? (port) boolean))
+(terminal-size (#(procedure #:clean #:enforce) terminal-size (port) fixnum fixnum))
+(time->string (#(procedure #:clean #:enforce) time->string (vector #!optional string) string))
+(unmap-file-from-memory (#(procedure #:clean #:enforce) unmap-file-from-memory ((struct mmap) #!optional fixnum) undefined))
+(unsetenv (#(procedure #:clean #:enforce) unsetenv (string) undefined))
+(user-information (#(procedure #:clean #:enforce) user-information ((or string fixnum) #!optional *) *))
+(utc-time->seconds (#(procedure #:clean #:enforce) utc-time->seconds ((vector number)) number))
(with-input-from-pipe (#(procedure #:enforce) with-input-from-pipe (string (procedure () . *) #!optional symbol) . *))
(with-output-to-pipe (#(procedure #:enforce) with-output-to-pipe (string (procedure () . *) #!optional symbol) . *))
;; srfi-1
-(alist-cons (forall (a b c) (procedure alist-cons (a b (list c)) (pair a (pair b (list c))))))
-(alist-copy (forall (a) (#(procedure #:enforce) alist-copy ((list a)) (list a))))
+(alist-cons (forall (a b c) (#(procedure #:clean) alist-cons (a b (list c)) (pair a (pair b (list c))))))
+(alist-copy (forall (a) (#(procedure #:clean #:enforce) alist-copy ((list a)) (list a))))
(alist-delete (forall (a b) (#(procedure #:enforce) alist-delete (a (list b) #!optional (procedure (a b) *)) list)))
(alist-delete! (forall (a b) (#(procedure #:enforce) alist-delete! (a (list b) #!optional (procedure (a b) *)) undefined)))
(any (forall (a) (#(procedure #:enforce) any ((procedure (a #!rest) *) (list a) #!rest list) *)))
@@ -1702,19 +1711,19 @@
(forall (a b) (#(procedure #:enforce) append-map! ((procedure (a #!rest) (list b)) (list a) #!rest list)
(list b))))
-(append-reverse (#(procedure #:enforce) append-reverse (list list) list))
+(append-reverse (#(procedure #:clean #:enforce) append-reverse (list list) list))
(append-reverse! (#(procedure #:enforce) append-reverse! (list list) list))
(break (forall (a) (#(procedure #:enforce) break ((procedure (a) *) (list a)) (list a) (list a))))
(break! (forall (a) (#(procedure #:enforce) break! ((procedure (a) *) (list a)) (list a) (list a))))
-(car+cdr (forall (a b) (#(procedure #:enforce) car+cdr ((pair a b)) a b)))
-(circular-list (procedure circular-list (#!rest) list))
+(car+cdr (forall (a b) (#(procedure #:clean #:enforce) car+cdr ((pair a b)) a b)))
+(circular-list (#(procedure #:clean) circular-list (#!rest) list))
-(circular-list? (procedure circular-list? (*) boolean)
+(circular-list? (#(procedure #:clean) circular-list? (*) boolean)
((null) (let ((#(tmp) #(1))) '#f)))
-(concatenate (#(procedure #:enforce) concatenate ((list list)) list))
+(concatenate (#(procedure #:clean #:enforce) concatenate ((list list)) list))
(concatenate! (#(procedure #:enforce) concatenate! ((list list)) list))
-(cons* (forall (a) (procedure cons* (a #!rest) (pair a *))))
+(cons* (forall (a) (#(procedure #:clean) cons* (a #!rest) (pair a *))))
(count (forall (a) (#(procedure #:enforce) count ((procedure (a #!rest) *) (list a) #!rest list) fixnum)))
(delete (forall (a b) (#(procedure #:enforce) delete (a (list b) #!optional (procedure (a *) *)) (list b))))
(delete! (forall (a b) (#(procedure #:enforce) delete! (a (list b) #!optional (procedure (a *) *)) (list b))))
@@ -1725,17 +1734,17 @@
(delete-duplicates!
(forall (a) (#(procedure #:enforce) delete-duplicates! ((list a) #!optional (procedure (a *) *)) (list a))))
-(dotted-list? (procedure dotted-list? (*) boolean))
+(dotted-list? (#(procedure #:clean) dotted-list? (*) boolean))
(drop (forall (a) (#(procedure #:enforce) drop ((list a) fixnum) (list a))))
(drop-right (forall (a) (#(procedure #:enforce) drop-right ((list a) fixnum) (list a))))
(drop-right! (forall (a) (#(procedure #:enforce) drop-right! ((list a) fixnum) (list a))))
(drop-while (forall (a) (#(procedure #:enforce) drop-while ((procedure (a) *) (list a)) (list a))))
-(eighth (#(procedure #:enforce) eighth (pair) *))
+(eighth (#(procedure #:clean #:enforce) eighth (pair) *))
(every
(forall (a) (#(procedure #:enforce) every ((procedure (a #!rest) *) (list a) #!rest list) *)))
-(fifth (#(procedure #:enforce) fifth (pair) *))
+(fifth (#(procedure #:clean #:enforce) fifth (pair) *))
(filter (forall (a) (#(procedure #:enforce) filter ((procedure (a) *) (list a)) (list a))))
(filter! (forall (a) (#(procedure #:enforce) filter! ((procedure (a) *) (list a)) (list a))))
@@ -1745,27 +1754,27 @@
(find (forall (a) (#(procedure #:enforce) find ((procedure (a) *) (list a)) *)))
(find-tail (forall (a) (#(procedure #:enforce) find-tail ((procedure (a) *) (list a)) *)))
-(first (forall (a) (#(procedure #:enforce) first ((pair a *)) a))
+(first (forall (a) (#(procedure #:clean #:enforce) 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 #:enforce) fourth ((pair * (pair * (pair * (pair a *))))) a))
+(fourth (forall (a) (#(procedure #:clean #:enforce) fourth ((pair * (pair * (pair * (pair a *))))) a))
(((pair * (pair * (pair * (pair * *)))))
(##core#inline "C_u_i_car"
(##core#inline "C_u_i_cdr"
(##core#inline "C_u_i_cdr"
(##core#inline "C_u_i_cdr" #(1)))))))
-(iota (#(procedure #:enforce) iota (fixnum #!optional fixnum fixnum) (list number)))
-(last (#(procedure #:enforce) last (pair) *))
-(last-pair (#(procedure #:enforce) last-pair (pair) *))
-(length+ (#(procedure #:enforce) length+ (list) *))
-(list-copy (forall (a) (#(procedure #:enforce) list-copy ((list a)) (list a))))
+(iota (#(procedure #:clean #:enforce) iota (fixnum #!optional fixnum fixnum) (list number)))
+(last (#(procedure #:clean #:enforce) last (pair) *))
+(last-pair (#(procedure #:clean #:enforce) last-pair (pair) *))
+(length+ (#(procedure #:clean #:enforce) length+ (list) *))
+(list-copy (forall (a) (#(procedure #:clean #:enforce) list-copy ((list a)) (list a))))
(list-index (forall (a) (#(procedure #:enforce) list-index ((procedure (a #!rest) *) (list a) #!rest list) *)))
(list-tabulate (forall (a) (#(procedure #:enforce) list-tabulate (fixnum (procedure (fixnum) a)) (list a))))
-(list= (#(procedure #:enforce) list= (#!rest list) boolean))
+(list= (#(procedure #:clean #:enforce) list= (#!rest list) boolean))
(lset-adjoin
(forall (a) (#(procedure #:enforce) lset-adjoin ((procedure (a a) *) (list a) #!rest a) (list a))))
@@ -1811,7 +1820,7 @@
(forall (a) (#(procedure #:enforce) lset= ((procedure (a a) *) (list a) #!rest (list a)) boolean)))
;; see note about "make-vector", above
-(make-list (forall (a) (#(procedure #:enforce) make-list (fixnum #!optional a) list)))
+(make-list (forall (a) (#(procedure #:clean #:enforce) make-list (fixnum #!optional a) list)))
(map!
(forall (a b) (#(procedure #:enforce) map! ((procedure (a #!rest) b) (list a) #!rest list) (list b))))
@@ -1821,13 +1830,13 @@
(a b)
(#(procedure #:enforce) map-in-order ((procedure (a #!rest) b) (list a) #!rest list) (list b))))
-(ninth (#(procedure #:enforce) ninth (pair) *))
+(ninth (#(procedure #:clean #:enforce) ninth (pair) *))
-(not-pair? (procedure not-pair? (*) boolean)
+(not-pair? (#(procedure #:clean) not-pair? (*) boolean)
((pair) (let ((#(tmp) #(1))) '#f))
(((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
-(null-list? (#(procedure #:enforce) null-list? (list) boolean)
+(null-list? (#(procedure #:clean #:enforce) null-list? (list) boolean)
((pair) (let ((#(tmp) #(1))) '#f))
((list) (let ((#(tmp) #(1))) '#f))
((null) (let ((#(tmp) #(1))) '#t)))
@@ -1838,7 +1847,7 @@
(partition (forall (a) (#(procedure #:enforce) partition ((procedure (a) *) (list a)) (list a) (list a))))
(partition! (forall (a) (#(procedure #:enforce) partition! ((procedure (a) *) (list a)) (list a) (list a))))
-(proper-list? (procedure proper-list? (*) boolean)
+(proper-list? (#(procedure #:clean) proper-list? (*) boolean)
((null) (let ((#(tmp) #(1))) '#t)))
(reduce (#(procedure #:enforce) reduce ((procedure (* *) *) * list) *)) ;XXX
@@ -1847,11 +1856,11 @@
(remove! (forall (a) (#(procedure #:enforce) remove! ((procedure (a) *) (list a)) (list a))))
(reverse! (forall (a) (#(procedure #:enforce) reverse! ((list a)) (list a))))
-(second (forall (a) (#(procedure #:enforce) second ((pair * (pair a *))) a))
+(second (forall (a) (#(procedure #:clean #:enforce) second ((pair * (pair a *))) a))
(((pair * (pair * *))) (##core#inline "C_u_i_car" (##core#inline "C_u_i_cdr" #(1)))))
-(seventh (#(procedure #:enforce) seventh (pair) *))
-(sixth (#(procedure #:enforce) sixth (pair) *))
+(seventh (#(procedure #:clean #:enforce) seventh (pair) *))
+(sixth (#(procedure #:clean #:enforce) sixth (pair) *))
(span (forall (a) (#(procedure #:enforce) span ((procedure (a) *) (list a)) (list a) (list a))))
(span! (forall (a) (#(procedure #:enforce) span! ((procedure (a) *) (list a)) (list a) (list a))))
(split-at (forall (a) (#(procedure #:enforce) split-at ((list a) fixnum) (list a) (list a))))
@@ -1861,32 +1870,32 @@
(take-right (forall (a) (#(procedure #:enforce) take-right ((list a) fixnum) (list a))))
(take-while (forall (a) (#(procedure #:enforce) take-while ((procedure (a) *) (list a)) (list a))))
(take-while! (forall (a) (#(procedure #:enforce) take-while! ((procedure (a) *) (list a)) (list a))))
-(tenth (#(procedure #:enforce) tenth (pair) *))
+(tenth (#(procedure #:clean #:enforce) tenth (pair) *))
-(third (forall (a) (#(procedure #:enforce) third ((pair * (pair * (pair a *)))) a))
+(third (forall (a) (#(procedure #:clean #:enforce) 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))))))
(unfold (#(procedure #:enforce) unfold ((procedure (*) *) (procedure (*) *) (procedure (*) *) * #!optional (procedure (*) *)) *)) ;XXX
(unfold-right (#(procedure #:enforce) unfold-right ((procedure (*) *) (procedure (*) *) (procedure (*) *) * #!optional (procedure (*) *)) *)) ;XXX
-(unzip1 (forall (a) (#(procedure #:enforce) unzip1 ((list (pair a *))) (list a))))
-(unzip2 (forall (a b) (#(procedure #:enforce) unzip2 ((list (pair a (pair b *)))) (list a) (list b))))
+(unzip1 (forall (a) (#(procedure #:clean #:enforce) unzip1 ((list (pair a *))) (list a))))
+(unzip2 (forall (a b) (#(procedure #:clean #:enforce) unzip2 ((list (pair a (pair b *)))) (list a) (list b))))
(unzip3
- (forall (a b c) (#(procedure #:enforce) unzip3 ((list (pair a (pair b (pair c *))))) (list a) (list b) (list c))))
+ (forall (a b c) (#(procedure #:clean #:enforce) unzip3 ((list (pair a (pair b (pair c *))))) (list a) (list b) (list c))))
-(unzip4 (#(procedure #:enforce) unzip4 (list) list list list list)) ; yeah
-(unzip5 (#(procedure #:enforce) unzip5 (list) list list list list list)) ; yeah, too
-(xcons (forall (a b) (procedure xcons (a b) (pair b a))))
-(zip (forall (a) (#(procedure #:enforce) zip ((list a) #!rest list) (list (pair a *)))))
+(unzip4 (#(procedure #:clean #:enforce) unzip4 (list) list list list list)) ; yeah
+(unzip5 (#(procedure #:clean #:enforce) unzip5 (list) list list list list list)) ; yeah, too
+(xcons (forall (a b) (#(procedure #:pure) xcons (a b) (pair b a))))
+(zip (forall (a) (#(procedure #:clean #:enforce) zip ((list a) #!rest list) (list (pair a *)))))
;; srfi-13
-(check-substring-spec (#(procedure #:enforce) check-substring-spec (* string fixnum fixnum) undefined))
+(check-substring-spec (#(procedure #:clean #:enforce) check-substring-spec (* string fixnum fixnum) undefined))
(kmp-step (#(procedure #:enforce) kmp-step (string vector char fixnum (procedure (char char) *) fixnum) fixnum))
-(make-kmp-restart-vector (#(procedure #:enforce) make-kmp-restart-vector (string #!optional (procedure (* *) *) fixnum fixnum) vector))
+(make-kmp-restart-vector (#(procedure #:clean #:enforce) make-kmp-restart-vector (string #!optional (procedure (* *) *) fixnum fixnum) vector))
(string-any
(#(procedure #:enforce)
@@ -1894,43 +1903,43 @@
((or char (struct char-set) (procedure (char) *)) string #!optional fixnum fixnum)
boolean))
-(string-append/shared (#(procedure #:enforce) string-append/shared (#!rest string) string)
+(string-append/shared (#(procedure #:clean #:enforce) string-append/shared (#!rest string) string)
((string string) (##sys#string-append #(1) #(2))))
-(string-ci< (#(procedure #:enforce) string-ci< (string string #!optional fixnum fixnum) boolean)
+(string-ci< (#(procedure #:clean #:enforce) string-ci< (string string #!optional fixnum fixnum) boolean)
((string string) (string-ci<? #(1) #(2))))
-(string-ci<= (#(procedure #:enforce) string-ci<= (string string #!optional fixnum fixnum) boolean)
+(string-ci<= (#(procedure #:clean #:enforce) string-ci<= (string string #!optional fixnum fixnum) boolean)
((string string) (string-ci<=? #(1) #(2))))
-(string-ci<> (#(procedure #:enforce) string-ci<> (string string #!optional fixnum fixnum) boolean)
+(string-ci<> (#(procedure #:clean #:enforce) string-ci<> (string string #!optional fixnum fixnum) boolean)
((string string) (not (##core#inline "C_i_string_ci_equal_p" #(1) #(2)))))
-(string-ci= (#(procedure #:enforce) string-ci= (string string #!optional fixnum fixnum) boolean)
+(string-ci= (#(procedure #:clean #:enforce) string-ci= (string string #!optional fixnum fixnum) boolean)
((string string) (##core#inline "C_i_string_ci_equal_p" #(1) #(2))))
-(string-ci> (#(procedure #:enforce) string-ci> (string string #!optional fixnum fixnum) boolean)
+(string-ci> (#(procedure #:clean #:enforce) string-ci> (string string #!optional fixnum fixnum) boolean)
((string string) (string-ci>? #(1) #(2))))
-(string-ci>= (#(procedure #:enforce) string-ci>= (string string #!optional fixnum fixnum) boolean)
+(string-ci>= (#(procedure #:clean #:enforce) string-ci>= (string string #!optional fixnum fixnum) boolean)
((string string) (string-ci>=? #(1) #(2))))
(string-compare (#(procedure #:enforce) string-compare (string string (procedure (fixnum) *) (procedure (fixnum) *) (procedure (fixnum) *) #!optional fixnum fixnum fixnum fixnum) *))
(string-compare-ci (#(procedure #:enforce) string-compare (string string (procedure (fixnum) *) (procedure (fixnum) *) (procedure (fixnum) *) #!optional fixnum fixnum fixnum fixnum) *))
-(string-concatenate (#(procedure #:enforce) string-concatenate ((list string)) string))
-(string-concatenate-reverse (#(procedure #:enforce) string-concatenate-reverse ((list string) #!optional string fixnum) string))
-(string-concatenate-reverse/shared (#(procedure #:enforce) string-concatenate-reverse/shared ((list string) #!optional string fixnum) string))
-(string-concatenate/shared (#(procedure #:enforce) string-concatenate/shared ((list string)) string))
-(string-contains (#(procedure #:enforce) string-contains (string string #!optional fixnum fixnum fixnum fixnum) (or fixnum boolean)))
-(string-contains-ci (#(procedure #:enforce) string-contains-ci (string string #!optional fixnum fixnum fixnum fixnum) (or fixnum boolean)))
-(string-copy (#(procedure #:enforce) string-copy (string #!optional fixnum fixnum) string))
-(string-copy! (#(procedure #:enforce) string-copy! (string fixnum string #!optional fixnum fixnum) undefined))
-(string-count (#(procedure #:enforce) string-count (string * #!optional fixnum fixnum) fixnum))
-(string-delete (#(procedure #:enforce) string-delete (* string #!optional fixnum fixnum) string))
-(string-downcase (#(procedure #:enforce) string-downcase (string #!optional fixnum fixnum) string))
-(string-downcase! (#(procedure #:enforce) string-downcase! (string #!optional fixnum fixnum) string))
-(string-drop (#(procedure #:enforce) string-drop (string fixnum) string))
-(string-drop-right (#(procedure #:enforce) string-drop-right (string fixnum) string))
+(string-concatenate (#(procedure #:clean #:enforce) string-concatenate ((list string)) string))
+(string-concatenate-reverse (#(procedure #:clean #:enforce) string-concatenate-reverse ((list string) #!optional string fixnum) string))
+(string-concatenate-reverse/shared (#(procedure #:clean #:enforce) string-concatenate-reverse/shared ((list string) #!optional string fixnum) string))
+(string-concatenate/shared (#(procedure #:clean #:enforce) string-concatenate/shared ((list string)) string))
+(string-contains (#(procedure #:clean #:enforce) string-contains (string string #!optional fixnum fixnum fixnum fixnum) (or fixnum boolean)))
+(string-contains-ci (#(procedure #:clean #:enforce) string-contains-ci (string string #!optional fixnum fixnum fixnum fixnum) (or fixnum boolean)))
+(string-copy (#(procedure #:clean #:enforce) string-copy (string #!optional fixnum fixnum) string))
+(string-copy! (#(procedure #:clean #:enforce) string-copy! (string fixnum string #!optional fixnum fixnum) undefined))
+(string-count (#(procedure #:clean #:enforce) string-count (string * #!optional fixnum fixnum) fixnum))
+(string-delete (#(procedure #:clean #:enforce) string-delete (* string #!optional fixnum fixnum) string))
+(string-downcase (#(procedure #:clean #:enforce) string-downcase (string #!optional fixnum fixnum) string))
+(string-downcase! (#(procedure #:clean #:enforce) string-downcase! (string #!optional fixnum fixnum) string))
+(string-drop (#(procedure #:clean #:enforce) string-drop (string fixnum) string))
+(string-drop-right (#(procedure #:clean #:enforce) string-drop-right (string fixnum) string))
(string-every
(#(procedure #:enforce)
@@ -1938,7 +1947,7 @@
((or char (struct char-set) (procedure (char) *)) string #!optional fixnum fixnum)
boolean))
-(string-fill! (#(procedure #:enforce) string-fill! (string char #!optional fixnum fixnum) string))
+(string-fill! (#(procedure #:clean #:enforce) string-fill! (string char #!optional fixnum fixnum) string))
(string-filter
(#(procedure #:enforce)
@@ -1964,25 +1973,25 @@
(string (or char (struct char-set) (procedure (char) *)) #!optional fixnum fixnum)
(or fixnum boolean)))
-(string-join (#(procedure #:enforce) string-join (list #!optional string symbol) string))
+(string-join (#(procedure #:clean #:enforce) string-join (list #!optional string symbol) string))
(string-kmp-partial-search (#(procedure #:enforce) string-kmp-partial-search (string vector string fixnum #!optional (procedure (char char) *) fixnum fixnum fixnum) fixnum))
(string-map (#(procedure #:enforce) string-map ((procedure (char) char) string #!optional fixnum fixnum) string))
(string-map! (#(procedure #:enforce) string-map! ((procedure (char) char) string #!optional fixnum fixnum) string))
-(string-null? (#(procedure #:enforce) string-null? (string) boolean)
+(string-null? (#(procedure #:clean #:enforce) string-null? (string) boolean)
((string) (##core#inline "C_zero_length_p" #(1))))
-(string-pad (#(procedure #:enforce) string-pad (string fixnum #!optional char fixnum fixnum) string))
-(string-pad-right (#(procedure #:enforce) string-pad-right (string fixnum #!optional char fixnum fixnum) string))
+(string-pad (#(procedure #:clean #:enforce) string-pad (string fixnum #!optional char fixnum fixnum) string))
+(string-pad-right (#(procedure #:clean #:enforce) string-pad-right (string fixnum #!optional char fixnum fixnum) string))
(string-parse-final-start+end (#(procedure #:enforce) string-parse-final-start+end (procedure string #!rest) . *))
(string-parse-start+end (#(procedure #:enforce) string-parse-start+end (procedure string #!rest) . *))
-(string-prefix-ci? (#(procedure #:enforce) string-prefix-ci? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
-(string-prefix-length (#(procedure #:enforce) string-prefix-length (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
-(string-prefix-length-ci (#(procedure #:enforce) string-prefix-length-ci (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
-(string-prefix? (#(procedure #:enforce) string-prefix? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
-(string-replace (#(procedure #:enforce) string-replace (string string fixnum fixnum #!optional fixnum fixnum) string))
-(string-reverse (#(procedure #:enforce) string-reverse (string #!optional fixnum fixnum) string))
-(string-reverse! (#(procedure #:enforce) string-reverse! (string #!optional fixnum fixnum) string))
+(string-prefix-ci? (#(procedure #:clean #:enforce) string-prefix-ci? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
+(string-prefix-length (#(procedure #:clean #:enforce) string-prefix-length (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
+(string-prefix-length-ci (#(procedure #:clean #:enforce) string-prefix-length-ci (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
+(string-prefix? (#(procedure #:clean #:enforce) string-prefix? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
+(string-replace (#(procedure #:clean #:enforce) string-replace (string string fixnum fixnum #!optional fixnum fixnum) string))
+(string-reverse (#(procedure #:clean #:enforce) string-reverse (string #!optional fixnum fixnum) string))
+(string-reverse! (#(procedure #:clean #:enforce) string-reverse! (string #!optional fixnum fixnum) string))
(string-skip
(#(procedure #:enforce)
@@ -1996,21 +2005,21 @@
(string (or char (struct char-set) (procedure (char) *)) #!optional fixnum fixnum)
(or fixnum boolean)))
-(string-suffix-ci? (#(procedure #:enforce) string-suffix-ci? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
-(string-suffix-length (#(procedure #:enforce) string-suffix-length (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
-(string-suffix-length-ci (#(procedure #:enforce) string-suffix-length-ci (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
-(string-suffix? (#(procedure #:enforce) string-suffix? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
+(string-suffix-ci? (#(procedure #:clean #:enforce) string-suffix-ci? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
+(string-suffix-length (#(procedure #:clean #:enforce) string-suffix-length (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
+(string-suffix-length-ci (#(procedure #:clean #:enforce) string-suffix-length-ci (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
+(string-suffix? (#(procedure #:clean #:enforce) string-suffix? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
(string-tabulate (#(procedure #:enforce) string-tabulate ((procedure (fixnum) char) fixnum) string))
-(string-take (#(procedure #:enforce) string-take (string fixnum) string))
-(string-take-right (#(procedure #:enforce) string-take-right (string fixnum) string))
-(string-titlecase (#(procedure #:enforce) string-titlecase (string #!optional fixnum fixnum) string))
-(string-titlecase! (#(procedure #:enforce) string-titlecase! (string #!optional fixnum fixnum) string))
+(string-take (#(procedure #:clean #:enforce) string-take (string fixnum) string))
+(string-take-right (#(procedure #:clean #:enforce) string-take-right (string fixnum) string))
+(string-titlecase (#(procedure #:clean #:enforce) string-titlecase (string #!optional fixnum fixnum) string))
+(string-titlecase! (#(procedure #:clean #:enforce) string-titlecase! (string #!optional fixnum fixnum) string))
(string-tokenize
- (#(procedure #:enforce) string-tokenize (string #!optional (struct char-set) fixnum fixnum) list))
+ (#(procedure #:clean #:enforce) string-tokenize (string #!optional (struct char-set) fixnum fixnum) list))
(string-trim
- (#(procedure #:enforce)
+ (#(procedure #:enforce)
string-trim
(string #!optional (or char (struct char-set) (procedure (char) *)) fixnum fixnum)
string))
@@ -2029,31 +2038,31 @@
(string-unfold (#(procedure #:enforce) string-unfold (procedure procedure procedure * #!optional * procedure) string)) ;XXX
(string-unfold-right (#(procedure #:enforce) string-unfold-right (procedure procedure procedure * #!optional * procedure) string)) ;XXX
-(string-upcase (#(procedure #:enforce) string-upcase (string #!optional fixnum fixnum) string))
-(string-upcase! (#(procedure #:enforce) string-upcase! (string #!optional fixnum fixnum) string))
-(string-xcopy! (#(procedure #:enforce) string-xcopy! (string string string fixnum #!optional fixnum fixnum fixnum) string))
+(string-upcase (#(procedure #:clean #:enforce) string-upcase (string #!optional fixnum fixnum) string))
+(string-upcase! (#(procedure #:clean #:enforce) string-upcase! (string #!optional fixnum fixnum) string))
+(string-xcopy! (#(procedure #:clean #:enforce) string-xcopy! (string string string fixnum #!optional fixnum fixnum fixnum) string))
-(string< (#(procedure #:enforce) string< (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+(string< (#(procedure #:clean #:enforce) string< (string string #!optional fixnum fixnum fixnum fixnum) boolean)
((string string) (string<? #(1) #(2))))
-(string<= (#(procedure #:enforce) string<= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+(string<= (#(procedure #:clean #:enforce) string<= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
((string string) (string<=? #(1) #(2))))
-(string<> (#(procedure #:enforce) string<> (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+(string<> (#(procedure #:clean #:enforce) string<> (string string #!optional fixnum fixnum fixnum fixnum) boolean)
((string string) (not (##core#inline "C_i_string_equal_p" #(1) #(2)))))
-(string= (#(procedure #:enforce) string= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+(string= (#(procedure #:clean #:enforce) string= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
((string string) (##core#inline "C_i_string_equal_p" #(1) #(2))))
-(string> (#(procedure #:enforce) string> (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+(string> (#(procedure #:clean #:enforce) string> (string string #!optional fixnum fixnum fixnum fixnum) boolean)
((string string) (string>? #(1) #(2))))
-(string>= (#(procedure #:enforce) string>= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+(string>= (#(procedure #:clean #:enforce) string>= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
((string string) (string>=? #(1) #(2))))
-(substring-spec-ok? (#(procedure #:enforce) substring-spec-ok? (string fixnum fixnum) boolean))
-(substring/shared (#(procedure #:enforce) substring/shared (string fixnum #!optional fixnum) string))
-(xsubstring (#(procedure #:enforce) xsubstring (string fixnum #!optional fixnum fixnum fixnum) string))
+(substring-spec-ok? (#(procedure #:clean #:enforce) substring-spec-ok? (string fixnum fixnum) boolean))
+(substring/shared (#(procedure #:clean #:enforce) substring/shared (string fixnum #!optional fixnum) string))
+(xsubstring (#(procedure #:clean #:enforce) xsubstring (string fixnum #!optional fixnum fixnum fixnum) string))
;; srfi-14
@@ -2064,41 +2073,41 @@
((char) (char-set #(1))))
(char-set (#(procedure #:enforce) char-set (#!rest char) (struct char-set)))
-(char-set->list (#(procedure #:enforce) char-set->list ((struct char-set)) list))
-(char-set->string (#(procedure #:enforce) char-set->string ((struct char-set)) string))
-(char-set-adjoin (#(procedure #:enforce) char-set-adjoin ((struct char-set) #!rest char) (struct char-set)))
-(char-set-adjoin! (#(procedure #:enforce) char-set-adjoin! ((struct char-set) #!rest char) (struct char-set)))
+(char-set->list (#(procedure #:clean #:enforce) char-set->list ((struct char-set)) list))
+(char-set->string (#(procedure #:clean #:enforce) char-set->string ((struct char-set)) string))
+(char-set-adjoin (#(procedure #:clean #:enforce) char-set-adjoin ((struct char-set) #!rest char) (struct char-set)))
+(char-set-adjoin! (#(procedure #:clean #:enforce) char-set-adjoin! ((struct char-set) #!rest char) (struct char-set)))
(char-set-any (#(procedure #:enforce) char-set-any ((procedure (char) *) (struct char-set)) *))
-(char-set-complement (#(procedure #:enforce) char-set-complement ((struct char-set)) (struct char-set)))
-(char-set-complement! (#(procedure #:enforce) char-set-complement! ((struct char-set)) (struct char-set)))
-(char-set-contains? (#(procedure #:enforce) char-set-contains? ((struct char-set) char) boolean))
-(char-set-copy (#(procedure #:enforce) char-set-copy ((struct char-set)) (struct char-set)))
-(char-set-count (#(procedure #:enforce) char-set-count ((procedure (char) *) (struct char-set)) fixnum))
-(char-set-cursor (#(procedure #:enforce) char-set-cursor ((struct char-set)) fixnum))
-(char-set-cursor-next (#(procedure #:enforce) char-set-cursor-next ((struct char-set) fixnum) fixnum))
-(char-set-delete (#(procedure #:enforce) char-set-delete ((struct char-set) #!rest char) (struct char-set)))
-(char-set-delete! (#(procedure #:enforce) char-set-delete! ((struct char-set) #!rest char) (struct char-set)))
-(char-set-diff+intersection (#(procedure #:enforce) char-set-diff+intersection ((struct char-set) #!rest (struct char-set)) (struct char-set) (struct char-set)))
-(char-set-diff+intersection! (#(procedure #:enforce) char-set-diff+intersection! ((struct char-set) #!rest (struct char-set)) (struct char-set) (struct char-set)))
-(char-set-difference (#(procedure #:enforce) char-set-difference ((struct char-set) #!rest (struct char-set)) (struct char-set)))
-(char-set-difference! (#(procedure #:enforce) char-set-difference! ((struct char-set) #!rest (struct char-set)) (struct char-set)))
+(char-set-complement (#(procedure #:clean #:enforce) char-set-complement ((struct char-set)) (struct char-set)))
+(char-set-complement! (#(procedure #:clean #:enforce) char-set-complement! ((struct char-set)) (struct char-set)))
+(char-set-contains? (#(procedure #:clean #:enforce) char-set-contains? ((struct char-set) char) boolean))
+(char-set-copy (#(procedure #:clean #:enforce) char-set-copy ((struct char-set)) (struct char-set)))
+(char-set-count (#(procedure #:clean #:enforce) char-set-count ((procedure (char) *) (struct char-set)) fixnum))
+(char-set-cursor (#(procedure #:clean #:enforce) char-set-cursor ((struct char-set)) fixnum))
+(char-set-cursor-next (#(procedure #:clean #:enforce) char-set-cursor-next ((struct char-set) fixnum) fixnum))
+(char-set-delete (#(procedure #:clean #:enforce) char-set-delete ((struct char-set) #!rest char) (struct char-set)))
+(char-set-delete! (#(procedure #:clean #:enforce) char-set-delete! ((struct char-set) #!rest char) (struct char-set)))
+(char-set-diff+intersection (#(procedure #:clean #:enforce) char-set-diff+intersection ((struct char-set) #!rest (struct char-set)) (struct char-set) (struct char-set)))
+(char-set-diff+intersection! (#(procedure #:clean #:enforce) char-set-diff+intersection! ((struct char-set) #!rest (struct char-set)) (struct char-set) (struct char-set)))
+(char-set-difference (#(procedure #:clean #:enforce) char-set-difference ((struct char-set) #!rest (struct char-set)) (struct char-set)))
+(char-set-difference! (#(procedure #:clean #:enforce) char-set-difference! ((struct char-set) #!rest (struct char-set)) (struct char-set)))
(char-set-every (#(procedure #:enforce) char-set-every ((procedure (char) *) (struct char-set)) boolean))
(char-set-filter (#(procedure #:enforce) char-set-filter ((procedure (char) *) (struct char-set) #!optional (struct char-set)) (struct char-set)))
(char-set-filter! (#(procedure #:enforce) char-set-filter! ((procedure (char) *) (struct char-set) #!optional (struct char-set)) (struct char-set)))
(char-set-fold (#(procedure #:enforce) char-set-fold ((procedure (char *) *) * (struct char-set)) *))
(char-set-for-each (#(procedure #:enforce) char-set-for-each ((procedure (char) . *) (struct char-set)) undefined))
-(char-set-hash (#(procedure #:enforce) char-set-hash ((struct char-set) #!optional number) number))
-(char-set-intersection (#(procedure #:enforce) char-set-intersection (#!rest (struct char-set)) (struct char-set)))
-(char-set-intersection! (#(procedure #:enforce) char-set-intersection! (#!rest (struct char-set)) (struct char-set)))
+(char-set-hash (#(procedure #:clean #:enforce) char-set-hash ((struct char-set) #!optional number) number))
+(char-set-intersection (#(procedure #:clean #:enforce) char-set-intersection (#!rest (struct char-set)) (struct char-set)))
+(char-set-intersection! (#(procedure #:clean #:enforce) char-set-intersection! (#!rest (struct char-set)) (struct char-set)))
(char-set-map (#(procedure #:enforce) char-set-map ((procedure (char) char) (struct char-set)) (struct char-set)))
-(char-set-ref (#(procedure #:enforce) char-set-ref ((struct char-set) fixnum) char))
-(char-set-size (#(procedure #:enforce) char-set-size ((struct char-set)) fixnum))
+(char-set-ref (#(procedure #:clean #:enforce) char-set-ref ((struct char-set) fixnum) char))
+(char-set-size (#(procedure #:clean #:enforce) char-set-size ((struct char-set)) fixnum))
(char-set-unfold (#(procedure #:enforce) char-set-unfold (procedure procedure procedure * #!optional (struct char-set)) (struct char-set)))
(char-set-unfold! (#(procedure #:enforce) char-set-unfold! (procedure procedure procedure * (struct char-set)) (struct char-set)))
-(char-set-union (#(procedure #:enforce) char-set-union (#!rest (struct char-set)) (struct char-set)))
-(char-set-union! (#(procedure #:enforce) char-set-union! (#!rest (struct char-set)) (struct char-set)))
-(char-set-xor (#(procedure #:enforce) char-set-xor (#!rest (struct char-set)) (struct char-set)))
-(char-set-xor! (#(procedure #:enforce) char-set-xor! (#!rest (struct char-set)) (struct char-set)))
+(char-set-union (#(procedure #:clean #:enforce) char-set-union (#!rest (struct char-set)) (struct char-set)))
+(char-set-union! (#(procedure #:clean #:enforce) char-set-union! (#!rest (struct char-set)) (struct char-set)))
+(char-set-xor (#(procedure #:clean #:enforce) char-set-xor (#!rest (struct char-set)) (struct char-set)))
+(char-set-xor! (#(procedure #:clean #:enforce) char-set-xor! (#!rest (struct char-set)) (struct char-set)))
(char-set:ascii (struct char-set))
(char-set:blank (struct char-set))
(char-set:digit (struct char-set))
@@ -2116,345 +2125,345 @@
(char-set:title-case (struct char-set))
(char-set:upper-case (struct char-set))
(char-set:whitespace (struct char-set))
-(char-set<= (#(procedure #:enforce) char-set<= (#!rest (struct char-set)) boolean))
-(char-set= (#(procedure #:enforce) char-set= (#!rest (struct char-set)) boolean))
+(char-set<= (#(procedure #:clean #:enforce) char-set<= (#!rest (struct char-set)) boolean))
+(char-set= (#(procedure #:clean #:enforce) char-set= (#!rest (struct char-set)) boolean))
-(char-set? (#(procedure #:predicate (struct char-set)) char-set? (*) boolean))
+(char-set? (#(procedure #:pure #:predicate (struct char-set)) char-set? (*) boolean))
-(end-of-char-set? (#(procedure #:enforce) end-of-char-set? (fixnum) boolean))
-(list->char-set (#(procedure #:enforce) list->char-set (list #!optional (struct char-set)) (struct char-set)))
-(list->char-set! (#(procedure #:enforce) list->char-set! (list #!optional (struct char-set)) (struct char-set)))
-(string->char-set (#(procedure #:enforce) string->char-set (string #!optional (struct char-set)) (struct char-set)))
-(string->char-set! (#(procedure #:enforce) string->char-set! (string #!optional (struct char-set)) (struct char-set)))
-(ucs-range->char-set (#(procedure #:enforce) ucs-range->char-set (fixnum fixnum #!optional * (struct char-set)) (struct char-set)))
-(ucs-range->char-set! (#(procedure #:enforce) ucs-range->char-set! (fixnum fixnum #!optional * (struct char-set)) (struct char-set)))
+(end-of-char-set? (#(procedure #:clean #:enforce) end-of-char-set? (fixnum) boolean))
+(list->char-set (#(procedure #:clean #:enforce) list->char-set (list #!optional (struct char-set)) (struct char-set)))
+(list->char-set! (#(procedure #:clean #:enforce) list->char-set! (list #!optional (struct char-set)) (struct char-set)))
+(string->char-set (#(procedure #:clean #:enforce) string->char-set (string #!optional (struct char-set)) (struct char-set)))
+(string->char-set! (#(procedure #:clean #:enforce) string->char-set! (string #!optional (struct char-set)) (struct char-set)))
+(ucs-range->char-set (#(procedure #:clean #:enforce) ucs-range->char-set (fixnum fixnum #!optional * (struct char-set)) (struct char-set)))
+(ucs-range->char-set! (#(procedure #:clean #:enforce) ucs-range->char-set! (fixnum fixnum #!optional * (struct char-set)) (struct char-set)))
;; srfi-18
-(abandoned-mutex-exception? (procedure abandoned-mutex-exception? (*) boolean))
-(condition-variable-broadcast! (#(procedure #:enforce) condition-variable-broadcast! ((struct condition-variable)) undefined))
-(condition-variable-name (#(procedure #:enforce) condition-variable-name ((struct condition-variable)) *))
-(condition-variable-signal! (#(procedure #:enforce) condition-variable-signal! ((struct condition-variable)) undefined))
-(condition-variable-specific (#(procedure #:enforce) condition-variable-specific ((struct condition-variable)) *))
-(condition-variable-specific-set! (#(procedure #:enforce) condition-variable-specific-set! ((struct condition-variable) *) undefined))
+(abandoned-mutex-exception? (#(procedure #:pure) abandoned-mutex-exception? (*) boolean))
+(condition-variable-broadcast! (#(procedure #:clean #:enforce) condition-variable-broadcast! ((struct condition-variable)) undefined))
+(condition-variable-name (#(procedure #:clean #:enforce) condition-variable-name ((struct condition-variable)) *))
+(condition-variable-signal! (#(procedure #:clean #:enforce) condition-variable-signal! ((struct condition-variable)) undefined))
+(condition-variable-specific (#(procedure #:clean #:enforce) condition-variable-specific ((struct condition-variable)) *))
+(condition-variable-specific-set! (#(procedure #:clean #:enforce) condition-variable-specific-set! ((struct condition-variable) *) undefined))
-(condition-variable? (#(procedure #:predicate (struct condition-variable))
+(condition-variable? (#(procedure #:pure #:predicate (struct condition-variable))
condition-variable? (*)
boolean))
-(current-thread (procedure current-thread () (struct thread))) ;XXX
+(current-thread (#(procedure #:clean) current-thread () (struct thread))) ;XXX
-(current-time (procedure current-time () (struct time)))
-(join-timeout-exception? (procedure join-timeout-exception? (*) boolean))
-(make-condition-variable (procedure make-condition-variable (#!optional *) (struct condition-variable)))
-(make-mutex (procedure make-mutex (#!optional *) (struct mutex)))
-(make-thread (#(procedure #:enforce) make-thread ((procedure () . *) #!optional *) (struct thread)))
+(current-time (#(procedure #:clean) current-time () (struct time)))
+(join-timeout-exception? (#(procedure #:pure) join-timeout-exception? (*) boolean))
+(make-condition-variable (#(procedure #:clean) make-condition-variable (#!optional *) (struct condition-variable)))
+(make-mutex (#(procedure #:clean) make-mutex (#!optional *) (struct mutex)))
+(make-thread (#(procedure #:clean #:enforce) make-thread ((procedure () . *) #!optional *) (struct thread)))
(milliseconds->time deprecated)
-(mutex-lock! (#(procedure #:enforce) mutex-lock! ((struct mutex) #!optional * (struct thread)) boolean))
+(mutex-lock! (#(procedure #:clean #:enforce) mutex-lock! ((struct mutex) #!optional * (struct thread)) boolean))
-(mutex-name (#(procedure #:enforce) mutex-name ((struct mutex)) *)
+(mutex-name (#(procedure #:clean #:enforce) mutex-name ((struct mutex)) *)
(((struct mutex)) (##sys#slot #(1) '1)))
-(mutex-specific (#(procedure #:enforce) mutex-specific ((struct mutex)) *)
+(mutex-specific (#(procedure #:clean #:enforce) mutex-specific ((struct mutex)) *)
(((struct mutex)) (##sys#slot #(1) '6)))
-(mutex-specific-set! (#(procedure #:enforce) mutex-specific-set! ((struct mutex) *) undefined)
+(mutex-specific-set! (#(procedure #:clean #:enforce) mutex-specific-set! ((struct mutex) *) undefined)
(((struct mutex) *) (##sys#setslot #(1) '6 #(2))))
-(mutex-state (#(procedure #:enforce) mutex-state ((struct mutex)) symbol))
-(mutex-unlock! (#(procedure #:enforce) mutex-unlock! ((struct mutex) #!optional (struct condition-variable) *) undefined))
+(mutex-state (#(procedure #:clean #:enforce) mutex-state ((struct mutex)) symbol))
+(mutex-unlock! (#(procedure #:clean #:enforce) mutex-unlock! ((struct mutex) #!optional (struct condition-variable) *) undefined))
-(mutex? (#(procedure #:predicate (struct mutex)) mutex? (*) boolean))
+(mutex? (#(procedure #:pure #:predicate (struct mutex)) mutex? (*) boolean))
(raise (procedure raise (*) noreturn))
-(seconds->time (#(procedure #:enforce) seconds->time (number) (struct time)))
-(terminated-thread-exception? (procedure terminated-thread-exception? (*) boolean))
-(thread-join! (#(procedure #:enforce) thread-join! ((struct thread) #!optional * *) *))
+(seconds->time (#(procedure #:clean #:enforce) seconds->time (number) (struct time)))
+(terminated-thread-exception? (#(procedure #:pure) terminated-thread-exception? (*) boolean))
+(thread-join! (#(procedure #:clean #:enforce) thread-join! ((struct thread) #!optional * *) *))
-(thread-name (#(procedure #:enforce) thread-name ((struct thread)) *)
+(thread-name (#(procedure #:clean #:enforce) thread-name ((struct thread)) *)
(((struct thread)) (##sys#slot #(1) '6)))
-(thread-quantum (#(procedure #:enforce) thread-quantum ((struct thread)) fixnum)
+(thread-quantum (#(procedure #:clean #:enforce) thread-quantum ((struct thread)) fixnum)
(((struct thread)) (##sys#slot #(1) '9)))
-(thread-quantum-set! (#(procedure #:enforce) thread-quantum-set! ((struct thread) fixnum) undefined))
-(thread-resume! (#(procedure #:enforce) thread-resume! ((struct thread)) undefined))
-(thread-signal! (#(procedure #:enforce) thread-signal! ((struct thread) *) undefined))
-(thread-sleep! (procedure thread-sleep! (*) undefined))
+(thread-quantum-set! (#(procedure #:clean #:enforce) thread-quantum-set! ((struct thread) fixnum) undefined))
+(thread-resume! (#(procedure #:clean #:enforce) thread-resume! ((struct thread)) undefined))
+(thread-signal! (#(procedure #:clean #:enforce) thread-signal! ((struct thread) *) undefined))
+(thread-sleep! (#(procedure #:clean) thread-sleep! (*) undefined))
-(thread-specific (#(procedure #:enforce) thread-specific ((struct thread)) *)
+(thread-specific (#(procedure #:clean #:enforce) thread-specific ((struct thread)) *)
(((struct thread)) (##sys#slot #(1) '10)))
-(thread-specific-set! (#(procedure #:enforce) thread-specific-set! ((struct thread) *) undefined)
+(thread-specific-set! (#(procedure #:clean #:enforce) thread-specific-set! ((struct thread) *) undefined)
(((struct thread) *) (##sys#setslot #(1) '10 #(2))))
(thread-start! (#(procedure #:enforce) thread-start! ((or (struct thread) (procedure () . *))) (struct thread)))
-(thread-state (#(procedure #:enforce) thread-state ((struct thread)) symbol)
+(thread-state (#(procedure #:clean #:enforce) thread-state ((struct thread)) symbol)
(((struct thread)) (##sys#slot #(1) '3)))
-(thread-suspend! (#(procedure #:enforce) thread-suspend! ((struct thread)) undefined))
-(thread-terminate! (#(procedure #:enforce) thread-terminate! ((struct thread)) undefined))
-(thread-wait-for-i/o! (#(procedure #:enforce) thread-wait-for-i/o! (fixnum #!optional symbol) undefined))
-(thread-yield! (procedure thread-yield! () undefined))
+(thread-suspend! (#(procedure #:clean #:enforce) thread-suspend! ((struct thread)) undefined))
+(thread-terminate! (#(procedure #:clean #:enforce) thread-terminate! ((struct thread)) undefined))
+(thread-wait-for-i/o! (#(procedure #:clean #:enforce) thread-wait-for-i/o! (fixnum #!optional symbol) undefined))
+(thread-yield! (#(procedure #:clean) thread-yield! () undefined))
-(thread? (#(procedure #:predicate (struct thread)) thread? (*) boolean))
+(thread? (#(procedure #:pure #:predicate (struct thread)) thread? (*) boolean))
(time->milliseconds deprecated)
-(time->seconds (#(procedure #:enforce) time->seconds ((struct time)) number))
+(time->seconds (#(procedure #:clean #:enforce) time->seconds ((struct time)) number))
-(time? (#(procedure #:predicate (struct time)) time? (*) boolean))
+(time? (#(procedure #:pure #:predicate (struct time)) time? (*) boolean))
-(uncaught-exception-reason (#(procedure #:enforce) uncaught-exception-reason ((struct condition)) *))
-(uncaught-exception? (procedure uncaught-exception? (*) boolean))
+(uncaught-exception-reason (#(procedure #:clean #:enforce) uncaught-exception-reason ((struct condition)) *))
+(uncaught-exception? (#(procedure #:pure) uncaught-exception? (*) boolean))
;; srfi-4
-(blob->f32vector (#(procedure #:enforce) blob->f32vector (blob) (struct f32vector)))
-(blob->f32vector/shared (#(procedure #:enforce) blob->f32vector/shared (blob) (struct f32vector)))
-(blob->f64vector (#(procedure #:enforce) blob->f64vector (blob) (struct f64vector)))
-(blob->f64vector/shared (#(procedure #:enforce) blob->f64vector/shared (blob) (struct f64vector)))
-(blob->s16vector (#(procedure #:enforce) blob->s16vector (blob) (struct s16vector)))
-(blob->s16vector/shared (#(procedure #:enforce) blob->s16vector/shared (blob) (struct s16vector)))
-(blob->s32vector (#(procedure #:enforce) blob->s32vector (blob) (struct s32vector)))
-(blob->s32vector/shared (#(procedure #:enforce) blob->s32vector/shared (blob) (struct s32vector)))
-(blob->s8vector (#(procedure #:enforce) blob->s8vector (blob) (struct u8vector)))
-(blob->s8vector/shared (#(procedure #:enforce) blob->s8vector/shared (blob) (struct u8vector)))
-(blob->u16vector (#(procedure #:enforce) blob->u16vector (blob) (struct u16vector)))
-(blob->u16vector/shared (#(procedure #:enforce) blob->u16vector/shared (blob) (struct u16vector)))
-(blob->u32vector (#(procedure #:enforce) blob->u32vector (blob) (struct u32vector)))
-(blob->u32vector/shared (#(procedure #:enforce) blob->u32vector/shared (blob) (struct u32vector)))
-(blob->u8vector (#(procedure #:enforce) blob->u8vector (blob) (struct u8vector)))
-(blob->u8vector/shared (#(procedure #:enforce) blob->u8vector/shared (blob) (struct u8vector)))
-(f32vector (#(procedure #:enforce) f32vector (#!rest number) (struct f32vector)))
-(f32vector->blob (#(procedure #:enforce) f32vector->blob ((struct f32vector)) blob))
-(f32vector->blob/shared (#(procedure #:enforce) f32vector->blob/shared ((struct f32vector)) blob))
-(f32vector->list (#(procedure #:enforce) f32vector->list ((struct f32vector)) list))
-
-(f32vector-length (#(procedure #:enforce) f32vector-length ((struct f32vector)) fixnum)
+(blob->f32vector (#(procedure #:clean #:enforce) blob->f32vector (blob) (struct f32vector)))
+(blob->f32vector/shared (#(procedure #:clean #:enforce) blob->f32vector/shared (blob) (struct f32vector)))
+(blob->f64vector (#(procedure #:clean #:enforce) blob->f64vector (blob) (struct f64vector)))
+(blob->f64vector/shared (#(procedure #:clean #:enforce) blob->f64vector/shared (blob) (struct f64vector)))
+(blob->s16vector (#(procedure #:clean #:enforce) blob->s16vector (blob) (struct s16vector)))
+(blob->s16vector/shared (#(procedure #:clean #:enforce) blob->s16vector/shared (blob) (struct s16vector)))
+(blob->s32vector (#(procedure #:clean #:enforce) blob->s32vector (blob) (struct s32vector)))
+(blob->s32vector/shared (#(procedure #:clean #:enforce) blob->s32vector/shared (blob) (struct s32vector)))
+(blob->s8vector (#(procedure #:clean #:enforce) blob->s8vector (blob) (struct u8vector)))
+(blob->s8vector/shared (#(procedure #:clean #:enforce) blob->s8vector/shared (blob) (struct u8vector)))
+(blob->u16vector (#(procedure #:clean #:enforce) blob->u16vector (blob) (struct u16vector)))
+(blob->u16vector/shared (#(procedure #:clean #:enforce) blob->u16vector/shared (blob) (struct u16vector)))
+(blob->u32vector (#(procedure #:clean #:enforce) blob->u32vector (blob) (struct u32vector)))
+(blob->u32vector/shared (#(procedure #:clean #:enforce) blob->u32vector/shared (blob) (struct u32vector)))
+(blob->u8vector (#(procedure #:clean #:enforce) blob->u8vector (blob) (struct u8vector)))
+(blob->u8vector/shared (#(procedure #:clean #:enforce) blob->u8vector/shared (blob) (struct u8vector)))
+(f32vector (#(procedure #:clean #:enforce) f32vector (#!rest number) (struct f32vector)))
+(f32vector->blob (#(procedure #:clean #:enforce) f32vector->blob ((struct f32vector)) blob))
+(f32vector->blob/shared (#(procedure #:clean #:enforce) f32vector->blob/shared ((struct f32vector)) blob))
+(f32vector->list (#(procedure #:clean #:enforce) f32vector->list ((struct f32vector)) list))
+
+(f32vector-length (#(procedure #:clean #:enforce) f32vector-length ((struct f32vector)) fixnum)
(((struct f32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
-(f32vector-ref (#(procedure #:enforce) f32vector-ref ((struct f32vector) fixnum) float))
-(f32vector-set! (#(procedure #:enforce) f32vector-set! ((struct f32vector) fixnum number) undefined))
+(f32vector-ref (#(procedure #:clean #:enforce) f32vector-ref ((struct f32vector) fixnum) float))
+(f32vector-set! (#(procedure #:clean #:enforce) f32vector-set! ((struct f32vector) fixnum number) undefined))
-(f32vector? (#(procedure #:predicate (struct f32vector)) f32vector? (*) boolean))
+(f32vector? (#(procedure #:pure #:predicate (struct f32vector)) f32vector? (*) boolean))
-(f64vector (#(procedure #:enforce) f64vector (#!rest number) (struct f64vector)))
-(f64vector->blob (#(procedure #:enforce) f64vector->blob ((struct f32vector)) blob))
-(f64vector->blob/shared (#(procedure #:enforce) f64vector->blob/shared ((struct f64vector)) blob))
-(f64vector->list (#(procedure #:enforce) f64vector->list ((struct f64vector)) blob))
+(f64vector (#(procedure #:clean #:enforce) f64vector (#!rest number) (struct f64vector)))
+(f64vector->blob (#(procedure #:clean #:enforce) f64vector->blob ((struct f32vector)) blob))
+(f64vector->blob/shared (#(procedure #:clean #:enforce) f64vector->blob/shared ((struct f64vector)) blob))
+(f64vector->list (#(procedure #:clean #:enforce) f64vector->list ((struct f64vector)) blob))
-(f64vector-length (#(procedure #:enforce) f64vector-length ((struct f64vector)) fixnum)
+(f64vector-length (#(procedure #:clean #:enforce) f64vector-length ((struct f64vector)) fixnum)
(((struct f32vector)) (##core#inline "C_u_i_64vector_length" #(1))))
-(f64vector-ref (#(procedure #:enforce) f64vector-ref ((struct f64vector) fixnum) float))
-(f64vector-set! (#(procedure #:enforce) f64vector-set! ((struct f64vector) fixnum number) undefined))
-
-(f64vector? (#(procedure #:predicate (struct f64vector)) f64vector? (*) boolean))
-
-(list->f32vector (#(procedure #:enforce) list->f32vector ((list number)) (struct f32vector)))
-(list->f64vector (#(procedure #:enforce) list->f64vector ((list number)) (struct f64vector)))
-(list->s16vector (#(procedure #:enforce) list->s16vector ((list fixnum)) (struct s16vector)))
-(list->s32vector (#(procedure #:enforce) list->s32vector ((list number)) (struct s32vector)))
-(list->s8vector (#(procedure #:enforce) list->s8vector ((list fixnum)) (struct s8vector)))
-(list->u16vector (#(procedure #:enforce) list->u16vector ((list fixnum)) (struct u16vector)))
-(list->u32vector (#(procedure #:enforce) list->u32vector ((list number)) (struct u32vector)))
-(list->u8vector (#(procedure #:enforce) list->u8vector ((list fixnum)) (struct u8vector)))
-(make-f32vector (#(procedure #:enforce) make-f32vector (fixnum #!optional * * *) (struct f32vector)))
-(make-f64vector (#(procedure #:enforce) make-f64vector (fixnum #!optional * * *) (struct f64vector)))
-(make-s16vector (#(procedure #:enforce) make-s16vector (fixnum #!optional * * *) (struct s16vector)))
-(make-s32vector (#(procedure #:enforce) make-s32vector (fixnum #!optional * * *) (struct s32vector)))
-(make-s8vector (#(procedure #:enforce) make-s8vector (fixnum #!optional * * *) (struct s8vector)))
-(make-u16vector (#(procedure #:enforce) make-u16vector (fixnum #!optional * * *) (struct u16vector)))
-(make-u32vector (#(procedure #:enforce) make-u32vector (fixnum #!optional * * *) (struct u32vector)))
-(make-u8vector (#(procedure #:enforce) make-u8vector (fixnum #!optional * * *) (struct u8vector)))
+(f64vector-ref (#(procedure #:clean #:enforce) f64vector-ref ((struct f64vector) fixnum) float))
+(f64vector-set! (#(procedure #:clean #:enforce) f64vector-set! ((struct f64vector) fixnum number) undefined))
+
+(f64vector? (#(procedure #:pure #:predicate (struct f64vector)) f64vector? (*) boolean))
+
+(list->f32vector (#(procedure #:clean #:enforce) list->f32vector ((list number)) (struct f32vector)))
+(list->f64vector (#(procedure #:clean #:enforce) list->f64vector ((list number)) (struct f64vector)))
+(list->s16vector (#(procedure #:clean #:enforce) list->s16vector ((list fixnum)) (struct s16vector)))
+(list->s32vector (#(procedure #:clean #:enforce) list->s32vector ((list number)) (struct s32vector)))
+(list->s8vector (#(procedure #:clean #:enforce) list->s8vector ((list fixnum)) (struct s8vector)))
+(list->u16vector (#(procedure #:clean #:enforce) list->u16vector ((list fixnum)) (struct u16vector)))
+(list->u32vector (#(procedure #:clean #:enforce) list->u32vector ((list number)) (struct u32vector)))
+(list->u8vector (#(procedure #:clean #:enforce) list->u8vector ((list fixnum)) (struct u8vector)))
+(make-f32vector (#(procedure #:clean #:enforce) make-f32vector (fixnum #!optional * * *) (struct f32vector)))
+(make-f64vector (#(procedure #:clean #:enforce) make-f64vector (fixnum #!optional * * *) (struct f64vector)))
+(make-s16vector (#(procedure #:clean #:enforce) make-s16vector (fixnum #!optional * * *) (struct s16vector)))
+(make-s32vector (#(procedure #:clean #:enforce) make-s32vector (fixnum #!optional * * *) (struct s32vector)))
+(make-s8vector (#(procedure #:clean #:enforce) make-s8vector (fixnum #!optional * * *) (struct s8vector)))
+(make-u16vector (#(procedure #:clean #:enforce) make-u16vector (fixnum #!optional * * *) (struct u16vector)))
+(make-u32vector (#(procedure #:clean #:enforce) make-u32vector (fixnum #!optional * * *) (struct u32vector)))
+(make-u8vector (#(procedure #:clean #:enforce) make-u8vector (fixnum #!optional * * *) (struct u8vector)))
(read-u8vector (#(procedure #:enforce) read-u8vector (#!optional fixnum port) (struct u8vector)))
(read-u8vector! (#(procedure #:enforce) read-u8vector! (fixnum (struct u8vector) #!optional port fixnum) number))
(release-number-vector (procedure release-number-vector (*) undefined))
-(s16vector (#(procedure #:enforce) s16vector (#!rest fixnum) (struct s16vector)))
-(s16vector->blob (#(procedure #:enforce) s16vector->blob ((struct s16vector)) blob))
-(s16vector->blob/shared (#(procedure #:enforce) s16vector->blob/shared ((struct s16vector)) blob))
-(s16vector->list (#(procedure #:enforce) s16vector->list ((struct s16vector)) (list fixnum)))
+(s16vector (#(procedure #:clean #:enforce) s16vector (#!rest fixnum) (struct s16vector)))
+(s16vector->blob (#(procedure #:clean #:enforce) s16vector->blob ((struct s16vector)) blob))
+(s16vector->blob/shared (#(procedure #:clean #:enforce) s16vector->blob/shared ((struct s16vector)) blob))
+(s16vector->list (#(procedure #:clean #:enforce) s16vector->list ((struct s16vector)) (list fixnum)))
-(s16vector-length (#(procedure #:enforce) s16vector-length ((struct s16vector)) fixnum)
+(s16vector-length (#(procedure #:clean #:enforce) s16vector-length ((struct s16vector)) fixnum)
(((struct s16vector)) (##core#inline "C_u_i_16vector_length" #(1))))
-(s16vector-ref (#(procedure #:enforce) s16vector-ref ((struct s16vector) fixnum) fixnum))
-(s16vector-set! (#(procedure #:enforce) s16vector-set! ((struct s16vector) fixnum fixnum) undefined))
+(s16vector-ref (#(procedure #:clean #:enforce) s16vector-ref ((struct s16vector) fixnum) fixnum))
+(s16vector-set! (#(procedure #:clean #:enforce) s16vector-set! ((struct s16vector) fixnum fixnum) undefined))
-(s16vector? (#(procedure #:predicate (struct s16vector)) s16vector? (*) boolean))
+(s16vector? (#(procedure #:pure #:predicate (struct s16vector)) s16vector? (*) boolean))
-(s32vector (#(procedure #:enforce) s32vector (#!rest number) (struct s32vector)))
-(s32vector->blob (#(procedure #:enforce) s32vector->blob ((struct 32vector)) blob))
-(s32vector->blob/shared (#(procedure #:enforce) s32vector->blob/shared ((struct s32vector)) blob))
-(s32vector->list (#(procedure #:enforce) s32vector->list ((struct s32vector)) (list number)))
+(s32vector (#(procedure #:clean #:enforce) s32vector (#!rest number) (struct s32vector)))
+(s32vector->blob (#(procedure #:clean #:enforce) s32vector->blob ((struct 32vector)) blob))
+(s32vector->blob/shared (#(procedure #:clean #:enforce) s32vector->blob/shared ((struct s32vector)) blob))
+(s32vector->list (#(procedure #:clean #:enforce) s32vector->list ((struct s32vector)) (list number)))
-(s32vector-length (#(procedure #:enforce) s32vector-length ((struct s32vector)) fixnum)
+(s32vector-length (#(procedure #:clean #:enforce) s32vector-length ((struct s32vector)) fixnum)
(((struct s32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
-(s32vector-ref (#(procedure #:enforce) s32vector-ref ((struct s32vector) fixnum) number))
-(s32vector-set! (#(procedure #:enforce) s32vector-set! ((struct s32vector) fixnum number) undefined))
+(s32vector-ref (#(procedure #:clean #:enforce) s32vector-ref ((struct s32vector) fixnum) number))
+(s32vector-set! (#(procedure #:clean #:enforce) s32vector-set! ((struct s32vector) fixnum number) undefined))
-(s32vector? (#(procedure #:predicate (struct s32vector)) s32vector? (*) boolean))
+(s32vector? (#(procedure #:pure #:predicate (struct s32vector)) s32vector? (*) boolean))
-(s8vector (#(procedure #:enforce) s8vector (#!rest fixnum) (struct s8vector)))
-(s8vector->blob (#(procedure #:enforce) s8vector->blob ((struct s8vector)) blob))
-(s8vector->blob/shared (#(procedure #:enforce) s8vector->blob/shared ((struct s8vector)) blob))
-(s8vector->list (#(procedure #:enforce) s8vector->list ((struct s8vector)) (list fixnum)))
+(s8vector (#(procedure #:clean #:enforce) s8vector (#!rest fixnum) (struct s8vector)))
+(s8vector->blob (#(procedure #:clean #:enforce) s8vector->blob ((struct s8vector)) blob))
+(s8vector->blob/shared (#(procedure #:clean #:enforce) s8vector->blob/shared ((struct s8vector)) blob))
+(s8vector->list (#(procedure #:clean #:enforce) s8vector->list ((struct s8vector)) (list fixnum)))
-(s8vector-length (#(procedure #:enforce) s8vector-length ((struct s8vector)) fixnum)
+(s8vector-length (#(procedure #:clean #:enforce) s8vector-length ((struct s8vector)) fixnum)
(((struct s8vector)) (##core#inline "C_u_i_8vector_length" #(1))))
-(s8vector-ref (#(procedure #:enforce) s8vector-ref ((struct s8vector) fixnum) fixnum))
-(s8vector-set! (#(procedure #:enforce) s8vector-set! ((struct s8vector) fixnum fixnum) undefined))
-
-(s8vector? (#(procedure #:predicate (struct s8vector)) s8vector? (*) boolean))
-
-(subf32vector (#(procedure #:enforce) subf32vector ((struct f32vector) fixnum fixnum) (struct f32vector)))
-(subf64vector (#(procedure #:enforce) subf64vector ((struct f64vector) fixnum fixnum) (struct f64vector)))
-(subs16vector (#(procedure #:enforce) subs16vector ((struct s16vector) fixnum fixnum) (struct s16vector)))
-(subs32vector (#(procedure #:enforce) subs32vector ((struct s32vector) fixnum fixnum) (struct s32vector)))
-(subs8vector (#(procedure #:enforce) subs8vector ((struct s8vector) fixnum fixnum) (struct s8vector)))
-(subu16vector (#(procedure #:enforce) subu16vector ((struct u16vector) fixnum fixnum) (struct u16vector)))
-(subu32vector (#(procedure #:enforce) subu32vector ((struct u32vector) fixnum fixnum) (struct u32vector)))
-(subu8vector (#(procedure #:enforce) subu8vector ((struct u8vector) fixnum fixnum) (struct u8vector)))
-(u16vector (#(procedure #:enforce) u16vector (#!rest fixnum) (struct u16vector)))
-(u16vector->blob (#(procedure #:enforce) u16vector->blob ((struct u16vector)) blob))
-(u16vector->blob/shared (#(procedure #:enforce) u16vector->blob/shared ((struct u16vector)) blob))
-(u16vector->list (#(procedure #:enforce) u16vector->list ((struct u16vector)) (list fixnum)))
-
-(u16vector-length (#(procedure #:enforce) u16vector-length ((struct u16vector)) fixnum)
+(s8vector-ref (#(procedure #:clean #:enforce) s8vector-ref ((struct s8vector) fixnum) fixnum))
+(s8vector-set! (#(procedure #:clean #:enforce) s8vector-set! ((struct s8vector) fixnum fixnum) undefined))
+
+(s8vector? (#(procedure #:pure #:predicate (struct s8vector)) s8vector? (*) boolean))
+
+(subf32vector (#(procedure #:clean #:enforce) subf32vector ((struct f32vector) fixnum fixnum) (struct f32vector)))
+(subf64vector (#(procedure #:clean #:enforce) subf64vector ((struct f64vector) fixnum fixnum) (struct f64vector)))
+(subs16vector (#(procedure #:clean #:enforce) subs16vector ((struct s16vector) fixnum fixnum) (struct s16vector)))
+(subs32vector (#(procedure #:clean #:enforce) subs32vector ((struct s32vector) fixnum fixnum) (struct s32vector)))
+(subs8vector (#(procedure #:clean #:enforce) subs8vector ((struct s8vector) fixnum fixnum) (struct s8vector)))
+(subu16vector (#(procedure #:clean #:enforce) subu16vector ((struct u16vector) fixnum fixnum) (struct u16vector)))
+(subu32vector (#(procedure #:clean #:enforce) subu32vector ((struct u32vector) fixnum fixnum) (struct u32vector)))
+(subu8vector (#(procedure #:clean #:enforce) subu8vector ((struct u8vector) fixnum fixnum) (struct u8vector)))
+(u16vector (#(procedure #:clean #:enforce) u16vector (#!rest fixnum) (struct u16vector)))
+(u16vector->blob (#(procedure #:clean #:enforce) u16vector->blob ((struct u16vector)) blob))
+(u16vector->blob/shared (#(procedure #:clean #:enforce) u16vector->blob/shared ((struct u16vector)) blob))
+(u16vector->list (#(procedure #:clean #:enforce) u16vector->list ((struct u16vector)) (list fixnum)))
+
+(u16vector-length (#(procedure #:clean #:enforce) u16vector-length ((struct u16vector)) fixnum)
(((struct u16vector)) (##core#inline "C_u_i_16vector_length" #(1))))
-(u16vector-ref (#(procedure #:enforce) u16vector-ref ((struct u16vector) fixnum) fixnum))
-(u16vector-set! (#(procedure #:enforce) u16vector-set! ((struct u16vector) fixnum fixnum) undefined))
+(u16vector-ref (#(procedure #:clean #:enforce) u16vector-ref ((struct u16vector) fixnum) fixnum))
+(u16vector-set! (#(procedure #:clean #:enforce) u16vector-set! ((struct u16vector) fixnum fixnum) undefined))
-(u16vector? (#(procedure #:predicate (struct u16vector)) u16vector? (*) boolean))
+(u16vector? (#(procedure #:pure #:predicate (struct u16vector)) u16vector? (*) boolean))
-(u32vector (#(procedure #:enforce) u32vector (#!rest number) (struct u32vector)))
-(u32vector->blob (#(procedure #:enforce) u32vector->blob ((struct u32vector)) blob))
-(u32vector->blob/shared (#(procedure #:enforce) u32vector->blob/shared ((struct u32vector)) blob))
-(u32vector->list (#(procedure #:enforce) u32vector->list ((struct u32vector)) (list number)))
+(u32vector (#(procedure #:clean #:enforce) u32vector (#!rest number) (struct u32vector)))
+(u32vector->blob (#(procedure #:clean #:enforce) u32vector->blob ((struct u32vector)) blob))
+(u32vector->blob/shared (#(procedure #:clean #:enforce) u32vector->blob/shared ((struct u32vector)) blob))
+(u32vector->list (#(procedure #:clean #:enforce) u32vector->list ((struct u32vector)) (list number)))
-(u32vector-length (#(procedure #:enforce) u32vector-length ((struct u32vector)) fixnum)
+(u32vector-length (#(procedure #:clean #:enforce) u32vector-length ((struct u32vector)) fixnum)
(((struct u32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
-(u32vector-ref (#(procedure #:enforce) u32vector-ref ((struct u32vector) fixnum) number))
-(u32vector-set! (#(procedure #:enforce) u32vector-set! ((struct u32vector) fixnum number) undefined))
+(u32vector-ref (#(procedure #:clean #:enforce) u32vector-ref ((struct u32vector) fixnum) number))
+(u32vector-set! (#(procedure #:clean #:enforce) u32vector-set! ((struct u32vector) fixnum number) undefined))
-(u32vector? (#(procedure #:predicate (struct u32vector)) u32vector? (*) boolean))
+(u32vector? (#(procedure #:pure #:predicate (struct u32vector)) u32vector? (*) boolean))
-(u8vector (#(procedure #:enforce) u8vector (#!rest fixnum) (struct u8vector)))
-(u8vector->blob (#(procedure #:enforce) u8vector->blob ((struct u8vector)) blob))
-(u8vector->blob/shared (#(procedure #:enforce) u8vector->blob/shared ((struct u8vector)) blob))
-(u8vector->list (#(procedure #:enforce) u8vector->list ((struct u8vector)) (list fixnum)))
+(u8vector (#(procedure #:clean #:enforce) u8vector (#!rest fixnum) (struct u8vector)))
+(u8vector->blob (#(procedure #:clean #:enforce) u8vector->blob ((struct u8vector)) blob))
+(u8vector->blob/shared (#(procedure #:clean #:enforce) u8vector->blob/shared ((struct u8vector)) blob))
+(u8vector->list (#(procedure #:clean #:enforce) u8vector->list ((struct u8vector)) (list fixnum)))
-(u8vector-length (#(procedure #:enforce) u8vector-length ((struct u8vector)) fixnum)
+(u8vector-length (#(procedure #:clean #:enforce) u8vector-length ((struct u8vector)) fixnum)
(((struct u8vector)) (##core#inline "C_u_i_8vector_length" #(1))))
-(u8vector-ref (#(procedure #:enforce) u8vector-ref ((struct u8vector) fixnum) fixnum))
-(u8vector-set! (#(procedure #:enforce) u8vector-set! ((struct u8vector) fixnum fixnum) undefined))
+(u8vector-ref (#(procedure #:clean #:enforce) u8vector-ref ((struct u8vector) fixnum) fixnum))
+(u8vector-set! (#(procedure #:clean #:enforce) u8vector-set! ((struct u8vector) fixnum fixnum) undefined))
-(u8vector? (#(procedure #:predicate (struct u8vector)) u8vector? (*) boolean))
+(u8vector? (#(procedure #:pure #:predicate (struct u8vector)) u8vector? (*) boolean))
(write-u8vector (#(procedure #:enforce) write-u8vector ((struct u8vector) #!optional port fixnum fixnum) undefined))
;; srfi-69
-(alist->hash-table (#(procedure #:enforce) alist->hash-table ((list pair) #!rest) (struct hash-table)))
-(eq?-hash (#(procedure #:enforce) eq?-hash (* #!optional fixnum) fixnum))
-(equal?-hash (#(procedure #:enforce) equal?-hash (* #!optional fixnum) fixnum))
-(eqv?-hash (#(procedure #:enforce) eqv?-hash (* #!optional fixnum) fixnum))
-(hash (#(procedure #:enforce) hash (* #!optional fixnum) fixnum))
-(hash-by-identity (#(procedure #:enforce) hash-by-identity (* #!optional fixnum) fixnum))
-(hash-table->alist (#(procedure #:enforce) hash-table->alist ((struct hash-table)) (list pair)))
-(hash-table-clear! (#(procedure #:enforce) hash-table-clear! ((struct hash-table)) undefined))
-(hash-table-copy (#(procedure #:enforce) hash-table-copy ((struct hash-table)) (struct hash-table)))
-(hash-table-delete! (#(procedure #:enforce) hash-table-delete! ((struct hash-table) *) boolean))
-(hash-table-equivalence-function (#(procedure #:enforce) hash-table-equivalence-function ((struct hash-table)) (procedure (* *) *)))
-(hash-table-exists? (#(procedure #:enforce) hash-table-exists? ((struct hash-table) *) boolean))
+(alist->hash-table (#(procedure #:clean #:enforce) alist->hash-table ((list pair) #!rest) (struct hash-table)))
+(eq?-hash (#(procedure #:clean #:enforce) eq?-hash (* #!optional fixnum) fixnum))
+(equal?-hash (#(procedure #:clean #:enforce) equal?-hash (* #!optional fixnum) fixnum))
+(eqv?-hash (#(procedure #:clean #:enforce) eqv?-hash (* #!optional fixnum) fixnum))
+(hash (#(procedure #:pure #:enforce) hash (* #!optional fixnum) fixnum))
+(hash-by-identity (#(procedure #:pure #:enforce) hash-by-identity (* #!optional fixnum) fixnum))
+(hash-table->alist (#(procedure #:clean #:enforce) hash-table->alist ((struct hash-table)) (list pair)))
+(hash-table-clear! (#(procedure #:clean #:enforce) hash-table-clear! ((struct hash-table)) undefined))
+(hash-table-copy (#(procedure #:clean #:enforce) hash-table-copy ((struct hash-table)) (struct hash-table)))
+(hash-table-delete! (#(procedure #:clean #:enforce) hash-table-delete! ((struct hash-table) *) boolean))
+(hash-table-equivalence-function (#(procedure #:clean #:enforce) hash-table-equivalence-function ((struct hash-table)) (procedure (* *) *)))
+(hash-table-exists? (#(procedure #:clean #:enforce) hash-table-exists? ((struct hash-table) *) boolean))
(hash-table-fold (#(procedure #:enforce) hash-table-fold ((struct hash-table) (procedure (* * *) *) *) *))
(hash-table-for-each (#(procedure #:enforce) hash-table-for-each ((struct hash-table) (procedure (* *) . *)) undefined))
-(hash-table-has-initial? (#(procedure #:enforce) hash-table-has-initial? ((struct hash-table)) boolean)
+(hash-table-has-initial? (#(procedure #:clean #:enforce) hash-table-has-initial? ((struct hash-table)) boolean)
(((struct hash-table)) (##sys#slot #(1) '9))) ;XXX might return other than #t
-(hash-table-hash-function (#(procedure #:enforce) hash-table-hash-function ((struct hash-table)) (procedure (* fixnum) fixnum))
+(hash-table-hash-function (#(procedure #:clean #:enforce) hash-table-hash-function ((struct hash-table)) (procedure (* fixnum) fixnum))
(((struct hash-table)) (##sys#slot #(1) '4)))
-(hash-table-initial (#(procedure #:enforce) hash-table-initial ((struct hash-table)) *))
-(hash-table-keys (#(procedure #:enforce) hash-table-keys ((struct hash-table)) list))
-(hash-table-map (#(procedure #:enforce) hash-table-map ((struct hash-table) (procedure (* *) *)) list))
+(hash-table-initial (#(procedure #:clean #:enforce) hash-table-initial ((struct hash-table)) *))
+(hash-table-keys (#(procedure #:clean #:enforce) hash-table-keys ((struct hash-table)) list))
+(hash-table-map (#(procedure #:clean #:enforce) hash-table-map ((struct hash-table) (procedure (* *) *)) list))
-(hash-table-max-load (#(procedure #:enforce) hash-table-max-load ((struct hash-table)) fixnum)
+(hash-table-max-load (#(procedure #:clean #:enforce) hash-table-max-load ((struct hash-table)) fixnum)
(((struct hash-table)) (##sys#slot #(1) '6)))
-(hash-table-merge (#(procedure #:enforce) hash-table-merge ((struct hash-table) (struct hash-table)) (struct hash-table)))
-(hash-table-merge! (#(procedure #:enforce) hash-table-merge! ((struct hash-table) (struct hash-table)) undefined))
+(hash-table-merge (#(procedure #:clean #:enforce) hash-table-merge ((struct hash-table) (struct hash-table)) (struct hash-table)))
+(hash-table-merge! (#(procedure #:clean #:enforce) hash-table-merge! ((struct hash-table) (struct hash-table)) undefined))
-(hash-table-min-load (#(procedure #:enforce) hash-table-min-load ((struct hash-table)) fixnum)
+(hash-table-min-load (#(procedure #:clean #:enforce) hash-table-min-load ((struct hash-table)) fixnum)
(((struct hash-table)) (##sys#slot #(1) '5)))
-(hash-table-ref (#(procedure #:enforce) hash-table-ref ((struct hash-table) * #!optional (procedure () *)) *))
-(hash-table-ref/default (#(procedure #:enforce) hash-table-ref/default ((struct hash-table) * *) *))
-(hash-table-remove! (#(procedure #:enforce) hash-table-remove! ((struct hash-table) (procedure (* *) *)) undefined))
-(hash-table-set! (#(procedure #:enforce) hash-table-set! ((struct hash-table) * *) undefined))
+(hash-table-ref (#(procedure #:clean #:enforce) hash-table-ref ((struct hash-table) * #!optional (procedure () *)) *))
+(hash-table-ref/default (#(procedure #:clean #:enforce) hash-table-ref/default ((struct hash-table) * *) *))
+(hash-table-remove! (#(procedure #:clean #:enforce) hash-table-remove! ((struct hash-table) (procedure (* *) *)) undefined))
+(hash-table-set! (#(procedure #:clean #:enforce) hash-table-set! ((struct hash-table) * *) undefined))
-(hash-table-size (#(procedure #:enforce) hash-table-size ((struct hash-table)) fixnum)
+(hash-table-size (#(procedure #:clean #:enforce) hash-table-size ((struct hash-table)) fixnum)
(((struct hash-table)) (##sys#slot #(1) '2)))
(hash-table-update! (#(procedure #:enforce) hash-table-update! ((struct hash-table) * (procedure (*) *) #!optional (procedure () *)) *))
-(hash-table-update!/default (#(procedure #:enforce) hash-table-update!/default ((struct hash-table) * (procedure (*) *) *) *))
-(hash-table-values (#(procedure #:enforce) hash-table-values ((struct hash-table)) list))
+(hash-table-update!/default (#(procedure #:clean #:enforce) hash-table-update!/default ((struct hash-table) * (procedure (*) *) *) *))
+(hash-table-values (#(procedure #:clean #:enforce) hash-table-values ((struct hash-table)) list))
(hash-table-walk (#(procedure #:enforce) hash-table-walk ((struct hash-table) (procedure (* *) . *)) undefined))
-(hash-table-weak-keys (#(procedure #:enforce) hash-table-weak-keys ((struct hash-table)) boolean)
+(hash-table-weak-keys (#(procedure #:clean #:enforce) hash-table-weak-keys ((struct hash-table)) boolean)
(((struct hash-table)) (##sys#slot #(1) '7)))
-(hash-table-weak-values (#(procedure #:enforce) hash-table-weak-values ((struct hash-table)) boolean)
+(hash-table-weak-values (#(procedure #:clean #:enforce) hash-table-weak-values ((struct hash-table)) boolean)
(((struct hash-table)) (##sys#slot #(1) '8)))
-(hash-table? (#(procedure #:predicate (struct hash-table)) hash-table? (*) boolean))
+(hash-table? (#(procedure #:pure #:predicate (struct hash-table)) hash-table? (*) boolean))
;;XXX if we want to hardcode hash-default-bound here, we could rewrite the 1-arg case...
; (applies to all hash-functions)
-(keyword-hash (#(procedure #:enforce) keyword-hash (* #!optional fixnum) fixnum))
+(keyword-hash (#(procedure #:clean #:enforce) keyword-hash (* #!optional fixnum) fixnum))
-(make-hash-table (#(procedure #:enforce) make-hash-table (#!rest) (struct hash-table)))
-(number-hash (#(procedure #:enforce) number-hash (fixnum #!optional fixnum) fixnum))
-(object-uid-hash (#(procedure #:enforce) object-uid-hash (* #!optional fixnum) fixnum))
-(symbol-hash (#(procedure #:enforce) symbol-hash (symbol #!optional fixnum) fixnum))
-(string-hash (#(procedure #:enforce) string-hash (string #!optional fixnum fixnum fixnum) number))
-(string-hash-ci (#(procedure #:enforce) string-hash-ci (string #!optional fixnum fixnum fixnum) number))
-(string-ci-hash (#(procedure #:enforce) string-ci-hash (string #!optional fixnum fixnum fixnum) number))
+(make-hash-table (#(procedure #:clean #:enforce) make-hash-table (#!rest) (struct hash-table)))
+(number-hash (#(procedure #:clean #:enforce) number-hash (fixnum #!optional fixnum) fixnum))
+(object-uid-hash (#(procedure #:clean #:enforce) object-uid-hash (* #!optional fixnum) fixnum))
+(symbol-hash (#(procedure #:clean #:enforce) symbol-hash (symbol #!optional fixnum) fixnum))
+(string-hash (#(procedure #:clean #:enforce) string-hash (string #!optional fixnum fixnum fixnum) number))
+(string-hash-ci (#(procedure #:clean #:enforce) string-hash-ci (string #!optional fixnum fixnum fixnum) number))
+(string-ci-hash (#(procedure #:clean #:enforce) string-ci-hash (string #!optional fixnum fixnum fixnum) number))
;; tcp
-(tcp-abandon-port (#(procedure #:enforce) tcp-abandon-port (port) undefined))
-(tcp-accept (#(procedure #:enforce) tcp-accept ((struct tcp-listener)) port port))
-(tcp-accept-ready? (#(procedure #:enforce) tcp-accept-ready? ((struct tcp-listener)) boolean))
-(tcp-accept-timeout (#(procedure #:enforce) tcp-accept-timeout (#!optional number) number))
-(tcp-addresses (#(procedure #:enforce) tcp-addresses (port) string string))
-(tcp-buffer-size (#(procedure #:enforce) tcp-buffer-size (#!optional fixnum) fixnum))
-(tcp-close (#(procedure #:enforce) tcp-close ((struct tcp-listener)) undefined))
-(tcp-connect (#(procedure #:enforce) tcp-connect (string #!optional fixnum) port port))
-(tcp-connect-timeout (#(procedure #:enforce) tcp-connect-timeout (#!optional number) number))
-(tcp-listen (#(procedure #:enforce) tcp-listen (fixnum #!optional fixnum *) (struct tcp-listener)))
-
-(tcp-listener-fileno (#(procedure #:enforce) tcp-listener-fileno ((struct tcp-listener)) fixnum)
+(tcp-abandon-port (#(procedure #:clean #:enforce) tcp-abandon-port (port) undefined))
+(tcp-accept (#(procedure #:clean #:enforce) tcp-accept ((struct tcp-listener)) port port))
+(tcp-accept-ready? (#(procedure #:clean #:enforce) tcp-accept-ready? ((struct tcp-listener)) boolean))
+(tcp-accept-timeout (#(procedure #:clean #:enforce) tcp-accept-timeout (#!optional number) number))
+(tcp-addresses (#(procedure #:clean #:enforce) tcp-addresses (port) string string))
+(tcp-buffer-size (#(procedure #:clean #:enforce) tcp-buffer-size (#!optional fixnum) fixnum))
+(tcp-close (#(procedure #:clean #:enforce) tcp-close ((struct tcp-listener)) undefined))
+(tcp-connect (#(procedure #:clean #:enforce) tcp-connect (string #!optional fixnum) port port))
+(tcp-connect-timeout (#(procedure #:clean #:enforce) tcp-connect-timeout (#!optional number) number))
+(tcp-listen (#(procedure #:clean #:enforce) tcp-listen (fixnum #!optional fixnum *) (struct tcp-listener)))
+
+(tcp-listener-fileno (#(procedure #:clean #:enforce) tcp-listener-fileno ((struct tcp-listener)) fixnum)
(((struct tcp-listener)) (##sys#slot #(1) '1)))
-(tcp-listener-port (#(procedure #:enforce) tcp-listener-port ((struct tcp-listener)) fixnum))
+(tcp-listener-port (#(procedure #:clean #:enforce) tcp-listener-port ((struct tcp-listener)) fixnum))
-(tcp-listener? (#(procedure #:predicate (struct tcp-listener)) tcp-listener? (*) boolean))
+(tcp-listener? (#(procedure #:clean #:predicate (struct tcp-listener)) tcp-listener? (*) boolean))
-(tcp-port-numbers (#(procedure #:enforce) tcp-port-numbers (port) fixnum fixnum))
-(tcp-read-timeout (#(procedure #:enforce) tcp-read-timeout (#!optional number) number))
-(tcp-write-timeout (#(procedure #:enforce) tcp-write-timeout (#!optional number) number))
+(tcp-port-numbers (#(procedure #:clean #:enforce) tcp-port-numbers (port) fixnum fixnum))
+(tcp-read-timeout (#(procedure #:clean #:enforce) tcp-read-timeout (#!optional number) number))
+(tcp-write-timeout (#(procedure #:clean #:enforce) tcp-write-timeout (#!optional number) number))
;; utils
@@ -2462,9 +2471,9 @@
(for-each-argv-line deprecated)
(for-each-line deprecated)
(read-all (#(procedure #:enforce) read-all (#!optional (or port string)) string))
-(system* (#(procedure #:enforce) system* (string #!rest) undefined))
-(qs (#(procedure #:enforce) qs (string) string))
-(compile-file (#(procedure #:enforce) compile-file (string #!rest) (or boolean string)))
-(compile-file-options (#(procedure #:enforce) compile-file-options (#!optional (list string)) (list string)))
+(system* (#(procedure #:clean #:enforce) system* (string #!rest) undefined))
+(qs (#(procedure #:clean #:enforce) qs (string) string))
+(compile-file (#(procedure #:clean #:enforce) compile-file (string #!rest) (or boolean string)))
+(compile-file-options (#(procedure #:clean #:enforce) compile-file-options (#!optional (list string)) (list string)))
(scan-input-lines (#(procedure #:enforce) scan-input-lines (* #!optional port) *))
(yes-or-no? (#(procedure #:enforce) yes-or-no? (string #!rest) *))
Trap