From: Alan Post <alanp...@sunflowerriver.org>
Subject: Re: [Chicken-hackers] [PATCH] add input- and output port types
specifiers
Date: Thu, 29 Sep 2011 06:21:22 -0600
> On Thu, Sep 29, 2011 at 03:46:41AM -0400, Felix wrote:
>> The attached patch introduces separate type-specifiers for input- and
>> output-ports. The old "port" type is still available but only
>> abbreviates "(or input-port output-port)". types.db has been
>> changed accordingly and is thus not compatible to old chickens
>> (so needs bootstrap).
>>
>>
>> cheers,
>> felix
>
> Some of this was eyeball glaze for me: I had trouble following long
> lines and just skipped over them. I did spot one typo.
>
>> commit aa5ad07f1cf2c0754be6af26e6a937935e0f198b
>> Author: felix <fe...@call-with-current-continuation.org>
>> Date: Thu Sep 29 09:11:18 2011 +0200
>>
>> - added distinguished types for input and output ports
>> - old "port" type abbreviates "(or input-port output-port)"
>> - small optimization in over-all-instantiations
>> - removed commented out obsolete type-check generator code
>> - updated types.db to use new port types
>>
>> diff --git a/manual/Types b/manual/Types
>> index 710a17b..e45f4c2 100644
>> --- a/manual/Types
>> +++ b/manual/Types
>> @@ -127,7 +127,7 @@ or {{:}} should follow the syntax given below:
>> <tr><td>{{pair}}</td><td>pair</td></tr>
>> <tr><td>{{pointer-vector}}</td><td>vector or native pointers</td></tr>
>> <tr><td>{{pointer}}</td><td>native pointer</td></tr>
>> -<tr><td>{{port}}</td><td>input- or output-port</td></tr>
>> +<tr><td>{{inputport}} {{output-port}}</td><td>input- or
>> output-port</td></tr>
>> <tr><td>{{procedure}}</td><td>unspecific procedure</td></tr>
>> <tr><td>{{string}}</td><td>string</td></tr>
>> <tr><td>{{symbol}}</td><td>symbol</td></tr>
>
> Should the '+' line rather be (adding a '-')?:
>
>> +<tr><td>{{input-port}} {{output-port}}</td><td>input- or
>> output-port</td></tr>
Thanks. Attached a new version, introducing more bugs and typos.
cheers,
felix
commit 34109149d35ed46cc909104c02b01ee6a971a42c
Author: felix <fe...@call-with-current-continuation.org>
Date: Fri Sep 30 08:36:08 2011 +0200
Squashed commit of the following:
commit f1e71d18fda1b3779a71db70185075578e75af3f
Author: felix <fe...@call-with-current-continuation.org>
Date: Fri Sep 30 08:21:49 2011 +0200
fixed typo in type-table in manual (thanks to Alan Post)
commit aa5ad07f1cf2c0754be6af26e6a937935e0f198b
Author: felix <fe...@call-with-current-continuation.org>
Date: Thu Sep 29 09:11:18 2011 +0200
- added distinguished types for input and output ports
- old "port" type abbreviates "(or input-port output-port)"
- small optimization in over-all-instantiations
- removed commented out obsolete type-check generator code
- updated types.db to use new port types
diff --git a/manual/Types b/manual/Types
index 710a17b..c180a3e 100644
--- a/manual/Types
+++ b/manual/Types
@@ -127,7 +127,7 @@ or {{:}} should follow the syntax given below:
<tr><td>{{pair}}</td><td>pair</td></tr>
<tr><td>{{pointer-vector}}</td><td>vector or native pointers</td></tr>
<tr><td>{{pointer}}</td><td>native pointer</td></tr>
-<tr><td>{{port}}</td><td>input- or output-port</td></tr>
+<tr><td>{{input-port}} {{output-port}}</td><td>input- or output-port</td></tr>
<tr><td>{{procedure}}</td><td>unspecific procedure</td></tr>
<tr><td>{{string}}</td><td>string</td></tr>
<tr><td>{{symbol}}</td><td>symbol</td></tr>
@@ -200,6 +200,7 @@ Additionally, some aliases are allowed:
<tr><th>Alias</th><th>Type</th></tr>
<tr><td>{{any}}</td><td>{{*}}</td></tr>
<tr><td>{{immediate}}</td><td>{{(or eof null fixnum char boolean)}}</td></tr>
+<tr><td>{{port}}</td><td>{{(or input-port output-port)}}</td></tr>
<tr><td>{{void}}</td><td>{{undefined}}</td></tr>
</table>
diff --git a/scrutinizer.scm b/scrutinizer.scm
index d74a1d0..6d7bc97 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -71,7 +71,7 @@
; | deprecated
; | (deprecated NAME)
; BASIC = * | string | symbol | char | number | boolean | list | pair |
-; procedure | vector | null | eof | undefined | port |
+; procedure | vector | null | eof | undefined | input-port | output-port |
; blob | noreturn | pointer | locative | fixnum | float |
; pointer-vector
; COMPLEX = (pair VAL VAL)
@@ -1708,8 +1708,8 @@
(resolve t2 (cons t done))))))
((not (pair? t))
(if (memq t '(* fixnum eof char string symbol float number list vector pair
- undefined blob port pointer locative boolean pointer-vector
- null procedure noreturn))
+ undefined blob input-port output-port pointer locative boolean
+ pointer-vector null procedure noreturn))
t
(bomb "resolve: can't resolve unknown type-variable" t)))
(else
@@ -1909,8 +1909,8 @@
(and l1 l2 (cons l1 l2))))))
(define (validate t #!optional (rec #t))
(cond ((memq t '(* string symbol char number boolean list pair
- procedure vector null eof undefined port blob
- pointer locative fixnum float pointer-vector
+ procedure vector null eof undefined input-port output-port
+ blob pointer locative fixnum float pointer-vector
deprecated noreturn values))
t)
((memq t '(u8vector s8vector u16vector s16vector u32vector s32vector
@@ -1920,6 +1920,8 @@
`(struct ,t))
((eq? t 'immediate)
'(or eof null fixnum char boolean))
+ ((eq? t 'port)
+ '(or input-port output-port))
((eq? t 'any) '*)
((eq? t 'void) 'undefined)
((and (symbol? t) (##sys#get t '##compiler#type-abbreviation)))
@@ -2149,127 +2151,6 @@
`((vector ,@(cdr args)))))
-;;; generate type-checks for formal variables
-;
-;XXX not used in the moment
-
-#;(define (generate-type-checks! node loc vars inits)
- ;; assumes type is validated
- (define (test t v)
- (case t
- ((null) `(##core#inline "C_eqp" ,v '()))
- ((eof) `(##core#inline "C_eofp" ,v))
- ((string) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_stringp" ,v)
- '#f))
- ((float) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_flonump" ,v)
- '#f))
- ((char) `(##core#inline "C_charp" ,v))
- ((fixnum) `(##core#inline "C_fixnump" ,v))
- ((number) `(##core#inline "C_i_numberp" ,v))
- ((list) `(##core#inline "C_i_listp" ,v))
- ((symbol) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_symbolp" ,v)
- '#f))
- ((pair) `(##core#inline "C_i_pairp" ,v))
- ((boolean) `(##core#inline "C_booleanp" ,v))
- ((procedure) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_closurep" ,v)
- '#f))
- ((vector) `(##core#inline "C_i_vectorp" ,v))
- ((pointer) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_pointerp" ,v)
- '#f))
- ((blob) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_byteblockp" ,v)
- '#f))
- ((pointer-vector) `(##core#inline "C_i_structurep" ,v 'pointer-vector))
- ((port) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_portp" ,v)
- '#f))
- ((locative) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_locativep" ,v)
- '#f))
- (else
- (case (car t)
- ((forall) (test (third t) v))
- ((procedure) `(if (##core#inline "C_blockp" ,v)
- (##core#inline "C_closurep" ,v)
- '#f))
- ((or)
- (cond ((null? (cdr t)) '(##core#undefined))
- ((null? (cddr t)) (test (cadr t) v))
- (else
- `(if ,(test (cadr t) v)
- '#t
- ,(test `(or ,@(cddr t)) v)))))
- ((and)
- (cond ((null? (cdr t)) '(##core#undefined))
- ((null? (cddr t)) (test (cadr t) v))
- (else
- `(if ,(test (cadr t) v)
- ,(test `(and ,@(cddr t)) v)
- '#f))))
- ((pair)
- `(if (##core#inline "C_i_pairp" ,v)
- (if ,(test (second t) `(##sys#slot ,v 0))
- ,(test (third t) `(##sys#slot ,v 1))
- '#f)
- '#f))
- ((list-of)
- (let ((var (gensym)))
- `(if (##core#inline "C_i_listp" ,v)
- (##sys#check-list-items ;XXX missing
- ,v
- (lambda (,var)
- ,(test (second t) var)))
- '#f)))
- ((vector-of)
- (let ((var (gensym)))
- `(if (##core#inline "C_i_vectorp" ,v)
- (##sys#check-vector-items ;XXX missing
- ,v
- (lambda (,var)
- ,(test (second t) var)))
- '#f)))
- ;;XXX missing: vector, list
- ((not)
- `(not ,(test (cadr t) v)))
- (else (bomb "generate-type-checks!: invalid type" t v))))))
- (let ((body (first (node-subexpressions node))))
- (let loop ((vars (reverse vars)) (inits (reverse inits)) (b body))
- (cond ((null? inits)
- (if (eq? b body)
- body
- (copy-node!
- (make-node
- (node-class node) ; lambda
- (node-parameters node)
- (list b))
- node)))
- ((eq? '* (car inits))
- (loop (cdr vars) (cdr inits) b))
- (else
- (loop
- (cdr vars) (cdr inits)
- (make-node
- 'let (list (gensym))
- (list
- (build-node-graph
- (let ((t (car inits))
- (v (car vars)))
- `(if ,(test t v)
- (##core#undefined)
- ;;XXX better call non-CPS C routine
- (##core#app
- ##sys#error ',loc
- ',(sprintf "expected argument `~a' to be of type `~s'"
- v t)
- ,v))))
- b))))))))
-
-
;;; perform check over all typevar instantiations
(define (over-all-instantiations tlist typeenv exact process)
@@ -2297,21 +2178,21 @@
;; collect candidates for each typevar
(define (collect)
(let* ((vars (delete-duplicates (concatenate (map unzip1 insts)) eq?))
- ;;(_ (dd "vars: ~s, insts: ~s" vars insts)) ;XXX remove
(all (map (lambda (var)
(cons
var
- (append-map
+ (filter-map
(lambda (inst)
- (cond ((assq var inst) => (o list cdr))
- (exact '(*))
- (else '())))
+ (cond ((assq var inst) => cdr)
+ ;;XXX is the following correct in all cases?
+ (exact '*)
+ (else #f)))
insts)))
vars)))
;;(dd " collected: ~s" all) ;XXX remove
all))
- (dd " over-all-instantiations: ~s exact=~a" tlist exact) ;XXX remove
+ ;;(dd " over-all-instantiations: ~s exact=~a" tlist exact) ;XXX remove
;; process all tlist elements
(let loop ((ts tlist) (ok #f))
(cond ((null? ts)
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 6b687c8..6ea5b49 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -112,7 +112,7 @@
(check + 1.2 procedure)
(check '#(1) 1.2 vector)
(check '() 1 null)
-(check (current-input-port) 1.2 port)
+(check (current-input-port) 1.2 input-port)
(check (make-blob 10) 1.2 blob)
(check (address->pointer 0) 1.2 pointer)
(check (make-pointer-vector 1) 1.2 pointer-vector)
@@ -133,7 +133,7 @@
(ms '#(1) 1.2 (vector fixnum))
(ms '() 1 null)
(ms (void) 1.2 undefined)
-(ms (current-input-port) 1.2 port)
+(ms (current-input-port) 1.2 input-port)
(ms (make-blob 10) 1.2 blob)
(ms (address->pointer 0) 1.2 pointer)
(ms (make-pointer-vector 1) 1.2 pointer-vector)
@@ -166,7 +166,7 @@
(checkp condition? (##sys#make-structure 'condition) (struct condition))
(checkp fixnum? 1 fixnum)
(checkp flonum? 1.2 float)
-(checkp port? (current-input-port) port)
+(checkp input-port? (current-input-port) input-port)
(checkp pointer-vector? (make-pointer-vector 1) pointer-vector)
(checkp pointer? (address->pointer 1) pointer)
diff --git a/types.db b/types.db
index 17f1f01..d577806 100644
--- a/types.db
+++ b/types.db
@@ -42,6 +42,10 @@
; - "#:clean" means: will not invoke procedures that modify local variables and
; will not modify list or vector data held locally (note that I/O may invoke
; port handlers)
+; - "#:pure" means: will not have side-effects; this is a bit of a lie,
+; since arity-mismatch will for example always have a side effect.
+; - "#:enforce" means: after return from this procedure, the argument is of
+; the correct type (it would have signalled an error otherwise)
;; scheme
@@ -583,46 +587,45 @@
(call-with-current-continuation
(#(procedure #:enforce) call-with-current-continuation ((procedure (procedure) . *)) . *))
-(input-port? (#(procedure #:pure) input-port? (*) boolean))
-(output-port? (#(procedure #:pure) output-port? (*) boolean))
+(input-port? (#(procedure #:pure #:predicate input-port) input-port? (*) boolean))
+(output-port? (#(procedure #:pure #:predicate output-port) output-port? (*) boolean))
(current-input-port
- (#(procedure #:clean #:enforce) current-input-port (#!optional port) port)
- ((port) (let ((#(tmp1) #(1)))
- (let ((#(tmp2) (set! ##sys#standard-input #(tmp1))))
- #(tmp1))))
+ (#(procedure #:clean #:enforce) current-input-port (#!optional input-port) input-port)
+ ((input-port) (let ((#(tmp1) #(1)))
+ (let ((#(tmp2) (set! ##sys#standard-input #(tmp1))))
+ #(tmp1))))
(() ##sys#standard-input))
(current-output-port
- (#(procedure #:clean #:enforce) current-output-port (#!optional port) port)
- ((port) (let ((#(tmp1) #(1)))
- (let ((#(tmp2) (set! ##sys#standard-output #(tmp1))))
- #(tmp1))))
+ (#(procedure #:clean #:enforce) current-output-port (#!optional output-port) output-port)
+ ((output-port) (let ((#(tmp1) #(1)))
+ (let ((#(tmp2) (set! ##sys#standard-output #(tmp1))))
+ #(tmp1))))
(() ##sys#standard-output))
(call-with-input-file
- (procedure call-with-input-file (string (procedure (port) . *) #!rest) . *))
+ (procedure call-with-input-file (string (procedure (input-port) . *) #!rest) . *))
(call-with-output-file
- (procedure call-with-output-file (string (procedure (port) . *) #!rest) . *))
+ (procedure call-with-output-file (string (procedure (output-port) . *) #!rest) . *))
-(open-input-file (#(procedure #:clean #:enforce) open-input-file (string #!rest symbol) port))
-(open-output-file (#(procedure #:clean #:enforce) open-output-file (string #!rest symbol) port))
-(close-input-port (#(procedure #:enforce) close-input-port (port) undefined))
-(close-output-port (#(procedure #:enforce) close-output-port (port) undefined))
+(open-input-file (#(procedure #:clean #:enforce) open-input-file (string #!rest symbol) input-port))
+(open-output-file (#(procedure #:clean #:enforce) open-output-file (string #!rest symbol) output-port))
+(close-input-port (#(procedure #:enforce) close-input-port (input-port) undefined))
+(close-output-port (#(procedure #:enforce) close-output-port (output-port) undefined))
(load (procedure load (string #!optional (procedure (*) . *)) undefined))
-(read (#(procedure #:enforce) read (#!optional port) *))
+(read (#(procedure #:enforce) read (#!optional input-port) *))
(eof-object? (#(procedure #:pure #:predicate eof) eof-object? (*) boolean))
-;;XXX if we had input/output port distinction, we could specialize these:
-(read-char (#(procedure #:enforce) read-char (#!optional port) *)) ;XXX result (or eof char) ?
-(peek-char (#(procedure #:enforce) peek-char (#!optional port) *))
+(read-char (#(procedure #:enforce) read-char (#!optional input-port) (or eof char)))
+(peek-char (#(procedure #:enforce) peek-char (#!optional input-port) (or eof char)))
-(write (#(procedure #:enforce) write (* #!optional port) undefined))
-(display (#(procedure #:enforce) display (* #!optional port) undefined))
-(write-char (#(procedure #:enforce) write-char (char #!optional port) undefined))
-(newline (#(procedure #:enforce) newline (#!optional port) undefined))
+(write (#(procedure #:enforce) write (* #!optional output-port) undefined))
+(display (#(procedure #:enforce) display (* #!optional output-port) undefined))
+(write-char (#(procedure #:enforce) write-char (char #!optional output-port) undefined))
+(newline (#(procedure #:enforce) newline (#!optional output-port) undefined))
(with-input-from-file
(#(procedure #:enforce) with-input-from-file (string (procedure () . *) #!rest symbol) . *))
@@ -648,7 +651,7 @@
(#(tmp2) (#(tmp1)))))))
(eval (procedure eval (* #!optional (struct environment)) *))
-(char-ready? (#(procedure #:enforce) char-ready? (#!optional port) boolean))
+(char-ready? (#(procedure #:enforce) char-ready? (#!optional input-port) boolean))
(imag-part (#(procedure #:clean #:enforce) imag-part (number) number)
(((or fixnum float number)) (let ((#(tmp) #(1))) '0)))
@@ -742,10 +745,10 @@
(cpu-time (#(procedure #:clean) cpu-time () fixnum fixnum))
(current-error-port
- (#(procedure #:clean #:enforce) current-error-port (#!optional port) port)
- ((port) (let ((#(tmp1) #(1)))
- (let ((#(tmp2) (set! ##sys#standard-error #(tmp1))))
- #(tmp1))))
+ (#(procedure #:clean #:enforce) current-error-port (#!optional output-port) output-port)
+ ((output-port) (let ((#(tmp1) #(1)))
+ (let ((#(tmp2) (set! ##sys#standard-error #(tmp1))))
+ #(tmp1))))
(() ##sys#standard-error))
(current-exception-handler
@@ -811,7 +814,7 @@
(flonum? (#(procedure #:pure #:predicate float) flonum? (*) boolean))
-(flush-output (#(procedure #:enforce) flush-output (#!optional port) undefined))
+(flush-output (#(procedure #:enforce) flush-output (#!optional output-port) undefined))
(foldl (forall (a b) (#(procedure #:enforce) foldl ((procedure (a b) a) a (list-of b)) a)))
(foldr (forall (a b) (#(procedure #:enforce) foldr ((procedure (a b) b) b (list-of a)) b)))
@@ -938,7 +941,7 @@
(get-condition-property (#(procedure #:clean #:enforce) get-condition-property ((struct condition) symbol symbol #!optional *) *))
(get-environment-variable (#(procedure #:clean #:enforce) get-environment-variable (string) *))
(get-keyword (#(procedure #:clean #:enforce) get-keyword (symbol list #!optional *) *))
-(get-output-string (#(procedure #:clean #:enforce) get-output-string (port) string))
+(get-output-string (#(procedure #:clean #:enforce) get-output-string (output-port) string))
(get-properties (#(procedure #:clean #:enforce) get-properties (symbol list) symbol * list))
(getter-with-setter
@@ -978,8 +981,8 @@
(most-negative-fixnum fixnum)
(most-positive-fixnum fixnum)
(on-exit (#(procedure #:clean #:enforce) on-exit ((procedure () . *)) undefined))
-(open-input-string (#(procedure #:clean #:enforce) open-input-string (string #!rest) port))
-(open-output-string (#(procedure #:clean) open-output-string (#!rest) port))
+(open-input-string (#(procedure #:clean #:enforce) open-input-string (string #!rest) input-port))
+(open-output-string (#(procedure #:clean) open-output-string (#!rest) output-port))
(parentheses-synonyms (#(procedure #:clean) parentheses-synonyms (#!optional *) *))
(port-name (#(procedure #:clean #:enforce) port-name (#!optional port) *)
@@ -987,11 +990,11 @@
(port-position (#(procedure #:clean #:enforce) port-position (#!optional port) fixnum fixnum))
-(port? (#(procedure #:pure #:predicate port) port? (*) boolean))
+(port? (#(procedure #:pure) port? (*) boolean))
(print (procedure print (#!rest *) undefined))
-(print-call-chain (#(procedure #:clean #:enforce) print-call-chain (#!optional port fixnum * string) undefined))
-(print-error-message (#(procedure #:clean #:enforce) print-error-message (* #!optional port string) undefined))
+(print-call-chain (#(procedure #:clean #:enforce) print-call-chain (#!optional output-port fixnum * string) undefined))
+(print-error-message (#(procedure #:clean #:enforce) print-error-message (* #!optional output-port string) undefined))
(print* (procedure print* (#!rest) undefined))
(procedure-information (#(procedure #:clean #:enforce) procedure-information (procedure) *))
(program-name (#(procedure #:clean #:enforce) program-name (#!optional string) string))
@@ -1017,13 +1020,13 @@
(set-gc-report! (#(procedure #:clean) set-gc-report! (*) undefined))
(set-parameterized-read-syntax!
- (#(procedure #:clean #:enforce) set-parameterized-read-syntax! (char (procedure (port fixnum) . *)) undefined))
+ (#(procedure #:clean #:enforce) set-parameterized-read-syntax! (char (procedure (input-port fixnum) . *)) undefined))
(set-port-name! (#(procedure #:clean #:enforce) set-port-name! (port string) undefined)
((port string) (##sys#setslot #(1) '3 #(2))))
-(set-read-syntax! (#(procedure #:clean #:enforce) set-read-syntax! (char (procedure (port) . *)) undefined))
-(set-sharp-read-syntax! (#(procedure #:clean #:enforce) set-sharp-read-syntax! (char (procedure (port) . *)) undefined))
+(set-read-syntax! (#(procedure #:clean #:enforce) set-read-syntax! (char (procedure (input-port) . *)) undefined))
+(set-sharp-read-syntax! (#(procedure #:clean #:enforce) set-sharp-read-syntax! (char (procedure (input-port) . *)) undefined))
(setter (#(procedure #:clean #:enforce) setter (procedure) procedure))
(signal (procedure signal (*) . *))
(signum (#(procedure #:clean #:enforce) signum (number) number))
@@ -1229,29 +1232,29 @@
;; extras
(format (procedure format (#!rest) *))
-(fprintf (#(procedure #:enforce) fprintf (port string #!rest) undefined))
-(pp (#(procedure #:enforce) pp (* #!optional port) undefined))
-(pretty-print (#(procedure #:enforce) pretty-print (* #!optional port) undefined))
+(fprintf (#(procedure #:enforce) fprintf (output-port string #!rest) undefined))
+(pp (#(procedure #:enforce) pp (* #!optional output-port) undefined))
+(pretty-print (#(procedure #:enforce) pretty-print (* #!optional output-port) undefined))
(pretty-print-width (#(procedure #:clean) pretty-print-width (#!optional fixnum) *))
(printf (#(procedure #:enforce) printf (string #!rest) undefined))
(random (#(procedure #:clean #:enforce) random (fixnum) fixnum))
(randomize (#(procedure #:clean #:enforce) randomize (#!optional fixnum) undefined))
-(read-buffered (#(procedure #:enforce) read-buffered (#!optional port) string))
-(read-byte (#(procedure #:enforce) read-byte (#!optional port) *))
-(read-file (#(procedure #:enforce) read-file (#!optional (or port string) (procedure (port) *) fixnum) list))
-(read-line (#(procedure #:enforce) read-line (#!optional port (or boolean fixnum)) *))
-(read-lines (#(procedure #:enforce) read-lines (#!optional (or port string) fixnum) (list-of string)))
-(read-string (#(procedure #:enforce) read-string (#!optional * port) string))
-(read-string! (#(procedure #:enforce) read-string! (fixnum string #!optional port fixnum) fixnum))
-(read-token (#(procedure #:enforce) read-token ((procedure (char) *) #!optional port) string))
+(read-buffered (#(procedure #:enforce) read-buffered (#!optional input-port) string))
+(read-byte (#(procedure #:enforce) read-byte (#!optional input-port) *))
+(read-file (#(procedure #:enforce) read-file (#!optional (or input-port string) (procedure (input-port) *) fixnum) list))
+(read-line (#(procedure #:enforce) read-line (#!optional input-port (or boolean fixnum)) *))
+(read-lines (#(procedure #:enforce) read-lines (#!optional (or input-port string) fixnum) (list-of string)))
+(read-string (#(procedure #:enforce) read-string (#!optional * input-port) string))
+(read-string! (#(procedure #:enforce) read-string! (fixnum string #!optional input-port fixnum) fixnum))
+(read-token (#(procedure #:enforce) read-token ((procedure (char) *) #!optional input-port) string))
(sprintf (#(procedure #:enforce) sprintf (string #!rest) string))
-(write-byte (#(procedure #:enforce) write-byte (fixnum #!optional port) undefined)
+(write-byte (#(procedure #:enforce) write-byte (fixnum #!optional output-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 #:enforce) write-line (string #!optional port) undefined))
-(write-string (#(procedure #:enforce) write-string (string #!optional * port) undefined))
+(write-line (#(procedure #:enforce) write-line (string #!optional output-port) undefined))
+(write-string (#(procedure #:enforce) write-string (string #!optional * output-port) undefined))
;; files
@@ -1499,37 +1502,37 @@
;; ports
-(call-with-input-string (#(procedure #:enforce) call-with-input-string (string (procedure (port) . *)) . *))
-(call-with-output-string (#(procedure #:enforce) call-with-output-string ((procedure (port) . *)) string))
-(copy-port (#(procedure #:enforce) copy-port (* * #!optional (procedure (*) *) (procedure (* port) *)) undefined))
-(make-input-port (#(procedure #:clean #:enforce) make-input-port ((procedure () (or char eof)) (procedure () *) (procedure () . *) #!optional * * * *) port))
-(make-output-port (#(procedure #:clean #:enforce) make-output-port ((procedure (string) . *) (procedure () . *) #!optional (procedure () . *)) port))
+(call-with-input-string (#(procedure #:enforce) call-with-input-string (string (procedure (input-port) . *)) . *))
+(call-with-output-string (#(procedure #:enforce) call-with-output-string ((procedure (output-port) . *)) string))
+(copy-port (#(procedure #:enforce) copy-port (* * #!optional (procedure (*) *) (procedure (* output-port) *)) undefined))
+(make-input-port (#(procedure #:clean #:enforce) make-input-port ((procedure () (or char eof)) (procedure () *) (procedure () . *) #!optional * * * *) input-port))
+(make-output-port (#(procedure #:clean #:enforce) make-output-port ((procedure (string) . *) (procedure () . *) #!optional (procedure () . *)) output-port))
(port-for-each (#(procedure #:enforce) port-for-each ((procedure (*) *) (procedure () . *)) undefined))
(port-map
(forall (a b) (#(procedure #:enforce) port-map ((procedure (a) b) (procedure () a)) (list-of b))))
(port-fold (#(procedure #:enforce) port-fold ((procedure (* *) *) * (procedure () *)) *))
-(make-broadcast-port (#(procedure #:clean #:enforce) make-broadcast-port (#!rest port) port))
-(make-concatenated-port (#(procedure #:clean #:enforce) make-concatenated-port (port #!rest port) port))
-(with-error-output-to-port (#(procedure #:enforce) with-error-output-to-port (port (procedure () . *)) . *))
-(with-input-from-port (#(procedure #:enforce) with-input-from-port (port (procedure () . *)) . *))
+(make-broadcast-port (#(procedure #:clean #:enforce) make-broadcast-port (#!rest output-port) output-port))
+(make-concatenated-port (#(procedure #:clean #:enforce) make-concatenated-port (port #!rest input-port) input-port))
+(with-error-output-to-port (#(procedure #:enforce) with-error-output-to-port (output-port (procedure () . *)) . *))
+(with-input-from-port (#(procedure #:enforce) with-input-from-port (input-port (procedure () . *)) . *))
(with-input-from-string (#(procedure #:enforce) with-input-from-string (string (procedure () . *)) . *))
-(with-output-to-port (#(procedure #:enforce) with-output-to-port (port (procedure () . *)) . *))
+(with-output-to-port (#(procedure #:enforce) with-output-to-port (output-port (procedure () . *)) . *))
(with-output-to-string (#(procedure #:enforce) with-output-to-string ((procedure () . *)) . *))
;; posix
(_exit (procedure _exit (fixnum) noreturn))
-(call-with-input-pipe (#(procedure #:enforce) call-with-input-pipe (string (procedure (port) . *) #!optional symbol) . *))
-(call-with-output-pipe (#(procedure #:enforce) call-with-output-pipe (string (procedure (port) . *) #!optional symbol) . *))
+(call-with-input-pipe (#(procedure #:enforce) call-with-input-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
+(call-with-output-pipe (#(procedure #:enforce) call-with-output-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
(change-directory (#(procedure #:clean #:enforce) change-directory (string) string))
(change-directory* (#(procedure #:clean #:enforce) change-directory* (fixnum) fixnum))
(change-file-mode (#(procedure #:clean #:enforce) change-file-mode (string fixnum) undefined))
(change-file-owner (#(procedure #:clean #:enforce) change-file-owner (string fixnum fixnum) undefined))
-(close-input-pipe (#(procedure #:clean #:enforce) close-input-pipe (port) fixnum))
-(close-output-pipe (#(procedure #:clean #:enforce) close-output-pipe (port) fixnum))
+(close-input-pipe (#(procedure #:clean #:enforce) close-input-pipe (input-port) fixnum))
+(close-output-pipe (#(procedure #:clean #:enforce) close-output-pipe (input-port) fixnum))
(create-directory (#(procedure #:clean #:enforce) create-directory (string #!optional *) string))
(create-fifo (#(procedure #:clean #:enforce) create-fifo (string #!optional fixnum) undefined))
(create-pipe (procedure create-pipe () fixnum fixnum))
@@ -1641,10 +1644,10 @@
(map/shared fixnum)
(memory-mapped-file-pointer (#(procedure #:clean #:enforce) memory-mapped-file-pointer ((struct mmap)) pointer))
(memory-mapped-file? (#(procedure #:clean #:predicate (struct mmap)) memory-mapped-file? (*) boolean))
-(open-input-file* (#(procedure #:clean #:enforce) open-input-file* (fixnum #!optional symbol) port))
-(open-input-pipe (#(procedure #:clean #:enforce) open-input-pipe (string #!optional symbol) port))
-(open-output-file* (#(procedure #:clean #:enforce) open-output-file* (fixnum #!optional symbol) port))
-(open-output-pipe (#(procedure #:clean #:enforce) open-output-pipe (string #!optional symbol) port))
+(open-input-file* (#(procedure #:clean #:enforce) open-input-file* (fixnum #!optional symbol) input-port))
+(open-input-pipe (#(procedure #:clean #:enforce) open-input-pipe (string #!optional symbol) input-port))
+(open-output-file* (#(procedure #:clean #:enforce) open-output-file* (fixnum #!optional symbol) output-port))
+(open-output-pipe (#(procedure #:clean #:enforce) open-output-pipe (string #!optional symbol) output-port))
(open/append fixnum)
(open/binary fixnum)
(open/creat fixnum)
@@ -1678,8 +1681,8 @@
(perm/ixusr fixnum)
(pipe/buf fixnum)
(port->fileno (#(procedure #:clean #:enforce) port->fileno (port) fixnum))
-(process (#(procedure #:clean #:enforce) process (string #!optional (list-of string) (list-of string)) port port fixnum))
-(process* (#(procedure #:clean #:enforce) process* (string #!optional (list-of string) (list-of string)) port port fixnum *))
+(process (#(procedure #:clean #:enforce) process (string #!optional (list-of string) (list-of string)) input-port output-port fixnum))
+(process* (#(procedure #:clean #:enforce) process* (string #!optional (list-of string) (list-of string)) input-port output-port fixnum *))
(process-execute
(#(procedure #:clean #:enforce) process-execute (string #!optional (list-of string) (list-of string)) noreturn))
@@ -2345,8 +2348,8 @@
(make-u16vector (#(procedure #:clean #:enforce) make-u16vector (fixnum #!optional * * *) (struct u16vector)))
(make-u32vector (#(procedure #:clean #:enforce) make-u32vector (fixnum #!optional * * *) (struct u32vector)))
(make-u8vector (#(procedure #:clean #:enforce) make-u8vector (fixnum #!optional * * *) (struct u8vector)))
-(read-u8vector (#(procedure #:enforce) read-u8vector (#!optional fixnum port) (struct u8vector)))
-(read-u8vector! (#(procedure #:enforce) read-u8vector! (fixnum (struct u8vector) #!optional port fixnum) number))
+(read-u8vector (#(procedure #:enforce) read-u8vector (#!optional fixnum input-port) (struct u8vector)))
+(read-u8vector! (#(procedure #:enforce) read-u8vector! (fixnum (struct u8vector) #!optional input-port fixnum) number))
(release-number-vector (procedure release-number-vector (*) undefined))
(s16vector (#(procedure #:clean #:enforce) s16vector (#!rest fixnum) (struct s16vector)))
(s16vector->blob (#(procedure #:clean #:enforce) s16vector->blob ((struct s16vector)) blob))
@@ -2434,7 +2437,7 @@
(u8vector? (#(procedure #:pure #:predicate (struct u8vector)) u8vector? (*) boolean))
-(write-u8vector (#(procedure #:enforce) write-u8vector ((struct u8vector) #!optional port fixnum fixnum) undefined))
+(write-u8vector (#(procedure #:enforce) write-u8vector ((struct u8vector) #!optional output-port fixnum fixnum) undefined))
;; srfi-69
@@ -2510,13 +2513,13 @@
;; tcp
(tcp-abandon-port (#(procedure #:clean #:enforce) tcp-abandon-port (port) undefined))
-(tcp-accept (#(procedure #:clean #:enforce) tcp-accept ((struct tcp-listener)) port port))
+(tcp-accept (#(procedure #:clean #:enforce) tcp-accept ((struct tcp-listener)) input-port output-port))
(tcp-accept-ready? (#(procedure #:clean #:enforce) tcp-accept-ready? ((struct tcp-listener)) boolean))
(tcp-accept-timeout (#(procedure #:clean #:enforce) tcp-accept-timeout (#!optional (or boolean number)) (or boolean number)))
(tcp-addresses (#(procedure #:clean #:enforce) tcp-addresses (port) string string))
(tcp-buffer-size (#(procedure #:clean #:enforce) tcp-buffer-size (#!optional fixnum) fixnum))
(tcp-close (#(procedure #:clean #:enforce) tcp-close ((struct tcp-listener)) undefined))
-(tcp-connect (#(procedure #:clean #:enforce) tcp-connect (string #!optional fixnum) port port))
+(tcp-connect (#(procedure #:clean #:enforce) tcp-connect (string #!optional fixnum) input-port output-port))
(tcp-connect-timeout (#(procedure #:clean #:enforce) tcp-connect-timeout (#!optional (or boolean number)) (or boolean number)))
(tcp-listen (#(procedure #:clean #:enforce) tcp-listen (fixnum #!optional fixnum *) (struct tcp-listener)))
@@ -2536,10 +2539,10 @@
(for-each-argv-line deprecated)
(for-each-line deprecated)
-(read-all (#(procedure #:enforce) read-all (#!optional (or port string)) string))
+(read-all (#(procedure #:enforce) read-all (#!optional (or input-port string)) string))
(system* (#(procedure #:clean #:enforce) system* (string #!rest) undefined))
(qs (#(procedure #:clean #:enforce) qs (string) string))
(compile-file (#(procedure #:clean #:enforce) compile-file (string #!rest) (or boolean string)))
(compile-file-options (#(procedure #:clean #:enforce) compile-file-options (#!optional (list-of string)) (list-of string)))
-(scan-input-lines (#(procedure #:enforce) scan-input-lines (* #!optional port) *))
+(scan-input-lines (#(procedure #:enforce) scan-input-lines (* #!optional input-port) *))
(yes-or-no? (#(procedure #:enforce) yes-or-no? (string #!rest) *))
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
