~ chicken-core (chicken-5) bce5af534277f4fc408575407f0c65d6183e8525
commit bce5af534277f4fc408575407f0c65d6183e8525
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Aug 18 13:07:09 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Aug 18 13:07:09 2011 +0200
use general matcher also for specialization; many fixes; started with adapted types.db.new
diff --git a/common-declarations.scm b/common-declarations.scm
index e1bea2df..ddae44ba 100644
--- a/common-declarations.scm
+++ b/common-declarations.scm
@@ -25,7 +25,7 @@
(declare
- (specialize)
+ ;XXX (specialize)
(usual-integrations))
(cond-expand
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 90963b00..766c21d4 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -200,7 +200,6 @@
make-variable-list
mark-variable
match-node
- match-specialization
membership-test-operators
membership-unfold-limit
no-argc-checks
diff --git a/manual/Types b/manual/Types
index d8b4bcd3..70c51491 100644
--- a/manual/Types
+++ b/manual/Types
@@ -90,6 +90,7 @@ or {{:}} should follow the syntax given below:
<table>
<tr><th>VALUETYPE</th><th>meaning</th></tr>
<tr><td>{{(or VALUETYPE ...)}}</td><td>"union" or "sum" type</td></tr>
+<tr><td>{{(not VALUETYPE)}}</td><td>non-matching type (*)</td></tr>
<tr><td>{{(struct STRUCTURENAME)}}</td><td>record structure of given kind</td></tr>
<tr><td>{{(procedure [NAME] (VALUETYPE ... [#!optional VALUETYPE ...] [#!rest [VALUETYPE]]) . RESULTS)}}</td><td>procedure type, optionally with name</td></tr>
<tr><td>{{(VALUETYPE ... [#!optional VALUETYPE ...] [#!rest [VALUETYPE]] -> . RESULTS)}}</td><td>alternative procedure type syntax</td></tr>
@@ -141,6 +142,8 @@ or {{:}} should follow the syntax given below:
<tr><td>VALUETYPE</td><td></td></tr>
</table>
+(*) Note: no type-variables are bound inside {{(not TYPE)}}.
+
==== Predicates
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 2b5a9222..9ecd2bba 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -26,11 +26,11 @@
(declare
(unit scrutinizer)
- (hide match-specialization specialize-node! specialization-statistics
+ (hide specialize-node! specialization-statistics
procedure-type? named? procedure-result-types procedure-argument-types
noreturn-type? rest-type procedure-name d-depth
noreturn-procedure-type? trail trail-restore
- compatible-types? type<=? initial-argument-types))
+ compatible-types? type<=? match-types resolve match-argument-types))
(include "compiler-namespace")
@@ -56,6 +56,7 @@
;
; SPEC = * | (VAL1 ...)
; VAL = (or VAL1 ...)
+; | (not VAL)
; | (struct NAME)
; | (procedure [NAME] (VAL1 ... [#!optional VALOPT1 ...] [#!rest [VAL | values]]) . RESULTS)
; | BASIC
@@ -83,20 +84,13 @@
;
; specialization specifiers:
;
-; SPECIALIZATION = ((MVAL ... [#!rest MVAL]) [RESULTS] TEMPLATE)
-; MVAL = VAL
-; | (not MVAL)
-; | (or MVAL ...)
-; | (and MVAL ...)
-; | (forall (VAR1 ...) MVAL)
+; SPECIALIZATION = ((VAL ... [#!rest VAL]) [RESULTS] TEMPLATE)
; TEMPLATE = #(INDEX)
; | #(INDEX ...)
; | #(SYMBOL)
; | INTEGER | SYMBOL | STRING
; | (quote CONSTANT)
; | (TEMPLATE . TEMPLATE)
-;
-; - complex procedure types can currently not be matched
(define-constant +fragment-max-length+ 6)
@@ -270,131 +264,6 @@
len m m
(map typename results))))))
- (define (match t1 t2 typeenv)
- (define (match1 t1 t2)
- (cond ((eq? t1 t2))
- ((and (symbol? t1) (assq t1 typeenv)) =>
- (lambda (e)
- (if (cdr e)
- (match1 (cdr e) t2)
- (begin
- (dd " unify ~a = ~a" t1 t2)
- (set! trail (cons t1 trail))
- (set-cdr! e t2)
- #t))))
- ((and (symbol? t2) (assq t2 typeenv)) =>
- (lambda (e)
- (if (cdr e)
- (match1 t1 (cdr e))
- (begin
- (dd " unify ~a = ~a" t2 t1)
- (set! trail (cons t2 trail))
- (set-cdr! e t1)
- #t))))
- ((eq? t1 '*))
- ((eq? t2 '*))
- ((eq? t1 'noreturn))
- ((eq? t2 'noreturn))
- ((and (eq? t1 'number) (memq t2 '(number fixnum float))))
- ((and (eq? t2 'number) (memq t1 '(number fixnum float))))
- ((eq? 'procedure t1) (and (pair? t2) (eq? 'procedure (car t2))))
- ((eq? 'procedure t2) (and (pair? t1) (eq? 'procedure (car t1))))
- ((and (pair? t1) (eq? 'or (car t1))) (any (cut match1 <> t2) (cdr t1)))
- ((and (pair? t2) (eq? 'or (car t2))) (any (cut match1 t1 <>) (cdr t2)))
- ((and (pair? t1) (eq? 'forall (car t1)))
- (match1 (third t1) t2)) ; assumes typeenv has already been extracted
- ((and (pair? t2) (eq? 'forall (car t2)))
- (match1 t1 (third t2))) ; assumes typeenv has already been extracted
- ((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 'null)
- (or (memq t2 '(null list))
- (and (pair? t2) (eq? 'list (car t2)))))
- ((eq? t2 'null)
- (or (memq t1 '(null list))
- (and (pair? t1) (eq? 'list (car t1)))))
- ((and (pair? t1) (pair? t2) (eq? (car t1) (car t2)))
- (case (car t1)
- ((procedure)
- (let ((args1 (if (named? t1) (third t1) (second t1)))
- (args2 (if (named? t2) (third t2) (second t2)))
- (results1 (if (named? t1) (cdddr t1) (cddr t1)))
- (results2 (if (named? t2) (cdddr t2) (cddr t2))) )
- (and (match-args args1 args2 typeenv)
- (match-results results1 results2 typeenv))))
- ((struct) (equal? t1 t2))
- ((pair) (every match1 (cdr t1) (cdr t2)))
- ((list vector) (match1 (second t1) (second t2)))
- (else #f) ) )
- ((and (pair? t1) (eq? 'pair (car t1)))
- (and (pair? t2)
- (eq? 'list (car t2))
- (match1 (second t1) (second t2))
- (match1 (third t1) t2)))
- ((and (pair? t2) (eq? 'pair (car t2)))
- (and (pair? t1)
- (eq? 'list (car t1))
- (match1 (second t1) (second t2))
- (match1 t1 (third t2))))
- ((and (pair? t1) (eq? 'list (car t1)))
- (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)))
- (or (eq? 'null t1)
- (and (pair? t1)
- (eq? 'pair? (car t1))
- (match1 (second t1) (second t2))
- (match1 (third t1) t2))))
- (else #f)))
- (let ((m (match1 t1 t2)))
- (dd " match ~a <-> ~a -> ~a" t1 t2 m)
- m))
-
- (define (match-args args1 args2 typeenv)
- (d "match-args: ~s <-> ~s" args1 args2)
- (define (match-rest rtype args opt) ;XXX currently ignores `opt'
- (let-values (((head tail) (break (cut eq? '#!rest <>) args)))
- (and (every (cut match rtype <> typeenv) head) ; match required args
- (match rtype (if (pair? tail) (rest-type (cdr tail)) '*) typeenv))))
- (define (optargs a)
- (memq a '(#!rest #!optional)))
- (let loop ((args1 args1) (args2 args2) (opt1 #f) (opt2 #f))
- (dd " args ~a ~a ~a ~a" args1 args2 opt1 opt2)
- (cond ((null? args1)
- (or opt2
- (null? args2)
- (optargs (car args2))))
- ((null? args2)
- (or opt1
- (optargs (car args1))))
- ((eq? '#!optional (car args1))
- (loop (cdr args1) args2 #t opt2))
- ((eq? '#!optional (car args2))
- (loop args1 (cdr args2) opt1 #t))
- ((eq? '#!rest (car args1))
- (match-rest (rest-type (cdr args1)) args2 opt2))
- ((eq? '#!rest (car args2))
- (match-rest (rest-type (cdr args2)) args1 opt1))
- ((match (car args1) (car args2) typeenv)
- (loop (cdr args1) (cdr args2) opt1 opt2))
- (else #f))))
-
- (define (match-results results1 results2 typeenv)
- (cond ((null? results1) (atom? results2))
- ((eq? '* results1))
- ((eq? '* results2))
- ((null? results2) #f)
- ((match (car results1) (car results2) typeenv)
- (match-results (cdr results1) (cdr results2) typeenv))
- (else #f)))
-
(define (multiples n)
(if (= n 1) "" "s"))
@@ -485,11 +354,7 @@
(xptype `(procedure ,(make-list nargs '*) *))
(typeenv (or (and pptype? (type-typeenv ptype)) '()))
(op #f))
- (define (resolve t)
- (cond ((not t) '*)
- ((assq t typeenv) => (lambda (a) (resolve (cdr a))))
- (else t)))
- (cond ((and (not pptype?) (not (match xptype ptype typeenv)))
+ (cond ((and (not pptype?) (not (match-types xptype ptype typeenv)))
(report
loc
(sprintf
@@ -514,7 +379,7 @@
(atypes atypes (cdr atypes))
(i 1 (add1 i)))
((or (null? args) (null? atypes)))
- (unless (match (car atypes) (car args) typeenv)
+ (unless (match-types (car atypes) (car args) typeenv)
(report
loc
(sprintf
@@ -524,12 +389,13 @@
(set! noreturn #t))
(let ((r (procedure-result-types ptype values-rest (cdr args) typeenv)))
;;XXX we should check whether this is a standard- or extended binding
- (let* ((pn (procedure-name ptype)))
+ (let* ((pn (procedure-name ptype))
+ (trail0 trail))
(when pn
(cond ((and (fx= 1 nargs)
(variable-mark pn '##compiler#predicate)) =>
(lambda (pt)
- (cond ((match-specialization
+ (cond ((match-argument-types
(list pt) (cdr args) typeenv #t)
(report-notice
loc
@@ -541,8 +407,11 @@
node
`(let ((#(tmp) #(1))) '#t))
(set! op (list pn pt))))
- ((match-specialization
- (list `(not ,pt)) (cdr args) typeenv #t)
+ ((begin
+ (trail-restore trail0 typeenv)
+ (match-argument-types
+ (list `(not ,pt)) (cdr args) typeenv
+ #t))
(report-notice
loc
(sprintf
@@ -552,26 +421,27 @@
(specialize-node!
node
`(let ((#(tmp) #(1))) '#f))
- (set! op (list pt `(not ,pt))))))))
+ (set! op (list pt `(not ,pt)))))
+ (else (trail-restore trail0 typeenv)))))
((and specialize (get-specializations pn)) =>
(lambda (specs)
- (let ((trail0 trail))
- (let loop ((specs specs))
- (cond ((null? specs))
- ((match-specialization
- (first (car specs)) (cdr args) typeenv #f)
- (let ((spec (car specs)))
- (set! op (cons pn (car spec)))
- (let* ((r2 (and (pair? (cddr spec))
- (second spec)))
- (rewrite (if r2
- (third spec)
- (second spec))))
- (specialize-node! node rewrite)
- (when r2 (set! r r2)))))
- (else
- (trail-restore trail0 typeenv)
- (loop (cdr specs)))))))))
+ (let loop ((specs specs))
+ (cond ((null? specs))
+ ((match-argument-types
+ (first (car specs)) (cdr args) typeenv
+ #t)
+ (let ((spec (car specs)))
+ (set! op (cons pn (car spec)))
+ (let* ((r2 (and (pair? (cddr spec))
+ (second spec)))
+ (rewrite (if r2
+ (third spec)
+ (second spec))))
+ (specialize-node! node rewrite)
+ (when r2 (set! r r2)))))
+ (else
+ (trail-restore trail0 typeenv)
+ (loop (cdr specs))))))))
(when op
(d " specialized: `~s'" op)
(cond ((assoc op specialization-statistics) =>
@@ -583,7 +453,7 @@
(when (and specialize (not op) (procedure-type? ptype))
(set-car! (node-parameters node) #t)
(set! safe-calls (add1 safe-calls))))
- (let ((r (if (eq? '* r) r (map resolve r))))
+ (let ((r (if (eq? '* r) r (map (cut resolve <> typeenv) r))))
(d " result-types: ~a" r)
(values r op))))))))
@@ -613,6 +483,16 @@
(d " applying to alias: ~a -> ~a" (cdr a) type)
(loop (cdr a))))))
+ (define (initial-argument-types dest vars argc)
+ (if (and dest
+ strict-variable-types
+ (variable-mark dest '##compiler#declared-type))
+ (let ((ptype (variable-mark dest '##compiler#type)))
+ (if (procedure-type? ptype)
+ (nth-value 0 (procedure-argument-types ptype argc '() #t))
+ (make-list argc '*)))
+ (make-list argc '*)))
+
(define (walk n e loc dest tail flow ctags) ; returns result specifier
(let ((subs (node-subexpressions n))
(params (node-parameters n))
@@ -675,8 +555,11 @@
(sprintf
"branches in conditional expression differ in the number of results:~%~%~a"
(pp-fragment n))))
- (map (lambda (t1 t2) (simplify-type `(or ,t1 ,t2)))
- r1 r2))
+ (cond (nor1 r2)
+ (nor2 r1)
+ (else
+ (map (lambda (t1 t2) (simplify-type `(or ,t1 ,t2)))
+ r1 r2))))
(else '*))))))
((let)
;; before CPS-conversion, `let'-nodes may have multiple bindings
@@ -748,7 +631,7 @@
(b (assq var e)) )
(when (and type (not b)
(not (eq? type 'deprecated))
- (not (match type rt '())))
+ (not (match-types type rt '())))
;;XXX make this an error with strict-types?
(report
loc
@@ -808,24 +691,20 @@
(enforces
(and pn (variable-mark pn '##compiler#enforce)))
(pt (and pn (variable-mark pn '##compiler#predicate))))
- (define (resolve t)
- (cond ((not t) '*)
- ((assq t typeenv) => (lambda (a) (resolve (cdr a))))
- (else t)))
(let-values (((r specialized?)
(call-result n args e loc params typeenv)))
(cond (specialized?
(walk n e loc dest tail flow ctags)
;; keep type, as the specialization may contain icky stuff
;; like "##core#inline", etc.
- (resolve r))
+ (resolve r typeenv))
(else
(for-each
(lambda (arg argr)
(when (eq? '##core#variable (node-class arg))
(let* ((var (first (node-parameters arg)))
(a (assq var e))
- (argr (resolve argr))
+ (argr (resolve argr typeenv))
(oparg? (eq? arg (first subs)))
(pred (and pt
ctags
@@ -836,7 +715,7 @@
;; branch by subtracting pt from the current type
;; of var, at least in the simple case of
;; "(or ... <PT> ...)" -> "(or ... ...)"
- (let ((pt (resolve pt)))
+ (let ((pt (resolve pt typeenv)))
(d " predicate `~a' indicates `~a' is ~a in flow ~a"
pn var pt (car ctags))
(add-to-blist
@@ -897,12 +776,13 @@
(first rt) t)))))
(list t))))
((##core#typecase)
- (let ((ts (walk (first subs) e loc #f #f flow ctags)))
+ (let ((ts (walk (first subs) e loc #f #f flow ctags))
+ (trail0 trail))
;; first exp is always a variable so ts must be of length 1
(let loop ((types params) (subs (cdr subs)))
(cond ((null? types)
(bomb "no clause applies in `compiler-typecase'" params (car ts)))
- ((match-specialization (list (car types)) ts '() #f)
+ ((match-types (car types) (car ts) '())
;; drops exp
(copy-node! (car subs) n)
(walk n e loc dest tail flow ctags))
@@ -931,6 +811,177 @@
rn)))
+;;; Type-matching
+;
+; - "exact" means: first argument must match second one exactly
+
+(define (match-types t1 t2 typeenv #!optional exact)
+
+ (define (match-args args1 args2)
+ (d "match-args: ~s <-> ~s" args1 args2)
+ (let loop ((args1 args1) (args2 args2) (opt1 #f) (opt2 #f))
+ (dd " args ~a ~a ~a ~a" args1 args2 opt1 opt2)
+ (cond ((null? args1)
+ (or opt2
+ (null? args2)
+ (optargs? (car args2))))
+ ((null? args2)
+ (or opt1
+ (optargs? (car args1))))
+ ((eq? '#!optional (car args1))
+ (loop (cdr args1) args2 #t opt2))
+ ((eq? '#!optional (car args2))
+ (loop args1 (cdr args2) opt1 #t))
+ ((eq? '#!rest (car args1))
+ (match-rest (rest-type (cdr args1)) args2 opt2))
+ ((eq? '#!rest (car args2))
+ (match-rest (rest-type (cdr args2)) args1 opt1))
+ ((match1 (car args1) (car args2))
+ (loop (cdr args1) (cdr args2) opt1 opt2))
+ (else #f))))
+
+ (define (match-rest rtype args opt) ;XXX currently ignores `opt'
+ (let-values (((head tail) (break (cut eq? '#!rest <>) args)))
+ (and (every (cut match1 rtype <>) head) ; match required args
+ (match1 rtype (if (pair? tail) (rest-type (cdr tail)) '*)))))
+
+ (define (optargs? a)
+ (memq a '(#!rest #!optional)))
+
+ (define (match-results results1 results2)
+ (cond ((null? results1) (atom? results2))
+ ((eq? '* results1))
+ ((eq? '* results2))
+ ((null? results2) #f)
+ ((match1 (car results1) (car results2))
+ (match-results (cdr results1) (cdr results2)))
+ (else #f)))
+
+ (define (match1 t1 t2)
+ (cond ((eq? t1 t2))
+ ((and (symbol? t1) (assq t1 typeenv)) =>
+ (lambda (e)
+ (if (cdr e)
+ (match1 (cdr e) t2)
+ (begin
+ (dd " unify ~a = ~a" t1 t2)
+ (set! trail (cons t1 trail))
+ (set-cdr! e t2)
+ #t))))
+ ((and (symbol? t2) (assq t2 typeenv)) =>
+ (lambda (e)
+ (if (cdr e)
+ (match1 t1 (cdr e))
+ (begin
+ (dd " unify ~a = ~a" t2 t1)
+ (set! trail (cons t2 trail))
+ (set-cdr! e t1)
+ #t))))
+ ((eq? t1 '*))
+ ((eq? t2 '*) (not exact))
+ ((eq? t1 'noreturn) (not exact))
+ ((eq? t2 'noreturn) (not exact))
+ ((eq? t1 'number)
+ (and (not exact)
+ (match1 '(or fixnum float) t2)))
+ ((eq? t2 'number)
+ (and (not exact)
+ (match1 t1 '(or fixnum float))))
+ ((eq? 'procedure t1)
+ (and (pair? t2)
+ (eq? 'procedure (car t2))))
+ ((eq? 'procedure t2)
+ (and (not exact)
+ (pair? t1)
+ (eq? 'procedure (car t1))))
+ ((and (pair? t1) (eq? 'not (car t1)))
+ (let* ((trail0 trail)
+ (m (match1 (cadr t1) t2)))
+ (trail-restore trail0 typeenv)
+ (not m)))
+ ((and (pair? t2) (eq? 'not (car t2)))
+ (and (not exact)
+ (let* ((trail0 trail)
+ (m (match1 t1 (cadr t2))))
+ (trail-restore trail0 typeenv)
+ (not m))))
+ ((and (pair? t1) (eq? 'or (car t1)))
+ (any (cut match1 <> t2) (cdr t1)))
+ ((and (pair? t2) (eq? 'or (car t2)))
+ ((if exact every any) (cut match1 t1 <>) (cdr t2)))
+ ((and (pair? t1) (eq? 'forall (car t1)))
+ (match1 (third t1) t2)) ; assumes typeenv has already been extracted
+ ((and (pair? t2) (eq? 'forall (car t2)))
+ (match1 t1 (third t2))) ; assumes typeenv has already been extracted
+ ((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 'null)
+ (and (not exact)
+ (or (memq t2 '(null list))
+ (and (pair? t2) (eq? 'list (car t2))))))
+ ((eq? t2 'null)
+ (and (not exact)
+ (or (memq t1 '(null list))
+ (and (pair? t1) (eq? 'list (car t1))))))
+ ((and (pair? t1) (pair? t2) (eq? (car t1) (car t2)))
+ (case (car t1)
+ ((procedure)
+ (let ((args1 (if (named? t1) (third t1) (second t1)))
+ (args2 (if (named? t2) (third t2) (second t2)))
+ (results1 (if (named? t1) (cdddr t1) (cddr t1)))
+ (results2 (if (named? t2) (cdddr t2) (cddr t2))) )
+ (and (match-args args1 args2)
+ (match-results results1 results2))))
+ ((struct) (equal? t1 t2))
+ ((pair) (every match1 (cdr t1) (cdr t2)))
+ ((list vector) (match1 (second t1) (second t2)))
+ (else #f) ) )
+ ((and (pair? t1) (eq? 'pair (car t1)))
+ (and (not exact)
+ (pair? t2)
+ (eq? 'list (car t2))
+ (match1 (second t1) (second t2))
+ (match1 (third t1) t2)))
+ ((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)))
+ (and (not exact)
+ (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)))
+ (and (not exact)
+ (or (eq? 'null t1)
+ (and (pair? t1)
+ (eq? 'pair? (car t1))
+ (match1 (second t1) (second t2))
+ (match1 (third t1) t2)))))
+ (else #f)))
+ (let ((m (match1 t1 t2)))
+ (dd " match ~a <-> ~a -> ~a" t1 t2 m)
+ m))
+
+(define (match-argument-types typelist atypes typeenv #!optional exact)
+ (let loop ((tl typelist) (atypes atypes))
+ (cond ((null? tl) (null? atypes))
+ ((null? atypes) #f)
+ ((eq? (car tl) '#!rest)
+ (every (cute match-types (cadr tl) <> typeenv exact) atypes))
+ ((match-types (car tl) (car atypes) typeenv exact)
+ (loop (cdr tl) (cdr atypes)))
+ (else #f))))
+
+
;;; Simplify type specifier
;
; - coalesces "forall" and renames type-variables
@@ -1060,8 +1111,8 @@
(call/cc
(lambda (return)
(let loop ((ts1 ts11) (ts2 ts21))
- (cond ((null? ts1) ts2)
- ((null? ts2) ts1)
+ (cond ((null? ts1) '())
+ ((null? ts2) '())
((or (atom? ts1) (atom? ts2)) (return '*))
((eq? 'noreturn (car ts1)) (loop (cdr ts1) ts2))
((eq? 'noreturn (car ts2)) (loop ts1 (cdr ts2)))
@@ -1286,6 +1337,9 @@
((forall) (noreturn-type? (third t)))
(else #f)))))
+
+;;; Type-environments and -variables
+
(define (type-typeenv t)
(let ((te '()))
(let loop ((t t))
@@ -1313,6 +1367,33 @@
(let ((a (assq (car tr2) typeenv)))
(set-cdr! a #f))))
+(define (resolve t typeenv)
+ (let resolve ((t t))
+ (cond ((not t) '*) ; unbound type-variable
+ ((assq t typeenv) => (lambda (a) (resolve (cdr a))))
+ ((not (pair? t)) t)
+ (else
+ (case (car t)
+ ((or) `(or ,@(map resolve (cdr t))))
+ ((not) `(not ,(resolve (second t))))
+ ((forall) `(forall ,(second t) ,(resolve (third t))))
+ ((pair list vector)
+ (cons (car t) (map resolve (cdr t))))
+ ((procedure)
+ (let* ((n (named? t))
+ (argtypes ((if n third second) t))
+ (rtypes ((if n cdddr cddr) t)))
+ `(procedure
+ ,(let loop ((args argtypes))
+ (cond ((null? args) '())
+ ((eq? '#!rest (car args))
+ (cons '#!rest (loop (cdr args))))
+ (else (cons (resolve (car args)) (loop (cdr args))))))
+ ,@(if (eq? '* rtypes)
+ '*
+ (map resolve rtypes)))))
+ (else t))))))
+
;;; type-db processing
@@ -1366,166 +1447,34 @@
source-filename "\n")
(##sys#hash-table-for-each
(lambda (sym plist)
- (when (variable-visible? sym)
- (when (variable-mark sym '##compiler#declared-type)
- (let ((specs (or (variable-mark sym '##compiler#specializations) '()))
- (type (variable-mark sym '##compiler#type))
- (pred (variable-mark sym '##compiler#predicate))
- (enforce (variable-mark sym '##compiler#enforce)))
- (pp (cons*
- sym
- (if (and (pair? type) (eq? 'procedure (car type)))
- `(,(cond ((and enforce pred) 'procedure!?)
- (pred 'procedure?)
- (enforce 'procedure!)
- (else 'procedure))
- ,@(if pred (list pred) '())
- ,@(cdr type))
- type)
- specs))))))
+ (when (and (variable-visible? sym)
+ (variable-mark sym '##compiler#declared-type))
+ (let ((specs (or (variable-mark sym '##compiler#specializations) '()))
+ (type (variable-mark sym '##compiler#type))
+ (pred (variable-mark sym '##compiler#predicate))
+ (enforce (variable-mark sym '##compiler#enforce)))
+ (pp (cons*
+ sym
+ (let wrap ((type type))
+ (if (pair? type)
+ (case (car type)
+ ((procedure)
+ `(,(cond ((and enforce pred) 'procedure!?)
+ (pred 'procedure?)
+ (enforce 'procedure!)
+ (else 'procedure))
+ ,@(if pred (list pred) '())
+ ,@(cdr type)))
+ ((forall)
+ `(forall ,(second type) ,(wrap (third type))))
+ (else type))
+ type))
+ specs)))))
db)
(print "; END OF FILE"))))
-;;; matching for specialization
-
-(define (match-specialization typelist atypes typeenv exact)
- ;; - does not accept complex procedure types in typelist!
- ;; - "exact" means: "or"-type in atypes is not allowed (used for predicates)
- ;;
- ;;XXX It is not entirely clear to me whether we can simply use the "match"
- ;; above instead of having a second matcher. The only difference
- ;; seems to be the specialization-types allow "not" and disallow
- ;; complex procedure types (the latter would be handled by the
- ;; full matcher). And what about "exact"?
- ;;
- (define (match st t)
- (cond ((eq? st t))
- ((and (symbol? st) (assq st typeenv)) =>
- (lambda (e)
- (if (cdr e)
- (match (cdr e) t)
- (begin
- (d " unify (specialization) ~a = ~a" st t)
- (set-cdr! e t)
- #t))))
- ((and (symbol? t) (assq t typeenv)) =>
- (lambda (e)
- (if (cdr e)
- (match st (cdr e))
- (begin
- (d " unify (specialization) ~a = ~a" t st)
- (set-cdr! e st)
- #t))))
- ((memq st '(vector list))
- (match (list st '*) t))
- ((memq t '(vector list))
- (match st (list t '*)))
- ((eq? 'pair st)
- (match '(pair * *) t))
- ((eq? 'pair t)
- (match st '(pair * *)))
- ((and (pair? t) (eq? 'or (car t)))
- ((if exact every any) (cut match st <>) (cdr t)))
- ((and (pair? t) (eq? 'and (car t)))
- (every (cut match st <>) (cdr t)))
- ((and (pair? t) (eq? 'forall (car t)))
- (match st (third t))) ; assumes typeenv has already been extracted
- ((and (pair? t) (eq? 'procedure (car t)))
- (match st 'procedure))
- ((pair? st)
- (case (car st)
- ((forall)
- (match (third st) t)) ; assumes typeenv has already been extracted
- ((not) (matchnot (cadr st) t))
- ((or) (any (cut match <> t) (cdr st)))
- ((and) (every (cut match <> t) (cdr st)))
- ((list)
- (or (eq? 'null t)
- (and (pair? t)
- (eq? 'list (car t))
- (match (second st) (second t)))))
- ((vector)
- (and (pair? t)
- (eq? 'vector (car t))
- (match (second st) (second t))))
- ((pair)
- (and (pair? t)
- (eq? 'pair (car t))
- (match (second st) (second t))
- (match (third st) (third t))))
- ((procedure)
- (bomb "match-specialization: can not match complex procedure type" st))
- (else (equal? st t))))
- ((eq? st '*))
- ;; "list" different from "number": a pair is not necessarily a list:
- ((eq? st 'number) (match '(or fixnum float) t))
- (else (equal? st t))))
- (define (matchnot st t)
- (cond ((eq? st t) #f)
- ((and (symbol? st) (assq st typeenv)) => ; doesn't unify
- (lambda (e)
- (if (cdr e)
- (matchnot (cdr e) t)
- #f)))
- ((and (symbol? t) (assq t typeenv)) =>
- (lambda (e)
- (if (cdr e)
- (matchnot st (cdr e))
- #f)))
- ((memq st '(vector list))
- (matchnot (list st '*) t))
- ((memq t '(vector list))
- (matchnot st (list t '*)))
- ((eq? 'pair st)
- (matchnot '(pair * *) t))
- ((eq? 'pair t)
- (matchnot st '(pair * *)))
- ((and (pair? t) (eq? 'or (car t)))
- (every (cut matchnot st <>) (cdr t)))
- ((and (pair? t) (eq? 'and (car t)))
- (any (cut matchnot st <>) (cdr t))) ;XXX test for "exact" here, too?
- ((eq? 'number st) (not (match '(or fixnum float) t)))
- ((eq? 'number t) (matchnot st '(or fixnum float)))
- ((eq? '* t) #f)
- ((eq? 'null st)
- (or (not (pair? t))
- (not (eq? 'list (car t)))))
- ((and (pair? t) (eq? 'forall (car t)))
- (match st (third t))) ; assumes typeenv has already been extracted
- ((pair? st)
- (case (car st)
- ;;XXX "and" not handled here
- ((forall)
- (match (third st) t)) ; assumes typeenv has already been extracted
- ((or) (every (cut matchnot <> t) (cdr t)))
- ((list)
- (and (not (eq? 'null t))
- (or (not (pair? t))
- (and (eq? 'list (car t))
- (matchnot (second st) (second t)))
- (matchnot `(pair ,(second st) *) t)))) ;XXX too conservative?
- ((vector)
- (or (not (pair? t))
- (not (eq? 'vector (car t)))
- (matchnot (second st) (second t))))
- ((pair)
- (or (not (pair? t))
- (case (car t)
- ((list) (matchnot (second st) (second t)))
- ((pair)
- (and (matchnot (second st) (second t))
- (matchnot (third st) (third t))))
- (else #f))))
- (else (not (match st t)))))
- (else (not (match st t)))))
- (let loop ((tl typelist) (atypes atypes))
- (cond ((null? tl) (null? atypes))
- ((null? atypes) #f)
- ((eq? (car tl) '#!rest)
- (every (cute match (cadr tl) <>) atypes))
- ((match (car tl) (car atypes)) (loop (cdr tl) (cdr atypes)))
- (else #f))))
+;; Mutate node for specialization
(define (specialize-node! node template)
(let ((args (cdr (node-subexpressions node)))
@@ -1555,6 +1504,9 @@
(let ((spec (subst template)))
(copy-node! (build-node-graph spec) node))))
+
+;;; Type-validation and -normalization
+
(define (validate-type type name)
;; - returns converted type or #f
;; - also converts "(... -> ...)" types
@@ -1672,16 +1624,6 @@
(let ((type (simplify-type type)))
(values type (and ptype (eq? (car ptype) type) (cdr ptype)))))))
-(define (initial-argument-types dest vars argc)
- (if (and dest
- strict-variable-types
- (variable-mark dest '##compiler#declared-type))
- (let ((ptype (variable-mark dest '##compiler#type)))
- (if (procedure-type? ptype)
- (nth-value 0 (procedure-argument-types ptype argc '() #t))
- (make-list argc '*)))
- (make-list argc '*)))
-
;;; hardcoded result types for certain primitives
diff --git a/types.db.new b/types.db.new
new file mode 100644
index 00000000..e3a0f72e
--- /dev/null
+++ b/types.db.new
@@ -0,0 +1,2198 @@
+;;;; types.db - Type-information for core library functions -*- Scheme -*-
+;
+; Copyright (c)2009-2011, The Chicken Team
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+; conditions are met:
+;
+; Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+; disclaimer.
+; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+; disclaimer in the documentation and/or other materials provided with the distribution.
+; Neither the name of the author nor the names of its contributors may be used to endorse or promote
+; products derived from this software without specific prior written permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION HOWEVER CAUSED AND ON ANY
+; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+; OTHERWISE ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+; POSSIBILITY OF SUCH DAMAGE.
+
+
+;;; Notes:
+;
+; - numeric types are disjoint, "fixnum" or "float" will not match "number" in the
+; rewrite rules
+; - for a description of the type-specifier syntax, see "scrutinizer.scm" (top of file)
+; - in templates, "#(INTEGER)" refers to the INTEGERth argument (starting from 1)
+; - in templates, "#(INTEGER ...)" refers to the INTEGERth argument (starting from 1) and
+; all remaining arguments
+; - in templates "#(SYMBOL)" binds X to a temporary gensym'd variable, further references
+; to "#(SYMBOL)" allow backreferences to this generated identifier
+; - a type of the form "(procedure! ...)" is internally treated like "(procedure ..."
+; but declares the procedure as "argument-type enforcing"
+; - a type of the form "(procedure? TYPE ...)" is internally treated like "(procedure ..."
+; but declares the procedure as a predicate over TYPE.
+; - a type of the form "(procedure!? TYPE ...)" or "(procedure?! TYPE ...)" is the obvious.
+; - types in specializations are currently not validated
+
+
+;; scheme
+
+(not (procedure not (*) boolean)
+ (((not boolean)) (let ((#(tmp) #(1))) '#t)))
+
+(boolean? (procedure? boolean boolean? (*) boolean))
+
+(eq? (procedure eq? (* *) boolean))
+
+(eqv? (procedure eqv? (* *) boolean)
+ (((not float) *) (eq? #(1) #(2)))
+ ((* (not float)) (eq? #(1) #(2))))
+
+(equal? (procedure equal? (* *) boolean)
+ (((or fixnum symbol char eof null undefined) *) (eq? #(1) #(2)))
+ ((* (or fixnum symbol char eof null undefined) (eq? #(1) #(2)))))
+
+(pair? (procedure? pair pair? (*) boolean))
+
+(cons (forall (a b) (procedure cons (a b) (pair a b))))
+
+(##sys#cons (forall (a b) (procedure ##sys#cons (a b) (pair a b))))
+
+(car (forall (a) (procedure! car ((pair a *)) a) ((pair) (##core#inline "C_u_i_car" #(1)))))
+(cdr (forall (a) (procedure! cdr ((pair * a)) a) ((pair) (##core#inline "C_u_i_cdr" #(1)))))
+
+(caar (forall (a) (procedure! caar ((pair (pair a *) *)) a)))
+
+(cadr (forall (a) (procedure! cadr ((pair * (pair a *))) a)))
+(cdar (forall (a) (procedure! cdar ((pair (pair * a) *)) a)))
+(cddr (forall (a) (procedure! cddr ((pair * (pair * a))) a)))
+(caaar (forall (a) (procedure! caaar ((pair (pair (pair a *) *) *)) a)))
+(caadr (forall (a) (procedure! caadr ((pair * (pair (pair a *) *))) a)))
+(cadar (forall (a) (procedure! cadar ((pair (pair * (pair a *)) *)) a)))
+(caddr (forall (a) (procedure! caddr ((pair * (pair * (pair a *)))) a)))
+(cdaar (forall (a) (procedure! cdaar ((pair (pair (pair * a) *) *)) a)))
+(cdadr (forall (a) (procedure! cdadr ((pair * (pair (pair * a) *))) a)))
+(cddar (forall (a) (procedure! cddar ((pair (pair * (pair * a)) *)) a)))
+(cdddr (forall (a) (procedure! cdddr ((pair * (pair * (pair * a)))) a)))
+(caaaar (forall (a) (procedure! caaaar ((pair (pair (pair (pair a *) *) *) *)) a)))
+(caaadr (forall (a) (procedure! caaadr ((pair * (pair (pair (pair a *) *) *))) a)))
+(caadar (forall (a) (procedure! caadar ((pair (pair * (pair (pair a *) *)) *)) a)))
+(caaddr (forall (a) (procedure! caaddr ((pair * (pair * (pair (pair a *) *)))) a)))
+(cadaar (forall (a) (procedure! cadaar ((pair (pair (pair * (pair a *)) *) *)) a)))
+(cadadr (forall (a) (procedure! cadadr ((pair * (pair (pair * (pair a *)) *))) a)))
+(caddar (forall (a) (procedure! caddar ((pair (pair * (pair * (pair a *))) *)) a)))
+(cadddr (forall (a) (procedure! cadddr ((pair * (pair * (pair * (pair a *))))) a)))
+(cdaaar (forall (a) (procedure! cdaaar ((pair (pair (pair (pair * a) *) *) *)) a)))
+(cdaadr (forall (a) (procedure! cdaadr ((pair * (pair (pair (pair * a) *) *))) a)))
+(cdadar (forall (a) (procedure! cdadar ((pair (pair * (pair (pair * a) *)) *)) a)))
+(cdaddr (forall (a) (procedure! cdaddr ((pair * (pair * (pair (pair * a) *)))) a)))
+(cddaar (forall (a) (procedure! cddaar ((pair (pair (pair * (pair * a)) *) *)) a)))
+(cddadr (forall (a) (procedure! cddadr ((pair * (pair (pair * (pair * a)) *))) a)))
+(cdddar (forall (a) (procedure! cdddar ((pair (pair * (pair * (pair * a))) *)) a)))
+(cddddr (forall (a) (procedure! cddddr ((pair * (pair * (pair * (pair * a))))) a)))
+
+(set-car! (procedure! set-car! (pair *) undefined)
+ ((pair (or fixnum char boolean eof null undefined)) (##sys#setislot #(1) '0 #(2)))
+ ((pair *) (##sys#setslot #(1) '0 #(2))))
+
+(set-cdr! (procedure! set-cdr! (pair *) undefined)
+ ((pair (or fixnum char boolean eof null undefined)) (##sys#setislot #(1) '1 #(2)))
+ ((pair *) (##sys#setslot #(1) '1 #(2))))
+
+(null? (procedure? null null? (*) boolean))
+(list? (procedure? list list? (*) boolean))
+
+(list (procedure list (#!rest) list))
+(##sys#list (procedure ##sys#list (#!rest) list))
+(length (procedure! length (list) fixnum) ((list) (##core#inline "C_u_i_length" #(1))))
+(##sys#length (procedure! ##sys#length (list) fixnum) ((list) (##core#inline "C_u_i_length" #(1))))
+(list-tail (forall (a) (procedure! list-tail ((list a) fixnum) (list a))))
+(list-ref (forall (a) (procedure! list-ref ((list a) fixnum) a)))
+(append (procedure append (list #!rest) *))
+(##sys#append (procedure ##sys#append (list #!rest) *))
+(reverse (forall (a) (procedure! reverse ((list a)) (list a))))
+(memq (procedure memq (* list) *) ((* list) (##core#inline "C_u_i_memq" #(1) #(2))))
+
+(memv (procedure memv (* list) *)
+ (((or fixnum boolean char eof undefined null) list)
+ (##core#inline "C_u_i_memq" #(1) #(2))))
+
+;; this may be a bit much...
+(member (forall (a) (procedure member (* list #!optional (procedure (* *) *)) *))
+ (((or fixnum boolean char eof undefined null) list)
+ (##core#inline "C_u_i_memq" #(1) #(2)))
+ ((* (list (or fixnum boolean char eof undefined null)))
+ (##core#inline "C_u_i_memq" #(1) #(2))))
+
+(assq (procedure assq (* list) *) ((* list) (##core#inline "C_u_i_assq" #(1) #(2))))
+
+(assv (procedure assv (* list) *)
+ (((or fixnum boolean char eof undefined null) list)
+ (##core#inline "C_u_i_assq" #(1) #(2)))
+ ((* (list (or fixnum boolean char eof undefined null)))
+ (##core#inline "C_u_i_assq" #(1) #(2))))
+
+(assoc (procedure assoc (* list #!optional (procedure (* *) *)) *)
+ (((or fixnum boolean char eof undefined null) list)
+ (##core#inline "C_u_i_assq" #(1) #(2)))
+ ((* (list (or fixnum boolean char eof undefined null)))
+ (##core#inline "C_u_i_assq" #(1) #(2))))
+
+(symbol? (procedure? symbol symbol? (*) boolean))
+
+(symbol-append (procedure! symbol-append (#!rest symbol) symbol))
+(symbol->string (procedure! symbol->string (symbol) string))
+(string->symbol (procedure! string->symbol (string) symbol))
+
+(number? (procedure? number number? (*) boolean))
+
+;;XXX predicate?
+(integer? (procedure integer? (*) boolean)
+ ((fixnum) (let ((#(tmp) #(1))) '#t))
+ ((float) (##core#inline "C_u_i_fpintegerp" #(1))))
+
+(exact? (procedure? fixnum exact? (*) boolean))
+(real? (procedure? number real? (*) boolean))
+(complex? (procedure? number complex? (*) boolean))
+(inexact? (procedure? float inexact? (*) boolean))
+
+;;XXX predicate?
+(rational? (procedure rational? (*) boolean)
+ ((fixnum) (let ((#(tmp) #(1))) '#t)))
+
+(zero? (procedure! zero? (number) boolean)
+ ((fixnum) (eq? #(1) '0))
+ ((number) (##core#inline "C_u_i_zerop" #(1))))
+
+(odd? (procedure! odd? (number) boolean) ((fixnum) (fxodd? #(1))))
+(even? (procedure! even? (number) boolean) ((fixnum) (fxeven? #(1))))
+
+(positive? (procedure! positive? (number) boolean)
+ ((fixnum) (##core#inline "C_fixnum_greaterp" #(1) '0))
+ ((number) (##core#inline "C_u_i_positivep" #(1))))
+
+(negative? (procedure! negative? (number) boolean)
+ ((fixnum) (##core#inline "C_fixnum_lessp" #(1) '0))
+ ((number) (##core#inline "C_u_i_negativep" #(1))))
+
+(max (procedure! max (#!rest number) number)
+ ((fixnum fixnum) (fxmax #(1) #(2)))
+ ((float float) (##core#inline "C_i_flonum_max" #(1) #(2))))
+
+(min (procedure! min (#!rest number) number)
+ ((fixnum fixnum) (fxmin #(1) #(2)))
+ ((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
+
+(+ (procedure! + (#!rest number) number)
+ ((fixnum) (fixnum) #(1))
+ ((float) (float) #(1))
+ ((number) #(1))
+ ((float fixnum) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_plus" 4)
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float)
+ (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_plus" 4)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2))))
+
+(- (procedure! - (number #!rest number) number)
+ ((fixnum) (fixnum)
+ (##core#inline "C_u_fixnum_negate" #(1)))
+ ((float fixnum) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_difference" 4)
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_difference" 4)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) #(2)))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1))))
+
+(* (procedure! * (#!rest number) number)
+ ((fixnum) (fixnum) #(1))
+ ((float) (float) #(1))
+ ((number) (number) #(1))
+ ((float fixnum) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_times" 4)
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_times" 4)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2))))
+
+(/ (procedure! / (number #!rest number) number)
+ ((float fixnum) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_quotient_checked" 4)
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (float)
+ (##core#inline_allocate
+ ("C_a_i_flonum_quotient_checked" 4)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_quotient_checked" 4) #(1) #(2))))
+
+(= (procedure! = (#!rest number) boolean)
+ ((fixnum fixnum) (eq? #(1) #(2)))
+ ((float fixnum) (##core#inline
+ "C_flonum_equalp"
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (##core#inline
+ "C_flonum_equalp"
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (##core#inline "C_flonum_equalp" #(1) #(2))))
+
+(> (procedure! > (#!rest number) boolean)
+ ((fixnum fixnum) (fx> #(1) #(2)))
+ ((float fixnum) (##core#inline
+ "C_flonum_greaterp"
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (##core#inline
+ "C_flonum_greaterp"
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (##core#inline "C_flonum_greaterp" #(1) #(2))))
+
+(< (procedure! < (#!rest number) boolean)
+ ((fixnum fixnum) (fx< #(1) #(2)))
+ ((float fixnum) (##core#inline
+ "C_flonum_lessp"
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (##core#inline
+ "C_flonum_lessp"
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (##core#inline "C_flonum_lessp" #(1) #(2))))
+
+(>= (procedure! >= (#!rest number) boolean)
+ ((fixnum fixnum) (fx>= #(1) #(2)))
+ ((float fixnum) (##core#inline
+ "C_flonum_greater_or_equal_p"
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (##core#inline
+ "C_flonum_greater_or_equal_p"
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2))))
+
+(<= (procedure! <= (#!rest number) boolean)
+ ((fixnum fixnum) (fx<= #(1) #(2)))
+ ((float fixnum) (##core#inline
+ "C_flonum_less_or_equal_p"
+ #(1)
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
+ ((fixnum float) (##core#inline
+ "C_flonum_less_or_equal_p"
+ (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
+ #(2)))
+ ((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2))))
+
+(quotient (procedure! quotient (number number) number)
+ ;;XXX flonum/mixed case
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_divide" #(1) #(2))))
+
+(remainder (procedure! remainder (number number) number)
+ ;;XXX flonum/mixed case
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_modulo" #(1) #(2))))
+
+(modulo (procedure! modulo (number number) number))
+
+(gcd (procedure! gcd (#!rest number) number) ((* *) (##sys#gcd #(1) #(2))))
+(lcm (procedure! lcm (#!rest number) number) ((* *) (##sys#lcm #(1) #(2))))
+
+(abs (procedure! abs (number) number)
+ ((fixnum) (fixnum)
+ (##core#inline "C_fixnum_abs" #(1)))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1))))
+
+(floor (procedure! floor (number) number)
+ ((fixnum) (fixnum) #(1))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1))))
+
+(ceiling (procedure! ceiling (number) number)
+ ((fixnum) (fixnum) #(1))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1))))
+
+(truncate (procedure! truncate (number) number)
+ ((fixnum) (fixnum) #(1))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1))))
+
+(round (procedure! round (number) number)
+ ((fixnum) (fixnum) #(1))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1))))
+
+(exact->inexact (procedure! exact->inexact (number) float)
+ ((float) #(1))
+ ((fixnum) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))))
+
+(inexact->exact (procedure! inexact->exact (number) fixnum) ((fixnum) #(1)))
+
+(exp (procedure! exp (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1))))
+
+(log (procedure! log (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1))))
+
+(expt (procedure! expt (number number) number)
+ ((float float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_expt" 4) #(1) #(2))))
+
+(sqrt (procedure! sqrt (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1))))
+
+(sin (procedure! sin (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1))))
+
+(cos (procedure! cos (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1))))
+
+(tan (procedure! tan (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1))))
+
+(asin (procedure! asin (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1))))
+
+(acos (procedure! acos (number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1))))
+
+(atan (procedure! atan (number #!optional number) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1)))
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1))))
+
+(number->string (procedure! number->string (number #!optional number) string)
+ ((fixnum) (##sys#fixnum->string #(1))))
+
+(string->number (procedure! string->number (string #!optional number) (or number boolean)))
+
+(char? (procedure? char char? (*) boolean))
+
+;; we could rewrite these, but this is done by the optimizer anyway (safe)
+(char=? (procedure! char=? (char char) boolean))
+(char>? (procedure! char>? (char char) boolean))
+(char<? (procedure! char<? (char char) boolean))
+(char>=? (procedure! char>=? (char char) boolean))
+(char<=? (procedure! char<=? (char char) boolean))
+
+(char-ci=? (procedure! char-ci=? (char char) boolean))
+(char-ci<? (procedure! char-ci<? (char char) boolean))
+(char-ci>? (procedure! char-ci>? (char char) boolean))
+(char-ci>=? (procedure! char-ci>=? (char char) boolean))
+(char-ci<=? (procedure! char-ci<=? (char char) boolean))
+(char-alphabetic? (procedure! char-alphabetic? (char) boolean))
+(char-whitespace? (procedure! char-whitespace? (char) boolean))
+(char-numeric? (procedure! char-numeric? (char) boolean))
+(char-upper-case? (procedure! char-upper-case? (char) boolean))
+(char-lower-case? (procedure! char-lower-case? (char) boolean))
+(char-upcase (procedure! char-upcase (char) char))
+(char-downcase (procedure! char-downcase (char) char))
+
+(char->integer (procedure! char->integer (char) fixnum))
+(integer->char (procedure! integer->char (fixnum) char))
+
+(string? (procedure? string string? (*) boolean))
+
+(string=? (procedure! string=? (string string) boolean)
+ ((string string) (##core#inline "C_u_i_string_equal_p" #(1) #(2))))
+
+(string>? (procedure! string>? (string string) boolean))
+(string<? (procedure! string<? (string string) boolean))
+(string>=? (procedure! string>=? (string string) boolean))
+(string<=? (procedure! string<=? (string string) boolean))
+(string-ci=? (procedure! string-ci=? (string string) boolean))
+(string-ci<? (procedure! string-ci<? (string string) boolean))
+(string-ci>? (procedure! string-ci>? (string string) boolean))
+(string-ci>=? (procedure! string-ci>=? (string string) boolean))
+(string-ci<=? (procedure! string-ci<=? (string string) boolean))
+
+(make-string (procedure! make-string (fixnum #!optional char) string)
+ ((fixnum char) (##sys#make-string #(1) #(2)))
+ ((fixnum) (##sys#make-string #(1) '#\space)))
+
+(string-length (procedure! string-length (string) fixnum)
+ ((string) (##sys#size #(1))))
+
+(string-ref (procedure! string-ref (string fixnum) char)
+ ((string fixnum) (##core#inline "C_subchar" #(1) #(2))))
+
+(string-set! (procedure! string-set! (string fixnum char) undefined)
+ ((string fixnum char) (##core#inline "C_setsubchar" #(1) #(2) #(3))))
+
+(string-append (procedure! string-append (#!rest string) string)
+ ((string string) (##sys#string-append #(1) #(2))))
+
+;(string-copy (procedure! string-copy (string) string)) - we use the more general version from srfi-13
+
+;;XXX continue ...
+
+(string->list (procedure! string->list (string) list))
+(list->string (procedure! list->string (list) string))
+(substring (procedure! substring (string fixnum #!optional fixnum) string))
+;(string-fill! (procedure! string-fill! (string char) string)) - s.a.
+(string (procedure! string (#!rest char) string))
+
+(vector? (procedure? vector vector? (*) boolean))
+
+(make-vector (procedure! make-vector (fixnum #!optional *) vector))
+
+(vector-ref (procedure! vector-ref (vector fixnum) *))
+(##sys#vector-ref (procedure! ##sys#vector-ref (vector fixnum) *))
+(vector-set! (procedure! vector-set! (vector fixnum *) undefined))
+(vector (procedure vector (#!rest) vector))
+(##sys#vector (procedure ##sys#vector (#!rest) vector))
+
+(vector-length (procedure! vector-length (vector) fixnum)
+ ((vector) (##sys#size #(1))))
+(##sys#vector-length (procedure! ##sys#vector-length (vector) fixnum)
+ ((vector) (##sys#size #(1))))
+
+(vector->list (procedure! vector->list (vector) list))
+(##sys#vector->list (procedure! ##sys#vector->list (vector) list))
+(list->vector (procedure! list->vector (list) vector))
+(##sys#list->vector (procedure! ##sys#list->vector (list) vector))
+(vector-fill! (procedure! vector-fill! (vector *) vector))
+
+(procedure? (procedure? procedure procedure? (*) boolean))
+
+(vector-copy! (procedure! vector-copy! (vector vector #!optional fixnum) undefined))
+(map (procedure! map (procedure #!rest list) list))
+(for-each (procedure! for-each (procedure #!rest list) undefined))
+(apply (procedure! apply (procedure #!rest) . *))
+(##sys#apply (procedure! ##sys#apply (procedure #!rest) . *))
+(force (procedure force (*) *))
+(call-with-current-continuation (procedure! call-with-current-continuation (procedure) . *))
+(input-port? (procedure input-port? (*) boolean))
+(output-port? (procedure output-port? (*) boolean))
+(current-input-port (procedure! current-input-port (#!optional port) port))
+(current-output-port (procedure! current-output-port (#!optional port) port))
+(call-with-input-file (procedure call-with-input-file (string (procedure (port) . *) #!rest) . *))
+(call-with-output-file (procedure call-with-output-file (string (procedure (port) . *) #!rest) . *))
+(open-input-file (procedure! open-input-file (string #!rest symbol) port))
+(open-output-file (procedure! open-output-file (string #!rest symbol) port))
+(close-input-port (procedure! close-input-port (port) undefined))
+(close-output-port (procedure! close-output-port (port) undefined))
+(load (procedure load (string #!optional procedure) undefined))
+(read (procedure! read (#!optional port) *))
+
+(eof-object? (procedure? eof eof-object? (*) boolean))
+
+;;XXX if we had input/output port distinction, we could specialize these:
+(read-char (procedure! read-char (#!optional port) *)) ; result (or eof char) ?
+(peek-char (procedure! peek-char (#!optional port) *))
+
+(write (procedure! write (* #!optional port) undefined))
+(display (procedure! display (* #!optional port) undefined))
+(write-char (procedure! write-char (char #!optional port) undefined))
+(newline (procedure! newline (#!optional port) undefined))
+(with-input-from-file (procedure! with-input-from-file (string procedure #!rest symbol) . *))
+(with-output-to-file (procedure! with-output-to-file (string procedure #!rest symbol) . *))
+(dynamic-wind (procedure! dynamic-wind (procedure procedure procedure) . *))
+(values (procedure values (#!rest values) . *))
+(##sys#values (procedure ##sys#values (#!rest values) . *))
+
+(call-with-values (procedure! call-with-values ((procedure () . *) procedure) . *))
+
+#;(call-with-values (procedure! call-with-values ((procedure () . *) procedure) . *)
+ (((procedure () *) *) (let ((#(tmp1) #(1)))
+ (let ((#(tmp2) #(2)))
+ (#(tmp2) (#(tmp1)))))))
+
+(##sys#call-with-values
+ (procedure! ##sys#call-with-values ((procedure () . *) procedure) . *))
+
+#;(##sys#call-with-values
+ (procedure! ##sys#call-with-values ((procedure () . *) procedure) . *)
+ (((procedure () *) *) (let ((#(tmp1) #(1)))
+ (let ((#(tmp2) #(2)))
+ (#(tmp2) (#(tmp1)))))))
+
+(eval (procedure eval (* #!optional *) *))
+(char-ready? (procedure! char-ready? (#!optional port) boolean))
+
+(imag-part (procedure! imag-part (number) number)
+ ((or fixnum float number) (let ((#(tmp) #(1))) '0)))
+
+(real-part (procedure! real-part (number) number)
+ ((or fixnum float number) #(1)))
+
+(magnitude (procedure! magnitude (number) number)
+ ((fixnum) (fixnum)
+ (##core#inline "C_fixnum_abs" #(1)))
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1))))
+
+(numerator (procedure! numerator (number) number)
+ ((fixnum) (fixnum) #(1)))
+
+(denominator (procedure! denominator (number) number)
+ ((fixnum) (fixnum) (let ((#(tmp) #(1))) '1)))
+
+(scheme-report-environment (procedure! scheme-report-environment (#!optional fixnum) *))
+(null-environment (procedure! null-environment (#!optional fixnum) *))
+(interaction-environment (procedure interaction-environment () *))
+
+(port-closed? (procedure! port-closed? (port) boolean)
+ ((port) (##sys#slot #(1) '8)))
+
+;; chicken
+
+(abort (procedure abort (*) noreturn))
+
+(add1 (procedure! add1 (number) number)
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0)))
+
+(argc+argv (procedure argc+argv () fixnum list))
+(argv (procedure argv () list))
+(arithmetic-shift (procedure! arithmetic-shift (number number) number))
+
+(bit-set? (procedure! bit-set? (number fixnum) boolean)
+ ((fixnum fixnum) (##core#inline "C_u_i_bit_setp" #(1) #(2))))
+
+(bitwise-and (procedure! bitwise-and (#!rest number) number)
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_and" #(1) #(2))))
+
+(bitwise-ior (procedure! bitwise-ior (#!rest number) number)
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_or" #(1) #(2))))
+
+(bitwise-not (procedure! bitwise-not (number) number))
+
+(bitwise-xor (procedure! bitwise-xor (#!rest number) number)
+ ((fixnum fixnum) (fixnum)
+ (##core#inline "C_fixnum_xor" #(1) #(2))))
+
+(blob->string (procedure! blob->string (blob) string))
+
+(blob-size (procedure! blob-size (blob) fixnum)
+ ((blob) (##sys#size #(1))))
+
+(blob? (procedure? blob blob? (*) boolean))
+
+(blob=? (procedure! blob=? (blob blob) boolean))
+(breakpoint (procedure breakpoint (#!optional *) . *))
+(build-platform (procedure build-platform () symbol))
+(call/cc (procedure! call/cc (procedure) . *))
+(case-sensitive (procedure case-sensitive (#!optional *) *))
+(char-name (procedure! char-name ((or char symbol) #!optional char) *))
+(chicken-home (procedure chicken-home () string))
+(chicken-version (procedure chicken-version (#!optional *) string))
+(command-line-arguments (procedure command-line-arguments (#!optional list) list))
+(condition-predicate (procedure! condition-predicate (symbol) (procedure ((struct condition)) boolean)))
+(condition-property-accessor (procedure! condition-property-accessor (symbol symbol #!optional *) (procedure ((struct condition)) *)))
+
+(condition? (procedure? (struct condition) condition? (*) boolean))
+
+(condition->list (procedure! condition->list ((struct condition)) list))
+(continuation-capture (procedure! continuation-capture ((procedure ((struct continuation)) . *)) *))
+(continuation-graft (procedure! continuation-graft ((struct continuation) (procedure () . *)) *))
+(continuation-return (procedure! continuation-return (procedure #!rest) . *)) ;XXX make return type more specific?
+
+(continuation? (procedure? (struct continuation) continuation? (*) boolean))
+
+(copy-read-table (procedure! copy-read-table ((struct read-table)) (struct read-table)))
+(cpu-time (procedure cpu-time () fixnum fixnum))
+
+(current-error-port (procedure! current-error-port (#!optional port) port)
+ ((port) (set! ##sys#standard-error #(1)))
+ (() ##sys#standard-error))
+
+(current-exception-handler
+ (procedure! current-exception-handler (#!optional procedure) procedure)
+ ((procedure) (set! ##sys#current-exception-handler #(1)))
+ (() ##sys#current-exception-handler))
+
+(current-gc-milliseconds (procedure current-gc-milliseconds () fixnum))
+(current-milliseconds (procedure current-milliseconds () float))
+(current-read-table (procedure current-read-table () (struct read-table)))
+(current-seconds (procedure current-seconds () float))
+(define-reader-ctor (procedure! define-reader-ctor (symbol procedure) undefined))
+(delete-file (procedure! delete-file (string) string))
+(enable-warnings (procedure enable-warnings (#!optional *) *))
+(equal=? (procedure equal=? (* *) boolean))
+(er-macro-transformer (procedure! er-macro-transformer ((procedure (* * *) *)) (struct transformer)))
+(errno (procedure errno () fixnum))
+(error (procedure error (#!rest) noreturn))
+(##sys#error (procedure ##sys#error (#!rest) noreturn))
+(##sys#signal-hook (procedure ##sys#signal-hook (#!rest) noreturn))
+(exit (procedure exit (#!optional fixnum) noreturn))
+(exit-handler (procedure! exit-handler (#!optional procedure) procedure))
+(expand (procedure expand (* #!optional *) *))
+(extension-information (procedure extension-information (symbol) *))
+(feature? (procedure feature? (symbol) boolean))
+(features (procedure features () list))
+(file-exists? (procedure! file-exists? (string) *))
+(directory-exists? (procedure! directory-exists? (string) *))
+(fixnum-bits fixnum)
+(fixnum-precision fixnum)
+
+(fixnum? (procedure? fixnum fixnum? (*) boolean))
+
+(flonum-decimal-precision fixnum)
+(flonum-epsilon float)
+(flonum-maximum-decimal-exponent fixnum)
+(flonum-maximum-exponent fixnum)
+(flonum-minimum-decimal-exponent fixnum)
+(flonum-minimum-exponent fixnum)
+(flonum-precision fixnum)
+(flonum-print-precision (procedure! (#!optional fixnum) fixnum))
+(flonum-radix fixnum)
+
+(flonum? (procedure? float flonum? (*) boolean))
+
+(flush-output (procedure! flush-output (#!optional port) undefined))
+
+(foldl (procedure! foldl ((procedure (* *) *) * list) *))
+(foldr (procedure! foldr ((procedure (* *) *) * list) *))
+
+(force-finalizers (procedure force-finalizers () undefined))
+
+(fp- (procedure! fp- (float float) float)
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) #(2)) ))
+
+(fp* (procedure! fp* (float float) float)
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2)) ))
+
+(fp/ (procedure! fp/ (float float) float)
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1) #(2)) ))
+
+(fp+ (procedure! fp+ (float float) float)
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2)) ))
+
+(fp< (procedure! fp< (float float) boolean)
+ ((float float) (##core#inline "C_flonum_lessp" #(1) #(2)) ))
+
+(fp<= (procedure! fp<= (float float) boolean)
+ ((float float) (##core#inline "C_flonum_less_or_equal_p" #(1) #(2)) ))
+
+(fp= (procedure! fp= (float float) boolean)
+ ((float float) (##core#inline "C_flonum_equalp" #(1) #(2)) ))
+
+(fp> (procedure! fp> (float float) boolean)
+ ((float float) (##core#inline "C_flonum_greaterp" #(1) #(2)) ))
+
+(fp>= (procedure! fp>= (float float) boolean)
+ ((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2)) ))
+
+(fpabs (procedure! fpabs (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1) )))
+
+(fpacos (procedure! fpacos (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1) )))
+
+(fpasin (procedure! fpasin (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1) )))
+
+(fpatan (procedure! fpatan (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_atan" 4) #(1) )))
+
+(fpatan2 (procedure! fpatan2 (float float) float)
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4)
+ #(1) #(2))))
+(fpceiling (procedure! fpceiling (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1) )))
+
+(fpcos (procedure! fpcos (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_cos" 4) #(1) )))
+
+(fpexp (procedure! fpexp (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_exp" 4) #(1) )))
+
+(fpexpt (procedure! fpexpt (float float) float)
+ ((float float) (##core#inline_allocate ("C_a_i_flonum_expt" 4)
+ #(1) #(2))))
+
+(fpfloor (procedure! fpfloor (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_floor" 4) #(1) )))
+
+(fpinteger? (procedure! fpinteger? (float) boolean)
+ ((float) (##core#inline "C_u_i_flonum_intergerp" #(1) )))
+
+(fplog (procedure! fplog (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_log" 4) #(1) )))
+
+(fpmax (procedure! fpmax (float float) float)
+ ((float float) (##core#inline "C_i_flonum_max" #(1) #(2))))
+
+(fpmin (procedure! fpmin (float float) float)
+ ((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
+
+(fpneg (procedure! fpneg (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1) )))
+
+(fpround (procedure! fpround (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_round" 4) #(1) )))
+
+(fpsin (procedure! fpsin (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_sin" 4) #(1) )))
+
+(fpsqrt (procedure! fpsqrt (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_sqrt" 4) #(1) )))
+
+(fptan (procedure! fptan (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1) )))
+
+(fptruncate (procedure! fptruncate (float) float)
+ ((float) (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1) )))
+
+(fx- (procedure fx- (fixnum fixnum) fixnum))
+(fx* (procedure fx* (fixnum fixnum) fixnum))
+(fx/ (procedure fx/ (fixnum fixnum) fixnum))
+(fx+ (procedure fx+ (fixnum fixnum) fixnum))
+(fx< (procedure fx< (fixnum fixnum) boolean))
+(fx<= (procedure fx<= (fixnum fixnum) boolean))
+(fx= (procedure fx= (fixnum fixnum) boolean))
+(fx> (procedure fx> (fixnum fixnum) boolean))
+(fx>= (procedure fx>= (fixnum fixnum) boolean))
+(fxand (procedure fxand (fixnum fixnum) fixnum))
+(fxeven? (procedure fxeven? (fixnum) boolean))
+(fxior (procedure fxior (fixnum fixnum) fixnum))
+(fxmax (procedure fxmax (fixnum fixnum) fixnum))
+(fxmin (procedure fxmin (fixnum fixnum) fixnum))
+(fxmod (procedure fxmod (fixnum fixnum) fixnum))
+(fxneg (procedure fxneg (fixnum) fixnum))
+(fxnot (procedure fxnot (fixnum) fixnum))
+(fxodd? (procedure fxodd? (fixnum) boolean))
+(fxshl (procedure fxshl (fixnum fixnum) fixnum))
+(fxshr (procedure fxshr (fixnum fixnum) fixnum))
+(fxxor (procedure fxxor (fixnum fixnum) fixnum))
+(gc (procedure gc (#!optional *) fixnum))
+(gensym (procedure gensym (#!optional *) symbol))
+
+(get (procedure! get (symbol symbol #!optional *) *)
+ ((symbol symbol *) (##core#inline "C_i_getprop" #(1) #(2) #(3))))
+
+(get-call-chain (procedure! get-call-chain (#!optional fixnum *) list))
+(get-condition-property (procedure! get-condition-property ((struct condition) symbol symbol #!optional *) *))
+(get-environment-variable (procedure! get-environment-variable (string) *))
+(get-keyword (procedure! get-keyword (symbol list #!optional *) *))
+(get-output-string (procedure! get-output-string (port) string))
+(get-properties (procedure! get-properties (symbol list) symbol * list))
+(getter-with-setter (procedure! getter-with-setter (procedure procedure #!optional string) procedure))
+(implicit-exit-handler (procedure! implicit-exit-handler (#!optional procedure) procedure))
+(ir-macro-transformer (procedure ir-macro-transformer ((procedure (* * *) *)) (struct transformer)))
+(keyword->string (procedure! keyword->string (symbol) string))
+(keyword-style (procedure keyword-style (#!optional *) *))
+(keyword? (procedure keyword? (*) boolean))
+(load-library (procedure! load-library (symbol #!optional string) undefined))
+(load-relative (procedure! load-relative (string #!optional procedure) undefined))
+(load-verbose (procedure load-verbose (#!optional *) *))
+(machine-byte-order (procedure machine-byte-order () symbol))
+(machine-type (procedure machine-type () symbol))
+
+(make-blob (procedure! make-blob (fixnum) blob)
+ ((fixnum) (##sys#make-blob #(1))))
+
+(make-composite-condition (procedure! make-composite-condition (#!rest (struct condition)) (struct condition)))
+(make-parameter (procedure! make-parameter (* #!optional procedure) procedure))
+(make-property-condition (procedure! make-property-condition (symbol #!rest *) (struct condition)))
+(maximum-flonum float)
+(memory-statistics (procedure memory-statistics () vector))
+(minimum-flonum float)
+(most-negative-fixnum fixnum)
+(most-positive-fixnum fixnum)
+(on-exit (procedure! on-exit ((procedure () . *)) undefined))
+(open-input-string (procedure! open-input-string (string #!rest) port))
+(open-output-string (procedure open-output-string (#!rest) port))
+(parentheses-synonyms (procedure parentheses-synonyms (#!optional *) *))
+
+(port-name (procedure! port-name (#!optional port) *)
+ ((port) (##sys#slot #(1) '3)))
+
+(port-position (procedure! port-position (#!optional port) fixnum))
+
+(port? (procedure? port port? (*) boolean))
+
+(print (procedure print (#!rest *) undefined))
+(print-call-chain (procedure! print-call-chain (#!optional port fixnum * string) undefined))
+(print-error-message (procedure! print-error-message (* #!optional port string) undefined))
+(print* (procedure print* (#!rest) undefined))
+(procedure-information (procedure! procedure-information (procedure) *))
+(program-name (procedure! program-name (#!optional string) string))
+(promise? (procedure? (struct promise) promise? (*) boolean))
+
+(put! (procedure! put! (symbol symbol *) undefined)
+ ((symbol symbol *)
+ (##core#inline_allocate ("C_a_i_putprop" 8) #(1) #(2) #(3))))
+
+(quit (procedure quit (#!optional *) noreturn))
+(register-feature! (procedure! register-feature! (#!rest symbol) undefined))
+(remprop! (procedure! remprop! (symbol symbol) undefined))
+(rename-file (procedure! rename-file (string string) string))
+(repl (procedure! repl (#!optional (procedure (*) *)) undefined))
+(repl-prompt (procedure! repl-prompt (#!optional procedure) procedure))
+(repository-path (procedure repository-path (#!optional *) *))
+(require (procedure require (#!rest *) undefined))
+(reset (procedure reset () undefined))
+(reset-handler (procedure! reset-handler (#!optional procedure) procedure))
+(return-to-host (procedure return-to-host () . *))
+(reverse-list->string (procedure! reverse-list->string (list) string))
+(set-finalizer! (procedure! set-finalizer! (* (procedure (*) . *)) *))
+(set-gc-report! (procedure set-gc-report! (*) undefined))
+(set-parameterized-read-syntax! (procedure! set-parameterized-read-syntax! (char procedure) undefined))
+
+(set-port-name! (procedure! set-port-name! (port string) undefined)
+ ((port string) (##sys#setslot #(1) '3 #(2))))
+
+(set-read-syntax! (procedure! set-read-syntax! (char procedure) undefined))
+(set-sharp-read-syntax! (procedure! set-sharp-read-syntax! (char procedure) undefined))
+(setter (procedure! setter (procedure) procedure))
+(signal (procedure signal (*) . *))
+(signum (procedure! signum (number) number))
+(software-type (procedure software-type () symbol))
+(software-version (procedure software-version () symbol))
+(string->blob (procedure! string->blob (string) blob))
+(string->keyword (procedure! string->keyword (string) symbol))
+(string->uninterned-symbol (procedure! string->uninterned-symbol (string) symbol))
+(strip-syntax (procedure strip-syntax (*) *))
+
+(sub1 (procedure! sub1 (number) number)
+ ((float) (float)
+ (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) '1.0)))
+
+(subvector (procedure! subvector (vector fixnum #!optional fixnum) vector))
+(symbol-escape (procedure symbol-escape (#!optional *) *))
+
+(symbol-plist (procedure! symbol-plist (symbol) list)
+ ((symbol) (##sys#slot #(1) '2)))
+
+(syntax-error (procedure syntax-error (#!rest) noreturn))
+(system (procedure! system (string) fixnum))
+(unregister-feature! (procedure! unregister-feature! (#!rest symbol) undefined))
+(vector-resize (procedure! vector-resize (vector fixnum) vector))
+(void (procedure void (#!rest) undefined))
+(warning (procedure warning (#!rest) . *))
+(with-exception-handler (procedure! with-exception-handler (procedure procedure) . *))
+
+;; chicken (internal)
+
+(##sys#foreign-char-argument (procedure! ##sys#foreign-char-argument (char) char)
+ ((char) #(1)))
+(##sys#foreign-fixnum-argument (procedure! ##sys#foreign-fixnum-argument (fixnum) fixnum)
+ ((fixnum) #(1)))
+(##sys#foreign-flonum-argument (procedure! ##sys#foreign-flonum-argument (number) number)
+ ((float) #(1)))
+(##sys#foreign-string-argument (procedure! ##sys#foreign-string-argument (string) string)
+ ((string) #(1)))
+(##sys#foreign-symbol-argument (procedure! ##sys#foreign-symbol-argument (symbol) symbol)
+ ((symbol) #(1)))
+(##sys#foreign-pointer-argument (procedure! ##sys#foreign-pointer-argument (pointer) pointer)
+ ((pointer) #(1)))
+
+(##sys#check-blob (procedure! ##sys#check-blob (blob #!optional *) *)
+ ((blob) (let ((#(tmp) #(1))) '#t))
+ ((blob *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-pair (procedure! ##sys#check-pair (pair #!optional *) *)
+ ((pair) (let ((#(tmp) #(1))) '#t))
+ ((pair *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-list (procedure! ##sys#check-list (list #!optional *) *)
+ (((or null pair list)) (let ((#(tmp) #(1))) '#t))
+ (((or null pair list) *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-string (procedure! ##sys#check-string (string #!optional *) *)
+ ((string) (let ((#(tmp) #(1))) '#t))
+ ((string) * (let ((#(tmp) #(1))) '#t)))
+(##sys#check-number (procedure! ##sys#check-number (number #!optional *) *)
+ ((number) (let ((#(tmp) #(1))) '#t))
+ ((number *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-exact (procedure! ##sys#check-exact (fixnum #!optional *) *)
+ ((fixnum) (let ((#(tmp) #(1))) '#t))
+ ((fixnum *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-inexact (procedure! ##sys#check-inexact (float #!optional *) *)
+ ((float) (let ((#(tmp) #(1))) '#t))
+ ((float *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-symbol (procedure! ##sys#check-symbol (symbol #!optional *) *)
+ ((symbol) (let ((#(tmp) #(1))) '#t))
+ ((symbol *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-vector (procedure! ##sys#check-vector (vector #!optional *) *)
+ ((vector) (let ((#(tmp) #(1))) '#t))
+ ((vector *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-char (procedure! ##sys#check-char (char #!optional *) *)
+ ((char) (let ((#(tmp) #(1))) '#t))
+ ((char *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-boolean (procedure! ##sys#check-boolean (boolean #!optional *) *)
+ ((boolean) (let ((#(tmp) #(1))) '#t))
+ ((boolean *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-locative (procedure! ##sys#check-locative (locative #!optional *) *)
+ ((locative) (let ((#(tmp) #(1))) '#t))
+ ((locative *) (let ((#(tmp) #(1))) '#t)))
+(##sys#check-closure (procedure! ##sys#check-closure (procedure #!optional *) *)
+ ((procedure) (let ((#(tmp) #(1))) '#t))
+ ((procedure *) (let ((#(tmp) #(1))) '#t)))
+
+
+;; data-structures
+
+(->string (procedure ->string (*) string)
+ ((string) #(1)))
+
+(alist-ref (procedure! alist-ref (* list #!optional (procedure (* *) *) *) *))
+(alist-update! (procedure! alist-update! (* * list #!optional (procedure (* *) *)) *))
+(always? (procedure always? (#!rest) boolean))
+
+(any? (procedure any? (*) boolean)
+ ((*) (let ((#(tmp) #(1))) '#t)))
+
+(atom? (procedure atom? (*) boolean)
+ ((pair) (let ((#(tmp) #(1))) '#f))
+ (((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
+
+(binary-search (procedure! binary-search (vector (procedure (*) *)) *))
+(butlast (procedure! butlast (pair) list))
+(chop (procedure! chop (list fixnum) list))
+(complement (procedure! complement (procedure) procedure))
+(compose (procedure! compose (#!rest procedure) procedure))
+(compress (procedure! compress (list list) list))
+(conc (procedure conc (#!rest) string))
+(conjoin (procedure! conjoin (#!rest (procedure (*) *)) (procedure (*) *)))
+(constantly (procedure constantly (#!rest) . *))
+(disjoin (procedure! disjoin (#!rest (procedure (*) *)) (procedure (*) *)))
+(each (procedure! each (#!rest procedure) procedure))
+(flatten (procedure! flatten (pair) list))
+(flip (procedure! flip ((procedure (* *) . *)) procedure))
+(identity (procedure identity (*) *))
+(intersperse (procedure! intersperse (list *) list))
+(join (procedure! join (list list) list))
+(list->queue (procedure! list->queue (list) (struct queue)))
+(list-of? (procedure! list-of? ((procedure (*) *)) (procedure (list) boolean)))
+(make-queue (procedure make-queue () (struct queue)))
+(merge (procedure! merge (list list (procedure (* *) *)) list))
+(merge! (procedure! merge! (list list (procedure (* *) *)) list))
+(never? (procedure never? (#!rest) boolean))
+
+(none? (procedure none? (*) boolean)
+ ((*) (let ((#(tmp) #(1))) '#f)))
+
+(o (procedure! o (#!rest (procedure (*) *)) (procedure (*) *)))
+
+(queue->list (procedure! queue->list ((struct queue)) list)
+ (((struct queue)) (##sys#slot #(1) '1)))
+
+(queue-add! (procedure! queue-add! ((struct queue) *) undefined))
+
+(queue-empty? (procedure! queue-empty? ((struct queue)) boolean)
+ (((struct queue)) (##core#inline "C_i_nullp" (##sys#slot #(1) '1))))
+
+(queue-first (procedure! queue-first ((struct queue)) *))
+(queue-last (procedure! queue-last ((struct queue)) *))
+
+(queue-length (procedure! queue-length ((struct queue)) fixnum)
+ (((struct queue)) (##sys#slot #(1) '3)))
+
+(queue-push-back! (procedure! queue-push-back! ((struct queue) *) undefined))
+(queue-push-back-list! (procedure! queue-push-back-list! ((struct queue) list) undefined))
+(queue-remove! (procedure! queue-remove! ((struct queue)) *))
+(queue? (procedure? (struct queue) queue? (*) boolean))
+
+(rassoc (procedure! rassoc (* list #!optional (procedure (* *) *)) *))
+(reverse-string-append (procedure! reverse-string-append (list) string))
+(shuffle deprecated)
+(sort (procedure! sort ((or list vector) (procedure (* *) *)) (or list vector)))
+(sort! (procedure! sort! ((or list vector) (procedure (* *) *)) (or list vector)))
+(sorted? (procedure! sorted? ((or list vector) (procedure (* *) *)) boolean))
+(topological-sort (procedure! topological-sort (list (procedure (* *) *)) list))
+(string-chomp (procedure! string-chomp (string #!optional string) string))
+(string-chop (procedure! string-chop (string fixnum) list))
+(string-compare3 (procedure! string-compare3 (string string) fixnum))
+(string-compare3-ci (procedure! string-compare3-ci (string string) fixnum))
+(string-intersperse (procedure! string-intersperse (list #!optional string) string))
+(string-split (procedure! string-split (string #!optional string *) list))
+(string-translate (procedure! string-translate (string * #!optional *) string))
+(string-translate* (procedure! string-translate* (string list) string))
+(substring-ci=? (procedure! substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean))
+
+(substring-index (procedure! substring-index (string string #!optional fixnum) *)
+ ((* *) (##sys#substring-index #(1) #(2) '0))
+ ((* * *) (##sys#substring-index #(1) #(2) #(3))))
+
+(substring-index-ci (procedure! substring-index-ci (string string #!optional fixnum) *)
+ ((* *) (##sys#substring-index-ci #(1) #(2) '0))
+ ((* * *) (##sys#substring-index-ci #(1) #(2) #(3))))
+
+(substring=? (procedure! substring=? (string string #!optional fixnum fixnum fixnum) boolean))
+(tail? (procedure tail? (* *) boolean))
+
+;; extras
+
+(format (procedure format (#!rest) *))
+(fprintf (procedure! fprintf (port string #!rest) undefined))
+(pp (procedure! pp (* #!optional port) undefined))
+(pretty-print (procedure! pretty-print (* #!optional port) undefined))
+(pretty-print-width (procedure pretty-print-width (#!optional *) *))
+(printf (procedure! printf (string #!rest) undefined))
+(random (procedure! random (number) number))
+(randomize (procedure! randomize (#!optional number) undefined))
+(read-buffered (procedure! read-buffered (#!optional port) string))
+(read-byte (procedure! read-byte (#!optional port) fixnum))
+(read-file (procedure! read-file (#!optional (or port string) (procedure (port) *) fixnum) list))
+(read-line (procedure! read-line (#!optional port (or boolean fixnum)) *))
+(read-lines (procedure! read-lines (#!optional (or port string) fixnum) list))
+(read-string (procedure! read-string (#!optional * port) string))
+(read-string! (procedure! read-string! (fixnum string #!optional port fixnum) fixnum))
+(read-token (procedure! read-token ((procedure (char) *) #!optional port) string))
+(sprintf (procedure! sprintf (string #!rest) string))
+
+(write-byte (procedure! write-byte (fixnum #!optional port) undefined)
+ ((fixnum port) (##sys#write-char-0 (integer->char #(1)) #(2)))
+ ((fixnum) (##sys#write-char-0 (integer->char #(1)) ##sys#standard-output)))
+
+(write-line (procedure! write-line (string #!optional port) undefined))
+(write-string (procedure! write-string (string #!optional * port) undefined))
+
+;; files
+
+(delete-file* (procedure! delete-file* (string) *))
+(file-copy (procedure! file-copy (string string #!optional * fixnum) fixnum))
+(file-move (procedure! file-move (string string #!optional * fixnum) fixnum))
+(make-pathname (procedure! make-pathname (* * #!optional string string) string))
+(directory-null? (procedure! directory-null? (string) boolean))
+(make-absolute-pathname (procedure! make-absolute-pathname (* * #!optional string string) string))
+(create-temporary-directory (procedure! create-temporary-directory () string))
+(create-temporary-file (procedure! create-temporary-file (#!optional string) string))
+(decompose-directory (procedure! decompose-directory (string) * * *))
+(decompose-pathname (procedure! decompose-pathname (string) * * *))
+(absolute-pathname? (procedure! absolute-pathname? (string) boolean))
+(pathname-directory (procedure! pathname-directory (string) *))
+(pathname-extension (procedure! pathname-extension (string) *))
+(pathname-file (procedure! pathname-file (string) *))
+(pathname-replace-directory (procedure! pathname-replace-directory (string string) string))
+(pathname-replace-extension (procedure! pathname-replace-extension (string string) string))
+(pathname-replace-file (procedure! pathname-replace-file (string string) string))
+(pathname-strip-directory (procedure! pathname-strip-directory (string) string))
+(pathname-strip-extension (procedure! pathname-strip-extension (string) string))
+(normalize-pathname (procedure! normalize-pathname (string #!optional symbol) string))
+
+;; irregex
+
+(irregex (procedure irregex (#!rest) *))
+;irregex-apply-match
+
+(irregex-dfa (procedure! irregex-dfa ((struct regexp)) *)
+ (((struct regexp)) (##sys#slot #(1) '1)))
+
+(irregex-dfa/extract (procedure! irregex-dfa/extract ((struct regexp)) *)
+ (((struct regexp)) (##sys#slot #(1) '3)))
+
+(irregex-dfa/search (procedure! irregex-dfa/search ((struct regexp)) *)
+ (((struct regexp)) (##sys#slot #(1) '2)))
+
+(irregex-extract (procedure! irregex-extract (* string #!optional fixnum fixnum) list))
+(irregex-flags (procedure! irregex-flags ((struct regexp)) *)
+ (((struct regexp)) (##sys#slot #(1) '5)))
+
+(irregex-fold (procedure! irregex-fold (* (procedure (fixnum (struct regexp-match) *) *) * string #!optional (procedure (fixnum *) *) fixnum fixnum) *))
+
+(irregex-fold/chunked (procedure! irregex-fold/chunked (* (procedure (* fixnum (struct regexp-match) *) *) * procedure * #!optional (procedure (* fixnum *) *) fixnum fixnum) *))
+
+(irregex-lengths (procedure! irregex-lengths ((struct regexp)) *)
+ (((struct regexp)) (##sys#slot #(1) '7)))
+
+(irregex-match (procedure! irregex-match (* string) *))
+;irregex-match?
+
+(irregex-match-data? (procedure? (struct regexp-match) irregex-match-data? (*) boolean))
+
+(irregex-match-end (procedure irregex-match-end (* #!optional *) *))
+;irregex-match-end-chunk
+(irregex-match-end-index (procedure! irregex-match-end-index ((struct regexp-match) #!optional *) fixnum))
+
+(irregex-match-names (procedure! irregex-match-names ((struct regexp-match)) list)
+ (((struct regexp-match)) (##sys#slot #(1) '2)))
+
+(irregex-match-num-submatches (procedure! irregex-match-num-submatches ((struct regexp-match)) fixnum))
+(irregex-match-start (procedure irregex-match-start (* #!optional *) *))
+;irregex-match-start-chunk
+(irregex-match-start-index (procedure! irregex-match-start-index ((struct regexp-match) #!optional *) fixnum))
+(irregex-match-string (procedure irregex-match-string (*) *))
+(irregex-match-subchunk (procedure! irregex-match-subchunk ((struct regexp-match) #!optional *) *))
+(irregex-match-substring (procedure irregex-match-substring (* #!optional *) *))
+(irregex-match/chunked (procedure! irregex-match/chunked (* * * #!optional fixnum) *))
+
+(irregex-names (procedure! irregex-names ((struct regexp)) *)
+ (((struct regexp)) (##sys#slot #(1) '8)))
+
+(irregex-new-matches (procedure irregex-new-matches (*) *))
+
+(irregex-nfa (procedure! irregex-nfa ((struct regexp)) *)
+ (((struct regexp)) (##sys#slot #(1) '4)))
+
+(irregex-num-submatches (procedure! irregex-num-submatches ((struct regexp))
+ fixnum)
+ (((struct regexp)) (##sys#slot #(1) '6)))
+
+(irregex-opt (procedure! irregex-opt (list) *))
+(irregex-quote (procedure! irregex-quote (string) string))
+(irregex-replace (procedure! irregex-replace (* string #!rest) *))
+(irregex-replace/all (procedure! irregex-replace/all (* string #!rest) *))
+(irregex-reset-matches! (procedure irregex-reset-matches! (*) *))
+(irregex-search (procedure! irregex-search (* string #!optional fixnum fixnum) *))
+(irregex-search/matches (procedure! irregex-search/matches (* string fixnum fixnum *) *))
+(irregex-split (procedure! irregex-split (* string #!optional fixnum fixnum) list))
+(irregex-search/chunked (procedure! irregex-search/chunked (* procedure * #!optional fixnum fixnum *) *))
+(irregex-match-valid-index?
+ (procedure! irregex-match-valid-index? ((struct regexp-match) *) boolean))
+
+(irregex? (procedure? (struct regexp) irregex? (*) boolean))
+
+(make-irregex-chunker
+ (procedure! make-irregex-chunker
+ ((procedure (*) *)
+ (procedure (*) *)
+ #!optional
+ (procedure (*) *)
+ (procedure (*) *)
+ (procedure (* fixnum * fixnum) string)
+ (procedure (* fixnum * fixnum) *))
+ *))
+(maybe-string->sre (procedure maybe-string->sre (*) *))
+(sre->irregex (procedure sre->irregex (#!rest) *))
+(string->irregex (procedure! string->irregex (string #!rest) *))
+(string->sre (procedure! string->sre (string #!rest) *))
+
+;; lolevel
+
+(address->pointer (procedure! address->pointer (fixnum) pointer)
+ ((fixnum) (##sys#address->pointer #(1))))
+
+(align-to-word (procedure align-to-word ((or number pointer locative procedure port)) (or pointer number)))
+(allocate (procedure! allocate (fixnum) (or boolean pointer)))
+(block-ref (procedure! block-ref (* fixnum) *))
+(block-set! (procedure! block-set! (* fixnum *) *))
+(extend-procedure (procedure! extend-procedure (procedure *) procedure))
+(extended-procedure? (procedure extended-procedure? (*) boolean))
+(free (procedure! free (pointer) *))
+(locative->object (procedure! locative->object (locative) *))
+(locative-ref (procedure! locative-ref (locative) *))
+(locative-set! (procedure! locative-set! (locative *) *))
+(locative? (procedure locative? (*) boolean))
+(make-locative (procedure! make-locative (* #!optional fixnum) locative))
+(make-pointer-vector (procedure! make-pointer-vector (fixnum #!optional pointer) pointer-vector))
+(make-record-instance (procedure make-record-instance (* #!rest) *))
+(make-weak-locative (procedure! make-weak-locative (* #!optional fixnum) locative))
+
+(move-memory! (procedure! move-memory! (* * #!optional fixnum fixnum fixnum) *)
+ ((pointer pointer fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
+ ((pointer pointer fixnum fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
+ ((pointer pointer fixnum fixnum fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4)))
+ ((locative locative fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
+ ((locative locative fixnum fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
+ ((locative locative fixnum fixnum fixnum)
+ (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4))))
+
+(mutate-procedure (procedure! mutate-procedure (procedure procedure) procedure))
+(null-pointer deprecated)
+(null-pointer? deprecated)
+
+(number-of-bytes (procedure number-of-bytes (*) fixnum)
+ (((or blob string)) (##sys#size #(1)))
+ (((or port procedure symbol pair vector locative float pointer-vector))
+ ;; would be applicable to all structure types, but we can't specify
+ ;; "(struct *)" (yet)
+ (##core#inline "C_w2b" (##sys#size #(1)))))
+
+(number-of-slots (procedure number-of-slots (*) fixnum)
+ (((or vector symbol pair)) (##sys#size #(1))))
+
+(object->pointer (procedure object->pointer (*) *))
+(object-become! (procedure object-become! (list) *))
+(object-copy (procedure object-copy (*) *))
+(object-evict (procedure! object-evict (* #!optional (procedure (fixnum) pointer)) *))
+(object-evict-to-location (procedure! object-evict-to-location (* (or pointer locative procedure port) #!optional fixnum) * pointer))
+(object-evicted? (procedure object-evicted? (*) boolean))
+(object-release (procedure! object-release (* #!optional (procedure (pointer) *)) *))
+(object-size (procedure object-size (*) fixnum))
+(object-unevict (procedure object-unevict (* #!optional *) *))
+(pointer+ (procedure! pointer+ ((or pointer procedure port locative) fixnum) pointer))
+
+(pointer->address (procedure! pointer->address ((or pointer procedure port locative)) number)
+ ((pointer) (##sys#pointer->address #(1))))
+
+(pointer->object (procedure! pointer->object (pointer) *)
+ ((pointer) (##core#inline "C_pointer_to_object" #(1))))
+
+(pointer-like? (procedure pointer-like? (*) boolean)
+ (((or pointer locative procedure port)) (let ((#(tmp) #(1))) '#t)))
+
+(pointer-f32-ref (procedure! pointer-f32-ref (pointer) number))
+(pointer-f32-set! (procedure! pointer-f32-set! (pointer number) undefined))
+(pointer-f64-ref (procedure! pointer-f64-ref (pointer) number))
+(pointer-f64-set! (procedure! pointer-f64-set! (pointer number) undefined))
+(pointer-vector (procedure! pointer-vector (#!rest pointer-vector) boolean))
+
+(pointer-vector? (procedure? pointer-vector pointer-vector? (*) boolean))
+
+(pointer-vector-fill! (procedure! pointer-vector-fill! (pointer-vector pointer) undefined))
+
+(pointer-vector-length (procedure! pointer-vector-length (pointer-vector) fixnum)
+ ((pointer-vector) (##sys#slot #(1) '1)))
+
+(pointer-vector-ref (procedure! pointer-vector-ref (pointer-vector fixnum) pointer))
+(pointer-vector-set! (procedure! pointer-vector-set! (pointer-vector fixnum pointer) undefined))
+(pointer-s16-ref (procedure! pointer-s16-ref (pointer) fixnum))
+(pointer-s16-set! (procedure! pointer-s16-set! (pointer fixnum) undefined))
+(pointer-s32-ref (procedure! pointer-s32-ref (pointer) number))
+(pointer-s32-set! (procedure! pointer-s32-set! (pointer number) undefined))
+(pointer-s8-ref (procedure! pointer-s8-ref (pointer) fixnum))
+(pointer-s8-set! (procedure! pointer-s8-set! (pointer fixnum) undefined))
+
+(pointer-tag (procedure! pointer-tag ((or pointer locative procedure port)) (or boolean number))
+ (((or locative procedure port)) (let ((#(tmp) #(1))) '#f)))
+
+(pointer-u16-ref (procedure! pointer-u16-ref (pointer) fixnum))
+(pointer-u16-set! (procedure! pointer-u16-set! (pointer fixnum) undefined))
+(pointer-u32-ref (procedure! pointer-u32-ref (pointer) number))
+(pointer-u32-set! (procedure! pointer-u32-set! (pointer number) undefined))
+(pointer-u8-ref (procedure! pointer-u8-ref (pointer) fixnum))
+(pointer-u8-set! (procedure! pointer-u8-set! (pointer fixnum) undefined))
+
+(pointer=? (procedure! pointer=? ((or pointer locative procedure port)
+ (or pointer procedure locative port)) boolean)
+ ((pointer pointer) (##core#inline "C_pointer_eqp" #(1) #(2))))
+
+(pointer? (procedure? pointer pointer? (*) boolean))
+
+(procedure-data (procedure! procedure-data (procedure) *))
+(record->vector (procedure record->vector (*) vector))
+(record-instance? (procedure record-instance? (*) boolean))
+(record-instance-length (procedure record-instance-length (*) fixnum))
+(record-instance-slot (procedure! record-instance-slot (* fixnum) *))
+(record-instance-slot-set! (procedure! record-instance-slot-set! (* fixnum *) undefined))
+(record-instance-type (procedure record-instance-type (*) *))
+(set-procedure-data! (procedure! set-procedure-data! (procedure *) undefined))
+(tag-pointer (procedure! tag-pointer (pointer *) pointer))
+(tagged-pointer? (procedure! tagged-pointer? (* #!optional *) boolean))
+
+;; ports
+
+(call-with-input-string (procedure! call-with-input-string (string (procedure (port) . *)) . *))
+(call-with-output-string (procedure! call-with-output-string ((procedure (port) . *)) string))
+(copy-port (procedure! copy-port (* * #!optional (procedure (*) *) (procedure (* *) *)) undefined))
+(make-input-port (procedure! make-input-port ((procedure () char) (procedure () *) (procedure () . *) #!optional * * * *) port))
+(make-output-port (procedure! make-output-port ((procedure (string) . *) (procedure () . *) #!optional (procedure () . *)) port))
+(port-for-each (procedure! port-for-each ((procedure (*) *) (procedure () . *)) undefined))
+(port-map (procedure! port-map ((procedure (*) *) (procedure () . *)) list))
+(port-fold (procedure! port-fold ((procedure (* *) *) * (procedure () *)) *))
+(make-broadcast-port (procedure! make-broadcast-port (#!rest port) port))
+(make-concatenated-port (procedure! make-concatenated-port (port #!rest port) port))
+(with-error-output-to-port (procedure! with-error-output-to-port (port (procedure () . *)) . *))
+(with-input-from-port (procedure! with-input-from-port (port (procedure () . *)) . *))
+(with-input-from-string (procedure! with-input-from-string (string (procedure () . *)) . *))
+(with-output-to-port (procedure! with-output-to-port (port (procedure () . *)) . *))
+(with-output-to-string (procedure! with-output-to-string ((procedure () . *)) . *))
+
+;; posix
+
+(_exit (procedure _exit (fixnum) noreturn))
+(call-with-input-pipe (procedure! call-with-input-pipe (string (procedure (port) . *) #!optional symbol) . *))
+(call-with-output-pipe (procedure! call-with-output-pipe (string (procedure (port) . *) #!optional symbol) . *))
+(change-directory (procedure! change-directory (string) string))
+(change-file-mode (procedure! change-file-mode (string fixnum) undefined))
+(change-file-owner (procedure! change-file-owner (string fixnum fixnum) undefined))
+(close-input-pipe (procedure! close-input-pipe (port) fixnum))
+(close-output-pipe (procedure! close-output-pipe (port) fixnum))
+(create-directory (procedure! create-directory (string #!optional *) string))
+(create-fifo (procedure! create-fifo (string #!optional fixnum) undefined))
+(create-pipe (procedure create-pipe () fixnum fixnum))
+(create-session (procedure create-session () fixnum))
+(create-symbolic-link (procedure! create-symbolic-link (string string) undefined))
+(current-directory (procedure! current-directory (#!optional string) string))
+(current-effective-group-id (procedure current-effective-group-id () fixnum))
+(current-effective-user-id (procedure current-effective-user-id () fixnum))
+(current-effective-user-name (procedure current-effective-user-name () string))
+(current-environment deprecated)
+(get-environment-variables (procedure get-environment-variables () list))
+(current-group-id (procedure current-group-id () fixnum))
+(current-process-id (procedure current-process-id () fixnum))
+(current-user-id (procedure current-user-id () fixnum))
+(current-user-name (procedure current-user-name () string))
+(delete-directory (procedure! delete-directory (string) string))
+(directory (procedure! directory (string #!optional *) list))
+(directory? (procedure! directory? ((or string fixnum)) boolean))
+(duplicate-fileno (procedure! duplicate-fileno (fixnum #!optional fixnum) fixnum))
+(errno/2big fixnum)
+(errno/acces fixnum)
+(errno/again fixnum)
+(errno/badf fixnum)
+(errno/busy fixnum)
+(errno/child fixnum)
+(errno/deadlk fixnum)
+(errno/dom fixnum)
+(errno/exist fixnum)
+(errno/fault fixnum)
+(errno/fbig fixnum)
+(errno/ilseq fixnum)
+(errno/intr fixnum)
+(errno/inval fixnum)
+(errno/io fixnum)
+(errno/isdir fixnum)
+(errno/mfile fixnum)
+(errno/mlink fixnum)
+(errno/nametoolong fixnum)
+(errno/nfile fixnum)
+(errno/nodev fixnum)
+(errno/noent fixnum)
+(errno/noexec fixnum)
+(errno/nolck fixnum)
+(errno/nomem fixnum)
+(errno/nospc fixnum)
+(errno/nosys fixnum)
+(errno/notdir fixnum)
+(errno/notempty fixnum)
+(errno/notty fixnum)
+(errno/nxio fixnum)
+(errno/perm fixnum)
+(errno/pipe fixnum)
+(errno/range fixnum)
+(errno/rofs fixnum)
+(errno/spipe fixnum)
+(errno/srch fixnum)
+(errno/wouldblock fixnum)
+(errno/xdev fixnum)
+(fcntl/dupfd fixnum)
+(fcntl/getfd fixnum)
+(fcntl/getfl fixnum)
+(fcntl/setfd fixnum)
+(fcntl/setfl fixnum)
+(file-access-time (procedure! file-access-time ((or string fixnum)) number))
+(file-change-time (procedure! file-change-time ((or string fixnum)) number))
+(file-close (procedure! file-close (fixnum) undefined))
+(file-control (procedure! file-control (fixnum fixnum #!optional fixnum) fixnum))
+(file-creation-mode (procedure! file-creation-mode (#!optional fixnum) fixnum))
+(file-execute-access? (procedure! file-execute-access? (string) boolean))
+(file-link (procedure! file-link (string string) undefined))
+(file-lock (procedure! file-lock (port #!optional fixnum *) (struct lock)))
+(file-lock/blocking (procedure! file-lock/blocking (port #!optional fixnum *) (struct lock)))
+(file-mkstemp (procedure! file-mkstemp (string) fixnum string))
+(file-modification-time (procedure! file-modification-time ((or string fixnum)) number))
+(file-open (procedure! file-open (string fixnum #!optional fixnum) fixnum))
+(file-owner (procedure! file-owner ((or string fixnum)) fixnum))
+(file-permissions (procedure! file-permissions ((or string fixnum)) fixnum))
+(file-position (procedure! file-position ((or port fixnum)) fixnum))
+(file-read (procedure! file-read (fixnum fixnum #!optional *) list))
+(file-read-access? (procedure! file-read-access? (string) boolean))
+(file-select (procedure! file-select (list list #!optional fixnum) list list))
+(file-size (procedure! file-size ((or string fixnum)) number))
+(file-stat (procedure! file-stat ((or string fixnum) #!optional *) vector))
+(file-test-lock (procedure! file-test-lock (port #!optional fixnum *) boolean))
+(file-truncate (procedure! file-truncate ((or string fixnum) fixnum) undefined))
+(file-type (procedure! ((or string fixnum) #!optional * *) symbol))
+(file-unlock (procedure! file-unlock ((struct lock)) undefined))
+(file-write (procedure! file-write (fixnum * #!optional fixnum) fixnum))
+(file-write-access? (procedure! file-write-access? (string) boolean))
+(fileno/stderr fixnum)
+(fileno/stdin fixnum)
+(fileno/stdout fixnum)
+(find-files (procedure! find-files (string #!rest) list))
+(get-groups (procedure get-groups () list))
+(get-host-name (procedure get-host-name () string))
+(glob (procedure! glob (#!rest string) list))
+(group-information (procedure! group-information (fixnum #!optional *) *))
+(initialize-groups (procedure! initialize-groups (string fixnum) undefined))
+(local-time->seconds (procedure! local-time->seconds (vector) number))
+(local-timezone-abbreviation (procedure local-timezone-abbreviation () string))
+(map-file-to-memory (procedure! map-file-to-memory (* fixnum fixnum fixnum fixnum #!optional fixnum) (struct mmap)))
+(map/anonymous fixnum)
+(map/file fixnum)
+(map/fixed fixnum)
+(map/private fixnum)
+(map/shared fixnum)
+(memory-mapped-file-pointer (procedure! memory-mapped-file-pointer ((struct mmap)) pointer))
+(memory-mapped-file? (procedure memory-mapped-file? (*) boolean))
+(open-input-file* (procedure! open-input-file* (fixnum #!optional symbol) port))
+(open-input-pipe (procedure! open-input-pipe (string #!optional symbol) port))
+(open-output-file* (procedure! open-output-file* (fixnum #!optional symbol) port))
+(open-output-pipe (procedure! open-output-pipe (string #!optional symbol) port))
+(open/append fixnum)
+(open/binary fixnum)
+(open/creat fixnum)
+(open/excl fixnum)
+(open/fsync fixnum)
+(open/noctty fixnum)
+(open/nonblock fixnum)
+(open/rdonly fixnum)
+(open/rdwr fixnum)
+(open/read fixnum)
+(open/sync fixnum)
+(open/text fixnum)
+(open/trunc fixnum)
+(open/write fixnum)
+(open/wronly fixnum)
+(parent-process-id (procedure parent-process-id () fixnum))
+(perm/irgrp fixnum)
+(perm/iroth fixnum)
+(perm/irusr fixnum)
+(perm/irwxg fixnum)
+(perm/irwxo fixnum)
+(perm/irwxu fixnum)
+(perm/isgid fixnum)
+(perm/isuid fixnum)
+(perm/isvtx fixnum)
+(perm/iwgrp fixnum)
+(perm/iwoth fixnum)
+(perm/iwusr fixnum)
+(perm/ixgrp fixnum)
+(perm/ixoth fixnum)
+(perm/ixusr fixnum)
+(pipe/buf fixnum)
+(port->fileno (procedure! port->fileno (port) fixnum))
+(process (procedure! process (string #!optional list list) port port fixnum))
+(process* (procedure! process* (string #!optional list list) port port fixnum *))
+(process-execute (procedure! process-execute (string #!optional list list) noreturn))
+(process-fork (procedure! process-fork (#!optional (procedure () . *)) fixnum))
+(process-group-id (procedure! process-group-id () fixnum))
+(process-run (procedure! process-run (string #!optional list) fixnum))
+(process-signal (procedure! process-signal (fixnum #!optional fixnum) undefined))
+(process-wait (procedure! process-wait (fixnum #!optional *) fixnum fixnum fixnum))
+(prot/exec fixnum)
+(prot/none fixnum)
+(prot/read fixnum)
+(prot/write fixnum)
+(read-symbolic-link (procedure! read-symbolic-link (string) string))
+(regular-file? (procedure! regular-file? ((or string fixnum)) boolean))
+(seconds->local-time (procedure! seconds->local-time (#!optional number) vector))
+(seconds->string (procedure! seconds->string (#!optional number) string))
+(seconds->utc-time (procedure! seconds->utc-time (#!optional number) vector))
+(seek/cur fixnum)
+(seek/end fixnum)
+(seek/set fixnum)
+(set-alarm! (procedure! set-alarm! (number) number))
+(set-buffering-mode! (procedure! set-buffering-mode! (port symbol #!optional fixnum) undefined))
+(set-file-position! (procedure! set-file-position! ((or port fixnum) fixnum #!optional fixnum) undefined))
+(set-groups! (procedure! set-groups! (list) undefined))
+(set-root-directory! (procedure! set-root-directory! (string) undefined))
+(set-signal-handler! (procedure! set-signal-handler! (fixnum (procedure (fixnum) . *)) undefined))
+(set-signal-mask! (procedure! set-signal-mask! (list) undefined))
+(setenv (procedure! setenv (string string) undefined))
+(signal-handler (procedure! signal-handler (fixnum) (procedure (fixnum) . *)))
+(signal-mask (procedure signal-mask () fixnum))
+(signal-mask! (procedure! signal-mask! (fixnum) undefined))
+(signal-masked? (procedure! signal-masked? (fixnum) boolean))
+(signal-unmask! (procedure! signal-unmask! (fixnum) undefined))
+(signal/abrt fixnum)
+(signal/alrm fixnum)
+(signal/chld fixnum)
+(signal/cont fixnum)
+(signal/fpe fixnum)
+(signal/hup fixnum)
+(signal/ill fixnum)
+(signal/int fixnum)
+(signal/io fixnum)
+(signal/kill fixnum)
+(signal/pipe fixnum)
+(signal/prof fixnum)
+(signal/quit fixnum)
+(signal/segv fixnum)
+(signal/stop fixnum)
+(signal/term fixnum)
+(signal/trap fixnum)
+(signal/tstp fixnum)
+(signal/urg fixnum)
+(signal/usr1 fixnum)
+(signal/usr2 fixnum)
+(signal/vtalrm fixnum)
+(signal/winch fixnum)
+(signal/xcpu fixnum)
+(signal/xfsz fixnum)
+(signals-list list)
+(sleep (procedure! sleep (fixnum) fixnum))
+(block-device? (procedure! block-device? ((or string fixnum)) boolean))
+(character-device? (procedure! character-device? ((or string fixnum)) boolean))
+(fifo? (procedure! fifo? ((or string fixnum)) boolean))
+(socket? (procedure! socket? ((or string fixnum)) boolean))
+(string->time (procedure! string->time (string #!optional string) vector))
+(symbolic-link? (procedure! symbolic-link? ((or string fixnum)) boolean))
+(system-information (procedure system-information () list))
+(terminal-name (procedure! terminal-name (port) string))
+(terminal-port? (procedure! terminal-port? (port) boolean))
+(terminal-size (procedure! terminal-size (port) fixnum fixnum))
+(time->string (procedure! time->string (vector #!optional string) string))
+(unmap-file-from-memory (procedure! unmap-file-from-memory ((struct mmap) #!optional fixnum) undefined))
+(unsetenv (procedure! unsetenv (string) undefined))
+(user-information (procedure! user-information ((or string fixnum) #!optional *) *))
+(utc-time->seconds (procedure! utc-time->seconds (vector) number))
+(with-input-from-pipe (procedure! with-input-from-pipe (string (procedure () . *) #!optional symbol) . *))
+(with-output-to-pipe (procedure! with-output-to-pipe (string (procedure () . *) #!optional symbol) . *))
+
+;; srfi-1
+
+(alist-cons (procedure alist-cons (* * *) list))
+(alist-copy (procedure! alist-copy (list) list))
+(alist-delete (procedure! alist-delete (* list #!optional (procedure (* *) *)) list))
+(alist-delete! (procedure! alist-delete! (* list #!optional (procedure (* *) *)) undefined))
+(any (procedure! any ((procedure (* #!rest) *) list #!rest list) *))
+(append! (procedure! append! (#!rest list) list))
+(append-map (procedure! append-map ((procedure (#!rest) *) list #!rest list) pair))
+(append-map! (procedure! append-map! ((procedure (#!rest) *) list #!rest list) pair))
+(append-reverse (procedure! append-reverse (list list) list))
+(append-reverse! (procedure! append-reverse! (list list) list))
+(break (procedure! break ((procedure (*) *) list) list list))
+(break! (procedure! break! ((procedure (*) *) list) list list))
+(car+cdr (procedure! car+cdr (pair) * *))
+(circular-list (procedure circular-list (#!rest) list))
+
+(circular-list? (procedure circular-list? (*) boolean)
+ ((null) (let ((#(tmp) #(1))) '#f)))
+
+(concatenate (procedure! concatenate (list) list))
+(concatenate! (procedure! concatenate! (list) list))
+(cons* (procedure cons* (* #!rest) pair))
+(count (procedure! count ((procedure (*) *) list #!rest list) fixnum))
+(delete (procedure! delete (* list #!optional (procedure (* *) *)) list))
+(delete! (procedure! delete! (* list #!optional (procedure (* *) *)) list))
+(delete-duplicates (procedure! delete-duplicates (list #!optional (procedure (* *) *)) list))
+(delete-duplicates! (procedure! delete-duplicates! (list #!optional (procedure (* *) *)) list))
+(dotted-list? (procedure dotted-list? (*) boolean))
+(drop (procedure! drop (list fixnum) list))
+(drop-right (procedure! drop-right (list fixnum) list))
+(drop-right! (procedure! drop-right! (list fixnum) list))
+(drop-while (procedure! drop-while ((procedure (*) *) list) list))
+(eighth (procedure! eighth (pair) *))
+(every (procedure! every ((procedure (* #!rest) *) list #!rest list) *))
+(fifth (procedure! fifth (pair) *))
+(filter (procedure! filter ((procedure (*) *) list) list))
+(filter! (procedure! filter! ((procedure (*) *) list) list))
+(filter-map (procedure! filter-map ((procedure (* #!rest) *) list #!rest list) list))
+(find (procedure! find ((procedure (*) *) list) *))
+(find-tail (procedure! find-tail ((procedure (*) *) list) *))
+
+(first (procedure! first (pair) *)
+ ((pair) (##core#inline "C_u_i_car" #(1))))
+
+(fold (procedure! fold ((procedure (* #!rest) *) * #!rest list) *))
+(fold-right (procedure! fold-right ((procedure (* #!rest) *) * #!rest list) *))
+(fourth (procedure! fourth (pair) *))
+(iota (procedure! iota (fixnum #!optional fixnum fixnum) list))
+(last (procedure! last (pair) *))
+(last-pair (procedure! last-pair (pair) *))
+(length+ (procedure! length+ (list) *))
+(list-copy (procedure! list-copy (list) list))
+(list-index (procedure! list-index ((procedure (* #!rest) *) list #!rest list) *))
+(list-tabulate (procedure! list-tabulate (fixnum (procedure (fixnum) *)) list))
+(list= (procedure! list= (#!rest list) boolean))
+(lset-adjoin (procedure! lset-adjoin ((procedure (* *) *) list #!rest) list))
+(lset-diff+intersection (procedure! lset-diff+intersection ((procedure (* *) *) list #!rest list) list))
+(lset-diff+intersection! (procedure! lset-diff+intersection! ((procedure (* *) *) list #!rest list) list))
+(lset-difference (procedure! lset-difference ((procedure (* *) *) list #!rest list) list))
+(lset-difference! (procedure! lset-difference! ((procedure (* *) *) list #!rest list) list))
+(lset-intersection (procedure! lset-intersection ((procedure (* *) *) list #!rest list) list))
+(lset-intersection! (procedure! lset-intersection! ((procedure (* *) *) list #!rest list) list))
+(lset-union (procedure! lset-union ((procedure (* *) *) list #!rest list) list))
+(lset-union! (procedure! lset-union! ((procedure (* *) *) list #!rest list) list))
+(lset-xor (procedure! lset-xor ((procedure (* *) *) list #!rest list) list))
+(lset-xor! (procedure! lset-xor! ((procedure (* *) *) list #!rest list) list))
+(lset<= (procedure! lset<= ((procedure (* *) *) list #!rest list) boolean))
+(lset= (procedure! lset= ((procedure (* *) *) list #!rest list) boolean))
+(make-list (procedure! make-list (fixnum #!optional *) list))
+(map! (procedure! map! ((procedure (*) *) list #!rest list) list))
+(map-in-order (procedure! map-in-order ((procedure (*) *) list #!rest list) list))
+(ninth (procedure! ninth (pair) *))
+
+(not-pair? (procedure not-pair? (*) boolean)
+ ((pair) (let ((#(tmp) #(1))) '#f))
+ (((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
+
+(null-list? (procedure! null-list? (list) boolean)
+ ((pair) (let ((#(tmp) #(1))) '#f))
+ ((list) (let ((#(tmp) #(1))) '#f))
+ ((null) (let ((#(tmp) #(1))) '#t)))
+
+(pair-fold (procedure! pair-fold (procedure * list #!rest list) *))
+(pair-fold-right (procedure! pair-fold-right (procedure * list #!rest list) *))
+(pair-for-each (procedure! pair-for-each ((procedure (#!rest) . *) list #!rest list) undefined))
+(partition (procedure! partition ((procedure (*) *) list) list list))
+(partition! (procedure! partition! ((procedure (*) *) list) list list))
+
+(proper-list? (procedure proper-list? (*) boolean)
+ ((null) (let ((#(tmp) #(1))) '#t)))
+
+(reduce (procedure! reduce ((procedure (* *) *) * list) *))
+(reduce-right (procedure! reduce-right ((procedure (* *) *) * list) *))
+(remove (procedure! remove ((procedure (*) *) list) list))
+(remove! (procedure! remove! ((procedure (*) *) list) list))
+(reverse! (procedure! reverse! (list) list))
+(second (procedure! second (pair) *))
+(seventh (procedure! seventh (pair) *))
+(sixth (procedure! sixth (pair) *))
+(span (procedure! span ((procedure (*) *) list) list list))
+(span! (procedure! span! ((procedure (*) *) list) list list))
+(split-at (procedure! split-at (list fixnum) list list))
+(split-at! (procedure! split-at! (list fixnum) list list))
+(take (procedure! take (list fixnum) list))
+(take! (procedure! take! (list fixnum) list))
+(take-right (procedure! take-right (list fixnum) list))
+(take-while (procedure! take-while ((procedure (*) *) list) list))
+(take-while! (procedure! take-while! ((procedure (*) *) list) list))
+(tenth (procedure! tenth (pair) *))
+(third (procedure! third (pair) *))
+(unfold (procedure! unfold ((procedure (*) *) (procedure (*) *) (procedure (*) *) * #!optional (procedure (*) *)) *))
+(unfold-right (procedure! unfold-right ((procedure (*) *) (procedure (*) *) (procedure (*) *) * #!optional (procedure (*) *)) *))
+(unzip1 (procedure! unzip1 (list) list))
+(unzip2 (procedure! unzip2 (list) list list))
+(unzip3 (procedure! unzip3 (list) list list list))
+(unzip4 (procedure! unzip4 (list) list list list list))
+(unzip5 (procedure! unzip5 (list) list list list list list))
+(xcons (procedure xcons (* *) pair))
+(zip (procedure! zip (list #!rest list) list))
+
+;; srfi-13
+
+(check-substring-spec (procedure! check-substring-spec (* string fixnum fixnum) undefined))
+(kmp-step (procedure! kmp-step (string vector char fixnum (procedure (char char) *) fixnum) fixnum))
+(make-kmp-restart-vector (procedure! make-kmp-restart-vector (string #!optional (procedure (* *) *) fixnum fixnum) vector))
+(string-any (procedure! string-any (* string #!optional fixnum fixnum) boolean))
+
+(string-append/shared (procedure! string-append/shared (#!rest string) string)
+ ((string string) (##sys#string-append #(1) #(2))))
+
+(string-ci< (procedure! string-ci< (string string #!optional fixnum fixnum) boolean)
+ ((string string) (string-ci<? #(1) #(2))))
+
+(string-ci<= (procedure! string-ci<= (string string #!optional fixnum fixnum) boolean)
+ ((string string) (string-ci<=? #(1) #(2))))
+
+(string-ci<> (procedure! string-ci<> (string string #!optional fixnum fixnum) boolean)
+ ((string string) (not (##core#inline "C_i_string_ci_equal_p" #(1) #(2)))))
+
+(string-ci= (procedure! string-ci= (string string #!optional fixnum fixnum) boolean)
+ ((string string) (##core#inline "C_i_string_ci_equal_p" #(1) #(2))))
+
+(string-ci> (procedure! string-ci> (string string #!optional fixnum fixnum) boolean)
+ ((string string) (string-ci>? #(1) #(2))))
+
+(string-ci>= (procedure! string-ci>= (string string #!optional fixnum fixnum) boolean)
+ ((string string) (string-ci>=? #(1) #(2))))
+
+(string-compare (procedure! string-compare (string string (procedure (fixnum) *) (procedure (fixnum) *) (procedure (fixnum) *) #!optional fixnum fixnum fixnum fixnum) *))
+(string-compare-ci (procedure! string-compare (string string (procedure (fixnum) *) (procedure (fixnum) *) (procedure (fixnum) *) #!optional fixnum fixnum fixnum fixnum) *))
+(string-concatenate (procedure! string-concatenate (list) string))
+(string-concatenate-reverse (procedure! string-concatenate-reverse (list #!optional string fixnum) string))
+(string-concatenate-reverse/shared (procedure! string-concatenate-reverse/shared (list #!optional string fixnum) string))
+(string-concatenate/shared (procedure! string-concatenate/shared (list) string))
+(string-contains (procedure! string-contains (string string #!optional fixnum fixnum fixnum fixnum) (or fixnum boolean)))
+(string-contains-ci (procedure! string-contains-ci (string string #!optional fixnum fixnum fixnum fixnum) (or fixnum boolean)))
+(string-copy (procedure! string-copy (string #!optional fixnum fixnum) string))
+(string-copy! (procedure! string-copy! (string fixnum string #!optional fixnum fixnum) undefined))
+(string-count (procedure! string-count (string * #!optional fixnum fixnum) fixnum))
+(string-delete (procedure! string-delete (* string #!optional fixnum fixnum) string))
+(string-downcase (procedure! string-downcase (string #!optional fixnum fixnum) string))
+(string-downcase! (procedure! string-downcase! (string #!optional fixnum fixnum) string))
+(string-drop (procedure! string-drop (string fixnum) string))
+(string-drop-right (procedure! string-drop-right (string fixnum) string))
+(string-every (procedure! string-every (* string #!optional fixnum fixnum) boolean))
+(string-fill! (procedure! string-fill! (string char #!optional fixnum fixnum) string))
+(string-filter (procedure! string-filter (* string #!optional fixnum fixnum) string))
+(string-fold (procedure! string-fold ((procedure (char *) *) * string #!optional fixnum fixnum) *))
+(string-fold-right (procedure! string-fold-right ((procedure (char *) *) * string #!optional fixnum fixnum) *))
+(string-for-each (procedure! string-for-each ((procedure (char) . *) string #!optional fixnum fixnum) undefined))
+(string-for-each-index (procedure! string-for-each-index ((procedure (fixnum) . *) string #!optional fixnum fixnum) undefined))
+(string-index (procedure! string-index (string * #!optional fixnum fixnum) (or fixnum boolean)))
+(string-index-right (procedure! string-index-right (string * #!optional fixnum fixnum) (or fixnum boolean)))
+(string-join (procedure! string-join (list #!optional string symbol) string))
+(string-kmp-partial-search (procedure! string-kmp-partial-search (string vector string fixnum #!optional (procedure (char char) *) fixnum fixnum fixnum) fixnum))
+(string-map (procedure! string-map ((procedure (char) char) string #!optional fixnum fixnum) string))
+(string-map! (procedure! string-map! ((procedure (char) char) string #!optional fixnum fixnum) string))
+
+(string-null? (procedure! string-null? (string) boolean)
+ ((string) (##core#inline "C_zero_length_p" #(1))))
+
+(string-pad (procedure! string-pad (string fixnum #!optional char fixnum fixnum) string))
+(string-pad-right (procedure! string-pad-right (string fixnum #!optional char fixnum fixnum) string))
+(string-parse-final-start+end (procedure! string-parse-final-start+end (procedure string #!rest) . *))
+(string-parse-start+end (procedure! string-parse-start+end (procedure string #!rest) . *))
+(string-prefix-ci? (procedure! string-prefix-ci? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
+(string-prefix-length (procedure! string-prefix-length (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
+(string-prefix-length-ci (procedure! string-prefix-length-ci (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
+(string-prefix? (procedure! string-prefix? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
+(string-replace (procedure! string-replace (string string fixnum fixnum #!optional fixnum fixnum) string))
+(string-reverse (procedure! string-reverse (string #!optional fixnum fixnum) string))
+(string-reverse! (procedure! string-reverse! (string #!optional fixnum fixnum) string))
+(string-skip (procedure! string-skip (string * #!optional fixnum fixnum) (or fixnum boolean)))
+(string-skip-right (procedure! string-skip-right (string * #!optional fixnum fixnum) (or fixnum boolean)))
+(string-suffix-ci? (procedure! string-suffix-ci? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
+(string-suffix-length (procedure! string-suffix-length (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
+(string-suffix-length-ci (procedure! string-suffix-length-ci (string string #!optional fixnum fixnum fixnum fixnum) fixnum))
+(string-suffix? (procedure! string-suffix? (string string #!optional fixnum fixnum fixnum fixnum) boolean))
+(string-tabulate (procedure! string-tabulate ((procedure (fixnum) char) fixnum) string))
+(string-take (procedure! string-take (string fixnum) string))
+(string-take-right (procedure! string-take-right (string fixnum) string))
+(string-titlecase (procedure! string-titlecase (string #!optional fixnum fixnum) string))
+(string-titlecase! (procedure! string-titlecase! (string #!optional fixnum fixnum) string))
+(string-tokenize (procedure! string-tokenize (string #!optional * fixnum fixnum) list))
+(string-trim (procedure! string-trim (string #!optional * fixnum fixnum) string))
+(string-trim-both (procedure! string-trim-both (string #!optional * fixnum fixnum) string))
+(string-trim-right (procedure! string-trim-right (string #!optional * fixnum fixnum) string))
+(string-unfold (procedure! string-unfold (procedure procedure procedure * #!optional * procedure) string))
+(string-unfold-right (procedure! string-unfold-right (procedure procedure procedure * #!optional * procedure) string))
+(string-upcase (procedure! string-upcase (string #!optional fixnum fixnum) string))
+(string-upcase! (procedure! string-upcase! (string #!optional fixnum fixnum) string))
+(string-xcopy! (procedure! string-xcopy! (string string string fixnum #!optional fixnum fixnum fixnum) string))
+
+(string< (procedure! string< (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+ ((string string) (string<? #(1) #(2))))
+
+(string<= (procedure! string<= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+ ((string string) (string<=? #(1) #(2))))
+
+(string<> (procedure! string<> (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+ ((string string) (not (##core#inline "C_i_string_equal_p" #(1) #(2)))))
+
+(string= (procedure! string= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+ ((string string) (##core#inline "C_i_string_equal_p" #(1) #(2))))
+
+(string> (procedure! string> (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+ ((string string) (string>? #(1) #(2))))
+
+(string>= (procedure! string>= (string string #!optional fixnum fixnum fixnum fixnum) boolean)
+ ((string string) (string>=? #(1) #(2))))
+
+(substring-spec-ok? (procedure! substring-spec-ok? (string fixnum fixnum) boolean))
+(substring/shared (procedure! substring/shared (string fixnum #!optional fixnum) string))
+(xsubstring (procedure! xsubstring (string fixnum #!optional fixnum fixnum fixnum) string))
+
+;; srfi-14
+
+(->char-set (procedure ->char-set (*) (struct char-set))
+ (((struct char-set)) #(1))
+ ((string) (string->char-set #(1)))
+ ((char) (char-set #(1))))
+
+(char-set (procedure! char-set (#!rest char) (struct char-set)))
+(char-set->list (procedure! char-set->list ((struct char-set)) list))
+(char-set->string (procedure! char-set->string ((struct char-set)) string))
+(char-set-adjoin (procedure! char-set-adjoin ((struct char-set) #!rest char) (struct char-set)))
+(char-set-adjoin! (procedure! char-set-adjoin! ((struct char-set) #!rest char) (struct char-set)))
+(char-set-any (procedure! char-set-any ((procedure (char) *) (struct char-set)) *))
+(char-set-complement (procedure! char-set-complement ((struct char-set)) (struct char-set)))
+(char-set-complement! (procedure! char-set-complement! ((struct char-set)) (struct char-set)))
+(char-set-contains? (procedure! char-set-contains? ((struct char-set) char) boolean))
+(char-set-copy (procedure! char-set-copy ((struct char-set)) (struct char-set)))
+(char-set-count (procedure! char-set-count ((procedure (char) *) (struct char-set)) fixnum))
+(char-set-cursor (procedure! char-set-cursor ((struct char-set)) fixnum))
+(char-set-cursor-next (procedure! char-set-cursor-next ((struct char-set) fixnum) fixnum))
+(char-set-delete (procedure! char-set-delete ((struct char-set) #!rest char) (struct char-set)))
+(char-set-delete! (procedure! char-set-delete! ((struct char-set) #!rest char) (struct char-set)))
+(char-set-diff+intersection (procedure! char-set-diff+intersection ((struct char-set) #!rest (struct char-set)) (struct char-set) (struct char-set)))
+(char-set-diff+intersection! (procedure! char-set-diff+intersection! ((struct char-set) #!rest (struct char-set)) (struct char-set) (struct char-set)))
+(char-set-difference (procedure! char-set-difference ((struct char-set) #!rest (struct char-set)) (struct char-set)))
+(char-set-difference! (procedure! char-set-difference! ((struct char-set) #!rest (struct char-set)) (struct char-set)))
+(char-set-every (procedure! char-set-every ((procedure (char) *) (struct char-set)) boolean))
+(char-set-filter (procedure! char-set-filter ((procedure (char) *) (struct char-set) #!optional (struct char-set)) (struct char-set)))
+(char-set-filter! (procedure! char-set-filter! ((procedure (char) *) (struct char-set) #!optional (struct char-set)) (struct char-set)))
+(char-set-fold (procedure! char-set-fold ((procedure (char *) *) * (struct char-set)) *))
+(char-set-for-each (procedure! char-set-for-each ((procedure (char) . *) (struct char-set)) undefined))
+(char-set-hash (procedure! char-set-hash ((struct char-set) #!optional number) number))
+(char-set-intersection (procedure! char-set-intersection (#!rest (struct char-set)) (struct char-set)))
+(char-set-intersection! (procedure! char-set-intersection! (#!rest (struct char-set)) (struct char-set)))
+(char-set-map (procedure! char-set-map ((procedure (char) char) (struct char-set)) (struct char-set)))
+(char-set-ref (procedure! char-set-ref ((struct char-set) fixnum) char))
+(char-set-size (procedure! char-set-size ((struct char-set)) fixnum))
+(char-set-unfold (procedure! char-set-unfold (procedure procedure procedure * #!optional (struct char-set)) (struct char-set)))
+(char-set-unfold! (procedure! char-set-unfold! (procedure procedure procedure * (struct char-set)) (struct char-set)))
+(char-set-union (procedure! char-set-union (#!rest (struct char-set)) (struct char-set)))
+(char-set-union! (procedure! char-set-union! (#!rest (struct char-set)) (struct char-set)))
+(char-set-xor (procedure! char-set-xor (#!rest (struct char-set)) (struct char-set)))
+(char-set-xor! (procedure! char-set-xor! (#!rest (struct char-set)) (struct char-set)))
+(char-set:ascii (struct char-set))
+(char-set:blank (struct char-set))
+(char-set:digit (struct char-set))
+(char-set:empty (struct char-set))
+(char-set:full (struct char-set))
+(char-set:graphic (struct char-set))
+(char-set:hex-digit (struct char-set))
+(char-set:iso-control (struct char-set))
+(char-set:letter (struct char-set))
+(char-set:letter+digit (struct char-set))
+(char-set:lower-case (struct char-set))
+(char-set:printing (struct char-set))
+(char-set:punctuation (struct char-set))
+(char-set:symbol (struct char-set))
+(char-set:title-case (struct char-set))
+(char-set:upper-case (struct char-set))
+(char-set:whitespace (struct char-set))
+(char-set<= (procedure! char-set<= (#!rest (struct char-set)) boolean))
+(char-set= (procedure! char-set= (#!rest (struct char-set)) boolean))
+
+(char-set? (procedure? (struct char-set) char-set? (*) boolean))
+
+(end-of-char-set? (procedure! end-of-char-set? (fixnum) boolean))
+(list->char-set (procedure! list->char-set (list #!optional (struct char-set)) (struct char-set)))
+(list->char-set! (procedure! list->char-set! (list #!optional (struct char-set)) (struct char-set)))
+(string->char-set (procedure! string->char-set (string #!optional (struct char-set)) (struct char-set)))
+(string->char-set! (procedure! string->char-set! (string #!optional (struct char-set)) (struct char-set)))
+(ucs-range->char-set (procedure! ucs-range->char-set (fixnum fixnum #!optional * (struct char-set)) (struct char-set)))
+(ucs-range->char-set! (procedure! ucs-range->char-set! (fixnum fixnum #!optional * (struct char-set)) (struct char-set)))
+
+;; srfi-18
+
+(abandoned-mutex-exception? (procedure abandoned-mutex-exception? (*) boolean))
+(condition-variable-broadcast! (procedure! condition-variable-broadcast! ((struct condition-variable)) undefined))
+(condition-variable-name (procedure! condition-variable-name ((struct condition-variable)) *))
+(condition-variable-signal! (procedure! condition-variable-signal! ((struct condition-variable)) undefined))
+(condition-variable-specific (procedure! condition-variable-specific ((struct condition-variable)) *))
+(condition-variable-specific-set! (procedure! condition-variable-specific-set! ((struct condition-variable) *) undefined))
+
+(condition-variable? (procedure? (struct condition-variable) condition-variable? (*)
+ boolean))
+
+(current-thread (procedure current-thread () (struct thread))) ;XXX
+
+(current-time (procedure current-time () (struct time)))
+(join-timeout-exception? (procedure join-timeout-exception? (*) boolean))
+(make-condition-variable (procedure make-condition-variable (#!optional *) (struct condition-variable)))
+(make-mutex (procedure make-mutex (#!optional *) (struct mutex)))
+(make-thread (procedure! make-thread ((procedure () . *) #!optional *) (struct thread)))
+(milliseconds->time deprecated)
+(mutex-lock! (procedure! mutex-lock! ((struct mutex) #!optional * (struct thread)) boolean))
+
+(mutex-name (procedure! mutex-name ((struct mutex)) *)
+ (((struct mutex)) (##sys#slot #(1) '1)))
+
+(mutex-specific (procedure! mutex-specific ((struct mutex)) *)
+ (((struct mutex)) (##sys#slot #(1) '6)))
+
+(mutex-specific-set! (procedure! mutex-specific-set! ((struct mutex) *) undefined)
+ (((struct mutex) *) (##sys#setslot #(1) '6 #(2))))
+
+(mutex-state (procedure! mutex-state ((struct mutex)) symbol))
+(mutex-unlock! (procedure! mutex-unlock! ((struct mutex) #!optional (struct condition-variable) *) undefined))
+
+(mutex? (procedure? (struct mutex) mutex? (*) boolean))
+
+(raise (procedure raise (*) noreturn))
+(seconds->time (procedure! seconds->time (number) (struct time)))
+(terminated-thread-exception? (procedure terminated-thread-exception? (*) boolean))
+(thread-join! (procedure! thread-join! ((struct thread) #!optional * *) *))
+
+(thread-name (procedure! thread-name ((struct thread)) *)
+ (((struct thread)) (##sys#slot #(1) '6)))
+
+(thread-quantum (procedure! thread-quantum ((struct thread)) fixnum)
+ (((struct thread)) (##sys#slot #(1) '9)))
+
+(thread-quantum-set! (procedure! thread-quantum-set! ((struct thread) fixnum) undefined))
+(thread-resume! (procedure! thread-resume! ((struct thread)) undefined))
+(thread-signal! (procedure! thread-signal! ((struct thread) *) undefined))
+(thread-sleep! (procedure thread-sleep! (*) undefined))
+
+(thread-specific (procedure! thread-specific ((struct thread)) *)
+ (((struct thread)) (##sys#slot #(1) '10)))
+
+(thread-specific-set! (procedure! thread-specific-set! ((struct thread) *) undefined)
+ (((struct thread) *) (##sys#setslot #(1) '10 #(2))))
+
+(thread-start! (procedure! thread-start! ((or (struct thread) (procedure () . *))) (struct thread)))
+
+(thread-state (procedure! thread-state ((struct thread)) symbol)
+ (((struct thread)) (##sys#slot #(1) '3)))
+
+(thread-suspend! (procedure! thread-suspend! ((struct thread)) undefined))
+(thread-terminate! (procedure! thread-terminate! ((struct thread)) undefined))
+(thread-wait-for-i/o! (procedure! thread-wait-for-i/o! (fixnum #!optional symbol) undefined))
+(thread-yield! (procedure thread-yield! () undefined))
+
+(thread? (procedure? (struct thread) thread? (*) boolean))
+
+(time->milliseconds deprecated)
+(time->seconds (procedure! time->seconds ((struct time)) number))
+
+(time? (procedure? (struct time) time? (*) boolean))
+
+(uncaught-exception-reason (procedure! uncaught-exception-reason ((struct condition)) *))
+(uncaught-exception? (procedure uncaught-exception? (*) boolean))
+
+;; srfi-4
+
+(blob->f32vector (procedure! blob->f32vector (blob) (struct f32vector)))
+(blob->f32vector/shared (procedure! blob->f32vector/shared (blob) (struct f32vector)))
+(blob->f64vector (procedure! blob->f64vector (blob) (struct f64vector)))
+(blob->f64vector/shared (procedure! blob->f64vector/shared (blob) (struct f64vector)))
+(blob->s16vector (procedure! blob->s16vector (blob) (struct s16vector)))
+(blob->s16vector/shared (procedure! blob->s16vector/shared (blob) (struct s16vector)))
+(blob->s32vector (procedure! blob->s32vector (blob) (struct s32vector)))
+(blob->s32vector/shared (procedure! blob->s32vector/shared (blob) (struct s32vector)))
+(blob->s8vector (procedure! blob->s8vector (blob) (struct u8vector)))
+(blob->s8vector/shared (procedure! blob->s8vector/shared (blob) (struct u8vector)))
+(blob->u16vector (procedure! blob->u16vector (blob) (struct u16vector)))
+(blob->u16vector/shared (procedure! blob->u16vector/shared (blob) (struct u16vector)))
+(blob->u32vector (procedure! blob->u32vector (blob) (struct u32vector)))
+(blob->u32vector/shared (procedure! blob->u32vector/shared (blob) (struct u32vector)))
+(blob->u8vector (procedure! blob->u8vector (blob) (struct u8vector)))
+(blob->u8vector/shared (procedure! blob->u8vector/shared (blob) (struct u8vector)))
+(f32vector (procedure! f32vector (#!rest number) (struct f32vector)))
+(f32vector->blob (procedure! f32vector->blob ((struct f32vector)) blob))
+(f32vector->blob/shared (procedure! f32vector->blob/shared ((struct f32vector)) blob))
+(f32vector->list (procedure! f32vector->list ((struct f32vector)) list))
+
+(f32vector-length (procedure! f32vector-length ((struct f32vector)) fixnum)
+ (((struct f32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
+
+(f32vector-ref (procedure! f32vector-ref ((struct f32vector) fixnum) float))
+(f32vector-set! (procedure! f32vector-set! ((struct f32vector) fixnum number) undefined))
+
+(f32vector? (procedure? (struct f32vector) f32vector? (*) boolean))
+
+(f64vector (procedure! f64vector (#!rest number) (struct f64vector)))
+(f64vector->blob (procedure! f64vector->blob ((struct f32vector)) blob))
+(f64vector->blob/shared (procedure! f64vector->blob/shared ((struct f64vector)) blob))
+(f64vector->list (procedure! f64vector->list ((struct f64vector)) blob))
+
+(f64vector-length (procedure! f64vector-length ((struct f64vector)) fixnum)
+ (((struct f32vector)) (##core#inline "C_u_i_64vector_length" #(1))))
+
+(f64vector-ref (procedure! f64vector-ref ((struct f64vector) fixnum) float))
+(f64vector-set! (procedure! f64vector-set! ((struct f64vector) fixnum number) undefined))
+
+(f64vector? (procedure? (struct f64vector) f64vector? (*) boolean))
+
+(list->f32vector (procedure! list->f32vector (list) (struct f32vector)))
+(list->f64vector (procedure! list->f64vector (list) (struct f64vector)))
+(list->s16vector (procedure! list->s16vector (list) (struct s16vector)))
+(list->s32vector (procedure! list->s32vector (list) (struct s32vector)))
+(list->s8vector (procedure! list->s8vector (list) (struct s8vector)))
+(list->u16vector (procedure! list->u16vector (list) (struct u16vector)))
+(list->u32vector (procedure! list->u32vector (list) (struct u32vector)))
+(list->u8vector (procedure! list->u8vector (list) (struct u8vector)))
+(make-f32vector (procedure! make-f32vector (fixnum #!optional * * *) (struct f32vector)))
+(make-f64vector (procedure! make-f64vector (fixnum #!optional * * *) (struct f64vector)))
+(make-s16vector (procedure! make-s16vector (fixnum #!optional * * *) (struct s16vector)))
+(make-s32vector (procedure! make-s32vector (fixnum #!optional * * *) (struct s32vector)))
+(make-s8vector (procedure! make-s8vector (fixnum #!optional * * *) (struct s8vector)))
+(make-u16vector (procedure! make-u16vector (fixnum #!optional * * *) (struct u16vector)))
+(make-u32vector (procedure! make-u32vector (fixnum #!optional * * *) (struct u32vector)))
+(make-u8vector (procedure! make-u8vector (fixnum #!optional * * *) (struct u8vector)))
+(read-u8vector (procedure! read-u8vector (#!optional fixnum port) (struct u8vector)))
+(read-u8vector! (procedure! read-u8vector! (fixnum (struct u8vector) #!optional port fixnum) number))
+(release-number-vector (procedure release-number-vector (*) undefined))
+(s16vector (procedure! s16vector (#!rest fixnum) (struct s16vector)))
+(s16vector->blob (procedure! s16vector->blob ((struct s16vector)) blob))
+(s16vector->blob/shared (procedure! s16vector->blob/shared ((struct s16vector)) blob))
+(s16vector->list (procedure! s16vector->list ((struct s16vector)) list))
+
+(s16vector-length (procedure! s16vector-length ((struct s16vector)) fixnum)
+ (((struct s16vector)) (##core#inline "C_u_i_16vector_length" #(1))))
+
+(s16vector-ref (procedure! s16vector-ref ((struct s16vector) fixnum) fixnum))
+(s16vector-set! (procedure! s16vector-set! ((struct s16vector) fixnum fixnum) undefined))
+
+(s16vector? (procedure? (struct s16vector) s16vector? (*) boolean))
+
+(s32vector (procedure! s32vector (#!rest number) (struct s32vector)))
+(s32vector->blob (procedure! s32vector->blob ((struct 32vector)) blob))
+(s32vector->blob/shared (procedure! s32vector->blob/shared ((struct s32vector)) blob))
+(s32vector->list (procedure! s32vector->list ((struct s32vector)) list))
+
+(s32vector-length (procedure! s32vector-length ((struct s32vector)) fixnum)
+ (((struct s32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
+
+(s32vector-ref (procedure! s32vector-ref ((struct s32vector) fixnum) number))
+(s32vector-set! (procedure! s32vector-set! ((struct s32vector) fixnum number) undefined))
+
+(s32vector? (procedure? (struct s32vector) s32vector? (*) boolean))
+
+(s8vector (procedure! s8vector (#!rest fixnum) (struct s8vector)))
+(s8vector->blob (procedure! s8vector->blob ((struct s8vector)) blob))
+(s8vector->blob/shared (procedure! s8vector->blob/shared ((struct s8vector)) blob))
+(s8vector->list (procedure! s8vector->list ((struct s8vector)) list))
+
+(s8vector-length (procedure! s8vector-length ((struct s8vector)) fixnum)
+ (((struct s8vector)) (##core#inline "C_u_i_8vector_length" #(1))))
+
+(s8vector-ref (procedure! s8vector-ref ((struct s8vector) fixnum) fixnum))
+(s8vector-set! (procedure! s8vector-set! ((struct s8vector) fixnum fixnum) undefined))
+
+(s8vector? (procedure? (struct s8vector) s8vector? (*) boolean))
+
+(subf32vector (procedure! subf32vector ((struct f32vector) fixnum fixnum) (struct f32vector)))
+(subf64vector (procedure! subf64vector ((struct f64vector) fixnum fixnum) (struct f64vector)))
+(subs16vector (procedure! subs16vector ((struct s16vector) fixnum fixnum) (struct s16vector)))
+(subs32vector (procedure! subs32vector ((struct s32vector) fixnum fixnum) (struct s32vector)))
+(subs8vector (procedure! subs8vector ((struct s8vector) fixnum fixnum) (struct s8vector)))
+(subu16vector (procedure! subu16vector ((struct u16vector) fixnum fixnum) (struct u16vector)))
+(subu32vector (procedure! subu32vector ((struct u32vector) fixnum fixnum) (struct u32vector)))
+(subu8vector (procedure! subu8vector ((struct u8vector) fixnum fixnum) (struct u8vector)))
+(u16vector (procedure! u16vector (#!rest fixnum) (struct u16vector)))
+(u16vector->blob (procedure! u16vector->blob ((struct u16vector)) blob))
+(u16vector->blob/shared (procedure! u16vector->blob/shared ((struct u16vector)) blob))
+(u16vector->list (procedure! u16vector->list ((struct u16vector)) list))
+
+(u16vector-length (procedure! u16vector-length ((struct u16vector)) fixnum)
+ (((struct u16vector)) (##core#inline "C_u_i_16vector_length" #(1))))
+
+(u16vector-ref (procedure! u16vector-ref ((struct u16vector) fixnum) fixnum))
+(u16vector-set! (procedure! u16vector-set! ((struct u16vector) fixnum fixnum) undefined))
+
+(u16vector? (procedure? (struct u16vector) u16vector? (*) boolean))
+
+(u32vector (procedure! u32vector (#!rest number) (struct u32vector)))
+(u32vector->blob (procedure! u32vector->blob ((struct u32vector)) blob))
+(u32vector->blob/shared (procedure! u32vector->blob/shared ((struct u32vector)) blob))
+(u32vector->list (procedure! u32vector->list ((struct u32vector)) list))
+
+(u32vector-length (procedure! u32vector-length ((struct u32vector)) fixnum)
+ (((struct u32vector)) (##core#inline "C_u_i_32vector_length" #(1))))
+
+(u32vector-ref (procedure! u32vector-ref ((struct u32vector) fixnum) number))
+(u32vector-set! (procedure! u32vector-set! ((struct u32vector) fixnum number) undefined))
+
+(u32vector? (procedure? (struct u32vector) u32vector? (*) boolean))
+
+(u8vector (procedure! u8vector (#!rest fixnum) (struct u8vector)))
+(u8vector->blob (procedure! u8vector->blob ((struct u8vector)) blob))
+(u8vector->blob/shared (procedure! u8vector->blob/shared ((struct u8vector)) blob))
+(u8vector->list (procedure! u8vector->list ((struct u8vector)) list))
+
+(u8vector-length (procedure! u8vector-length ((struct u8vector)) fixnum)
+ (((struct u8vector)) (##core#inline "C_u_i_8vector_length" #(1))))
+
+(u8vector-ref (procedure! u8vector-ref ((struct u8vector) fixnum) fixnum))
+(u8vector-set! (procedure! u8vector-set! ((struct u8vector) fixnum fixnum) undefined))
+
+(u8vector? (procedure? (struct u8vector) u8vector? (*) boolean))
+
+(write-u8vector (procedure! write-u8vector ((struct u8vector) #!optional port fixnum fixnum) undefined))
+
+;; srfi-69
+
+(alist->hash-table (procedure! alist->hash-table (list #!rest) (struct hash-table)))
+(eq?-hash (procedure! eq?-hash (* #!optional fixnum) fixnum))
+(equal?-hash (procedure! equal?-hash (* #!optional fixnum) fixnum))
+(eqv?-hash (procedure! eqv?-hash (* #!optional fixnum) fixnum))
+(hash (procedure! hash (* #!optional fixnum) fixnum))
+(hash-by-identity (procedure! hash-by-identity (* #!optional fixnum) fixnum))
+(hash-table->alist (procedure! hash-table->alist ((struct hash-table)) list))
+(hash-table-clear! (procedure! hash-table-clear! ((struct hash-table)) undefined))
+(hash-table-copy (procedure! hash-table-copy ((struct hash-table)) (struct hash-table)))
+(hash-table-delete! (procedure! hash-table-delete! ((struct hash-table) *) boolean))
+(hash-table-equivalence-function (procedure! hash-table-equivalence-function ((struct hash-table)) (procedure (* *) *)))
+(hash-table-exists? (procedure! hash-table-exists? ((struct hash-table) *) boolean))
+(hash-table-fold (procedure! hash-table-fold ((struct hash-table) (procedure (* * *) *) *) *))
+(hash-table-for-each (procedure! hash-table-for-each ((struct hash-table) (procedure (* *) . *)) undefined))
+
+(hash-table-has-initial? (procedure! hash-table-has-initial? ((struct hash-table)) boolean)
+ (((struct hash-table)) (##sys#slot #(1) '9))) ;XXX might return other than #t
+
+(hash-table-hash-function (procedure! hash-table-hash-function ((struct hash-table)) (procedure (* fixnum) fixnum))
+ (((struct hash-table)) (##sys#slot #(1) '4)))
+
+(hash-table-initial (procedure! hash-table-initial ((struct hash-table)) *))
+(hash-table-keys (procedure! hash-table-keys ((struct hash-table)) list))
+(hash-table-map (procedure! hash-table-map ((struct hash-table) (procedure (* *) *)) list))
+
+(hash-table-max-load (procedure! hash-table-max-load ((struct hash-table)) fixnum)
+ (((struct hash-table)) (##sys#slot #(1) '6)))
+
+(hash-table-merge (procedure! hash-table-merge ((struct hash-table) (struct hash-table)) (struct hash-table)))
+(hash-table-merge! (procedure! hash-table-merge! ((struct hash-table) (struct hash-table)) undefined))
+
+(hash-table-min-load (procedure! hash-table-min-load ((struct hash-table)) fixnum)
+ (((struct hash-table)) (##sys#slot #(1) '5)))
+
+(hash-table-ref (procedure! hash-table-ref ((struct hash-table) * #!optional (procedure () *)) *))
+(hash-table-ref/default (procedure! hash-table-ref/default ((struct hash-table) * *) *))
+(hash-table-remove! (procedure! hash-table-remove! ((struct hash-table) (procedure (* *) *)) undefined))
+(hash-table-set! (procedure! hash-table-set! ((struct hash-table) * *) undefined))
+
+(hash-table-size (procedure! hash-table-size ((struct hash-table)) fixnum)
+ (((struct hash-table)) (##sys#slot #(1) '2)))
+
+(hash-table-update! (procedure! hash-table-update! ((struct hash-table) * (procedure (*) *) #!optional (procedure () *)) *))
+(hash-table-update!/default (procedure! hash-table-update!/default ((struct hash-table) * (procedure (*) *) *) *))
+(hash-table-values (procedure! hash-table-values ((struct hash-table)) list))
+(hash-table-walk (procedure! hash-table-walk ((struct hash-table) (procedure (* *) . *)) undefined))
+
+(hash-table-weak-keys (procedure! hash-table-weak-keys ((struct hash-table)) boolean)
+ (((struct hash-table)) (##sys#slot #(1) '7)))
+
+(hash-table-weak-values (procedure! hash-table-weak-values ((struct hash-table)) boolean)
+ (((struct hash-table)) (##sys#slot #(1) '8)))
+
+(hash-table? (procedure? (struct hash-table) hash-table? (*) boolean))
+
+;;XXX if we want to hardcode hash-default-bound here, we could rewrite the 1-arg case...
+; (applies to all hash-functions)
+(keyword-hash (procedure! keyword-hash (* #!optional fixnum) fixnum))
+
+(make-hash-table (procedure! make-hash-table (#!rest) (struct hash-table)))
+(number-hash (procedure! number-hash (fixnum #!optional fixnum) fixnum))
+(object-uid-hash (procedure! object-uid-hash (* #!optional fixnum) fixnum))
+(symbol-hash (procedure! symbol-hash (symbol #!optional fixnum) fixnum))
+(string-hash (procedure! string-hash (string #!optional fixnum fixnum fixnum) number))
+(string-hash-ci (procedure! string-hash-ci (string #!optional fixnum fixnum fixnum) number))
+(string-ci-hash (procedure! string-ci-hash (string #!optional fixnum fixnum fixnum) number))
+
+;; tcp
+
+(tcp-abandon-port (procedure! tcp-abandon-port (port) undefined))
+(tcp-accept (procedure! tcp-accept ((struct tcp-listener)) port port))
+(tcp-accept-ready? (procedure! tcp-accept-ready? ((struct tcp-listener)) boolean))
+(tcp-accept-timeout (procedure! tcp-accept-timeout (#!optional number) number))
+(tcp-addresses (procedure! tcp-addresses (port) string string))
+(tcp-buffer-size (procedure! tcp-buffer-size (#!optional fixnum) fixnum))
+(tcp-close (procedure! tcp-close ((struct tcp-listener)) undefined))
+(tcp-connect (procedure! tcp-connect (string #!optional fixnum) port port))
+(tcp-connect-timeout (procedure! tcp-connect-timeout (#!optional number) number))
+(tcp-listen (procedure! tcp-listen (fixnum #!optional fixnum *) (struct tcp-listener)))
+
+(tcp-listener-fileno (procedure! tcp-listener-fileno ((struct tcp-listener)) fixnum)
+ (((struct tcp-listener)) (##sys#slot #(1) '1)))
+
+(tcp-listener-port (procedure! tcp-listener-port ((struct tcp-listener)) fixnum))
+
+(tcp-listener? (procedure? (struct tcp-listener) tcp-listener? (*) boolean))
+
+(tcp-port-numbers (procedure! tcp-port-numbers (port) fixnum fixnum))
+(tcp-read-timeout (procedure! tcp-read-timeout (#!optional number) number))
+(tcp-write-timeout (procedure! tcp-write-timeout (#!optional number) number))
+
+;; utils
+
+(for-each-argv-line deprecated)
+(for-each-line deprecated)
+(read-all (procedure! read-all (#!optional (or port string)) string))
+(system* (procedure! system* (string #!rest) undefined))
+(qs (procedure! qs (string) string))
+(compile-file (procedure! compile-file (string #!rest) (or boolean string)))
+(compile-file-options (procedure! compile-file-options (#!optional list) list))
+(scan-input-lines (procedure! scan-input-lines (* #!optional port) *))
+(yes-or-no? (procedure! yes-or-no? (string #!rest) *))
Trap