[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Chicken-hackers] [PATCH] sequence type corrections and enhancements
|
From: |
Felix |
|
Subject: |
[Chicken-hackers] [PATCH] sequence type corrections and enhancements |
|
Date: |
Sun, 11 Sep 2011 00:26:45 +0200 (CEST) |
Hello!
(Patches will from now on be posted on this mailing list and
will require sign-off by other core-developers. For more information
about this, see
http://wiki.call-cc.org/development-process
Note that this is still highly experimental. Give us a bit of time
to get used to it before warming up the flame throwers...)
The attached patch implements a correction of the available sequence
type specifiers. Currently "(list T)" and "(vector T)" designate lists
or vectors with an unknown number of elements of the given type. This
is suboptimal, because fixed-length lists/vectors (with possibly
different element types) can not be handled by the flow analysis.
So "(list T)" and "(vector T)" have been renamed to "(list-of T)" and
"(vector-of T)" (which is compatible to the type-syntax of some other
obscure Scheme implementation). "(list T ...)"/"(vector T ...)" now
specify lists/vectors of fixed length with elements of the given
types.
"vector-ref" is hardcoded as a special case, for example:
(let* ((tm (seconds->local-time))
(xy (cons (vector-ref tm 0) (vector-ref tm 8))))
;; "xy" known to be of type "(pair fixnum boolean)"
...)
Note that flow-analysis is done before optimization, so only
simple cases of known indices for "vector-ref" are detected
(constant-folding will not help here, as it is done later).
"list-ref" is not currently optimized. This is slightly more
complicated and doesn't seem to be worth it. Vectors on the other hand
are often used as a replacement for records, particularly in pure
standard-compliant code.
Tests have been corrected and added, the "Types" manual chapter
has been updated as well.
cheers,
felix
commit fe80ccfa8ce886c220b699211991c6a81fea50da
Author: felix <address@hidden>
Date: 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 <address@hidden>
Date: Sun Sep 11 00:05:03 2011 +0200
resolved conflicts
commit e35329fcdf68f6aecd88c0560268050813276329
Author: felix <address@hidden>
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 <address@hidden>
Date: Sat Sep 10 16:24:11 2011 +0200
various bugfixes in the FA and corrections in the tests
commit 81a084216f9f199926ceca4e79d7e0b5305cf456
Author: felix <address@hidden>
Date: Sat Sep 10 02:56:16 2011 +0200
special-case handler also receives argtypes
commit bf2642cb12de6f775ffc1bdd18cea1771a93a120
Author: felix <address@hidden>
Date: Sat Sep 10 02:55:58 2011 +0200
added variant of types.db with new-style sequence types
commit 39768d2c188b5b0037313e5cf297d6b4426da3c0
Author: felix <address@hidden>
Date: Sat Sep 10 02:55:24 2011 +0200
corrected use of old-style list type
commit 7a32bdc84122ccc7a3255777e261db18751ad603
Author: felix <address@hidden>
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 2d7f7dc..710a17b 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 ce4526c..f32c0dc 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 4a24457..332b980 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 4e2fa56..55f6602 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -9,6 +9,10 @@ Note: at toplevel:
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
Note: at toplevel:
@@ -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
@@ -41,6 +45,10 @@ Note: at toplevel:
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
Note: at toplevel:
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 6162270..eb437e0 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 859a289..172326b 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) *))
- [Chicken-hackers] [PATCH] sequence type corrections and enhancements,
Felix <=