use more specific signatures to imply true

original commit: 7d1ad70840d85912ff08cb2d3ec0c685fc134661

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]

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<?) [sig [(string string 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