From 2a20927ac27cfdbc816f5950785ba4ecf92ff7e3 Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Wed, 23 Jan 2019 18:15:49 -0300 Subject: [PATCH] use more specific signatures to imply true original commit: 7d1ad70840d85912ff08cb2d3ec0c685fc134661 --- mats/primvars.ms | 2 ++ s/primdata.ss | 54 ++++++++++++++++++++++++------------------------ 2 files changed, 29 insertions(+), 27 deletions(-) diff --git a/mats/primvars.ms b/mats/primvars.ms index 00f8e8c51f..9269698fc8 100644 --- a/mats/primvars.ms +++ b/mats/primvars.ms @@ -320,6 +320,7 @@ (def *binary-port binary-output-port)) (def *cost-center (make-cost-center)) (def *date (current-date)) + (def *phantom-bytevector (make-phantom-bytevector 10)) (def *eq-hashtable (make-eq-hashtable)) (def *ftype-pointer (make-ftype-pointer double 0)) (def *symbol-hashtable (make-hashtable symbol-hash eq?)) @@ -421,6 +422,7 @@ [(pair) '(a . b) 'a #f] [(pathname) "a" 'a #f] [(pfixnum) 1 0 #f] + [(phantom-bytevector) *phantom-bytevector '#vu8(0) #f] [(port) (current-input-port) 0 #f] [(procedure) values 0 #f] [(ptr) 1.0+2.0i] diff --git a/s/primdata.ss b/s/primdata.ss index b118524c43..90087db76f 100644 --- a/s/primdata.ss +++ b/s/primdata.ss @@ -134,9 +134,9 @@ (flatan [sig [(flonum) (flonum flonum) -> (flonum)]] [flags arith-op mifoldable discard safeongoodargs]) (flsqrt [sig [(flonum) -> (flonum)]] [flags arith-op mifoldable discard safeongoodargs]) (flexpt [sig [(flonum flonum) -> (flonum)]] [flags arith-op mifoldable discard safeongoodargs]) - (make-no-infinities-violation [sig [() -> (ptr)]] [flags pure unrestricted alloc]) + (make-no-infinities-violation [sig [() -> (condition)]] [flags pure unrestricted alloc]) (no-infinities-violation? [sig [(ptr) -> (ptr)]] [flags pure unrestricted mifoldable discard]) - (make-no-nans-violation [sig [() -> (ptr)]] [flags pure unrestricted alloc]) + (make-no-nans-violation [sig [() -> (condition)]] [flags pure unrestricted alloc]) (no-nans-violation? [sig [(ptr) -> (ptr)]] [flags pure unrestricted mifoldable discard]) (fixnum->flonum [sig [(fixnum) -> (flonum)]] [flags arith-op cp02 safeongoodargs]) ) @@ -312,7 +312,7 @@ (make-string [sig [(length) (length char) -> (string)]] [flags alloc ieee r5rs]) (string [sig [(char ...) -> (string)]] [flags alloc ieee r5rs cp02 safeongoodargs]) (string-length [sig [(string) -> (length)]] [flags pure true ieee r5rs mifoldable discard safeongoodargs]) - (string-ref [sig [(string sub-index) -> (ptr)]] [flags true ieee r5rs mifoldable discard cp02]) + (string-ref [sig [(string sub-index) -> (char)]] [flags true ieee r5rs mifoldable discard cp02]) ((r6rs: string<=?) [sig [(string string string ...) -> (boolean)]] [flags mifoldable discard safeongoodargs ieee r5rs]) ; restricted to 2+ arguments ((r6rs: string (boolean)]] [flags mifoldable discard safeongoodargs ieee r5rs]) ; restricted to 2+ arguments ((r6rs: string=?) [sig [(string string string ...) -> (boolean)]] [flags mifoldable discard safeongoodargs ieee r5rs cp03]) ; restricted to 2+ arguments @@ -798,7 +798,7 @@ (bound-identifier=? [sig [(identifier identifier) -> (boolean)]] [flags pure mifoldable discard cp03]) (free-identifier=? [sig [(identifier identifier) -> (boolean)]] [flags pure mifoldable discard cp03]) (syntax->datum [sig [(ptr) -> (ptr)]] [flags pure unrestricted mifoldable discard]) - (datum->syntax [sig [(identifier ptr) -> (ptr)]] [flags pure mifoldable discard]) + (datum->syntax [sig [(identifier ptr) -> (syntax)]] [flags pure mifoldable discard true]) (generate-temporaries [sig [(list) -> (list)]] [flags alloc]) (syntax-violation [sig [(who string ptr) (who string ptr ptr) -> (bottom)]] [flags abort-op]) ) @@ -953,11 +953,11 @@ (default-record-hash-procedure [sig [() -> (maybe-procedure)] [(maybe-procedure) -> (void)]] [flags]) (enable-arithmetic-left-associative [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (enable-cross-library-optimization [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) - (enable-object-backreferences [sig [() -> (boolean)] [(ptr) -> (void)]] [flags]) - (enable-object-counts [sig [() -> (boolean)] [(ptr) -> (void)]] [flags]) + (enable-object-backreferences [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) + (enable-object-counts [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (enable-type-recovery [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (eval-syntax-expanders-when [sig [() -> (list)] [(sub-list) -> (void)]] [flags]) - (expand-omit-library-invocations [sig [() -> (boolean)] [(ptr) -> (void)]] [flags]) + (expand-omit-library-invocations [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (expand-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags]) (expand/optimize-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags]) (exit-handler [sig [() -> (procedure)] [(procedure) -> (void)]] [flags]) @@ -1222,8 +1222,8 @@ (compile-script [sig [(pathname) (pathname pathname) (pathname pathname sub-symbol) -> (void)]] [flags true]) (compile-time-value? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (compile-time-value-value [sig [(compile-time-value) -> (ptr)]] [flags pure mifoldable discard]) - (compile-to-file [sig [(list pathname) (list pathname maybe-sfd) -> (ptr)]] [flags true]) - (compile-to-port [sig [(list binary-output-port) (list binary-output-port maybe-sfd) (list binary-output-port maybe-sfd maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port sub-symbol) (list binary-output-port maybe-sfd maybe-binary-output-port sub-symbol maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port sub-symbol maybe-binary-output-port maybe-pathname) -> (ptr)]] [flags true]) + (compile-to-file [sig [(list pathname) (list pathname maybe-sfd) -> (void/list)]] [flags true]) + (compile-to-port [sig [(list binary-output-port) (list binary-output-port maybe-sfd) (list binary-output-port maybe-sfd maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port sub-symbol) (list binary-output-port maybe-sfd maybe-binary-output-port sub-symbol maybe-binary-output-port) (list binary-output-port maybe-sfd maybe-binary-output-port sub-symbol maybe-binary-output-port maybe-pathname) -> (void/list)]] [flags true]) (compile-whole-program [sig [(string string) (string string ptr) -> (void)]] [flags]) (compile-whole-library [sig [(string string) -> (void)]] [flags]) (compute-composition [sig [(ptr) -> (list)] [(ptr sub-ufixnum) -> (list)]] [flags alloc]) @@ -1249,7 +1249,7 @@ (current-continuation-attachments [sig [() -> (list)]] [flags alloc]) (current-memory-bytes [sig [() -> (uint)]] [flags alloc]) (date-and-time [sig [() (date) -> (string)]] [flags unrestricted alloc]) - (datum->syntax-object [sig [(identifier ptr) -> (ptr)]] [flags pure mifoldable discard true]) + (datum->syntax-object [sig [(identifier ptr) -> (syntax)]] [flags pure mifoldable discard true]) (debug [sig [() -> (void)]] [flags]) (debug-condition [sig [() -> (ptr)] [(ptr) -> (void)]] [flags unrestricted]) (decode-float [sig [(flonum) -> (vector)]] [flags pure mifoldable discard true]) @@ -1274,7 +1274,7 @@ (environment? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (environment-mutable? [sig [(environment) -> (boolean)]] [flags pure mifoldable discard]) (environment-symbols [sig [(environment) -> (list)]] [flags true]) - (ephemeron-cons [sig [(ptr ptr) -> (ptr)]] [flags unrestricted alloc]) + (ephemeron-cons [sig [(ptr ptr) -> ((ptr . ptr))]] [flags unrestricted alloc]) (ephemeron-pair? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (errorf [sig [(who string sub-ptr ...) -> (bottom)]] [flags abort-op]) ; second arg is format string (eq-hashtable? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) @@ -1284,7 +1284,7 @@ (eq-hashtable-ephemeron? [sig [(eq-hashtable) -> (boolean)]] [flags pure mifoldable discard]) (eq-hashtable-ref [sig [(eq-hashtable ptr ptr) -> (ptr)]] [flags discard]) (eq-hashtable-set! [sig [(eq-hashtable ptr ptr) -> (void)]] [flags true]) - (eq-hashtable-try-atomic-cell [sig [(eq-hashtable ptr ptr) -> (ptr)]] [flags]) + (eq-hashtable-try-atomic-cell [sig [(eq-hashtable ptr ptr) -> (maybe-pair)]] [flags]) (eq-hashtable-update! [sig [(eq-hashtable ptr procedure ptr) -> (void)]] [flags]) (eq-hashtable-weak? [sig [(eq-hashtable) -> (boolean)]] [flags pure mifoldable discard]) (eval [sig [(ptr) (ptr environment) -> (ptr ...)]] [flags]) ; not restricted to two arguments @@ -1335,7 +1335,7 @@ (fresh-line [sig [() (textual-output-port) -> (void)]] [flags true]) (ftype-pointer=? [sig [(ftype-pointer ftype-pointer) -> (boolean)]] [flags pure mifoldable discard cp03]) (ftype-pointer-address [sig [(ftype-pointer) -> (exact-integer)]] [flags mifoldable discard true]) - (ftype-pointer-ftype [sig [(ftype-pointer) -> (ptr)]] [flags mifoldable discard true]) + (ftype-pointer-ftype [sig [(ftype-pointer) -> (symbol/list)]] [flags mifoldable discard true]) (ftype-pointer-null? [sig [(ftype-pointer) -> (boolean)]] [flags pure mifoldable discard]) (ftype-pointer->sexpr [sig [(ftype-pointer) -> (ptr)]] [flags]) (fx* [sig [(fixnum ...) -> (fixnum)]] [flags arith-op partial-folder]) ; not restricted to 2 arguments @@ -1396,7 +1396,7 @@ (hashtable-cell [sig [(old-hash-table ptr ptr) -> ((ptr . ptr))]] [flags true]) (hashtable-cells [sig [(hashtable) -> (vector)] [(hashtable uint) -> (vector)]] [flags alloc]) (hashtable-entries [sig [(hashtable) -> (vector vector)] [(hashtable uint) -> (vector vector)]] [flags discard]) ; has size argument - (hashtable-keys [sig [(hashtable) -> (vector)] [(hashtable uint) -> (vector)]] [flags alloc]) ; has size argument + (hashtable-keys [sig [(hashtable) -> (vector)] [(hashtable uint) -> (vector)]] [flags alloc]) ; has size argument (hashtable-values [sig [(hashtable) -> (vector)] [(hashtable uint) -> (vector)]] [flags alloc]) (hashtable-weak? [sig [(hashtable) -> (boolean)]] [flags pure mifoldable discard]) (iconv-codec [feature iconv] [sig [(sub-string) -> (codec)]] [flags pure true]) @@ -1419,7 +1419,7 @@ (list* [sig [(ptr) -> (ptr)] [(ptr ptr ptr ...) -> ((ptr . ptr))]] [flags unrestricted discard cp02]) (list->fxvector [sig [(sub-list) -> (fxvector)]] [flags alloc]) (list-copy [sig [(list) -> (list)]] [flags alloc]) - (list-head [sig [(sub-ptr sub-index) -> (ptr)]] [flags alloc]) + (list-head [sig [(sub-ptr sub-index) -> (list)]] [flags alloc]) (literal-identifier=? [sig [(identifier identifier) -> (boolean)]] [flags pure mifoldable discard cp03]) (load [sig [(pathname) (pathname procedure) -> (void)]] [flags true ieee r5rs]) (load-compiled-from-port [sig [(ptr) -> (ptr ...)]] [flags]) @@ -1463,13 +1463,13 @@ (make-object-finder [sig [(procedure) (procedure ptr) (procedure ptr sub-ufixnum) -> (procedure)]] [flags alloc]) (make-output-port [sig [(procedure string) -> (textual-output-port)]] [flags alloc]) (make-parameter [sig [(ptr) (ptr procedure) -> (procedure)]] [flags true cp02 cp03]) - (make-phantom-bytevector [sig [(uptr) -> (ptr)]] [flags true]) + (make-phantom-bytevector [sig [(uptr) -> (phantom-bytevector)]] [flags true]) (make-record-type [sig [(sub-ptr sub-list) (maybe-rtd sub-ptr sub-list) -> (rtd)]] [flags pure alloc cp02]) (make-source-condition [sig [(ptr) -> (condition)]] [flags pure unrestricted mifoldable discard]) (make-source-file-descriptor [sig [(string binary-input-port) (string binary-input-port ptr) (string binary-input-port ptr ptr) -> (sfd)]] [flags true]) (make-source-object [sig [(sfd uint uint) (sfd uint uint uint uint) -> (source-object)]] [flags pure true mifoldable discard]) (make-sstats [sig [(time time exact-integer exact-integer time time exact-integer) -> (sstats)]] [flags alloc]) - (make-thread-parameter [feature pthreads] [sig [(ptr) (ptr procedure) -> (ptr)]] [flags true cp02 cp03]) + (make-thread-parameter [feature pthreads] [sig [(ptr) (ptr procedure) -> (thread-parameter)]] [flags true cp02 cp03]) (make-weak-eq-hashtable [sig [() (uint) -> (eq-hashtable)]] [flags alloc]) (make-weak-eqv-hashtable [sig [() (uint) -> (hashtable)]] [flags alloc]) (make-wrapper-procedure [sig [(procedure sint ptr) -> (procedure)]] [flags pure true mifoldable discard]) @@ -1495,8 +1495,8 @@ (nonnegative? [sig [(real) -> (boolean)]] [flags pure mifoldable discard]) (nonpositive? [sig [(real) -> (boolean)]] [flags pure mifoldable discard]) (number->string [sig [(number) (number sub-ufixnum) (number sub-ufixnum sub-ufixnum) -> (string)]] [flags alloc]) ; radix not restricted to 2, 4, 8, 16 - (object-backreferences [sig [() -> (ptr)]] [flags alloc]) - (object-counts [sig [() -> (ptr)]] [flags alloc]) + (object-backreferences [sig [() -> (list)]] [flags alloc]) + (object-counts [sig [() -> (list)]] [flags alloc]) (oblist [sig [() -> (list)]] [flags alloc]) (open-fd-input-port [sig [(sub-ufixnum) (sub-ufixnum sub-symbol) (sub-ufixnum sub-symbol maybe-transcoder) -> (input-port)]] [flags true]) (open-fd-input/output-port [sig [(sub-ufixnum) (sub-ufixnum sub-symbol) (sub-ufixnum sub-symbol maybe-transcoder) -> (input/output-port)]] [flags true]) @@ -1516,8 +1516,8 @@ (path-parent [sig [(pathname) -> (pathname)]] [flags true #;cp02]) (path-rest [sig [(pathname) -> (pathname)]] [flags true #;cp02]) (path-root [sig [(pathname) -> (pathname)]] [flags true #;cp02]) - (phantom-bytevector? [sig [(ptr) -> (boolean)]] [flags pure mifoldable discard]) - (phantom-bytevector-length [sig [(ptr) -> (uptr)]] [flags true]) + (phantom-bytevector? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) + (phantom-bytevector-length [sig [(phantom-bytevector) -> (uptr)]] [flags true]) (port-bol? [sig [(textual-output-port) -> (boolean)]] [flags discard]) (port-closed? [sig [(port) -> (boolean)]] [flags discard]) (port-file-descriptor [sig [(port) -> (ufixnum)]] [flags discard]) @@ -1598,7 +1598,7 @@ (set-binary-port-output-index! [sig [(binary-output-port sub-index) -> (void)]] [flags true]) (set-binary-port-output-size! [sig [(binary-output-port sub-length) -> (void)]] [flags true]) (set-box! [sig [(box ptr) -> (void)]] [flags true]) - (set-phantom-bytevector-length! [sig [(ptr uptr) -> (void)]] [flags true]) + (set-phantom-bytevector-length! [sig [(phantom-bytevector uptr) -> (void)]] [flags true]) (set-port-bol! [sig [(textual-output-port ptr) -> (void)]] [flags true]) (set-port-eof! [sig [(input-port ptr) -> (void)]] [flags true]) (set-port-input-buffer! [sig [(input-port string/bytevector) -> (void)]] [flags true]) @@ -1636,13 +1636,13 @@ (source-condition-form [sig [(source-condition) -> (ptr)]] [flags pure mifoldable discard]) (source-file-descriptor [sig [(sfd uint) -> (sfd)]] [flags alloc]) (source-file-descriptor? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) - (source-file-descriptor-checksum [sig [(sfd) -> (ptr)]] [flags pure mifoldable discard true]) - (source-file-descriptor-path [sig [(sfd) -> (ptr)]] [flags pure mifoldable discard true]) + (source-file-descriptor-checksum [sig [(sfd) -> (sint)]] [flags pure mifoldable discard true]) + (source-file-descriptor-path [sig [(sfd) -> (string)]] [flags pure mifoldable discard true]) (source-object? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (source-object-bfp [sig [(source-object) -> (uint)]] [flags pure mifoldable discard]) - (source-object-column [sig [(source-object) -> (ptr)]] [flags pure mifoldable discard]) + (source-object-column [sig [(source-object) -> (maybe-uint)]] [flags pure mifoldable discard]) (source-object-efp [sig [(source-object) -> (uint)]] [flags pure mifoldable discard]) - (source-object-line [sig [(source-object) -> (ptr)]] [flags pure mifoldable discard]) + (source-object-line [sig [(source-object) -> (maybe-uint)]] [flags pure mifoldable discard]) (source-object-sfd [sig [(source-object) -> (sfd)]] [flags pure mifoldable discard]) (sstats-bytes [sig [(sstats) -> (exact-integer)]] [flags mifoldable discard]) (sstats-cpu [sig [(sstats) -> (time)]] [flags mifoldable discard]) @@ -1735,7 +1735,7 @@ (void [sig [() -> (void)]] [flags pure unrestricted mifoldable discard true]) (warning [sig [(who string sub-ptr ...) -> (ptr ...)]] [flags]) (warningf [sig [(who string sub-ptr ...) -> (ptr ...)]] [flags]) - (weak-cons [sig [(ptr ptr) -> (ptr)]] [flags unrestricted alloc]) + (weak-cons [sig [(ptr ptr) -> ((ptr . ptr))]] [flags unrestricted alloc]) (weak-pair? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (with-cost-center [sig [(cost-center procedure) (ptr cost-center procedure) -> (ptr ...)]] [flags]) (with-input-from-file [sig [(pathname procedure) (pathname procedure sub-ptr) -> (ptr ...)]] [flags]) ; has options argument