~ chicken-core (chicken-5) fe80ccfa8ce886c220b699211991c6a81fea50da
commit fe80ccfa8ce886c220b699211991c6a81fea50da
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Sep 11 00:07:43 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Sep 11 00:07:43 2011 +0200
Added support for fixed-size list and vector types, renamed old
(list T)/(vector T) type specifiers to (list-of T)/(vector-of T).
types.db was changed so making boot-chicken is needed to build
this version.
Squashed commit of the following:
commit 9f03791673927e769c1e5a2db8d1cce0e50ed0cb
Merge: e35329f... 3a2f7e3...
Author: felix <felix@call-with-current-continuation.org>
Date: Sun Sep 11 00:05:03 2011 +0200
resolved conflicts
commit e35329fcdf68f6aecd88c0560268050813276329
Author: felix <felix@call-with-current-continuation.org>
Date: Sat Sep 10 23:58:28 2011 +0200
fixed two bugs in handling of rest arg and simplification of list-of/vector-of
commit e228f022e1668d90fed8d3cc8e70c1af15b3393d
Author: felix <felix@call-with-current-continuation.org>
Date: Sat Sep 10 16:24:11 2011 +0200
various bugfixes in the FA and corrections in the tests
commit 81a084216f9f199926ceca4e79d7e0b5305cf456
Author: felix <felix@call-with-current-continuation.org>
Date: Sat Sep 10 02:56:16 2011 +0200
special-case handler also receives argtypes
commit bf2642cb12de6f775ffc1bdd18cea1771a93a120
Author: felix <felix@call-with-current-continuation.org>
Date: Sat Sep 10 02:55:58 2011 +0200
added variant of types.db with new-style sequence types
commit 39768d2c188b5b0037313e5cf297d6b4426da3c0
Author: felix <felix@call-with-current-continuation.org>
Date: Sat Sep 10 02:55:24 2011 +0200
corrected use of old-style list type
commit 7a32bdc84122ccc7a3255777e261db18751ad603
Author: felix <felix@call-with-current-continuation.org>
Date: Fri Sep 9 16:35:32 2011 +0200
renamed vector/list to vector-of/list-of; added support for vector/list
diff --git a/manual/Types b/manual/Types
index 2d7f7dc4..710a17b8 100644
--- a/manual/Types
+++ b/manual/Types
@@ -137,8 +137,10 @@ or {{:}} should follow the syntax given below:
<table>
<tr><th>COMPLEXTYPE</th><th>meaning</th></tr>
<tr><td>{{(pair TYPE1 TYPE2)}}</td><td>pair with given component types</td></tr>
-<tr><td>{{(list TYPE)}}</td><td>proper list with given element type</td></tr>
-<tr><td>{{(vector TYPE)}}</td><td>vector with given element types</td></tr>
+<tr><td>{{(list-of TYPE)}}</td><td>proper list with given element type</td></tr>
+<tr><td>{{(list TYPE1 ...)}}</td><td>proper list with given length and element types</td></tr>
+<tr><td>{{(vector-of TYPE)}}</td><td>vector with given element types</td></tr>
+<tr><td>{{(vector TYPE1 ...)}}</td><td>vector with given length and element types</td></tr>
</table>
<table>
@@ -158,7 +160,7 @@ or {{:}} should follow the syntax given below:
Note that type-variables in {{forall}} types may be given "constraint" types, i.e.
- (: sort (forall (e (s (or (vector e) (list e))))
+ (: sort (forall (e (s (or (vector e) (list-of e))))
(s (e e -> *) -> s)))
declares that {{sort}} is a procedure of two arguments, the first
diff --git a/scrutinizer.scm b/scrutinizer.scm
index ce4526c4..f32c0dc7 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -74,7 +74,11 @@
; procedure | vector | null | eof | undefined | port |
; blob | noreturn | pointer | locative | fixnum | float |
; pointer-vector
-; COMPLEX = (pair VAL VAL) | (vector VAL) | (list VAL)
+; COMPLEX = (pair VAL VAL)
+; | (vector-of VAL)
+; | (list-of VAL)
+; | (vector VAL1 ...)
+; | (list VAL1 ...)
; RESULTS = *
; | (VAL1 ...)
; TVAR = (VAR TYPE) | VAR
@@ -134,19 +138,14 @@
((boolean? lit) 'boolean)
((null? lit) 'null)
((list? lit)
- (let ((x (constant-result (car lit)))
- (r (cdr lit)))
- (simplify-type
- (if (null? r)
- `(pair ,x null)
- `(list (or ,@(map constant-result r)))))))
+ `(list ,@(map constant-result lit)))
((pair? lit)
(simplify-type
`(pair ,(constant-result (car lit)) ,(constant-result (cdr lit)))))
((eof-object? lit) 'eof)
((vector? lit)
(simplify-type
- `(vector (or ,@(map constant-result (vector->list lit))))))
+ `(vector ,@(map constant-result (vector->list lit)))))
((and (not (##sys#immediate? lit)) (##sys#generic-structure? lit))
`(struct ,(##sys#slot lit 0)))
((char? lit) 'char)
@@ -738,7 +737,7 @@
'##compiler#special-result-type))
=> (lambda (srt)
(dd " hardcoded special result-type: ~a" var)
- (set! r (srt n r))))))))
+ (set! r (srt n args r))))))))
subs
(cons
fn
@@ -780,6 +779,7 @@
;; first exp is always a variable so ts must be of length 1
(let loop ((types params) (subs (cdr subs)))
(cond ((null? types)
+ ;;XXX figure out line-number
(quit "~ano clause applies in `compiler-typecase' for expression of type `~s':~a"
(location-name loc) (car ts)
(string-concatenate
@@ -826,6 +826,10 @@
(change! (cute set-cdr! (car lst) <>)))
(when (pair? t)
(case (car t)
+ ((pair-of vector-of)
+ (dd " smashing `~s' in ~a" (caar lst) where)
+ (change! (if (eq? 'pair-of (car t)) 'pair 'vector))
+ (car t))
((pair vector)
(dd " smashing `~s' in ~a" (caar lst) where)
(change! (car t))
@@ -896,10 +900,14 @@
(sprintf "a pair wth car ~a and cdr ~a"
(typename (second t))
(typename (third t))))
- ((vector)
+ ((vector-of)
(sprintf "a vector with element type ~a" (typename (second t))))
- ((list)
+ ((list-of)
(sprintf "a list with element type ~a" (typename (second t))))
+ ((vector list)
+ (sprintf "a ~a with the element types ~a"
+ (car t)
+ (map typename (cdr t))))
(else (bomb "typename: invalid type" t))))
(else (bomb "typename: invalid type" t))))))
@@ -1051,18 +1059,18 @@
(eq? 'procedure (car t1))))
((eq? t1 'pair) (match1 '(pair * *) t2))
((eq? t2 'pair) (match1 t1 '(pair * *)))
- ((eq? t1 'list) (match1 '(list *) t2))
- ((eq? t2 'list) (match1 t1 '(list *)))
- ((eq? t1 'vector) (match1 '(vector *) t2))
- ((eq? t2 'vector) (match1 t1 '(vector *)))
+ ((eq? t1 'list) (match1 '(list-of *) t2))
+ ((eq? t2 'list) (match1 t1 '(list-of *)))
+ ((eq? t1 'vector) (match1 '(vector-of *) t2))
+ ((eq? t2 'vector) (match1 t1 '(vector-of *)))
((eq? t1 'null)
(and (not exact) (not all)
(or (memq t2 '(null list))
- (and (pair? t2) (eq? 'list (car t2))))))
+ (and (pair? t2) (eq? 'list-of (car t2))))))
((eq? t2 'null)
(and (not exact)
(or (memq t1 '(null list))
- (and (pair? t1) (eq? 'list (car t1))))))
+ (and (pair? t1) (eq? 'list-of (car t1))))))
((and (pair? t1) (pair? t2) (eq? (car t1) (car t2)))
(case (car t1)
((procedure)
@@ -1074,37 +1082,105 @@
(match-results results1 results2))))
((struct) (equal? t1 t2))
((pair) (every match1 (cdr t1) (cdr t2)))
- ((list vector) (match1 (second t1) (second t2)))
+ ((list-of vector-of) (match1 (second t1) (second t2)))
+ ((list vector)
+ (and (= (length t1) (length t2))
+ (every match1 (cdr t1) (cdr t2))))
(else #f) ) )
((and (pair? t1) (eq? 'pair (car t1)))
(and (not exact) (not all)
(pair? t2)
- (eq? 'list (car t2))
- (match1 (second t1) (second t2))
- (match1 (third t1) t2)))
+ (case (car t2)
+ ((list-of)
+ (and (match1 (second t1) (second t2))
+ (match1 (third t1) t2)))
+ ((list)
+ (and (match1 (second t1) (second t2))
+ (match1 (third t1)
+ (if (null? (cdr t2))
+ 'null
+ `(list ,@(cddr t2))))))
+ (else #f))))
((and (pair? t2) (eq? 'pair (car t2)))
- (and (not exact)
- (pair? t1)
- (eq? 'list (car t1))
- (match1 (second t1) (second t2))
- (match1 t1 (third t2))))
- ((and (pair? t1) (eq? 'list (car t1)))
- ;;XXX (list T) == (pair T (pair T ... (pair T null)))
+ (and (pair? t1)
+ (case (car t1)
+ ((list-of)
+ (and (not exact)
+ (match1 (second t1) (second t2))
+ (match1 t1 (third t2))))
+ ((list)
+ (and (match1 (second t1) (second t2))
+ (or (not exact) (pair? (cdr t1)))
+ (match1 (if (null? (cdr t1))
+ 'null
+ `(list ,@(cddr t1)))
+ (third t2))))
+ (else #f))))
+ ((and (pair? t1) (eq? 'list-of (car t1)))
+ ;;XXX (list-of T) == (pair T (pair T ... (pair T null)))
;; should also work in exact mode
(and (not exact) (not all)
(or (eq? 'null t2)
(and (pair? t2)
- (eq? 'pair (car t2))
- (match1 (second t1) (second t2))
- (match1 t1 (third t2))))))
- ((and (pair? t2) (eq? 'list (car t2)))
+ (case (car t2)
+ ((pair)
+ (and (match1 (second t1) (second t2))
+ (match1 t1 (third t2))))
+ ((list)
+ (match1
+ (second t1)
+ (simplify-type `(or ,@(cdr t2)))))
+ (else #f))))))
+ ((and (pair? t1) (eq? 'list (car t1)))
+ (and (pair? t2)
+ (case (car t2)
+ ((pair)
+ (and (pair? (cdr t1))
+ (match1 (second t1) (second t2))
+ (match1 t1 (third t2))))
+ ((list-of)
+ (and (not exact) (not all)
+ (match1
+ (simplify-type `(or ,@(cdr t1)))
+ (second t2))))
+ (else #f))))
+ ((and (pair? t2) (eq? 'list-of (car t2)))
(and (not exact)
(or (eq? 'null t1)
(and (pair? t1)
- (eq? 'pair (car t1))
- (match1 (second t1) (second t2))
- (match1 (third t1) t2)))))
+ (case (car t1)
+ ((pair)
+ (and (match1 (second t1) (second t2))
+ (match1 (third t1) t2)))
+ ((list)
+ (match1
+ (simplify-type `(or ,@(cdr t1)))
+ (second t2)))
+ (else #f))))))
+ ((and (pair? t2) (eq? 'list (car t2)))
+ (and (pair? t1)
+ (case (car t1)
+ ((pair)
+ (and (pair? (cdr t2))
+ (match1 (second t1) (second t2))
+ (match1 (third t1) t2)))
+ ((list-of)
+ (and (not exact) (not all)
+ (match1
+ (second t1)
+ (simplify-type `(or ,@(cdr t2))))))
+ (else #f))))
+ ((and (pair? t1) (eq? 'vector (car t1)))
+ (and (not exact) (not all)
+ (pair? t2)
+ (eq? 'vector-of (car t2))
+ (match1 (simplify-type `(or ,@(cdr t1))) (second t2))))
+ ((and (pair? t2) (eq? 'vector (car t2)))
+ (and (pair? t1)
+ (eq? 'vector-of (car t1))
+ (match1 (second t1) (simplify-type `(or ,@(cdr t2))))))
(else #f)))
+
(let ((m (match1 t1 t2)))
(dd " match~a~a ~a <-> ~a -> ~a te: ~s"
(if exact " (exact)" "")
@@ -1176,6 +1252,7 @@
((or)
(let ((ts (map simplify (cdr t))))
(cond ((= 1 (length ts)) (car ts))
+ ((null? ts) '*)
((every procedure-type? ts)
(if (any (cut eq? 'procedure <>) ts)
'procedure
@@ -1227,11 +1304,22 @@
(cond ((and (pair? tr) (eq? 'pair (first tr)))
(rec (third tr) (cons (second tr) ts)))
(else `(pair ,tcar ,tcdr)))))))
- ((vector list)
+ ((vector-of)
+ (let ((t2 (simplify (second t))))
+ (if (eq? t2 '*)
+ 'vector
+ `(,(car t) ,t2))))
+ ((vector-of list-of)
(let ((t2 (simplify (second t))))
(if (eq? t2 '*)
- (car t)
+ 'list
`(,(car t) ,t2))))
+ ((list)
+ (if (null? (cdr t))
+ 'null
+ `(list ,@(map simplify (cdr t)))))
+ ((vector)
+ `(vector ,@(map simplify (cdr t))))
((procedure)
(let* ((name (and (named? t) (cadr t)))
(rtypes (if name (cdddr t) (cddr t))))
@@ -1352,7 +1440,7 @@
((memq t1 '(vector list)) (type<=? `(,t1 *) t2))
((and (eq? 'null t1)
(pair? t2)
- (eq? (car t2) 'list)))
+ (eq? (car t2) 'list-of)))
((and (pair? t1) (eq? 'forall (car t1)))
(extract-vars (second t1))
(type<=? (third t1) t2))
@@ -1363,18 +1451,27 @@
(case t2
((procedure) (and (pair? t1) (eq? 'procedure (car t1))))
((number) (memq t1 '(fixnum float)))
- ((vector list) (type<=? t1 `(,t2 *)))
+ ((vector) (type<=? t1 '(vector-of *)))
+ ((list) (type<=? t1 '(list-of *)))
((pair) (type<=? t1 '(pair * *)))
(else
(cond ((not (pair? t1)) #f)
((not (pair? t2)) #f)
((eq? 'or (car t2))
(every (cut type<=? t1 <>) (cdr t2)))
+ ((and (eq? 'vector (car t1)) (eq? 'vector-of (car t2)))
+ (every (cute type<=? <> (second t2)) (cdr t1)))
+ ((and (eq? 'vector-of (car t1)) (eq? 'vector (car t2)))
+ (every (cute type<=? (second t1) <>) (cdr t2)))
+ ((and (eq? 'list (car t1)) (eq? 'list-of (car t2)))
+ (every (cute type<=? <> (second t2)) (cdr t1)))
+ ((and (eq? 'list-of (car t1)) (eq? 'list (car t2)))
+ (every (cute type<=? (second t1) <>) (cdr t2)))
((not (eq? (car t1) (car t2))) #f)
(else
(case (car t1)
((or) (every (cut type<=? <> t2) (cdr t1)))
- ((vector list) (type<=? (second t1) (second t2)))
+ ((vector-of list-of) (type<=? (second t1) (second t2)))
((pair) (every type<=? (cdr t1) (cdr t2)))
((procedure)
(let ((args1 (if (named? t1) (caddr t1) (cadr t1)))
@@ -1627,7 +1724,7 @@
((or) `(or ,@(map (cut resolve <> done) (cdr t))))
((not) `(not ,(resolve (second t) done)))
((forall) `(forall ,(second t) ,(resolve (third t) done)))
- ((pair list vector)
+ ((pair list vector vector-of list-of)
(cons (car t) (map (cut resolve <> done) (cdr t))))
((procedure)
(let* ((argtypes (procedure-arguments t))
@@ -1894,10 +1991,18 @@
(set! ptype (cons t (validate (cadr cp))))
(and ok t))
(else #f))))))
- ((memq (car t) '(vector list))
- (and (= 2 (length t))
+ ((memq (car t) '(vector-of list-of))
+ (and (list? t)
+ (= 2 (length t))
(let ((t2 (validate (second t))))
(and t2 `(,(car t) ,t2)))))
+ ((memq (car t) '(vector list))
+ (and (list? t)
+ (let loop ((ts (cdr t)) (ts2 '()))
+ (cond ((null? ts) `(,(car t) ,@(reverse ts2)))
+ ((validate (car ts)) =>
+ (lambda (t2) (loop (cdr ts) (cons t2 ts2))))
+ (else #f)))))
((eq? 'pair (car t))
(and (= 3 (length t))
(let ((ts (map validate (cdr t))))
@@ -1997,7 +2102,7 @@
(##sys#put! 'name '##compiler#special-result-type handler))))
(define-special-case ##sys#make-structure
- (lambda (node rtypes)
+ (lambda (node args rtypes)
(or (let ((subs (node-subexpressions node)))
(and (>= (length subs) 2)
(let ((arg1 (second subs)))
@@ -2011,6 +2116,43 @@
`((struct ,val)))))))))
rtypes)))
+(let ()
+ (define (vector-ref-result-type node args rtypes)
+ (or (let ((subs (node-subexpressions node))
+ (arg1 (second args)))
+ (and (pair? arg1)
+ (eq? 'vector (car arg1))
+ (= (length subs) 3)
+ (let ((index (third subs)))
+ (and (eq? 'quote (node-class index))
+ (let ((val (first (node-parameters index))))
+ (and (fixnum? val)
+ (>= val 0) (< val (length (cdr arg1))) ;XXX could warn on failure
+ (list (list-ref (cdr arg1) val))))))))
+ rtypes))
+ (define-special-case vector-ref vector-ref-result-type)
+ (define-special-case ##sys#vector-ref vector-ref-result-type))
+
+(define-special-case list
+ (lambda (node args rtypes)
+ (if (null? (cdr args))
+ '(null)
+ `((list ,@(cdr args))))))
+
+(define-special-case ##sys#list
+ (lambda (node args rtypes)
+ (if (null? (cdr args))
+ '(null)
+ `((list ,@(cdr args))))))
+
+(define-special-case vector
+ (lambda (node args rtypes)
+ `((vector ,@(cdr args)))))
+
+(define-special-case ##sys#vector
+ (lambda (node args rtypes)
+ `((vector ,@(cdr args)))))
+
;;; generate type-checks for formal variables
;
@@ -2080,7 +2222,7 @@
,(test (third t) `(##sys#slot ,v 1))
'#f)
'#f))
- ((list)
+ ((list-of)
(let ((var (gensym)))
`(if (##core#inline "C_i_listp" ,v)
(##sys#check-list-items ;XXX missing
@@ -2088,7 +2230,7 @@
(lambda (,var)
,(test (second t) var)))
'#f)))
- ((vector)
+ ((vector-of)
(let ((var (gensym)))
`(if (##core#inline "C_i_vectorp" ,v)
(##sys#check-vector-items ;XXX missing
@@ -2096,6 +2238,7 @@
(lambda (,var)
,(test (second t) var)))
'#f)))
+ ;;XXX missing: vector, list
((not)
`(not ,(test (cadr t) v)))
(else (bomb "generate-type-checks!: invalid type" t v))))))
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 4a24457a..332b9808 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -86,7 +86,7 @@ diff -bu scrutiny.expected scrutiny.out
$compile scrutiny-tests-2.scm -scrutinize -analyze-only -ignore-repository -types $TYPESDB 2>scrutiny-2.out -verbose
if test -n "$MSYSTEM"; then
- dos2unix scrutiny.out
+ dos2unix scrutiny-2.out
fi
# this is sensitive to gensym-names, so make it optional
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 4e2fa56a..55f66029 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -7,6 +7,10 @@ Note: at toplevel:
in procedure call to `pair?', the predicate is called with an argument of type
`null' and will always return false
+Note: at toplevel:
+ in procedure call to `pair?', the predicate is called with an argument of type
+ `null' and will always return false
+
Note: at toplevel:
in procedure call to `pair?', the predicate is called with an argument of type
`fixnum' and will always return false
@@ -17,7 +21,7 @@ Note: at toplevel:
Note: at toplevel:
in procedure call to `list?', the predicate is called with an argument of type
- `list' and will always return true
+ `null' and will always return true
Note: at toplevel:
in procedure call to `list?', the predicate is called with an argument of type
@@ -39,6 +43,10 @@ Note: at toplevel:
in procedure call to `null?', the predicate is called with an argument of type
`pair' and will always return false
+Note: at toplevel:
+ in procedure call to `null?', the predicate is called with an argument of type
+ `null' and will always return true
+
Note: at toplevel:
in procedure call to `null?', the predicate is called with an argument of type
`fixnum' and will always return false
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 61622704..eb437e0b 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -105,10 +105,9 @@
(check #\x 1.2 char)
(check #t 1.2 boolean)
(check (+ 1 2) 'a number)
-(check '(1) 1.2 (pair fixnum null))
-(check '(a) 1.2 (pair symbol null))
-(check (list 1) '(1 . 2) list)
-(check '(1) 1.2 pair)
+(check '(1) 1.2 (list fixnum))
+(check '(a) 1.2 (list symbol))
+(check (list 1) '(1 . 2) (list fixnum))
(check '(1 . 2) '() pair)
(check + 1.2 procedure)
(check '#(1) 1.2 vector)
@@ -121,17 +120,17 @@
(check (##sys#make-structure 'promise) 1 (struct promise))
(check '(1 . 2.3) '(a) (pair fixnum float))
(check '#(a) 1 (vector symbol))
-(check '("ok") 1 (pair string null))
+(check '("ok") 1 (list string))
(ms 123 1.2 fixnum)
(ms "abc" 1.2 string)
(ms 'abc 1.2 symbol)
(ms #\x 1.2 char)
(ms #t 1.2 boolean)
-(ms '(1) 1.2 pair)
+(ms '(1) 1.2 (list fixnum))
(ms '(1 . 2) '() pair)
(ms + 1.2 procedure)
-(ms '#(1) 1.2 vector)
+(ms '#(1) 1.2 (vector fixnum))
(ms '() 1 null)
(ms (void) 1.2 undefined)
(ms (current-input-port) 1.2 port)
@@ -142,8 +141,8 @@
(ms (##sys#make-structure 'promise) 1 (struct promise))
(ms '(1 . 2.3) '(a) (pair fixnum float))
(ms '#(a) 1 (vector symbol))
-(ms '(1) "a" (or pair symbol))
-(ms (list 1) 'a list)
+(ms '(1) "a" (or (list fixnum) symbol))
+(ms (list 1) 'a (list fixnum))
(ms '() 'a (or null pair))
(define n 1)
@@ -152,7 +151,7 @@
(checkp boolean? #f boolean)
(checkp pair? '(1 . 2) pair)
(checkp null? '() null)
-(checkp list? '(1) list)
+(checkp list? '(1) (list fixnum))
(checkp symbol? 'a symbol)
(checkp number? (+ n) number)
(checkp number? (+ n) number)
@@ -177,4 +176,26 @@
(mn (procedure () *) (procedure () * *))
(mx (forall (a) (procedure (#!rest a) a)) +)
-(mx (or pair null) '(1))
+(mx (list fixnum) '(1))
+
+
+;;; special cases
+
+(let ((x (##sys#make-structure 'foo)))
+ (mx (struct foo) x))
+
+(define x 1)
+
+(assert
+ (eq? 'number
+ (compiler-typecase (vector-ref '#(1 2 3.4) x)
+ (fixnum 'fixnum)
+ (float 'float)
+ (number 'number))))
+
+(mx float (vector-ref '#(1 2 3.4) 2))
+(mx fixnum (vector-ref '#(1 2 3.4) 0))
+(mx float (##sys#vector-ref '#(1 2 3.4) 2))
+(mx fixnum (##sys#vector-ref '#(1 2 3.4) 0))
+(mx (vector fixnum float) (vector 1 2.3))
+(mx (list fixnum float) (list 1 2.3))
diff --git a/types.db b/types.db
index 859a2891..172326b1 100644
--- a/types.db
+++ b/types.db
@@ -147,11 +147,9 @@
(null? (#(procedure #:pure #:predicate null) null? (*) boolean))
(list? (#(procedure #:pure #:predicate list) list? (*) boolean))
-(list (#(procedure #:pure) list (#!rest) list)
- (() (null) '()))
-
-(##sys#list (#(procedure #:pure) ##sys#list (#!rest) list)
- (() (null) '()))
+;; special cased (see scrutinizer.scm)
+(list (#(procedure #:pure) list (#!rest) list))
+(##sys#list (#(procedure #:pure) ##sys#list (#!rest) list))
(length (#(procedure #:clean #:enforce) length (list) fixnum) ; may loop
((null) '0)
@@ -161,8 +159,9 @@
((null) '0)
((list) (##core#inline "C_u_i_length" #(1))))
-(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)))
+(list-tail (forall (a) (#(procedure #:clean #:enforce) list-tail ((list-of a) fixnum) (list-of a))))
+(list-ref (forall (a) (#(procedure #:clean #:enforce) list-ref ((list-of a) fixnum) a)))
+
(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))))
@@ -510,20 +509,24 @@
;(string-copy (#(procedure #:clean #:enforce) string-copy (string) string)) - we use the more general version from srfi-13
-(string->list (#(procedure #:clean #:enforce) string->list (string) (list char)))
-(list->string (#(procedure #:clean #:enforce) list->string ((list char)) string))
+(string->list (#(procedure #:clean #:enforce) string->list (string) (list-of char)))
+(list->string (#(procedure #:clean #:enforce) list->string ((list-of 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 #:pure #:predicate vector) vector? (*) boolean))
-;; not result type "(vector a)", since it may be mutated!
-(make-vector (forall (a) (#(procedure #:clean #:enforce) make-vector (fixnum #!optional a) vector)))
+(make-vector (forall (a) (#(procedure #:clean #:enforce) make-vector (fixnum #!optional a)
+ (vector-of a))))
+
+;; these are special cased (see scrutinizer.scm)
+(vector-ref (forall (a) (#(procedure #:clean #:enforce) vector-ref ((vector-of a) fixnum) a)))
+(##sys#vector-ref (forall (a) (#(procedure #:clean #:enforce) ##sys#vector-ref ((vector-of a) fixnum) a)))
-(vector-ref (forall (a) (#(procedure #:clean #:enforce) 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))
+
+;; special cased (see scrutinizer.scm)
(vector (#(procedure #:clean #:clean) vector (#!rest) vector))
(##sys#vector (#(procedure #:clean #:clean) ##sys#vector (#!rest) vector))
@@ -532,20 +535,20 @@
(##sys#vector-length (#(procedure #:clean #:enforce) ##sys#vector-length (vector) fixnum)
((vector) (##sys#size #(1))))
-(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->list (forall (a) (#(procedure #:clean #:enforce) vector->list ((vector-of a)) (list-of a))))
+(##sys#vector->list (forall (a) (#(procedure #:clean #:enforce) ##sys#vector->list ((vector-of a)) (list-of a))))
+(list->vector (forall (a) (#(procedure #:clean #:enforce) list->vector ((list-of a)) (vector-of a))))
+(##sys#list->vector (forall (a) (#(procedure #:clean #:enforce) ##sys#list->vector ((list-of a)) (vector-of a))))
(vector-fill! (#(procedure #:enforce) vector-fill! (vector *) undefined))
(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))))
+(map (forall (a b) (#(procedure #:enforce) map ((procedure (a #!rest) b) (list-of a) #!rest list) (list-of b))))
(for-each
- (forall (a) (#(procedure #:enforce) for-each ((procedure (a #!rest) . *) (list a) #!rest list) undefined)))
+ (forall (a) (#(procedure #:enforce) for-each ((procedure (a #!rest) . *) (list-of a) #!rest list) undefined)))
(apply (#(procedure #:enforce) apply (procedure #!rest) . *))
(##sys#apply (#(procedure #:enforce) ##sys#apply (procedure #!rest) . *))
@@ -662,8 +665,8 @@
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0)))
-(argc+argv (#(procedure #:clean) argc+argv () fixnum (list string) fixnum))
-(argv (#(procedure #:clean) argv () (list string)))
+(argc+argv (#(procedure #:clean) argc+argv () fixnum (list-of string) fixnum))
+(argv (#(procedure #:clean) argv () (list-of string)))
(arithmetic-shift (#(procedure #:clean #:enforce) arithmetic-shift (number number) number))
(bit-set? (#(procedure #:clean #:enforce) bit-set? (number fixnum) boolean)
@@ -697,13 +700,13 @@
(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)))
+(command-line-arguments (#(procedure #:clean) command-line-arguments (#!optional (list-of string)) (list-of 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 #:pure #:predicate (struct condition)) condition? (*) boolean))
-(condition->list (#(procedure #:clean #:enforce) condition->list ((struct condition)) (list (pair symbol *))))
+(condition->list (#(procedure #:clean #:enforce) condition->list ((struct condition)) (list-of (pair symbol *))))
(continuation-capture (#(procedure #:enforce) continuation-capture ((procedure ((struct continuation)) . *)) *))
(continuation-graft (#(procedure #:clean #:enforce) continuation-graft ((struct continuation) (procedure () . *)) *))
(continuation-return (#(procedure #:enforce) continuation-return (procedure #!rest) . *)) ;XXX make return type more specific?
@@ -758,7 +761,7 @@
(expand (procedure expand (* #!optional list) *))
(extension-information (#(procedure #:clean) extension-information (symbol) *))
(feature? (#(procedure #:clean) feature? (symbol) boolean))
-(features (#(procedure #:clean) features () (list symbol)))
+(features (#(procedure #:clean) features () (list-of symbol)))
(file-exists? (#(procedure #:clean #:enforce) file-exists? (string) (or boolean string)))
(directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string) (or boolean string)))
@@ -785,8 +788,8 @@
(flush-output (#(procedure #:enforce) flush-output (#!optional port) undefined))
-(foldl (forall (a b) (#(procedure #:enforce) foldl ((procedure (a b) a) a (list b)) a)))
-(foldr (forall (a b) (#(procedure #:enforce) foldr ((procedure (a b) b) b (list a)) b)))
+(foldl (forall (a b) (#(procedure #:enforce) foldl ((procedure (a b) a) a (list-of b)) a)))
+(foldr (forall (a b) (#(procedure #:enforce) foldr ((procedure (a b) b) b (list-of a)) b)))
(force-finalizers (procedure force-finalizers () undefined))
@@ -906,7 +909,7 @@
(get (#(procedure #:clean #:enforce) get (symbol symbol #!optional *) *)
((symbol symbol *) (##core#inline "C_i_getprop" #(1) #(2) #(3))))
-(get-call-chain (#(procedure #:clean #:enforce) get-call-chain (#!optional fixnum (struct thread)) (list vector)))
+(get-call-chain (#(procedure #:clean #:enforce) get-call-chain (#!optional fixnum (struct thread)) (list-of 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 *) *))
@@ -944,7 +947,7 @@
(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 #:clean) memory-statistics () (vector fixnum)))
+(memory-statistics (#(procedure #:clean) memory-statistics () (vector-of fixnum)))
(minimum-flonum float)
(module-environment (#(procedure #:clean #:enforce) module-environment (symbol #!optional symbol) (struct environment)))
(most-negative-fixnum fixnum)
@@ -984,7 +987,7 @@
(reset (procedure reset () noreturn))
(reset-handler (#(procedure #:clean #:enforce) reset-handler (#!optional (procedure () . *)) procedure))
(return-to-host (procedure return-to-host () . *))
-(reverse-list->string (#(procedure #:clean #:enforce) reverse-list->string ((list char)) string))
+(reverse-list->string (#(procedure #:clean #:enforce) reverse-list->string ((list-of char)) string))
(set-finalizer! (#(procedure #:clean #:enforce) set-finalizer! (* (procedure (*) . *)) *))
(set-gc-report! (#(procedure #:clean) set-gc-report! (*) undefined))
@@ -1010,7 +1013,7 @@
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) '1.0)))
-(subvector (forall (a) (#(procedure #:clean #:enforce) subvector ((vector a) fixnum #!optional fixnum) (vector a))))
+(subvector (forall (a) (#(procedure #:clean #:enforce) subvector ((vector-of a) fixnum #!optional fixnum) (vector-of a))))
(symbol-escape (#(procedure #:clean) symbol-escape (#!optional *) *))
(symbol-plist (#(procedure #:clean #:enforce) symbol-plist (symbol) list)
@@ -1020,8 +1023,8 @@
(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 #!optional *)
- (vector a))))
+ (forall (a) (#(procedure #:clean #:enforce) vector-resize ((vector-of a) fixnum #!optional *)
+ (vector-of a))))
(void (#(procedure #:pure) void (#!rest) undefined))
(##sys#void (#(procedure #:pure) void (#!rest) undefined))
(warning (procedure warning (* #!rest) undefined))
@@ -1093,8 +1096,8 @@
(->string (procedure ->string (*) string)
((string) #(1)))
-(alist-ref (#(procedure #:clean #:enforce) alist-ref (* (list pair) #!optional (procedure (* *) *) *) *))
-(alist-update! (#(procedure #:enforce) alist-update! (* * (list pair) #!optional (procedure (* *) *)) *))
+(alist-ref (#(procedure #:clean #:enforce) alist-ref (* (list-of pair) #!optional (procedure (* *) *) *) *))
+(alist-update! (#(procedure #:enforce) alist-update! (* * (list-of pair) #!optional (procedure (* *) *)) *))
(always? deprecated)
(any? (#(procedure #:pure) any? (*) boolean)
@@ -1104,12 +1107,12 @@
((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 #:clean #:enforce) butlast ((pair a *)) (list a))))
-(chop (forall (a) (#(procedure #:clean #:enforce) chop ((list a) fixnum) (list a))))
+(binary-search (forall (a) (#(procedure #:enforce) binary-search ((vector-of a) (procedure (a) *)) *)))
+(butlast (forall (a) (#(procedure #:clean #:enforce) butlast ((pair a *)) (list-of a))))
+(chop (forall (a) (#(procedure #:clean #:enforce) chop ((list-of a) fixnum) (list-of 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))))
+(compress (forall (a) (#(procedure #:clean #:enforce) compress (list (list-of a)) (list-of a))))
(conc (procedure conc (#!rest) string))
(conjoin (#(procedure #:clean #:enforce) conjoin (#!rest (procedure (*) *)) (procedure (*) *)))
(constantly (forall (a) (#(procedure #:pure) constantly (a) (procedure (#!rest) a))))
@@ -1126,11 +1129,11 @@
(merge
(forall (e)
- (#(procedure #:enforce) merge ((list e) (list e) (procedure (e e) *)) (list e))))
+ (#(procedure #:enforce) merge ((list-of e) (list-of e) (procedure (e e) *)) (list-of e))))
(merge!
(forall (e)
- (#(procedure #:enforce) merge! ((list e) (list e) (procedure (e e) *)) (list e))))
+ (#(procedure #:enforce) merge! ((list-of e) (list-of e) (procedure (e e) *)) (list-of e))))
(never? deprecated)
(none? deprecated)
@@ -1152,36 +1155,36 @@
(queue-remove! (#(procedure #:clean #:enforce) queue-remove! ((struct queue)) *))
(queue? (#(procedure #:pure #:predicate (struct queue)) queue? (*) boolean))
-(rassoc (#(procedure #:clean #:enforce) rassoc (* (list pair) #!optional (procedure (* *) *)) *))
-(reverse-string-append (#(procedure #:clean #:enforce) reverse-string-append ((list string)) string))
+(rassoc (#(procedure #:clean #:enforce) rassoc (* (list-of pair) #!optional (procedure (* *) *)) *))
+(reverse-string-append (#(procedure #:clean #:enforce) reverse-string-append ((list-of string)) string))
(shuffle deprecated)
-;; (: sort (forall (e (s (or (vector e) (list e)))) (s (e e -> *) -> s)))
-;; if we had contraints for "forall"
+;; (: sort (forall (e (s (or (vector-of e) (list-of e)))) (s (e e -> *) -> s)))
+;; if we had constraints for "forall"
(sort
- (forall (e (s (or (vector e) (list e))))
+ (forall (e (s (or (vector-of e) (list-of e))))
(#(procedure #:enforce)
sort
(s (procedure (e e) *))
s)))
(sort!
- (forall (e (s (or (vector e) (list e))))
+ (forall (e (s (or (vector-of e) (list-of e))))
(#(procedure #:enforce)
sort
(s (procedure (e e) *))
s)))
(sorted? (#(procedure #:enforce) sorted? ((or list vector) (procedure (* *) *)) boolean))
-(topological-sort (#(procedure #:enforce) topological-sort ((list list) (procedure (* *) *)) list))
+(topological-sort (#(procedure #:enforce) topological-sort ((list-of list) (procedure (* *) *)) list))
(string-chomp (#(procedure #:clean #:enforce) string-chomp (string #!optional string) string))
-(string-chop (#(procedure #:clean #:enforce) string-chop (string fixnum) (list string)))
+(string-chop (#(procedure #:clean #:enforce) string-chop (string fixnum) (list-of 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-intersperse (#(procedure #:clean #:enforce) string-intersperse ((list-of string) #!optional string) string))
+(string-split (#(procedure #:clean #:enforce) string-split (string #!optional string *) (list-of string)))
(string-translate (#(procedure #:clean #:enforce) string-translate (string * #!optional *) string))
-(string-translate* (#(procedure #:clean #:enforce) string-translate* (string (list (pair string string))) string))
+(string-translate* (#(procedure #:clean #:enforce) string-translate* (string (list-of (pair string string))) string))
(substring-ci=? (#(procedure #:clean #:enforce) substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean))
(substring-index (#(procedure #:clean #:enforce) substring-index (string string #!optional fixnum) (or boolean fixnum))
@@ -1210,7 +1213,7 @@
(read-byte (#(procedure #:enforce) read-byte (#!optional port) *))
(read-file (#(procedure #:enforce) read-file (#!optional (or port string) (procedure (port) *) fixnum) list))
(read-line (#(procedure #:enforce) read-line (#!optional port (or boolean fixnum)) *))
-(read-lines (#(procedure #:enforce) read-lines (#!optional (or port string) fixnum) (list string)))
+(read-lines (#(procedure #:enforce) read-lines (#!optional (or port string) fixnum) (list-of string)))
(read-string (#(procedure #:enforce) read-string (#!optional * port) string))
(read-string! (#(procedure #:enforce) read-string! (fixnum string #!optional port fixnum) fixnum))
(read-token (#(procedure #:enforce) read-token ((procedure (char) *) #!optional port) string))
@@ -1477,7 +1480,7 @@
(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))))
+ (forall (a b) (#(procedure #:enforce) port-map ((procedure (a) b) (procedure () a)) (list-of b))))
(port-fold (#(procedure #:enforce) port-fold ((procedure (* *) *) * (procedure () *)) *))
(make-broadcast-port (#(procedure #:clean #:enforce) make-broadcast-port (#!rest port) port))
@@ -1513,13 +1516,13 @@
(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 #:clean) get-environment-variables () (list string)))
+(get-environment-variables (#(procedure #:clean) get-environment-variables () (list-of 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 (string #!optional *) (list-of string)))
(directory? (#(procedure #:clean #:enforce) directory? ((or string fixnum)) boolean))
(duplicate-fileno (#(procedure #:clean #:enforce) duplicate-fileno (fixnum #!optional fixnum) fixnum))
(errno/2big fixnum)
@@ -1583,9 +1586,9 @@
(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-select (#(procedure #:clean #:enforce) file-select ((list-of fixnum) (list-of 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-stat (#(procedure #:clean #:enforce) file-stat ((or string fixnum) #!optional *) (vector-of 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))
@@ -1601,7 +1604,7 @@
(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-time->seconds (#(procedure #:clean #:enforce) local-time->seconds ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)) 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)
@@ -1648,15 +1651,15 @@
(perm/ixusr fixnum)
(pipe/buf 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 (#(procedure #:clean #:enforce) process (string #!optional (list-of string) (list-of string)) port port fixnum))
+(process* (#(procedure #:clean #:enforce) process* (string #!optional (list-of string) (list-of string)) port port fixnum *))
(process-execute
- (#(procedure #:clean #:enforce) process-execute (string #!optional (list string) (list string)) noreturn))
+ (#(procedure #:clean #:enforce) process-execute (string #!optional (list-of string) (list-of string)) noreturn))
(process-fork (#(procedure #:enforce) process-fork (#!optional (procedure () . *)) fixnum))
(process-group-id (#(procedure #:clean #:enforce) process-group-id () fixnum))
-(process-run (#(procedure #:clean #:enforce) process-run (string #!optional (list string)) fixnum))
+(process-run (#(procedure #:clean #:enforce) process-run (string #!optional (list-of 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)
@@ -1665,9 +1668,9 @@
(prot/write fixnum)
(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->local-time (#(procedure #:clean #:enforce) seconds->local-time (#!optional number) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)))
(seconds->string (#(procedure #:clean #:enforce) seconds->string (#!optional number) string))
-(seconds->utc-time (#(procedure #:clean #:enforce) seconds->utc-time (#!optional number) (vector number)))
+(seconds->utc-time (#(procedure #:clean #:enforce) seconds->utc-time (#!optional number) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)))
(seek/cur fixnum)
(seek/end fixnum)
(seek/set fixnum)
@@ -1677,7 +1680,7 @@
(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 (or boolean (procedure (fixnum) . *))) undefined))
-(set-signal-mask! (#(procedure #:clean #:enforce) set-signal-mask! ((list fixnum)) undefined))
+(set-signal-mask! (#(procedure #:clean #:enforce) set-signal-mask! ((list-of 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))
@@ -1715,80 +1718,80 @@
(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))
+(string->time (#(procedure #:clean #:enforce) string->time (string #!optional string) (vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)))
(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))
+(time->string (#(procedure #:clean #:enforce) time->string ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum) #!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))
+(utc-time->seconds (#(procedure #:clean #:enforce) utc-time->seconds ((vector fixnum fixnum fixnum fixnum fixnum fixnum fixnum fixnum boolean fixnum)) 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 #: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) *)))
+(alist-cons (forall (a b c) (#(procedure #:clean) alist-cons (a b (list-of c)) (pair a (pair b (list-of c))))))
+(alist-copy (forall (a) (#(procedure #:clean #:enforce) alist-copy ((list-of a)) (list-of a))))
+(alist-delete (forall (a b) (#(procedure #:enforce) alist-delete (a (list-of b) #!optional (procedure (a b) *)) list)))
+(alist-delete! (forall (a b) (#(procedure #:enforce) alist-delete! (a (list-of b) #!optional (procedure (a b) *)) undefined)))
+(any (forall (a) (#(procedure #:enforce) any ((procedure (a #!rest) *) (list-of a) #!rest list) *)))
(append! (#(procedure #:enforce) append! (#!rest list) list))
(append-map
- (forall (a b) (#(procedure #:enforce) append-map ((procedure (a #!rest) (list b)) (list a) #!rest list)
- (list b))))
+ (forall (a b) (#(procedure #:enforce) append-map ((procedure (a #!rest) (list-of b)) (list-of a) #!rest list)
+ (list-of b))))
(append-map!
- (forall (a b) (#(procedure #:enforce) append-map! ((procedure (a #!rest) (list b)) (list a) #!rest list)
- (list b))))
+ (forall (a b) (#(procedure #:enforce) append-map! ((procedure (a #!rest) (list-of b)) (list-of a) #!rest list)
+ (list-of b))))
(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))))
+(break (forall (a) (#(procedure #:enforce) break ((procedure (a) *) (list-of a)) (list-of a) (list-of a))))
+(break! (forall (a) (#(procedure #:enforce) break! ((procedure (a) *) (list-of a)) (list-of a) (list-of a))))
(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 #:clean) circular-list? (*) boolean)
((null) (let ((#(tmp) #(1))) '#f)))
-(concatenate (#(procedure #:clean #:enforce) concatenate ((list list)) list))
-(concatenate! (#(procedure #:enforce) concatenate! ((list list)) list))
+(concatenate (#(procedure #:clean #:enforce) concatenate ((list-of list)) list))
+(concatenate! (#(procedure #:enforce) concatenate! ((list-of list)) list))
(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))))
+(count (forall (a) (#(procedure #:enforce) count ((procedure (a #!rest) *) (list-of a) #!rest list) fixnum)))
+(delete (forall (a b) (#(procedure #:enforce) delete (a (list-of b) #!optional (procedure (a *) *)) (list-of b))))
+(delete! (forall (a b) (#(procedure #:enforce) delete! (a (list-of b) #!optional (procedure (a *) *)) (list-of b))))
(delete-duplicates
- (forall (a) (#(procedure #:enforce) delete-duplicates ((list a) #!optional (procedure (a *) *)) (list a))))
+ (forall (a) (#(procedure #:enforce) delete-duplicates ((list-of a) #!optional (procedure (a *) *)) (list-of a))))
(delete-duplicates!
- (forall (a) (#(procedure #:enforce) delete-duplicates! ((list a) #!optional (procedure (a *) *)) (list a))))
+ (forall (a) (#(procedure #:enforce) delete-duplicates! ((list-of a) #!optional (procedure (a *) *)) (list-of a))))
(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))))
+(drop (forall (a) (#(procedure #:enforce) drop ((list-of a) fixnum) (list-of a))))
+(drop-right (forall (a) (#(procedure #:enforce) drop-right ((list-of a) fixnum) (list-of a))))
+(drop-right! (forall (a) (#(procedure #:enforce) drop-right! ((list-of a) fixnum) (list-of a))))
+(drop-while (forall (a) (#(procedure #:enforce) drop-while ((procedure (a) *) (list-of a)) (list-of a))))
(eighth (#(procedure #:clean #:enforce) eighth (pair) *))
(every
- (forall (a) (#(procedure #:enforce) every ((procedure (a #!rest) *) (list a) #!rest list) *)))
+ (forall (a) (#(procedure #:enforce) every ((procedure (a #!rest) *) (list-of a) #!rest list) *)))
(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))))
+(filter (forall (a) (#(procedure #:enforce) filter ((procedure (a) *) (list-of a)) (list-of a))))
+(filter! (forall (a) (#(procedure #:enforce) filter! ((procedure (a) *) (list-of a)) (list-of a))))
(filter-map
- (forall (a b) (#(procedure #:enforce) filter-map ((procedure (a #!rest) b) (list a) #!rest list) (list b))))
+ (forall (a b) (#(procedure #:enforce) filter-map ((procedure (a #!rest) b) (list-of a) #!rest list) (list-of b))))
-(find (forall (a) (#(procedure #:enforce) find ((procedure (a) *) (list a)) *)))
-(find-tail (forall (a) (#(procedure #:enforce) find-tail ((procedure (a) *) (list a)) *)))
+(find (forall (a) (#(procedure #:enforce) find ((procedure (a) *) (list-of a)) *)))
+(find-tail (forall (a) (#(procedure #:enforce) find-tail ((procedure (a) *) (list-of a)) *)))
(first (forall (a) (#(procedure #:clean #:enforce) first ((pair a *)) a))
((pair) (##core#inline "C_u_i_car" #(1))))
@@ -1803,68 +1806,68 @@
(##core#inline "C_u_i_cdr"
(##core#inline "C_u_i_cdr" #(1)))))))
-(iota (#(procedure #:clean #:enforce) iota (fixnum #!optional fixnum fixnum) (list number)))
+(iota (#(procedure #:clean #:enforce) iota (fixnum #!optional fixnum fixnum) (list-of number)))
(last (#(procedure #:clean #:enforce) last (pair) *))
(last-pair (#(procedure #:clean #:enforce) last-pair (pair) *))
(length+ (#(procedure #:clean #:enforce) length+ (list) *))
-(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-copy (forall (a) (#(procedure #:clean #:enforce) list-copy ((list-of a)) (list-of a))))
+(list-index (forall (a) (#(procedure #:enforce) list-index ((procedure (a #!rest) *) (list-of a) #!rest list) *)))
+(list-tabulate (forall (a) (#(procedure #:enforce) list-tabulate (fixnum (procedure (fixnum) a)) (list-of a))))
(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))))
+ (forall (a) (#(procedure #:enforce) lset-adjoin ((procedure (a a) *) (list-of a) #!rest a) (list-of a))))
(lset-diff+intersection
(forall (a)
- (#(procedure #:enforce) lset-diff+intersection ((procedure (a a) *) (list a) #!rest (list a))
- (list a))))
+ (#(procedure #:enforce) lset-diff+intersection ((procedure (a a) *) (list-of a) #!rest (list-of a))
+ (list-of a))))
(lset-diff+intersection!
(forall (a)
- (#(procedure #:enforce) lset-diff+intersection! ((procedure (a a) *) (list a) #!rest (list a))
- (list a))))
+ (#(procedure #:enforce) lset-diff+intersection! ((procedure (a a) *) (list-of a) #!rest (list-of a))
+ (list-of a))))
(lset-difference
- (forall (a) (#(procedure #:enforce) lset-difference ((procedure (a a) *) (list a) #!rest (list a)) (list a))))
+ (forall (a) (#(procedure #:enforce) lset-difference ((procedure (a a) *) (list-of a) #!rest (list-of a)) (list-of a))))
(lset-difference!
- (forall (a) (#(procedure #:enforce) lset-difference! ((procedure (a a) *) (list a) #!rest (list a)) (list a))))
+ (forall (a) (#(procedure #:enforce) lset-difference! ((procedure (a a) *) (list-of a) #!rest (list-of a)) (list-of a))))
(lset-intersection
- (forall (a) (#(procedure #:enforce) lset-intersection ((procedure (a a) *) (list a) #!rest (list a)) (list a))))
+ (forall (a) (#(procedure #:enforce) lset-intersection ((procedure (a a) *) (list-of a) #!rest (list-of a)) (list-of a))))
(lset-intersection!
- (forall (a) (#(procedure #:enforce) lset-intersection! ((procedure (a a) *) (list a) #!rest (list a)) (list a))))
+ (forall (a) (#(procedure #:enforce) lset-intersection! ((procedure (a a) *) (list-of a) #!rest (list-of a)) (list-of a))))
(lset-union
- (forall (a) (#(procedure #:enforce) lset-union ((procedure (a a) *) (list a) #!rest (list a)) (list a))))
+ (forall (a) (#(procedure #:enforce) lset-union ((procedure (a a) *) (list-of a) #!rest (list-of a)) (list-of a))))
(lset-union!
- (forall (a) (#(procedure #:enforce) lset-union! ((procedure (a a) *) (list a) #!rest (list a)) (list a))))
+ (forall (a) (#(procedure #:enforce) lset-union! ((procedure (a a) *) (list-of a) #!rest (list-of a)) (list-of a))))
(lset-xor
- (forall (a) (#(procedure #:enforce) lset-xor ((procedure (a a) *) (list a) #!rest (list a)) (list a))))
+ (forall (a) (#(procedure #:enforce) lset-xor ((procedure (a a) *) (list-of a) #!rest (list-of a)) (list-of a))))
(lset-xor!
- (forall (a) (#(procedure #:enforce) lset-xor! ((procedure (a a) *) (list a) #!rest (list a)) (list a))))
+ (forall (a) (#(procedure #:enforce) lset-xor! ((procedure (a a) *) (list-of a) #!rest (list-of a)) (list-of a))))
(lset<=
- (forall (a) (#(procedure #:enforce) lset<= ((procedure (a a) *) (list a) #!rest (list a)) boolean)))
+ (forall (a) (#(procedure #:enforce) lset<= ((procedure (a a) *) (list-of a) #!rest (list-of a)) boolean)))
(lset=
- (forall (a) (#(procedure #:enforce) lset= ((procedure (a a) *) (list a) #!rest (list a)) boolean)))
+ (forall (a) (#(procedure #:enforce) lset= ((procedure (a a) *) (list-of a) #!rest (list-of a)) boolean)))
;; see note about "make-vector", above
(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))))
+ (forall (a b) (#(procedure #:enforce) map! ((procedure (a #!rest) b) (list-of a) #!rest list) (list-of b))))
(map-in-order
(forall
(a b)
- (#(procedure #:enforce) map-in-order ((procedure (a #!rest) b) (list a) #!rest list) (list b))))
+ (#(procedure #:enforce) map-in-order ((procedure (a #!rest) b) (list-of a) #!rest list) (list-of b))))
(ninth (#(procedure #:clean #:enforce) ninth (pair) *))
@@ -1880,32 +1883,32 @@
(pair-fold (#(procedure #:enforce) pair-fold (procedure * list #!rest list) *)) ;XXX do this
(pair-fold-right (#(procedure #:enforce) pair-fold-right (procedure * list #!rest list) *)) ;XXX
(pair-for-each (#(procedure #:enforce) pair-for-each ((procedure (#!rest) . *) list #!rest list) undefined)) ;XXX
-(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))))
+(partition (forall (a) (#(procedure #:enforce) partition ((procedure (a) *) (list-of a)) (list-of a) (list-of a))))
+(partition! (forall (a) (#(procedure #:enforce) partition! ((procedure (a) *) (list-of a)) (list-of a) (list-of a))))
(proper-list? (#(procedure #:clean) proper-list? (*) boolean)
((null) (let ((#(tmp) #(1))) '#t)))
(reduce (#(procedure #:enforce) reduce ((procedure (* *) *) * list) *)) ;XXX
(reduce-right (#(procedure #:enforce) reduce-right ((procedure (* *) *) * list) *)) ;XXX
-(remove (forall (a) (#(procedure #:enforce) remove ((procedure (a) *) (list a)) (list a))))
-(remove! (forall (a) (#(procedure #:enforce) remove! ((procedure (a) *) (list a)) (list a))))
-(reverse! (forall (a) (#(procedure #:enforce) reverse! ((list a)) (list a))))
+(remove (forall (a) (#(procedure #:enforce) remove ((procedure (a) *) (list-of a)) (list-of a))))
+(remove! (forall (a) (#(procedure #:enforce) remove! ((procedure (a) *) (list-of a)) (list-of a))))
+(reverse! (forall (a) (#(procedure #:enforce) reverse! ((list-of a)) (list-of a))))
(second (forall (a) (#(procedure #:clean #:enforce) second ((pair * (pair a *))) a))
(((pair * (pair * *))) (##core#inline "C_u_i_car" (##core#inline "C_u_i_cdr" #(1)))))
(seventh (#(procedure #:clean #:enforce) seventh (pair) *))
(sixth (#(procedure #:clean #:enforce) sixth (pair) *))
-(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))))
-(split-at! (forall (a) (#(procedure #:enforce) split-at! ((list a) fixnum) (list a) (list a))))
-(take (forall (a) (#(procedure #:enforce) take ((list a) fixnum) (list a))))
-(take! (forall (a) (#(procedure #:enforce) take! ((list a) fixnum) (list a))))
-(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))))
+(span (forall (a) (#(procedure #:enforce) span ((procedure (a) *) (list-of a)) (list-of a) (list-of a))))
+(span! (forall (a) (#(procedure #:enforce) span! ((procedure (a) *) (list-of a)) (list-of a) (list-of a))))
+(split-at (forall (a) (#(procedure #:enforce) split-at ((list-of a) fixnum) (list-of a) (list-of a))))
+(split-at! (forall (a) (#(procedure #:enforce) split-at! ((list-of a) fixnum) (list-of a) (list-of a))))
+(take (forall (a) (#(procedure #:enforce) take ((list-of a) fixnum) (list-of a))))
+(take! (forall (a) (#(procedure #:enforce) take! ((list-of a) fixnum) (list-of a))))
+(take-right (forall (a) (#(procedure #:enforce) take-right ((list-of a) fixnum) (list-of a))))
+(take-while (forall (a) (#(procedure #:enforce) take-while ((procedure (a) *) (list-of a)) (list-of a))))
+(take-while! (forall (a) (#(procedure #:enforce) take-while! ((procedure (a) *) (list-of a)) (list-of a))))
(tenth (#(procedure #:clean #:enforce) tenth (pair) *))
(third (forall (a) (#(procedure #:clean #:enforce) third ((pair * (pair * (pair a *)))) a))
@@ -1915,16 +1918,16 @@
(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 #: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))))
+(unzip1 (forall (a) (#(procedure #:clean #:enforce) unzip1 ((list-of (pair a *))) (list-of a))))
+(unzip2 (forall (a b) (#(procedure #:clean #:enforce) unzip2 ((list-of (pair a (pair b *)))) (list-of a) (list-of b))))
(unzip3
- (forall (a b c) (#(procedure #:clean #:enforce) unzip3 ((list (pair a (pair b (pair c *))))) (list a) (list b) (list c))))
+ (forall (a b c) (#(procedure #:clean #:enforce) unzip3 ((list-of (pair a (pair b (pair c *))))) (list-of a) (list-of b) (list-of c))))
(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 *)))))
+(zip (forall (a) (#(procedure #:clean #:enforce) zip ((list-of a) #!rest list) (list-of (pair a *)))))
;; srfi-13
@@ -1962,10 +1965,10 @@
(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 #: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-concatenate (#(procedure #:clean #:enforce) string-concatenate ((list-of string)) string))
+(string-concatenate-reverse (#(procedure #:clean #:enforce) string-concatenate-reverse ((list-of string) #!optional string fixnum) string))
+(string-concatenate-reverse/shared (#(procedure #:clean #:enforce) string-concatenate-reverse/shared ((list-of string) #!optional string fixnum) string))
+(string-concatenate/shared (#(procedure #:clean #:enforce) string-concatenate/shared ((list-of 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))
@@ -2167,8 +2170,8 @@
(char-set? (#(procedure #:pure #:predicate (struct char-set)) char-set? (*) boolean))
(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)))
+(list->char-set (#(procedure #:clean #:enforce) list->char-set ((list-of char) #!optional (struct char-set)) (struct char-set)))
+(list->char-set! (#(procedure #:clean #:enforce) list->char-set! ((list-of char) #!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)))
@@ -2276,7 +2279,7 @@
(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 float)))
+(f32vector->list (#(procedure #:clean #:enforce) f32vector->list ((struct f32vector)) (list-of float)))
(f32vector-length (#(procedure #:clean #:enforce) f32vector-length ((struct f32vector)) fixnum)
(((struct f32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
@@ -2289,7 +2292,7 @@
(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)) (list float)))
+(f64vector->list (#(procedure #:clean #:enforce) f64vector->list ((struct f64vector)) (list-of float)))
(f64vector-length (#(procedure #:clean #:enforce) f64vector-length ((struct f64vector)) fixnum)
(((struct f32vector)) (##core#inline "C_u_i_64vector_length" #(1))))
@@ -2299,14 +2302,14 @@
(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)))
+(list->f32vector (#(procedure #:clean #:enforce) list->f32vector ((list-of number)) (struct f32vector)))
+(list->f64vector (#(procedure #:clean #:enforce) list->f64vector ((list-of number)) (struct f64vector)))
+(list->s16vector (#(procedure #:clean #:enforce) list->s16vector ((list-of fixnum)) (struct s16vector)))
+(list->s32vector (#(procedure #:clean #:enforce) list->s32vector ((list-of number)) (struct s32vector)))
+(list->s8vector (#(procedure #:clean #:enforce) list->s8vector ((list-of fixnum)) (struct s8vector)))
+(list->u16vector (#(procedure #:clean #:enforce) list->u16vector ((list-of fixnum)) (struct u16vector)))
+(list->u32vector (#(procedure #:clean #:enforce) list->u32vector ((list-of number)) (struct u32vector)))
+(list->u8vector (#(procedure #:clean #:enforce) list->u8vector ((list-of 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)))
@@ -2321,7 +2324,7 @@
(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->list (#(procedure #:clean #:enforce) s16vector->list ((struct s16vector)) (list-of fixnum)))
(s16vector-length (#(procedure #:clean #:enforce) s16vector-length ((struct s16vector)) fixnum)
(((struct s16vector)) (##core#inline "C_u_i_16vector_length" #(1))))
@@ -2334,7 +2337,7 @@
(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->list (#(procedure #:clean #:enforce) s32vector->list ((struct s32vector)) (list-of number)))
(s32vector-length (#(procedure #:clean #:enforce) s32vector-length ((struct s32vector)) fixnum)
(((struct s32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
@@ -2347,7 +2350,7 @@
(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->list (#(procedure #:clean #:enforce) s8vector->list ((struct s8vector)) (list-of fixnum)))
(s8vector-length (#(procedure #:clean #:enforce) s8vector-length ((struct s8vector)) fixnum)
(((struct s8vector)) (##core#inline "C_u_i_8vector_length" #(1))))
@@ -2368,7 +2371,7 @@
(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->list (#(procedure #:clean #:enforce) u16vector->list ((struct u16vector)) (list-of fixnum)))
(u16vector-length (#(procedure #:clean #:enforce) u16vector-length ((struct u16vector)) fixnum)
(((struct u16vector)) (##core#inline "C_u_i_16vector_length" #(1))))
@@ -2381,7 +2384,7 @@
(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->list (#(procedure #:clean #:enforce) u32vector->list ((struct u32vector)) (list-of number)))
(u32vector-length (#(procedure #:clean #:enforce) u32vector-length ((struct u32vector)) fixnum)
(((struct u32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
@@ -2394,7 +2397,7 @@
(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->list (#(procedure #:clean #:enforce) u8vector->list ((struct u8vector)) (list-of fixnum)))
(u8vector-length (#(procedure #:clean #:enforce) u8vector-length ((struct u8vector)) fixnum)
(((struct u8vector)) (##core#inline "C_u_i_8vector_length" #(1))))
@@ -2409,13 +2412,13 @@
;; srfi-69
-(alist->hash-table (#(procedure #:clean #:enforce) alist->hash-table ((list pair) #!rest) (struct hash-table)))
+(alist->hash-table (#(procedure #:clean #:enforce) alist->hash-table ((list-of 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->alist (#(procedure #:clean #:enforce) hash-table->alist ((struct hash-table)) (list-of 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))
@@ -2510,6 +2513,6 @@
(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)))
+(compile-file-options (#(procedure #:clean #:enforce) compile-file-options (#!optional (list-of string)) (list-of string)))
(scan-input-lines (#(procedure #:enforce) scan-input-lines (* #!optional port) *))
(yes-or-no? (#(procedure #:enforce) yes-or-no? (string #!rest) *))
Trap