diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 97db39e088..45b1f33e0f 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.3.0.11") +(define version "7.3.0.12") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/cs/convert.rkt b/racket/src/cs/convert.rkt index ae4f1f6a1b..4cb0c3051b 100644 --- a/racket/src/cs/convert.rkt +++ b/racket/src/cs/convert.rkt @@ -3,6 +3,9 @@ racket/pretty racket/match racket/file + racket/fixnum + racket/flonum + racket/unsafe/ops racket/extflonum racket/include "../schemify/schemify.rkt" @@ -113,6 +116,24 @@ (include "primitive/internal.ss") knowns)) +(define primitives + (let ([ns (make-base-namespace)]) + (namespace-attach-module (current-namespace) 'racket/fixnum ns) + (namespace-require 'racket/fixnum ns) + (namespace-attach-module (current-namespace) 'racket/flonum ns) + (namespace-require 'racket/flonum ns) + (namespace-attach-module (current-namespace) 'racket/unsafe/ops ns) + (namespace-require 'racket/unsafe/ops ns) + (define primitives (make-hasheq)) + (for ([s (in-list (namespace-mapped-symbols ns))]) + (define v (namespace-variable-value s + #t + (lambda () #f) + ns)) + (when v + (hash-set! primitives s v))) + primitives)) + ;; Convert: (define schemified-body (let () @@ -125,7 +146,7 @@ (printf "Schemify...\n") (define body (time - (schemify-body bodys/constants-lifted prim-knowns #hasheq() #hasheq() for-cify? unsafe-mode? #t))) + (schemify-body bodys/constants-lifted prim-knowns primitives #hasheq() #hasheq() for-cify? unsafe-mode? #t))) (printf "Lift...\n") ;; Lift functions to avoid closure creation: (define lifted-body diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index a4befe3ecd..7626d5f057 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -528,6 +528,7 @@ inline? (not use-prompt?) prim-knowns + primitives ;; Callback to get a specific linklet for a ;; given import: (if get-import diff --git a/racket/src/cs/primitive/flfxnum.ss b/racket/src/cs/primitive/flfxnum.ss index 49a0f826d7..4115bae689 100644 --- a/racket/src/cs/primitive/flfxnum.ss +++ b/racket/src/cs/primitive/flfxnum.ss @@ -1,71 +1,71 @@ (define-primitive-table flfxnum-table - [->fl (known-procedure 2)] - [fl* (known-procedure -1)] - [fl+ (known-procedure -1)] - [fl- (known-procedure -2)] - [fl->exact-integer (known-procedure 2)] - [fl->fx (known-procedure/has-unsafe 2 'unsafe-fl->fx)] - [fl/ (known-procedure -2)] - [fl< (known-procedure -2)] - [fl<= (known-procedure -2)] - [fl= (known-procedure -2)] - [fl> (known-procedure -2)] - [fl>= (known-procedure -2)] - [flabs (known-procedure 2)] - [flacos (known-procedure 2)] - [flasin (known-procedure 2)] - [flatan (known-procedure 2)] - [flceiling (known-procedure 2)] - [flcos (known-procedure 2)] - [flexp (known-procedure 2)] - [flexpt (known-procedure 4)] - [flfloor (known-procedure 2)] - [flimag-part (known-procedure 2)] - [fllog (known-procedure 2)] - [flmax (known-procedure -2)] - [flmin (known-procedure -2)] - [flreal-part (known-procedure 2)] - [flround (known-procedure 2)] - [flsin (known-procedure 2)] - [flsqrt (known-procedure 2)] - [fltan (known-procedure 2)] - [fltruncate (known-procedure 2)] - [flvector (known-procedure -1)] - [flvector-length (known-procedure 2)] - [flvector-ref (known-procedure 4)] - [flvector-set! (known-procedure 8)] - [flvector? (known-procedure 2)] - [fx* (known-procedure -1)] - [fx+ (known-procedure -1)] - [fx- (known-procedure -2)] - [fx->fl (known-procedure/has-unsafe 2 'unsafe-fx->fl)] - [fx< (known-procedure -2)] - [fx<= (known-procedure -2)] - [fx= (known-procedure -2)] - [fx> (known-procedure -2)] - [fx>= (known-procedure -2)] - [fxabs (known-procedure 2)] - [fxand (known-procedure -1)] - [fxior (known-procedure -1)] - [fxlshift (known-procedure 4)] - [fxmax (known-procedure -2)] - [fxmin (known-procedure -2)] - [fxmodulo (known-procedure 4)] - [fxnot (known-procedure 2)] - [fxquotient (known-procedure 4)] - [fxremainder (known-procedure 4)] - [fxrshift (known-procedure 4)] - [fxvector (known-procedure -1)] - [fxvector-length (known-procedure 2)] - [fxvector-ref (known-procedure 4)] - [fxvector-set! (known-procedure 8)] - [fxvector? (known-procedure 2)] - [fxxor (known-procedure -1)] - [make-flrectangular (known-procedure 4)] - [make-flvector (known-procedure 6)] - [make-fxvector (known-procedure 6)] - [make-shared-flvector (known-procedure 6)] - [make-shared-fxvector (known-procedure 6)] - [shared-flvector (known-procedure -1)] - [shared-fxvector (known-procedure -1)]) + [->fl (known-procedure/folding 2)] + [fl* (known-procedure/folding -1)] + [fl+ (known-procedure/folding -1)] + [fl- (known-procedure/folding -2)] + [fl->exact-integer (known-procedure/folding 2)] + [fl->fx (known-procedure/has-unsafe/folding 2 'unsafe-fl->fx)] + [fl/ (known-procedure/folding -2)] + [fl< (known-procedure/folding -2)] + [fl<= (known-procedure/folding -2)] + [fl= (known-procedure/folding -2)] + [fl> (known-procedure/folding -2)] + [fl>= (known-procedure/folding -2)] + [flabs (known-procedure/folding 2)] + [flacos (known-procedure/folding 2)] + [flasin (known-procedure/folding 2)] + [flatan (known-procedure/folding 2)] + [flceiling (known-procedure/folding 2)] + [flcos (known-procedure/folding 2)] + [flexp (known-procedure/folding 2)] + [flexpt (known-procedure/folding 4)] + [flfloor (known-procedure/folding 2)] + [flimag-part (known-procedure/folding 2)] + [fllog (known-procedure/folding 2)] + [flmax (known-procedure/folding -2)] + [flmin (known-procedure/folding -2)] + [flreal-part (known-procedure/folding 2)] + [flround (known-procedure/folding 2)] + [flsin (known-procedure/folding 2)] + [flsqrt (known-procedure/folding 2)] + [fltan (known-procedure/folding 2)] + [fltruncate (known-procedure/folding 2)] + [flvector (known-procedure/folding -1)] + [flvector-length (known-procedure/folding 2)] + [flvector-ref (known-procedure/folding 4)] + [flvector-set! (known-procedure/folding 8)] + [flvector? (known-procedure/pure/folding 2)] + [fx* (known-procedure/folding/limited -1 'fixnum)] + [fx+ (known-procedure/folding/limited -1 'fixnum)] + [fx- (known-procedure/folding/limited -2 'fixnum)] + [fx->fl (known-procedure/has-unsafe/folding/limited 2 'unsafe-fx->fl 'fixnum)] + [fx< (known-procedure/folding/limited -2 'fixnum)] + [fx<= (known-procedure/folding/limited -2 'fixnum)] + [fx= (known-procedure/folding/limited -2 'fixnum)] + [fx> (known-procedure/folding/limited -2 'fixnum)] + [fx>= (known-procedure/folding/limited -2 'fixnum)] + [fxabs (known-procedure/folding/limited 2 'fixnum)] + [fxand (known-procedure/folding/limited -1 'fixnum)] + [fxior (known-procedure/folding/limited -1 'fixnum)] + [fxlshift (known-procedure/folding/limited 4 'fixnum)] + [fxmax (known-procedure/folding/limited -2 'fixnum)] + [fxmin (known-procedure/folding/limited -2 'fixnum)] + [fxmodulo (known-procedure/folding/limited 4 'fixnum)] + [fxnot (known-procedure/folding/limited 2 'fixnum)] + [fxquotient (known-procedure/folding/limited 4 'fixnum)] + [fxremainder (known-procedure/folding/limited 4 'fixnum)] + [fxrshift (known-procedure/folding/limited 4 'fixnum)] + [fxvector (known-procedure/folding/limited -1 'fixnum)] + [fxvector-length (known-procedure/folding/limited 2 'fixnum)] + [fxvector-ref (known-procedure/folding/limited 4 'fixnum)] + [fxvector-set! (known-procedure/folding/limited 8 'fixnum)] + [fxvector? (known-procedure/pure/folding 2)] + [fxxor (known-procedure/folding/limited -1 'fixnum)] + [make-flrectangular (known-procedure/folding 4)] + [make-flvector (known-procedure/no-prompt 6)] + [make-fxvector (known-procedure/no-prompt 6)] + [make-shared-flvector (known-procedure/no-prompt 6)] + [make-shared-fxvector (known-procedure/no-prompt 6)] + [shared-flvector (known-procedure/no-prompt -1)] + [shared-fxvector (known-procedure/no-prompt -1)]) diff --git a/racket/src/cs/primitive/kernel.ss b/racket/src/cs/primitive/kernel.ss index 8f14eef3f4..9235df22a5 100644 --- a/racket/src/cs/primitive/kernel.ss +++ b/racket/src/cs/primitive/kernel.ss @@ -4,98 +4,98 @@ ;; `kernel-table` variant. (define-primitive-table kernel-table - [* (known-procedure -1)] - [+ (known-procedure -1)] - [- (known-procedure -2)] - [/ (known-procedure -2)] - [< (known-procedure -2)] - [<= (known-procedure -2)] - [= (known-procedure -2)] - [> (known-procedure -2)] - [>= (known-procedure -2)] + [* (known-procedure/folding -1)] + [+ (known-procedure/folding -1)] + [- (known-procedure/folding -2)] + [/ (known-procedure/folding -2)] + [< (known-procedure/folding -2)] + [<= (known-procedure/folding -2)] + [= (known-procedure/folding -2)] + [> (known-procedure/folding -2)] + [>= (known-procedure/folding -2)] [abort-current-continuation (known-procedure -2)] - [abs (known-procedure 2)] - [absolute-path? (known-procedure 2)] - [acos (known-procedure 2)] - [add1 (known-procedure 2)] - [alarm-evt (known-procedure 2)] + [abs (known-procedure/folding 2)] + [absolute-path? (known-procedure/no-prompt 2)] + [acos (known-procedure/folding 2)] + [add1 (known-procedure/folding 2)] + [alarm-evt (known-procedure/no-prompt 2)] [always-evt (known-constant)] [andmap (known-procedure -4)] - [angle (known-procedure 2)] - [append (known-procedure -1)] + [angle (known-procedure/folding 2)] + [append (known-procedure/no-prompt -1)] [apply (known-procedure -4)] - [arithmetic-shift (known-procedure 4)] + [arithmetic-shift (known-procedure/folding/limited 4 'expt)] [arity-at-least (known-constant)] [arity-at-least-value (known-procedure 2)] - [arity-at-least? (known-procedure/pure 2)] - [asin (known-procedure 2)] + [arity-at-least? (known-procedure/pure/folding 2)] + [asin (known-procedure/folding 2)] [assoc (known-procedure 4)] - [assq (known-procedure 4)] - [assv (known-procedure 4)] - [atan (known-procedure 6)] + [assq (known-procedure/no-prompt 4)] + [assv (known-procedure/no-prompt 4)] + [atan (known-procedure/folding 6)] [banner (known-procedure/pure 1)] - [bitwise-and (known-procedure -1)] - [bitwise-bit-field (known-procedure 8)] - [bitwise-bit-set? (known-procedure 4)] - [bitwise-ior (known-procedure -1)] - [bitwise-not (known-procedure 2)] - [bitwise-xor (known-procedure -1)] - [boolean? (known-procedure/pure 2)] + [bitwise-and (known-procedure/folding -1)] + [bitwise-bit-field (known-procedure/folding 8)] + [bitwise-bit-set? (known-procedure/folding 4)] + [bitwise-ior (known-procedure/folding -1)] + [bitwise-not (known-procedure/folding 2)] + [bitwise-xor (known-procedure/folding -1)] + [boolean? (known-procedure/pure/folding 2)] [box (known-procedure/pure 2)] [box-cas! (known-procedure/has-unsafe 8 'unsafe-box*-cas!)] [box-immutable (known-procedure/pure 2)] - [box? (known-procedure/pure 2)] - [break-enabled (known-procedure 3)] - [break-thread (known-procedure 6)] - [build-path (known-procedure -2)] - [build-path/convention-type (known-procedure -4)] - [byte-pregexp (known-procedure 6)] - [byte-pregexp? (known-procedure/pure 2)] + [box? (known-procedure/pure/folding 2)] + [break-enabled (known-procedure/no-prompt 3)] + [break-thread (known-procedure/no-prompt 6)] + [build-path (known-procedure/no-prompt -2)] + [build-path/convention-type (known-procedure/no-prompt -4)] + [byte-pregexp (known-procedure/no-prompt 6)] + [byte-pregexp? (known-procedure/pure/folding 2)] [byte-ready? (known-procedure 3)] - [byte-regexp (known-procedure 6)] - [byte-regexp? (known-procedure/pure 2)] - [byte? (known-procedure/pure 2)] - [bytes (known-procedure -1)] - [bytes->immutable-bytes (known-procedure 2)] - [bytes->list (known-procedure 2)] - [bytes->path (known-procedure 6)] - [bytes->path-element (known-procedure 6)] - [bytes->string/latin-1 (known-procedure 30)] - [bytes->string/locale (known-procedure 30)] - [bytes->string/utf-8 (known-procedure 30)] - [bytes-append (known-procedure -1)] - [bytes-close-converter (known-procedure 2)] - [bytes-convert (known-procedure 254)] - [bytes-convert-end (known-procedure 15)] - [bytes-converter? (known-procedure/pure 2)] - [bytes-copy (known-procedure 2)] - [bytes-copy! (known-procedure 56)] - [bytes-fill! (known-procedure 4)] + [byte-regexp (known-procedure/no-prompt 6)] + [byte-regexp? (known-procedure/pure/folding 2)] + [byte? (known-procedure/pure/folding 2)] + [bytes (known-procedure/no-prompt -1)] + [bytes->immutable-bytes (known-procedure/no-prompt 2)] + [bytes->list (known-procedure/no-prompt 2)] + [bytes->path (known-procedure/no-prompt 6)] + [bytes->path-element (known-procedure/no-prompt 6)] + [bytes->string/latin-1 (known-procedure/no-prompt 30)] + [bytes->string/locale (known-procedure/no-prompt 30)] + [bytes->string/utf-8 (known-procedure/no-prompt 30)] + [bytes-append (known-procedure/no-prompt -1)] + [bytes-close-converter (known-procedure/no-prompt 2)] + [bytes-convert (known-procedure/no-prompt 254)] + [bytes-convert-end (known-procedure/no-prompt 15)] + [bytes-converter? (known-procedure/pure/folding 2)] + [bytes-copy (known-procedure/no-prompt 2)] + [bytes-copy! (known-procedure/no-prompt 56)] + [bytes-fill! (known-procedure/no-prompt 4)] [bytes-length (known-procedure/has-unsafe 2 'unsafe-bytes-length)] - [bytes-open-converter (known-procedure 4)] + [bytes-open-converter (known-procedure/no-prompt 4)] [bytes-ref (known-procedure/has-unsafe 4 'unsafe-bytes-ref)] [bytes-set! (known-procedure/has-unsafe 8 'unsafe-bytes-set!)] - [bytes-utf-8-index (known-procedure 28)] - [bytes-utf-8-length (known-procedure 30)] - [bytes-utf-8-ref (known-procedure 28)] - [bytes? (known-procedure -2)] - [bytes? (known-procedure/pure 2)] - [caaaar (known-procedure 2)] - [caaadr (known-procedure 2)] - [caaar (known-procedure 2)] - [caadar (known-procedure 2)] - [caaddr (known-procedure 2)] - [caadr (known-procedure 2)] - [caar (known-procedure 2)] - [cadaar (known-procedure 2)] - [cadadr (known-procedure 2)] - [cadar (known-procedure 2)] - [caddar (known-procedure 2)] - [cadddr (known-procedure 2)] - [caddr (known-procedure 2)] - [cadr (known-procedure 2)] + [bytes-utf-8-index (known-procedure/no-prompt 28)] + [bytes-utf-8-length (known-procedure/no-prompt 30)] + [bytes-utf-8-ref (known-procedure/no-prompt 28)] + [bytes? (known-procedure/no-prompt -2)] + [bytes? (known-procedure/pure/folding 2)] + [caaaar (known-procedure/no-prompt 2)] + [caaadr (known-procedure/no-prompt 2)] + [caaar (known-procedure/no-prompt 2)] + [caadar (known-procedure/no-prompt 2)] + [caaddr (known-procedure/no-prompt 2)] + [caadr (known-procedure/no-prompt 2)] + [caar (known-procedure/no-prompt 2)] + [cadaar (known-procedure/no-prompt 2)] + [cadadr (known-procedure/no-prompt 2)] + [cadar (known-procedure/no-prompt 2)] + [caddar (known-procedure/no-prompt 2)] + [cadddr (known-procedure/no-prompt 2)] + [caddr (known-procedure/no-prompt 2)] + [cadr (known-procedure/no-prompt 2)] [call-in-nested-thread (known-procedure 6)] [call-with-composable-continuation (known-procedure 6)] [call-with-continuation-barrier (known-procedure 2)] @@ -103,100 +103,100 @@ [call-with-current-continuation (known-procedure 6)] [call-with-escape-continuation (known-procedure 2)] [call-with-immediate-continuation-mark (known-procedure 12)] - [call-with-input-file (known-procedure 12)] - [call-with-output-file (known-procedure 28)] + [call-with-input-file (known-procedure/no-prompt 12)] + [call-with-output-file (known-procedure/no-prompt 28)] [call-with-semaphore (known-procedure -4)] [call-with-semaphore/enable-break (known-procedure -4)] [call-with-values (known-procedure 4)] - [car (known-procedure 2)] - [cdaaar (known-procedure 2)] - [cdaadr (known-procedure 2)] - [cdaar (known-procedure 2)] - [cdadar (known-procedure 2)] - [cdaddr (known-procedure 2)] - [cdadr (known-procedure 2)] - [cdar (known-procedure 2)] - [cddaar (known-procedure 2)] - [cddadr (known-procedure 2)] - [cddar (known-procedure 2)] - [cdddar (known-procedure 2)] - [cddddr (known-procedure 2)] - [cdddr (known-procedure 2)] - [cddr (known-procedure 2)] - [cdr (known-procedure 2)] - [ceiling (known-procedure 2)] - [channel-put-evt (known-procedure 4)] - [channel-put-evt? (known-procedure/pure 2)] - [channel? (known-procedure/pure 2)] + [car (known-procedure/no-prompt 2)] + [cdaaar (known-procedure/no-prompt 2)] + [cdaadr (known-procedure/no-prompt 2)] + [cdaar (known-procedure/no-prompt 2)] + [cdadar (known-procedure/no-prompt 2)] + [cdaddr (known-procedure/no-prompt 2)] + [cdadr (known-procedure/no-prompt 2)] + [cdar (known-procedure/no-prompt 2)] + [cddaar (known-procedure/no-prompt 2)] + [cddadr (known-procedure/no-prompt 2)] + [cddar (known-procedure/no-prompt 2)] + [cdddar (known-procedure/no-prompt 2)] + [cddddr (known-procedure/no-prompt 2)] + [cdddr (known-procedure/no-prompt 2)] + [cddr (known-procedure/no-prompt 2)] + [cdr (known-procedure/no-prompt 2)] + [ceiling (known-procedure/folding 2)] + [channel-put-evt (known-procedure/no-prompt 4)] + [channel-put-evt? (known-procedure/pure/folding 2)] + [channel? (known-procedure/pure/folding 2)] [chaperone-box (known-procedure -8)] [chaperone-channel (known-procedure -8)] [chaperone-continuation-mark-key (known-procedure -8)] [chaperone-evt (known-procedure -4)] [chaperone-hash (known-procedure -32)] [chaperone-of? (known-procedure 4)] - [chaperone-procedure (known-procedure -4)] - [chaperone-procedure* (known-procedure -4)] + [chaperone-procedure (known-procedure/no-prompt -4)] + [chaperone-procedure* (known-procedure/no-prompt -4)] [chaperone-prompt-tag (known-procedure -8)] [chaperone-struct (known-procedure -2)] [chaperone-struct-type (known-procedure -16)] [chaperone-vector (known-procedure -8)] [chaperone-vector* (known-procedure -8)] - [chaperone? (known-procedure/pure 2)] - [char->integer (known-procedure 2)] - [char-alphabetic? (known-procedure 2)] - [char-blank? (known-procedure 2)] - [char-ci<=? (known-procedure -2)] - [char-ci=? (known-procedure -2)] - [char-ci>? (known-procedure -2)] - [char-downcase (known-procedure 2)] - [char-foldcase (known-procedure 2)] - [char-general-category (known-procedure 2)] - [char-graphic? (known-procedure 2)] - [char-iso-control? (known-procedure 2)] - [char-lower-case? (known-procedure 2)] - [char-numeric? (known-procedure 2)] - [char-punctuation? (known-procedure 2)] - [char-ready? (known-procedure 3)] - [char-symbolic? (known-procedure 2)] - [char-title-case? (known-procedure 2)] - [char-titlecase (known-procedure 2)] - [char-upcase (known-procedure 2)] - [char-upper-case? (known-procedure 2)] - [char-utf-8-length (known-procedure 2)] - [char-whitespace? (known-procedure 2)] - [char<=? (known-procedure -2)] - [char=? (known-procedure -2)] - [char>? (known-procedure -2)] - [char? (known-procedure/pure 2)] + [chaperone? (known-procedure/pure/folding 2)] + [char->integer (known-procedure/folding 2)] + [char-alphabetic? (known-procedure/folding 2)] + [char-blank? (known-procedure/folding 2)] + [char-ci<=? (known-procedure/folding -2)] + [char-ci=? (known-procedure/folding -2)] + [char-ci>? (known-procedure/folding -2)] + [char-downcase (known-procedure/folding 2)] + [char-foldcase (known-procedure/folding 2)] + [char-general-category (known-procedure/folding 2)] + [char-graphic? (known-procedure/folding 2)] + [char-iso-control? (known-procedure/folding 2)] + [char-lower-case? (known-procedure/folding 2)] + [char-numeric? (known-procedure/folding 2)] + [char-punctuation? (known-procedure/folding 2)] + [char-ready? (known-procedure/folding 3)] + [char-symbolic? (known-procedure/folding 2)] + [char-title-case? (known-procedure/folding 2)] + [char-titlecase (known-procedure/folding 2)] + [char-upcase (known-procedure/folding 2)] + [char-upper-case? (known-procedure/folding 2)] + [char-utf-8-length (known-procedure/folding 2)] + [char-whitespace? (known-procedure/folding 2)] + [char<=? (known-procedure/folding -2)] + [char=? (known-procedure/folding -2)] + [char>? (known-procedure/folding -2)] + [char? (known-procedure/pure/folding 2)] [checked-procedure-check-and-extract (known-procedure 32)] - [choice-evt (known-procedure -1)] - [cleanse-path (known-procedure 2)] - [close-input-port (known-procedure 2)] - [close-output-port (known-procedure 2)] - [collect-garbage (known-procedure 3)] + [choice-evt (known-procedure/no-prompt -1)] + [cleanse-path (known-procedure/no-prompt 2)] + [close-input-port (known-procedure/no-prompt 2)] + [close-output-port (known-procedure/no-prompt 2)] + [collect-garbage (known-procedure/no-prompt 3)] [compile-allow-set!-undefined (known-constant)] [compile-context-preservation-enabled (known-constant)] [compile-enforce-module-constants (known-constant)] - [compile-target-machine? (known-procedure 2)] - [complete-path? (known-procedure 2)] - [complex? (known-procedure/pure 2)] + [compile-target-machine? (known-procedure/no-prompt 2)] + [complete-path? (known-procedure/no-prompt 2)] + [complex? (known-procedure/pure/folding 2)] [cons (known-procedure/pure 4)] - [continuation-mark-key? (known-procedure/pure 2)] - [continuation-mark-set->context (known-procedure 2)] - [continuation-mark-set->list (known-procedure 12)] - [continuation-mark-set->list* (known-procedure 28)] - [continuation-mark-set-first (known-procedure 28)] - [continuation-mark-set? (known-procedure/pure 2)] + [continuation-mark-key? (known-procedure/pure/folding 2)] + [continuation-mark-set->context (known-procedure/no-prompt 2)] + [continuation-mark-set->list (known-procedure/no-prompt 12)] + [continuation-mark-set->list* (known-procedure/no-prompt 28)] + [continuation-mark-set-first (known-procedure/no-prompt 28)] + [continuation-mark-set? (known-procedure/pure/folding 2)] [continuation-marks (known-procedure 6)] [continuation-prompt-available? (known-procedure 6)] - [continuation-prompt-tag? (known-procedure/pure 2)] - [continuation? (known-procedure/pure 2)] - [copy-file (known-procedure 12)] - [cos (known-procedure 2)] + [continuation-prompt-tag? (known-procedure/pure/folding 2)] + [continuation? (known-procedure/pure/folding 2)] + [copy-file (known-procedure/no-prompt 12)] + [cos (known-procedure/folding 2)] [current-code-inspector (known-constant)] [current-command-line-arguments (known-constant)] [current-compile-target-machine (known-constant)] @@ -204,55 +204,55 @@ [current-custodian (known-constant)] [current-directory (known-constant)] [current-directory-for-user (known-constant)] - [current-drive (known-procedure 1)] + [current-drive (known-procedure/no-prompt 1)] [current-environment-variables (known-constant)] [current-error-port (known-constant)] [current-evt-pseudo-random-generator (known-constant)] [current-force-delete-permissions (known-constant)] - [current-gc-milliseconds (known-procedure 1)] + [current-gc-milliseconds (known-procedure/no-prompt 1)] [current-get-interaction-input-port (known-constant)] - [current-inexact-milliseconds (known-procedure 1)] + [current-inexact-milliseconds (known-procedure/no-prompt 1)] [current-input-port (known-constant)] [current-inspector (known-constant)] [current-load-extension (known-constant)] [current-load-relative-directory (known-constant)] [current-locale (known-constant)] [current-logger (known-constant)] - [current-memory-use (known-procedure 3)] - [current-milliseconds (known-procedure 1)] + [current-memory-use (known-procedure/no-prompt 3)] + [current-milliseconds (known-procedure/no-prompt 1)] [current-output-port (known-constant)] [current-plumber (known-constant)] - [current-preserved-thread-cell-values (known-procedure 3)] + [current-preserved-thread-cell-values (known-procedure/no-prompt 3)] [current-print (known-constant)] - [current-process-milliseconds (known-procedure 3)] + [current-process-milliseconds (known-procedure/no-prompt 3)] [current-prompt-read (known-constant)] [current-pseudo-random-generator (known-constant)] [current-read-interaction (known-constant)] - [current-seconds (known-procedure 1)] + [current-seconds (known-procedure/no-prompt 1)] [current-security-guard (known-constant)] [current-subprocess-custodian-mode (known-constant)] - [current-thread (known-procedure 1)] + [current-thread (known-procedure/no-prompt 1)] [current-thread-group (known-constant)] [current-thread-initial-stack-size (known-constant)] [current-write-relative-directory (known-constant)] - [custodian-box-value (known-procedure 2)] - [custodian-box? (known-procedure/pure 2)] - [custodian-limit-memory (known-procedure 12)] - [custodian-managed-list (known-procedure 4)] - [custodian-memory-accounting-available? (known-procedure 1)] - [custodian-require-memory (known-procedure 8)] - [custodian-shut-down? (known-procedure 2)] + [custodian-box-value (known-procedure/no-prompt 2)] + [custodian-box? (known-procedure/pure/folding 2)] + [custodian-limit-memory (known-procedure/no-prompt 12)] + [custodian-managed-list (known-procedure/no-prompt 4)] + [custodian-memory-accounting-available? (known-procedure/no-prompt 1)] + [custodian-require-memory (known-procedure/no-prompt 8)] + [custodian-shut-down? (known-procedure/no-prompt 2)] [custodian-shutdown-all (known-procedure 2)] - [custodian? (known-procedure/pure 2)] - [custom-print-quotable-accessor (known-procedure 2)] - [custom-print-quotable? (known-procedure 2)] - [custom-write-accessor (known-procedure 2)] - [custom-write? (known-procedure/pure 2)] + [custodian? (known-procedure/pure/folding 2)] + [custom-print-quotable-accessor (known-procedure/no-prompt 2)] + [custom-print-quotable? (known-procedure/no-prompt 2)] + [custom-write-accessor (known-procedure/no-prompt 2)] + [custom-write? (known-procedure/pure/folding 2)] [date (known-constant)] [date* (known-constant)] [date*-nanosecond (known-procedure 2)] [date*-time-zone-name (known-procedure 2)] - [date*? (known-procedure/pure 2)] + [date*? (known-procedure/pure/folding 2)] [date-day (known-procedure 2)] [date-dst? (known-procedure 2)] [date-hour (known-procedure 2)] @@ -263,36 +263,36 @@ [date-week-day (known-procedure 2)] [date-year (known-procedure 2)] [date-year-day (known-procedure 2)] - [date? (known-procedure/pure 2)] - [datum->syntax (known-procedure 60)] - [datum-intern-literal (known-procedure 2)] + [date? (known-procedure/pure/folding 2)] + [datum->syntax (known-procedure/no-prompt 60)] + [datum-intern-literal (known-procedure/no-prompt 2)] [default-continuation-prompt-tag (known-procedure/pure 1)] - [delete-directory (known-procedure 2)] - [delete-file (known-procedure 2)] - [denominator (known-procedure 2)] - [directory-exists? (known-procedure 2)] - [directory-list (known-procedure 3)] + [delete-directory (known-procedure/no-prompt 2)] + [delete-file (known-procedure/no-prompt 2)] + [denominator (known-procedure/folding 2)] + [directory-exists? (known-procedure/no-prompt 2)] + [directory-list (known-procedure/no-prompt 3)] [display (known-procedure 6)] [dump-memory-stats (known-procedure -1)] [dynamic-wind (known-procedure 8)] - [environment-variables-copy (known-procedure 2)] - [environment-variables-names (known-procedure 2)] - [environment-variables-ref (known-procedure 4)] - [environment-variables-set! (known-procedure 24)] - [environment-variables? (known-procedure/pure 2)] - [eof (known-constant)] - [eof-object? (known-procedure/pure 2)] - [ephemeron-value (known-procedure 6)] - [ephemeron? (known-procedure/pure 2)] + [environment-variables-copy (known-procedure/no-prompt 2)] + [environment-variables-names (known-procedure/no-prompt 2)] + [environment-variables-ref (known-procedure/no-prompt 4)] + [environment-variables-set! (known-procedure/no-prompt 24)] + [environment-variables? (known-procedure/pure/folding 2)] + [eof (known-literal eof)] + [eof-object? (known-procedure/pure/folding 2)] + [ephemeron-value (known-procedure/no-prompt 6)] + [ephemeron? (known-procedure/pure/folding 2)] [eprintf (known-procedure -2)] - [eq-hash-code (known-procedure 2)] - [eq? (known-procedure/pure 4)] + [eq-hash-code (known-procedure/no-prompt 2)] + [eq? (known-procedure/pure/folding 4)] [equal-hash-code (known-procedure 2)] [equal-secondary-hash-code (known-procedure 2)] [equal? (known-procedure 4)] [equal?/recur (known-procedure 8)] - [eqv-hash-code (known-procedure 2)] - [eqv? (known-procedure/pure 4)] + [eqv-hash-code (known-procedure/no-prompt 2)] + [eqv? (known-procedure/pure/folding 4)] [error (known-procedure -2)] [error-display-handler (known-constant)] [error-escape-handler (known-constant)] @@ -301,13 +301,13 @@ [error-print-width (known-constant)] [error-value->string-handler (known-constant)] [eval-jit-enabled (known-constant)] - [even? (known-procedure 2)] - [evt? (known-procedure/pure 2)] - [exact->inexact (known-procedure 2)] - [exact-integer? (known-procedure/pure 2)] - [exact-nonnegative-integer? (known-procedure/pure 2)] - [exact-positive-integer? (known-procedure/pure 2)] - [exact? (known-procedure 2)] + [even? (known-procedure/folding 2)] + [evt? (known-procedure/pure/folding 2)] + [exact->inexact (known-procedure/folding 2)] + [exact-integer? (known-procedure/pure/folding 2)] + [exact-nonnegative-integer? (known-procedure/pure/folding 2)] + [exact-positive-integer? (known-procedure/pure/folding 2)] + [exact? (known-procedure/folding 2)] [executable-yield-handler (known-constant)] [exit (known-procedure 3)] [exit-handler (known-constant)] @@ -317,89 +317,89 @@ [exn:break (known-constant)] [exn:break-continuation (known-procedure 2)] [exn:break:hang-up (known-constant)] - [exn:break:hang-up? (known-procedure/pure 2)] + [exn:break:hang-up? (known-procedure/pure/folding 2)] [exn:break:terminate (known-constant)] - [exn:break:terminate? (known-procedure/pure 2)] - [exn:break? (known-procedure/pure 2)] - [exn:fail (known-constant)] + [exn:break:terminate? (known-procedure/pure/folding 2)] + [exn:break? (known-procedure/pure/folding 2)] + [exn:fail (known-constant)] ; not a primitive provcedure due to guard [exn:fail:contract (known-constant)] [exn:fail:contract:arity (known-constant)] - [exn:fail:contract:arity? (known-procedure/pure 2)] + [exn:fail:contract:arity? (known-procedure/pure/folding 2)] [exn:fail:contract:continuation (known-constant)] - [exn:fail:contract:continuation? (known-procedure/pure 2)] + [exn:fail:contract:continuation? (known-procedure/pure/folding 2)] [exn:fail:contract:divide-by-zero (known-constant)] - [exn:fail:contract:divide-by-zero? (known-procedure/pure 2)] + [exn:fail:contract:divide-by-zero? (known-procedure/pure/folding 2)] [exn:fail:contract:non-fixnum-result (known-constant)] - [exn:fail:contract:non-fixnum-result? (known-procedure/pure 2)] + [exn:fail:contract:non-fixnum-result? (known-procedure/pure/folding 2)] [exn:fail:contract:variable (known-constant)] [exn:fail:contract:variable-id (known-procedure 2)] - [exn:fail:contract:variable? (known-procedure/pure 2)] - [exn:fail:contract? (known-procedure/pure 2)] + [exn:fail:contract:variable? (known-procedure/pure/folding 2)] + [exn:fail:contract? (known-procedure/pure/folding 2)] [exn:fail:filesystem (known-constant)] [exn:fail:filesystem:errno (known-constant)] [exn:fail:filesystem:errno-errno (known-procedure 2)] - [exn:fail:filesystem:errno? (known-procedure/pure 2)] + [exn:fail:filesystem:errno? (known-procedure/pure/folding 2)] [exn:fail:filesystem:exists (known-constant)] [exn:fail:filesystem:exists? (known-procedure 2)] [exn:fail:filesystem:version (known-constant)] - [exn:fail:filesystem:version? (known-procedure/pure 2)] + [exn:fail:filesystem:version? (known-procedure/pure/folding 2)] [exn:fail:filesystem? (known-procedure 2)] [exn:fail:network (known-constant)] [exn:fail:network:errno (known-constant)] [exn:fail:network:errno-errno (known-procedure 2)] - [exn:fail:network:errno? (known-procedure/pure 2)] + [exn:fail:network:errno? (known-procedure/pure/folding 2)] [exn:fail:network? (known-procedure 2)] [exn:fail:out-of-memory (known-constant)] - [exn:fail:out-of-memory? (known-procedure/pure 2)] + [exn:fail:out-of-memory? (known-procedure/pure/folding 2)] [exn:fail:read (known-constant)] [exn:fail:read-srclocs (known-procedure 2)] [exn:fail:read:eof (known-constant)] - [exn:fail:read:eof? (known-procedure/pure 2)] + [exn:fail:read:eof? (known-procedure/pure/folding 2)] [exn:fail:read:non-char (known-constant)] - [exn:fail:read:non-char? (known-procedure/pure 2)] + [exn:fail:read:non-char? (known-procedure/pure/folding 2)] [exn:fail:read? (known-procedure 2)] [exn:fail:unsupported (known-constant)] - [exn:fail:unsupported? (known-procedure/pure 2)] + [exn:fail:unsupported? (known-procedure/pure/folding 2)] [exn:fail:user (known-constant)] - [exn:fail:user? (known-procedure/pure 2)] - [exn:fail? (known-procedure/pure 2)] + [exn:fail:user? (known-procedure/pure/folding 2)] + [exn:fail? (known-procedure/pure/folding 2)] [exn:srclocs-accessor (known-procedure 2)] - [exn:srclocs? (known-procedure/pure 2)] - [exn? (known-procedure/pure 2)] - [exp (known-procedure 2)] - [expand-user-path (known-procedure 2)] - [explode-path (known-procedure 2)] - [expt (known-procedure 4)] - [file-exists? (known-procedure 2)] - [file-or-directory-identity (known-procedure 6)] - [file-or-directory-modify-seconds (known-procedure 14)] - [file-or-directory-permissions (known-procedure 6)] - [file-position (known-procedure 6)] - [file-position* (known-procedure 2)] - [file-size (known-procedure 2)] + [exn:srclocs? (known-procedure/pure/folding 2)] + [exn? (known-procedure/pure/folding 2)] + [exp (known-procedure/folding 2)] + [expand-user-path (known-procedure/no-prompt 2)] + [explode-path (known-procedure/no-prompt 2)] + [expt (known-procedure/folding/limited 4 'expt)] + [file-exists? (known-procedure/no-prompt 2)] + [file-or-directory-identity (known-procedure/no-prompt 6)] + [file-or-directory-modify-seconds (known-procedure/no-prompt 14)] + [file-or-directory-permissions (known-procedure/no-prompt 6)] + [file-position (known-procedure/no-prompt 6)] + [file-position* (known-procedure/no-prompt 2)] + [file-size (known-procedure/no-prompt 2)] [file-stream-buffer-mode (known-procedure 6)] - [file-stream-port? (known-procedure 2)] - [file-truncate (known-procedure 4)] - [filesystem-change-evt (known-procedure 6)] - [filesystem-change-evt-cancel (known-procedure 2)] - [filesystem-change-evt? (known-procedure/pure 2)] - [filesystem-root-list (known-procedure 1)] - [find-system-path (known-procedure 2)] + [file-stream-port? (known-procedure/no-prompt 2)] + [file-truncate (known-procedure/no-prompt 4)] + [filesystem-change-evt (known-procedure/no-prompt 6)] + [filesystem-change-evt-cancel (known-procedure/no-prompt 2)] + [filesystem-change-evt? (known-procedure/pure/folding 2)] + [filesystem-root-list (known-procedure/no-prompt 1)] + [find-system-path (known-procedure/no-prompt 2)] [fixnum? (known-procedure/pure 2)] - [floating-point-bytes->real (known-procedure 30)] - [flonum? (known-procedure/pure 2)] - [floor (known-procedure 2)] + [floating-point-bytes->real (known-procedure/no-prompt 30)] + [flonum? (known-procedure/pure/folding 2)] + [floor (known-procedure/folding 2)] [flush-output (known-procedure 3)] [for-each (known-procedure -4)] [format (known-procedure -2)] [fprintf (known-procedure -4)] - [gcd (known-procedure -1)] + [gcd (known-procedure/folding -1)] [gensym (known-procedure 3)] - [get-output-bytes (known-procedure 30)] - [get-output-string (known-procedure 2)] + [get-output-bytes (known-procedure/no-prompt 30)] + [get-output-string (known-procedure/no-prompt 2)] [global-port-print-handler (known-constant)] - [handle-evt (known-procedure 4)] - [handle-evt? (known-procedure/pure 2)] + [handle-evt (known-procedure/no-prompt 4)] + [handle-evt? (known-procedure/pure/folding 2)] [hash (known-procedure -1)] [hash-clear (known-procedure 2)] [hash-clear! (known-procedure 2)] @@ -417,24 +417,24 @@ [hash-iterate-value (known-procedure 4)] [hash-keys-subset? (known-procedure 4)] [hash-map (known-procedure 12)] - [hash-placeholder? (known-procedure/pure 2)] + [hash-placeholder? (known-procedure/pure/folding 2)] [hash-ref (known-procedure 12)] [hash-remove (known-procedure 4)] [hash-remove! (known-procedure 4)] [hash-set (known-procedure 8)] [hash-set! (known-procedure 8)] [hash-weak? (known-procedure 2)] - [hash? (known-procedure/pure 2)] + [hash? (known-procedure/pure/folding 2)] [hasheq (known-procedure -1)] [hasheqv (known-procedure -1)] - [imag-part (known-procedure 2)] - [immutable? (known-procedure/pure 2)] + [imag-part (known-procedure/folding 2)] + [immutable? (known-procedure/pure/folding 2)] [impersonate-box (known-procedure -8)] [impersonate-channel (known-procedure -8)] [impersonate-continuation-mark-key (known-procedure -8)] [impersonate-hash (known-procedure -32)] - [impersonate-procedure (known-procedure -4)] - [impersonate-procedure* (known-procedure -4)] + [impersonate-procedure (known-procedure/no-prompt -4)] + [impersonate-procedure* (known-procedure/no-prompt -4)] [impersonate-prompt-tag (known-procedure -8)] [impersonate-struct (known-procedure -2)] [impersonate-vector (known-procedure -8)] @@ -443,146 +443,146 @@ [impersonator-of? (known-procedure 4)] [impersonator-prop:application-mark (known-constant)] [impersonator-property-accessor-procedure? (known-procedure 2)] - [impersonator-property? (known-procedure/pure 2)] - [impersonator? (known-procedure/pure 2)] - [inexact->exact (known-procedure 2)] - [inexact-real? (known-procedure/pure 2)] - [inexact? (known-procedure 2)] - [input-port? (known-procedure/pure 2)] - [inspector-superior? (known-procedure 4)] - [inspector? (known-procedure/pure 2)] - [integer->char (known-procedure 2)] - [integer->integer-bytes (known-procedure 120)] - [integer-bytes->integer (known-procedure 60)] - [integer-length (known-procedure 2)] - [integer-sqrt (known-procedure 2)] - [integer-sqrt/remainder (known-procedure 2)] - [integer? (known-procedure/pure 2)] + [impersonator-property? (known-procedure/pure/folding 2)] + [impersonator? (known-procedure/pure/folding 2)] + [inexact->exact (known-procedure/folding 2)] + [inexact-real? (known-procedure/pure/folding 2)] + [inexact? (known-procedure/folding 2)] + [input-port? (known-procedure/pure/folding 2)] + [inspector-superior? (known-procedure/no-prompt 4)] + [inspector? (known-procedure/pure/folding 2)] + [integer->char (known-procedure/folding 2)] + [integer->integer-bytes (known-procedure/no-prompt 120)] + [integer-bytes->integer (known-procedure/no-prompt 60)] + [integer-length (known-procedure/folding 2)] + [integer-sqrt (known-procedure/folding 2)] + [integer-sqrt/remainder (known-procedure/no-prompt 2)] + [integer? (known-procedure/pure/folding 2)] [interned-char? (known-procedure/pure 2)] - [keyword->string (known-procedure 2)] - [keywordstring (known-procedure/no-prompt 2)] + [keywordbytes (known-procedure 2)] - [list->string (known-procedure 2)] - [list->vector (known-procedure 2)] - [list-pair? (known-procedure/pure 2)] - [list-ref (known-procedure 4)] - [list-tail (known-procedure 4)] - [list? (known-procedure/pure 2)] + [list->bytes (known-procedure/no-prompt 2)] + [list->string (known-procedure/no-prompt 2)] + [list->vector (known-procedure/no-prompt 2)] + [list-pair? (known-procedure/pure/folding 2)] + [list-ref (known-procedure/no-prompt 4)] + [list-tail (known-procedure/no-prompt 4)] + [list? (known-procedure/pure/folding 2)] [load-on-demand-enabled (known-constant)] - [locale-string-encoding (known-procedure 1)] - [log (known-procedure 6)] - [log-all-levels (known-procedure 2)] - [log-level-evt (known-procedure 2)] - [log-level? (known-procedure 12)] - [log-max-level (known-procedure 6)] - [log-message (known-procedure 112)] - [log-receiver? (known-procedure/pure 2)] - [logger-name (known-procedure 2)] - [logger? (known-procedure/pure 2)] - [magnitude (known-procedure 2)] - [make-bytes (known-procedure 6)] + [locale-string-encoding (known-procedure/no-prompt 1)] + [log (known-procedure/folding 6)] + [log-all-levels (known-procedure/no-prompt 2)] + [log-level-evt (known-procedure/no-prompt 2)] + [log-level? (known-procedure/no-prompt 12)] + [log-max-level (known-procedure/no-prompt 6)] + [log-message (known-procedure/no-prompt 112)] + [log-receiver? (known-procedure/pure/folding 2)] + [logger-name (known-procedure/no-prompt 2)] + [logger? (known-procedure/pure/folding 2)] + [magnitude (known-procedure/folding 2)] + [make-bytes (known-procedure/no-prompt 6)] [make-channel (known-procedure/pure 1)] - [make-continuation-mark-key (known-procedure 3)] - [make-continuation-prompt-tag (known-procedure 3)] - [make-custodian (known-procedure 3)] - [make-custodian-box (known-procedure 4)] + [make-continuation-mark-key (known-procedure/no-prompt 3)] + [make-continuation-prompt-tag (known-procedure/no-prompt 3)] + [make-custodian (known-procedure/no-prompt 3)] + [make-custodian-box (known-procedure/no-prompt 4)] [make-derived-parameter (known-procedure 8)] - [make-directory (known-procedure 2)] - [make-environment-variables (known-procedure -1)] + [make-directory (known-procedure/no-prompt 2)] + [make-environment-variables (known-procedure/no-prompt -1)] [make-ephemeron (known-procedure/pure 4)] - [make-file-or-directory-link (known-procedure 4)] + [make-file-or-directory-link (known-procedure/no-prompt 4)] [make-hash (known-procedure 3)] - [make-hash-placeholder (known-procedure 2)] - [make-hasheq (known-procedure 3)] - [make-hasheq-placeholder (known-procedure 2)] - [make-hasheqv (known-procedure 3)] - [make-hasheqv-placeholder (known-procedure 2)] + [make-hash-placeholder (known-procedure/no-prompt 2)] + [make-hasheq (known-procedure/no-prompt 3)] + [make-hasheq-placeholder (known-procedure/no-prompt 2)] + [make-hasheqv (known-procedure/no-prompt 3)] + [make-hasheqv-placeholder (known-procedure/no-prompt 2)] [make-immutable-hash (known-procedure 3)] - [make-immutable-hasheq (known-procedure 3)] - [make-immutable-hasheqv (known-procedure 3)] - [make-impersonator-property (known-procedure 2)] + [make-immutable-hasheq (known-procedure/no-prompt 3)] + [make-immutable-hasheqv (known-procedure/no-prompt 3)] + [make-impersonator-property (known-procedure/no-prompt 2)] [make-input-port (known-procedure 2032)] - [make-inspector (known-procedure 3)] + [make-inspector (known-procedure/no-prompt 3)] [make-known-char-range-list (known-procedure/pure 1)] - [make-log-receiver (known-procedure -4)] - [make-logger (known-procedure -1)] + [make-log-receiver (known-procedure/no-prompt -4)] + [make-logger (known-procedure/no-prompt -1)] [make-output-port (known-procedure 4080)] [make-parameter (known-procedure 6)] - [make-phantom-bytes (known-procedure 2)] - [make-pipe (known-procedure 15)] + [make-phantom-bytes (known-procedure/no-prompt 2)] + [make-pipe (known-procedure/no-prompt 15)] [make-placeholder (known-procedure/pure 2)] [make-plumber (known-procedure/pure 1)] - [make-polar (known-procedure 4)] + [make-polar (known-procedure/folding 4)] [make-prefab-struct (known-procedure -2)] - [make-pseudo-random-generator (known-procedure 1)] ; not pure, depends on (current-milliseconds) + [make-pseudo-random-generator (known-procedure/no-prompt 1)] ; not pure, depends on (current-milliseconds) [make-reader-graph (known-procedure 2)] - [make-rectangular (known-procedure 4)] + [make-rectangular (known-procedure/folding 4)] [make-security-guard (known-procedure 24)] - [make-semaphore (known-procedure 3)] - [make-shared-bytes (known-procedure 6)] - [make-sibling-inspector (known-procedure 3)] - [make-string (known-procedure 6)] + [make-semaphore (known-procedure/no-prompt 3)] + [make-shared-bytes (known-procedure/no-prompt 6)] + [make-sibling-inspector (known-procedure/no-prompt 3)] + [make-string (known-procedure/no-prompt 6)] [make-struct-field-accessor (known-procedure 12)] [make-struct-field-mutator (known-procedure 12)] [make-struct-type (known-procedure 4080)] [make-struct-type-property (known-procedure 30)] [make-thread-cell (known-procedure/pure 6)] - [make-thread-group (known-procedure 3)] - [make-vector (known-procedure 6)] + [make-thread-group (known-procedure/no-prompt 3)] + [make-vector (known-procedure/no-prompt 6)] [make-weak-box (known-procedure/pure 2)] [make-weak-hash (known-procedure 3)] - [make-weak-hasheq (known-procedure 3)] - [make-weak-hasheqv (known-procedure 3)] + [make-weak-hasheq (known-procedure/no-prompt 3)] + [make-weak-hasheqv (known-procedure/no-prompt 3)] [make-will-executor (known-procedure/pure 1)] [map (known-procedure -4)] - [max (known-procedure -2)] - [mcar (known-procedure 2)] - [mcdr (known-procedure 2)] + [max (known-procedure/folding -2)] + [mcar (known-procedure/no-prompt 2)] + [mcdr (known-procedure/no-prompt 2)] [mcons (known-procedure/pure 4)] - [min (known-procedure -2)] - [modulo (known-procedure 4)] - [mpair? (known-procedure/pure 2)] - [nack-guard-evt (known-procedure 2)] - [negative? (known-procedure 2)] + [min (known-procedure/folding -2)] + [modulo (known-procedure/folding 4)] + [mpair? (known-procedure/pure/folding 2)] + [nack-guard-evt (known-procedure/no-prompt 2)] + [negative? (known-procedure/folding 2)] [never-evt (known-constant)] [newline (known-procedure 3)] - [not (known-procedure/pure 2)] - [null (known-literal '(quote ()))] - [null? (known-procedure/pure 2)] - [number->string (known-procedure 6)] - [number? (known-procedure/pure 2)] - [numerator (known-procedure 2)] + [not (known-procedure/pure/folding 2)] + [null (known-literal '())] + [null? (known-procedure/pure/folding 2)] + [number->string (known-procedure/no-prompt 6)] + [number? (known-procedure/pure/folding 2)] + [numerator (known-procedure/folding 2)] [object-name (known-procedure 2)] - [odd? (known-procedure 2)] - [open-input-bytes (known-procedure 6)] - [open-input-file (known-procedure 14)] - [open-input-output-file (known-procedure 14)] - [open-input-string (known-procedure 6)] - [open-output-bytes (known-procedure 3)] - [open-output-file (known-procedure 14)] - [open-output-string (known-procedure 3)] + [odd? (known-procedure/folding 2)] + [open-input-bytes (known-procedure/no-prompt 6)] + [open-input-file (known-procedure/no-prompt 14)] + [open-input-output-file (known-procedure/no-prompt 14)] + [open-input-string (known-procedure/no-prompt 6)] + [open-output-bytes (known-procedure/no-prompt 3)] + [open-output-file (known-procedure/no-prompt 14)] + [open-output-string (known-procedure/no-prompt 3)] [ormap (known-procedure -4)] - [output-port? (known-procedure/pure 2)] - [pair? (known-procedure/pure 2)] + [output-port? (known-procedure/pure/folding 2)] + [pair? (known-procedure/pure/folding 2)] [parameter-procedure=? (known-procedure 4)] - [parameter? (known-procedure/pure 2)] - [parameterization? (known-procedure/pure 2)] - [path->bytes (known-procedure 2)] - [path->complete-path (known-procedure 6)] - [path->directory-path (known-procedure 2)] - [path->string (known-procedure 2)] - [path-convention-type (known-procedure 2)] - [path-element->bytes (known-procedure 2)] - [path-element->string (known-procedure 2)] - [path-for-some-system? (known-procedure/pure 2)] - [pathbytes (known-procedure/no-prompt 2)] + [path->complete-path (known-procedure/no-prompt 6)] + [path->directory-path (known-procedure/no-prompt 2)] + [path->string (known-procedure/no-prompt 2)] + [path-convention-type (known-procedure/no-prompt 2)] + [path-element->bytes (known-procedure/no-prompt 2)] + [path-element->string (known-procedure/no-prompt 2)] + [path-for-some-system? (known-procedure/pure/folding 2)] + [pathstruct-type (known-procedure 4)] - [prefab-key? (known-procedure 2)] ; not pure, the argument may have a mutable vector - [prefab-struct-key (known-procedure 2)] - [pregexp (known-procedure 6)] - [pregexp? (known-procedure/pure 2)] - [primitive-closure? (known-procedure/pure 2)] + [positive? (known-procedure/folding 2)] + [prefab-key->struct-type (known-procedure/no-prompt 4)] + [prefab-key? (known-procedure/no-prompt 2)] ; not pure, the argument may have a mutable vector + [prefab-struct-key (known-procedure/no-prompt 2)] + [pregexp (known-procedure/no-prompt 6)] + [pregexp? (known-procedure/pure/folding 2)] + [primitive-closure? (known-procedure/pure/folding 2)] [primitive-result-arity (known-procedure 2)] [primitive? (known-procedure/pure 2)] [print (known-procedure 14)] @@ -647,21 +647,21 @@ [print-unreadable (known-constant)] [print-vector-length (known-constant)] [printf (known-procedure -2)] - [procedure->method (known-procedure 2)] + [procedure->method (known-procedure/no-prompt 2)] [procedure-arity (known-procedure 2)] [procedure-arity-mask (known-procedure 2)] [procedure-arity-includes? (known-procedure 12)] - [procedure-arity? (known-procedure/pure 2)] + [procedure-arity? (known-procedure/pure/folding 2)] [procedure-closure-contents-eq? (known-procedure 4)] [procedure-extract-target (known-procedure 2)] - [procedure-impersonator*? (known-procedure/pure 2)] + [procedure-impersonator*? (known-procedure/pure/folding 2)] [procedure-reduce-arity (known-procedure 12)] [procedure-reduce-arity-mask (known-procedure 12)] [procedure-rename (known-procedure 4)] [procedure-result-arity (known-procedure 2)] [procedure-specialize (known-procedure 2)] [procedure-struct-type? (known-procedure 2)] - [procedure? (known-procedure/pure 2)] + [procedure? (known-procedure/pure/folding 2)] [progress-evt? (known-procedure 6)] [prop:arity-string (known-constant)] [prop:authentic (known-struct-type-property/immediate-guard)] @@ -678,11 +678,11 @@ [prop:object-name (known-constant)] [prop:output-port (known-constant)] [prop:procedure (known-struct-type-property/immediate-guard)] - [pseudo-random-generator->vector (known-procedure 2)] - [pseudo-random-generator-vector? (known-procedure 2)] - [pseudo-random-generator? (known-procedure/pure 2)] - [quotient (known-procedure 4)] - [quotient/remainder (known-procedure 4)] + [pseudo-random-generator->vector (known-procedure/no-prompt 2)] + [pseudo-random-generator-vector? (known-procedure/no-prompt 2)] + [pseudo-random-generator? (known-procedure/pure/folding 2)] + [quotient (known-procedure/folding 4)] + [quotient/remainder (known-procedure/no-prompt 4)] [raise (known-procedure 6)] [raise-argument-error (known-procedure -8)] [raise-arguments-error (known-procedure -4)] @@ -694,9 +694,9 @@ [raise-result-arity-error (known-procedure -16)] [raise-type-error (known-procedure -8)] [raise-user-error (known-procedure -2)] - [random (known-procedure 7)] - [random-seed (known-procedure 2)] - [rational? (known-procedure/pure 2)] + [random (known-procedure/no-prompt 7)] + [random-seed (known-procedure/no-prompt 2)] + [rational? (known-procedure/pure/folding 2)] [read-accept-bar-quote (known-constant)] [read-byte (known-procedure 3)] [read-byte-or-special (known-procedure 15)] @@ -713,12 +713,12 @@ [read-on-demand-source (known-constant)] [read-string (known-procedure 6)] [read-string! (known-procedure 30)] - [real->double-flonum (known-procedure 2)] + [real->double-flonum (known-procedure/folding 2)] [real->floating-point-bytes (known-procedure 60)] [real->single-flonum (known-procedure 2)] - [real-part (known-procedure 2)] - [real? (known-procedure/pure 2)] - [regexp (known-procedure 6)] + [real-part (known-procedure/folding 2)] + [real? (known-procedure/pure/folding 2)] + [regexp (known-procedure/no-prompt 6)] [regexp-match (known-procedure 124)] [regexp-match-peek (known-procedure 124)] [regexp-match-peek-immediate (known-procedure 124)] @@ -733,41 +733,41 @@ [regexp-max-lookbehind (known-procedure 2)] [regexp-replace (known-procedure 24)] [regexp-replace* (known-procedure 24)] - [regexp? (known-procedure/pure 2)] - [relative-path? (known-procedure 2)] - [remainder (known-procedure 4)] - [rename-file-or-directory (known-procedure 12)] + [regexp? (known-procedure/pure/folding 2)] + [relative-path? (known-procedure/no-prompt 2)] + [remainder (known-procedure/folding 4)] + [rename-file-or-directory (known-procedure/no-prompt 12)] [replace-evt (known-procedure 4)] - [resolve-path (known-procedure 2)] - [reverse (known-procedure 2)] - [round (known-procedure 2)] - [seconds->date (known-procedure 6)] - [security-guard? (known-procedure/pure 2)] - [semaphore-peek-evt (known-procedure 2)] - [semaphore-peek-evt? (known-procedure/pure 2)] - [semaphore-post (known-procedure 2)] - [semaphore-try-wait? (known-procedure 2)] - [semaphore-wait (known-procedure 2)] - [semaphore-wait/enable-break (known-procedure 2)] - [semaphore? (known-procedure/pure 2)] + [resolve-path (known-procedure/no-prompt 2)] + [reverse (known-procedure/no-prompt 2)] + [round (known-procedure/folding 2)] + [seconds->date (known-procedure/no-prompt 6)] + [security-guard? (known-procedure/pure/folding 2)] + [semaphore-peek-evt (known-procedure/no-prompt 2)] + [semaphore-peek-evt? (known-procedure/pure/folding 2)] + [semaphore-post (known-procedure/no-prompt 2)] + [semaphore-try-wait? (known-procedure/no-prompt 2)] + [semaphore-wait (known-procedure/no-prompt 2)] + [semaphore-wait/enable-break (known-procedure/no-prompt 2)] + [semaphore? (known-procedure/pure/folding 2)] [set-box! (known-procedure 4)] [set-box*! (known-procedure/has-unsafe 4 'unsafe-set-box*!)] - [set-mcar! (known-procedure 4)] - [set-mcdr! (known-procedure 4)] - [set-phantom-bytes! (known-procedure 4)] + [set-mcar! (known-procedure/no-prompt 4)] + [set-mcdr! (known-procedure/no-prompt 4)] + [set-phantom-bytes! (known-procedure/no-prompt 4)] [set-port-next-location! (known-procedure 16)] [sha1-bytes (known-procedure 14)] [sha224-bytes (known-procedure 14)] [sha256-bytes (known-procedure 14)] [shared-bytes (known-procedure -1)] [shell-execute (known-procedure 32)] - [simplify-path (known-procedure 6)] - [sin (known-procedure 2)] - [single-flonum? (known-procedure/pure 2)] + [simplify-path (known-procedure/no-prompt 6)] + [sin (known-procedure/folding 2)] + [single-flonum? (known-procedure/pure/folding 2)] [single-flonum-available? (known-procedure/pure 1)] - [sleep (known-procedure 3)] - [split-path (known-procedure 2)] - [sqrt (known-procedure 2)] + [sleep (known-procedure/no-prompt 3)] + [split-path (known-procedure/no-prompt 2)] + [sqrt (known-procedure/folding 2)] [srcloc (known-procedure/has-unsafe 32 'unsafe-make-srcloc)] [srcloc->string (known-procedure 2)] [srcloc-column (known-procedure 2)] @@ -775,68 +775,68 @@ [srcloc-position (known-procedure 2)] [srcloc-source (known-procedure 2)] [srcloc-span (known-procedure 2)] - [srcloc? (known-procedure/pure 2)] - [string (known-procedure -1)] - [string->bytes/latin-1 (known-procedure 30)] - [string->bytes/locale (known-procedure 30)] - [string->bytes/utf-8 (known-procedure 30)] - [string->immutable-string (known-procedure 2)] - [string->keyword (known-procedure 2)] - [string->list (known-procedure 2)] - [string->number (known-procedure 30)] - [string->path (known-procedure 2)] - [string->path-element (known-procedure 2)] - [string->symbol (known-procedure 2)] - [string->uninterned-symbol (known-procedure 2)] - [string->unreadable-symbol (known-procedure 2)] - [string-append (known-procedure -1)] - [string-ci<=? (known-procedure -2)] - [string-ci=? (known-procedure -2)] - [string-ci>? (known-procedure -2)] - [string-copy (known-procedure 2)] - [string-copy! (known-procedure 56)] - [string-downcase (known-procedure 2)] - [string-fill! (known-procedure 4)] - [string-foldcase (known-procedure 2)] - [string-length (known-procedure 2)] - [string-locale-ci? (known-procedure -2)] - [string-locale-downcase (known-procedure 2)] - [string-locale-upcase (known-procedure 2)] - [string-locale? (known-procedure -2)] - [string-normalize-nfc (known-procedure 2)] - [string-normalize-nfd (known-procedure 2)] - [string-normalize-nfkc (known-procedure 2)] - [string-normalize-nfkd (known-procedure 2)] - [string-port? (known-procedure 2)] - [string-ref (known-procedure 4)] - [string-set! (known-procedure 8)] - [string-titlecase (known-procedure 2)] - [string-upcase (known-procedure 2)] - [string-utf-8-length (known-procedure 14)] - [string<=? (known-procedure -2)] - [string=? (known-procedure -2)] - [string>? (known-procedure -2)] - [string? (known-procedure/pure 2)] + [srcloc? (known-procedure/pure/folding 2)] + [string (known-procedure/no-prompt -1)] + [string->bytes/latin-1 (known-procedure/no-prompt 30)] + [string->bytes/locale (known-procedure/no-prompt 30)] + [string->bytes/utf-8 (known-procedure/no-prompt 30)] + [string->immutable-string (known-procedure/no-prompt 2)] + [string->keyword (known-procedure/no-prompt 2)] + [string->list (known-procedure/no-prompt 2)] + [string->number (known-procedure/no-prompt 30)] + [string->path (known-procedure/no-prompt 2)] + [string->path-element (known-procedure/no-prompt 2)] + [string->symbol (known-procedure/no-prompt 2)] + [string->uninterned-symbol (known-procedure/no-prompt 2)] + [string->unreadable-symbol (known-procedure/no-prompt 2)] + [string-append (known-procedure/no-prompt -1)] + [string-ci<=? (known-procedure/no-prompt -2)] + [string-ci=? (known-procedure/no-prompt -2)] + [string-ci>? (known-procedure/no-prompt -2)] + [string-copy (known-procedure/no-prompt 2)] + [string-copy! (known-procedure/no-prompt 56)] + [string-downcase (known-procedure/no-prompt 2)] + [string-fill! (known-procedure/no-prompt 4)] + [string-foldcase (known-procedure/no-prompt 2)] + [string-length (known-procedure/no-prompt 2)] + [string-locale-ci? (known-procedure/no-prompt -2)] + [string-locale-downcase (known-procedure/no-prompt 2)] + [string-locale-upcase (known-procedure/no-prompt 2)] + [string-locale? (known-procedure/no-prompt -2)] + [string-normalize-nfc (known-procedure/no-prompt 2)] + [string-normalize-nfd (known-procedure/no-prompt 2)] + [string-normalize-nfkc (known-procedure/no-prompt 2)] + [string-normalize-nfkd (known-procedure/no-prompt 2)] + [string-port? (known-procedure/no-prompt 2)] + [string-ref (known-procedure/no-prompt 4)] + [string-set! (known-procedure/no-prompt 8)] + [string-titlecase (known-procedure/no-prompt 2)] + [string-upcase (known-procedure/no-prompt 2)] + [string-utf-8-length (known-procedure/no-prompt 14)] + [string<=? (known-procedure/no-prompt -2)] + [string=? (known-procedure/no-prompt -2)] + [string>? (known-procedure/no-prompt -2)] + [string? (known-procedure/pure/folding 2)] [struct->vector (known-procedure 6)] - [struct-accessor-procedure? (known-procedure/pure 2)] - [struct-constructor-procedure? (known-procedure/pure 2)] + [struct-accessor-procedure? (known-procedure/pure/folding 2)] + [struct-constructor-procedure? (known-procedure/pure/folding 2)] [struct-info (known-procedure 2)] - [struct-mutator-procedure? (known-procedure/pure 2)] - [struct-predicate-procedure? (known-procedure/pure 2)] + [struct-mutator-procedure? (known-procedure/pure/folding 2)] + [struct-predicate-procedure? (known-procedure/pure/folding 2)] [struct-type-info (known-procedure 2)] [struct-type-make-constructor (known-procedure 6)] [struct-type-make-predicate (known-procedure 2)] [struct-type-property-accessor-procedure? (known-procedure 2)] - [struct-type-property? (known-procedure 2)] - [struct-type? (known-procedure 2)] + [struct-type-property? (known-procedure/no-prompt 2)] + [struct-type? (known-procedure/no-prompt 2)] [struct:arity-at-least (known-constant)] [struct:date (known-constant)] [struct:date* (known-constant)] @@ -864,9 +864,9 @@ [struct:exn:fail:unsupported (known-constant)] [struct:exn:fail:user (known-constant)] [struct:srcloc (known-constant)] - [struct? (known-procedure 2)] ; not pure, depends on (current-inspector) - [sub1 (known-procedure 2)] - [subbytes (known-procedure 12)] + [struct? (known-procedure/no-prompt 2)] ; not pure, depends on (current-inspector) + [sub1 (known-procedure/folding 2)] + [subbytes (known-procedure/no-prompt 12)] [subprocess (known-procedure -16)] [subprocess-group-enabled (known-constant)] [subprocess-kill (known-procedure 4)] @@ -874,65 +874,65 @@ [subprocess-status (known-procedure 2)] [subprocess-wait (known-procedure 2)] [subprocess? (known-procedure 2)] - [substring (known-procedure 12)] - [symbol->string (known-procedure 2)] - [symbol-interned? (known-procedure 2)] - [symbol-unreadable? (known-procedure 2)] - [symbolstring (known-procedure/no-prompt 2)] + [symbol-interned? (known-procedure/no-prompt 2)] + [symbol-unreadable? (known-procedure/no-prompt 2)] + [symboldatum (known-procedure 2)] - [syntax-column (known-procedure 2)] - [syntax-e (known-procedure 2)] - [syntax-line (known-procedure 2)] - [syntax-position (known-procedure 2)] - [syntax-property (known-procedure 28)] - [syntax-property-symbol-keys (known-procedure 2)] - [syntax-source (known-procedure 2)] - [syntax-span (known-procedure 2)] - [syntax? (known-procedure/pure 2)] + [syntax->datum (known-procedure/no-prompt 2)] + [syntax-column (known-procedure/no-prompt 2)] + [syntax-e (known-procedure/no-prompt 2)] + [syntax-line (known-procedure/no-prompt 2)] + [syntax-position (known-procedure/no-prompt 2)] + [syntax-property (known-procedure/no-prompt 28)] + [syntax-property-symbol-keys (known-procedure/no-prompt 2)] + [syntax-source (known-procedure/no-prompt 2)] + [syntax-span (known-procedure/no-prompt 2)] + [syntax? (known-procedure/pure/folding 2)] [system-big-endian? (known-procedure/pure 1)] [system-idle-evt (known-procedure/pure 1)] - [system-language+country (known-procedure 1)] - [system-library-subpath (known-procedure 3)] + [system-language+country (known-procedure/no-prompt 1)] + [system-library-subpath (known-procedure/no-prompt 3)] [system-path-convention-type (known-procedure/pure 1)] - [system-type (known-procedure 3)] - [tan (known-procedure 2)] - [terminal-port? (known-procedure 2)] + [system-type (known-procedure/no-prompt 3)] + [tan (known-procedure/folding 2)] + [terminal-port? (known-procedure/no-prompt 2)] [thread (known-procedure 2)] - [thread-cell-ref (known-procedure 2)] - [thread-cell-set! (known-procedure 4)] - [thread-cell-values? (known-procedure/pure 2)] - [thread-cell? (known-procedure/pure 2)] - [thread-dead-evt (known-procedure 2)] - [thread-dead? (known-procedure 2)] - [thread-group? (known-procedure/pure 2)] - [thread-receive (known-procedure 1)] + [thread-cell-ref (known-procedure/no-prompt 2)] + [thread-cell-set! (known-procedure/no-prompt 4)] + [thread-cell-values? (known-procedure/pure/folding 2)] + [thread-cell? (known-procedure/pure/folding 2)] + [thread-dead-evt (known-procedure/no-prompt 2)] + [thread-dead? (known-procedure/no-prompt 2)] + [thread-group? (known-procedure/pure/folding 2)] + [thread-receive (known-procedure/no-prompt 1)] [thread-receive-evt (known-procedure/pure 1)] - [thread-resume (known-procedure 6)] - [thread-resume-evt (known-procedure 2)] - [thread-rewind-receive (known-procedure 2)] - [thread-running? (known-procedure 2)] - [thread-send (known-procedure 12)] - [thread-suspend (known-procedure 2)] - [thread-suspend-evt (known-procedure 2)] - [thread-try-receive (known-procedure 1)] - [thread-wait (known-procedure 2)] + [thread-resume (known-procedure/no-prompt 6)] + [thread-resume-evt (known-procedure/no-prompt 2)] + [thread-rewind-receive (known-procedure/no-prompt 2)] + [thread-running? (known-procedure/no-prompt 2)] + [thread-send (known-procedure/no-prompt 12)] + [thread-suspend (known-procedure/no-prompt 2)] + [thread-suspend-evt (known-procedure/no-prompt 2)] + [thread-try-receive (known-procedure/no-prompt 1)] + [thread-wait (known-procedure/no-prompt 2)] [thread/suspend-to-kill (known-procedure 2)] - [thread? (known-procedure/pure 2)] + [thread? (known-procedure/pure/folding 2)] [time-apply (known-procedure 4)] - [true-object? (known-procedure/pure 2)] - [truncate (known-procedure 2)] + [true-object? (known-procedure/pure/folding 2)] + [truncate (known-procedure/folding 2)] [unbox (known-procedure 2)] [unbox* (known-procedure/has-unsafe 2 'unsafe-unbox*)] [uncaught-exception-handler (known-constant)] - [unquoted-printing-string (known-procedure 2)] + [unquoted-printing-string (known-procedure/no-prompt 2)] [unquoted-printing-string-value (known-procedure 2)] - [unquoted-printing-string? (known-procedure 2)] - [values (known-procedure -1)] ; not marked as pure, because it is not single valued + [unquoted-printing-string? (known-procedure/no-prompt 2)] + [values (known-procedure/no-prompt -1)] ; not marked as pure, because it is not single valued [vector (known-procedure/pure -1)] [vector->immutable-vector (known-procedure 2)] [vector->list (known-procedure 2)] @@ -943,21 +943,21 @@ [vector-copy! (known-procedure 56)] [vector-fill! (known-procedure 4)] [vector-immutable (known-procedure/pure -1)] - [vector-length (known-procedure 2)] + [vector-length (known-procedure/no-prompt 2)] [vector-ref (known-procedure 4)] [vector-set! (known-procedure 8)] [vector-set-performance-stats! (known-procedure 6)] - [vector? (known-procedure/pure 2)] + [vector? (known-procedure/pure/folding 2)] [vector*-length (known-procedure/has-unsafe 2 'unsafe-vector*-length)] [vector*-ref (known-procedure/has-unsafe 4 'unsafe-vector*-ref)] [vector*-set! (known-procedure/has-unsafe 8 'unsafe-vector*-set!)] [version (known-procedure/pure 1)] - [void (known-procedure/pure -1)] - [void? (known-procedure/pure 2)] - [weak-box-value (known-procedure 6)] - [weak-box? (known-procedure/pure 2)] + [void (known-procedure/pure/folding -1)] + [void? (known-procedure/pure/folding 2)] + [weak-box-value (known-procedure/no-prompt 6)] + [weak-box? (known-procedure/pure/folding 2)] [will-execute (known-procedure 2)] - [will-executor? (known-procedure/pure 2)] + [will-executor? (known-procedure/pure/folding 2)] [will-register (known-procedure 8)] [will-try-execute (known-procedure 2)] [with-input-from-file (known-procedure 12)] @@ -975,4 +975,4 @@ [write-special-avail* (known-procedure 6)] [write-special-evt (known-procedure 4)] [write-string (known-procedure 30)] - [zero? (known-procedure 2)]) + [zero? (known-procedure/folding 2)]) diff --git a/racket/src/cs/primitive/unsafe.ss b/racket/src/cs/primitive/unsafe.ss index 0e50890481..5e7af09cfa 100644 --- a/racket/src/cs/primitive/unsafe.ss +++ b/racket/src/cs/primitive/unsafe.ss @@ -18,12 +18,12 @@ [unsafe-cdr (known-procedure/pure 2)] [unsafe-chaperone-procedure (known-procedure -4)] [unsafe-chaperone-vector (known-procedure -4)] - [unsafe-char? (known-procedure/pure -2)] - [unsafe-char>=? (known-procedure/pure -2)] - [unsafe-char->integer (known-procedure/pure 2)] + [unsafe-char? (known-procedure/pure/folding-unsafe -2 'char>?)] + [unsafe-char>=? (known-procedure/pure/folding-unsafe -2 'char>=?)] + [unsafe-char->integer (known-procedure/pure/folding-unsafe 2 'char->integer)] [unsafe-cons-list (known-procedure/pure 4)] [unsafe-custodian-register (known-procedure 32)] [unsafe-custodian-unregister (known-procedure 4)] @@ -52,51 +52,51 @@ [unsafe-f80vector-set! (known-procedure 8)] [unsafe-file-descriptor->port (known-procedure 8)] [unsafe-file-descriptor->semaphore (known-procedure 4)] - [unsafe-fl* (known-procedure/pure -1)] - [unsafe-fl+ (known-procedure/pure -1)] - [unsafe-fl- (known-procedure/pure -2)] - [unsafe-fl->fx (known-procedure/pure 2)] - [unsafe-fl/ (known-procedure/pure -2)] - [unsafe-fl< (known-procedure/pure -2)] - [unsafe-fl<= (known-procedure/pure -2)] - [unsafe-fl= (known-procedure/pure -2)] - [unsafe-fl> (known-procedure/pure -2)] - [unsafe-fl>= (known-procedure/pure -2)] - [unsafe-flabs (known-procedure/pure 2)] - [unsafe-flimag-part (known-procedure/pure 2)] - [unsafe-flmax (known-procedure/pure 4)] - [unsafe-flmin (known-procedure/pure 4)] - [unsafe-flrandom (known-procedure/pure 2)] - [unsafe-flreal-part (known-procedure/pure 2)] - [unsafe-flsqrt (known-procedure/pure 2)] - [unsafe-flvector-length (known-procedure/pure 2)] + [unsafe-fl* (known-procedure/pure/folding-unsafe -1 'fl*)] + [unsafe-fl+ (known-procedure/pure/folding-unsafe -1 'fl+)] + [unsafe-fl- (known-procedure/pure/folding-unsafe -2 'fl-)] + [unsafe-fl->fx (known-procedure/pure/folding-unsafe 2 'fl->fx)] + [unsafe-fl/ (known-procedure/pure/folding-unsafe -2 'fl/)] + [unsafe-fl< (known-procedure/pure/folding-unsafe -2 'fl<)] + [unsafe-fl<= (known-procedure/pure/folding-unsafe -2 'fl<=)] + [unsafe-fl= (known-procedure/pure/folding-unsafe -2 'fl=)] + [unsafe-fl> (known-procedure/pure/folding-unsafe -2 'fl>)] + [unsafe-fl>= (known-procedure/pure/folding-unsafe -2 'fl>=)] + [unsafe-flabs (known-procedure/pure/folding-unsafe 2 'flabs)] + [unsafe-flimag-part (known-procedure/pure/folding-unsafe 2 'flimag-part)] + [unsafe-flmax (known-procedure/pure/folding-unsafe 4 'flmax)] + [unsafe-flmin (known-procedure/pure/folding-unsafe 4 'flmin)] + [unsafe-flrandom (known-procedure/pure/folding-unsafe 2 'flrandom)] + [unsafe-flreal-part (known-procedure/pure/folding-unsafe 2 'flreal-part)] + [unsafe-flsqrt (known-procedure/pure/folding-unsafe 2 'flsqrt)] + [unsafe-flvector-length (known-procedure/pure/folding-unsafe 2 'flvector-length)] [unsafe-flvector-ref (known-procedure 4)] [unsafe-flvector-set! (known-procedure 8)] - [unsafe-fx* (known-procedure/pure -1)] - [unsafe-fx+ (known-procedure/pure -1)] - [unsafe-fx- (known-procedure/pure -2)] - [unsafe-fx->extfl (known-procedure/pure 2)] - [unsafe-fx->fl (known-procedure/pure 2)] - [unsafe-fx< (known-procedure/pure -2)] - [unsafe-fx<= (known-procedure/pure -2)] - [unsafe-fx= (known-procedure/pure -2)] - [unsafe-fx> (known-procedure/pure -2)] - [unsafe-fx>= (known-procedure/pure -2)] - [unsafe-fxabs (known-procedure/pure 2)] - [unsafe-fxand (known-procedure/pure -1)] - [unsafe-fxior (known-procedure/pure -1)] - [unsafe-fxlshift (known-procedure/pure 4)] - [unsafe-fxmax (known-procedure/pure -2)] - [unsafe-fxmin (known-procedure/pure -2)] - [unsafe-fxmodulo (known-procedure/pure 4)] - [unsafe-fxnot (known-procedure/pure 2)] - [unsafe-fxquotient (known-procedure/pure 4)] - [unsafe-fxremainder (known-procedure/pure 4)] - [unsafe-fxrshift (known-procedure/pure 4)] - [unsafe-fxvector-length (known-procedure/pure 2)] + [unsafe-fx* (known-procedure/pure/folding-unsafe -1 'fx*)] + [unsafe-fx+ (known-procedure/pure/folding-unsafe -1 'fx+)] + [unsafe-fx- (known-procedure/pure/folding-unsafe -2 'fx-)] + [unsafe-fx->extfl (known-procedure/pure/folding-unsafe 2 'fx->extfl)] + [unsafe-fx->fl (known-procedure/pure/folding-unsafe 2 'fx->fl)] + [unsafe-fx< (known-procedure/pure/folding-unsafe -2 'fx<)] + [unsafe-fx<= (known-procedure/pure/folding-unsafe -2 'fx<=)] + [unsafe-fx= (known-procedure/pure/folding-unsafe -2 'fx=)] + [unsafe-fx> (known-procedure/pure/folding-unsafe -2 'fx>)] + [unsafe-fx>= (known-procedure/pure/folding-unsafe -2 'fx>=)] + [unsafe-fxabs (known-procedure/pure/folding-unsafe 2 'fxabs)] + [unsafe-fxand (known-procedure/pure/folding-unsafe -1 'fxand)] + [unsafe-fxior (known-procedure/pure/folding-unsafe -1 'fxior)] + [unsafe-fxlshift (known-procedure/pure/folding-unsafe 4 'fxlshift)] + [unsafe-fxmax (known-procedure/pure/folding-unsafe -2 'fxmax)] + [unsafe-fxmin (known-procedure/pure/folding-unsafe -2 'fxmin)] + [unsafe-fxmodulo (known-procedure/pure/folding-unsafe 4 'fxmodulo)] + [unsafe-fxnot (known-procedure/pure/folding-unsafe 2 'fxnot)] + [unsafe-fxquotient (known-procedure/pure/folding-unsafe 4 'fxquotient)] + [unsafe-fxremainder (known-procedure/pure/folding-unsafe 4 'fxremainder)] + [unsafe-fxrshift (known-procedure/pure/folding-unsafe 4 'fxrshift)] + [unsafe-fxvector-length (known-procedure/pure/folding-unsafe 2 'fxvector-length)] [unsafe-fxvector-ref (known-procedure 4)] [unsafe-fxvector-set! (known-procedure 8)] - [unsafe-fxxor (known-procedure/pure -1)] + [unsafe-fxxor (known-procedure/pure/folding-unsafe -1 'fxxor)] [unsafe-get-place-table (known-procedure 1)] [unsafe-immutable-hash-iterate-first (known-procedure/pure 2)] [unsafe-immutable-hash-iterate-key (known-procedure/pure 4)] @@ -110,7 +110,7 @@ [unsafe-list-ref (known-procedure/pure 4)] [unsafe-list-tail (known-procedure/pure 4)] [unsafe-make-custodian-at-root (known-procedure 1)] - [unsafe-make-flrectangular (known-procedure/pure 4)] + [unsafe-make-flrectangular (known-procedure/pure/folding-unsafe 4 'make-flrectangular)] [unsafe-make-place-local (known-procedure/pure 2)] [unsafe-make-os-semaphore (known-procedure 1)] [unsafe-make-security-guard-at-root (known-procedure 15)] diff --git a/racket/src/racket/src/cify-startup.rkt b/racket/src/racket/src/cify-startup.rkt index 3697d3c7cc..bdc5fee08f 100644 --- a/racket/src/racket/src/cify-startup.rkt +++ b/racket/src/racket/src/cify-startup.rkt @@ -74,7 +74,7 @@ (printf "Schemify...\n") (define body (time - (schemify-body bodys/re-uniqued prim-knowns #hasheq() #hasheq() + (schemify-body bodys/re-uniqued prim-knowns #hasheq() #hasheq() #hasheq() ;; for cify: #t ;; unsafe mode: diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 7d4e0a64a9..552f0ea5fd 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 3 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 11 +#define MZSCHEME_VERSION_W 12 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x diff --git a/racket/src/schemify/find-definition.rkt b/racket/src/schemify/find-definition.rkt index 698b15cd85..322f81d0d6 100644 --- a/racket/src/schemify/find-definition.rkt +++ b/racket/src/schemify/find-definition.rkt @@ -12,14 +12,16 @@ ;; Record top-level functions and structure types, and returns ;; (values knowns struct-type-info-or-#f) (define (find-definitions v prim-knowns knowns imports mutated simples unsafe-mode? + #:primitives [primitives #hasheq()] ; for `optimize?` mode #:optimize? optimize?) (match v [`(define-values (,id) ,orig-rhs) (define rhs (if optimize? - (optimize orig-rhs prim-knowns knowns imports mutated) + (optimize orig-rhs prim-knowns primitives knowns imports mutated) orig-rhs)) (values (let ([k (infer-known rhs v #t id knowns prim-knowns imports mutated simples unsafe-mode? + #:primitives primitives #:optimize-inline? optimize?)]) (if k (hash-set knowns (unwrap id) k) diff --git a/racket/src/schemify/fold.rkt b/racket/src/schemify/fold.rkt new file mode 100644 index 0000000000..7f210f7989 --- /dev/null +++ b/racket/src/schemify/fold.rkt @@ -0,0 +1,56 @@ +#lang racket/base +(require racket/fixnum + "literal.rkt" + "known.rkt") + +(provide try-fold-primitive) + +(define (try-fold-primitive orig-prim-sym orig-k exps prim-knowns primitives) + (define prim-sym (if (known-procedure/pure/folding-unsafe? orig-k) + (known-procedure/pure/folding-unsafe-safe orig-k) + orig-prim-sym)) + (define k (if (known-procedure/pure/folding-unsafe? orig-k) + (hash-ref prim-knowns prim-sym #f) + orig-k)) + (define vals (for/list ([exp (in-list exps)]) + (unwrap-literal exp))) + (define check-result (limit-check k vals)) + (and check-result + (let/ec esc + (call-with-exception-handler + (lambda (exn) + (if (exn:fail? exn) + (esc #f) + exn)) + (lambda () + (define result + (apply (hash-ref primitives prim-sym (lambda args (error "missing"))) + vals)) + (check-result result) + (list (wrap-literal result))))))) + +(define (limit-check k vals) + (define kind + (cond + [(known-procedure/folding/limited? k) + (known-procedure/folding/limited-kind k)] + [(known-procedure/has-unsafe/folding/limited? k) + (known-procedure/has-unsafe/folding/limited-kind k)] + [else #f])) + (case kind + [(#f) void] + [(expt) + (and (not (and (= 2 (length vals)) + (exact-integer? (car vals)) + (exact-integer? (cadr vals)) + ((* (integer-length (car vals)) + (cadr vals)) + . > . 1000))) + void)] + [(fixnum) (and (for/and ([v (in-list vals)]) + (fixnum-for-every-system? v)) + (lambda (v) + (unless (fixnum-for-every-system? v) + (error "result is not a fixnum for every system"))))] + [else + (error 'schemify:limited-ok? "unknown limit kind: ~a" k)])) diff --git a/racket/src/schemify/infer-known.rkt b/racket/src/schemify/infer-known.rkt index c31ed891cb..e3ed9fee14 100644 --- a/racket/src/schemify/infer-known.rkt +++ b/racket/src/schemify/infer-known.rkt @@ -18,6 +18,7 @@ ;; that the variable will get a value without referencing anything ;; too early. (define (infer-known rhs defn rec? id knowns prim-knowns imports mutated simples unsafe-mode? + #:primitives [primitives #hasheq()] ; for `optimize-inline?` mode #:optimize-inline? [optimize-inline? #f]) (cond [(lambda? rhs) @@ -27,7 +28,7 @@ (or (can-inline? lam) (wrap-property defn 'compiler-hint:cross-module-inline))) (let ([lam (if optimize-inline? - (optimize* lam prim-knowns knowns imports mutated unsafe-mode?) + (optimize* lam prim-knowns primitives knowns imports mutated unsafe-mode?) lam)]) (known-procedure/can-inline arity-mask lam)) (known-procedure arity-mask))] diff --git a/racket/src/schemify/known.rkt b/racket/src/schemify/known.rkt index d6f570cf45..9bf31eb70a 100644 --- a/racket/src/schemify/known.rkt +++ b/racket/src/schemify/known.rkt @@ -6,14 +6,23 @@ (provide known-constant known-constant? known-consistent known-consistent? known-copy? known-copy known-copy-id - known-literal known-literal? known-literal-expr + known-literal known-literal? known-literal-value known-procedure known-procedure? known-procedure-arity-mask + known-procedure/no-prompt known-procedure/no-prompt? + known-procedure/folding known-procedure/folding? + known-procedure/folding/limited known-procedure/folding/limited? known-procedure/folding/limited-kind known-procedure/can-inline known-procedure/can-inline? known-procedure/can-inline-expr known-procedure/can-inline/need-imports known-procedure/can-inline/need-imports? known-procedure/can-inline/need-imports-needed known-procedure/succeeds known-procedure/succeeds? known-procedure/pure known-procedure/pure? + known-procedure/pure/folding known-procedure/pure/folding? ; not a subtype of `known-procedure/folding` + known-procedure/pure/folding-unsafe known-procedure/pure/folding-unsafe? + known-procedure/pure/folding-unsafe-safe known-procedure/has-unsafe known-procedure/has-unsafe? known-procedure/has-unsafe-alternate + known-procedure/has-unsafe/folding known-procedure/has-unsafe/folding? ; not a subtype of `known-procedure/folding` + known-procedure/has-unsafe/folding/limited known-procedure/has-unsafe/folding/limited? + known-procedure/has-unsafe/folding/limited-kind known-struct-type known-struct-type? known-struct-type-type known-struct-type-field-count known-struct-type-pure-constructor? known-constructor known-constructor? known-constructor-type @@ -41,26 +50,45 @@ (struct known-copy (id) #:prefab #:omit-define-syntaxes #:super struct:known-constant) ;; literal for constant propagation: -(struct known-literal (expr) #:prefab #:omit-define-syntaxes #:super struct:known-consistent) +(struct known-literal (value) #:prefab #:omit-define-syntaxes #:super struct:known-consistent) ;; procedure with arity mark; the procedure has to be a procedure from the host ;; Scheme's perspective --- not an applicable struct or chaperoned procedure, which ;; means that parameters don't count (struct known-procedure (arity-mask) #:prefab #:omit-define-syntaxes #:super struct:known-consistent) +;; procedure that does not need to run inside a module prompt, which implies that the +;; procedure does not call arbitrary other code, not even through an impersonator/chaperone +;; interposition procedure +(struct known-procedure/no-prompt () #:prefab #:omit-define-syntaxes #:super struct:known-procedure) + +;; procedure that can be inlined, where the `expr` is in pre-schemify form (struct known-procedure/can-inline (expr) #:prefab #:omit-define-syntaxes #:super struct:known-procedure) (struct known-procedure/can-inline/need-imports (needed) ; (list (cons (cons <#f-or-index>)) ...) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/can-inline) +;; procedure that can be applied at compile time to literals and returns a single value +(struct known-procedure/folding () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/no-prompt) + +;; procedure that's folding, but with some constraint described by `kind` (e.g., +;; `'expt` to mean "apply only to small numbers") +(struct known-procedure/folding/limited (kind) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/folding) + ;; procedure that never raises an exception or otherwise captures/escapes the calling context -(struct known-procedure/succeeds () #:prefab #:omit-define-syntaxes #:super struct:known-procedure) +(struct known-procedure/succeeds () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/no-prompt) ;; procedure that accepts any arguments and is functional so that it can be reordered (struct known-procedure/pure () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/succeeds) -;; procedure with an unsafe variant, especially ones that won't get substituted +;; pure and folding: +(struct known-procedure/pure/folding () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/pure) +(struct known-procedure/pure/folding-unsafe (safe) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/pure/folding) + +;; procedure (no-prompt) with an unsafe variant, especially ones that won't get substituted ;; simply by compiling in unsafe mode -(struct known-procedure/has-unsafe (alternate) #:prefab #:omit-define-syntaxes #:super struct:known-procedure) +(struct known-procedure/has-unsafe (alternate) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/no-prompt) +(struct known-procedure/has-unsafe/folding () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/has-unsafe) +(struct known-procedure/has-unsafe/folding/limited (kind) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/has-unsafe/folding) (struct known-struct-type (type field-count pure-constructor?) #:prefab #:omit-define-syntaxes #:super struct:known-consistent) diff --git a/racket/src/schemify/literal.rkt b/racket/src/schemify/literal.rkt index e3448c30dd..971441b66c 100644 --- a/racket/src/schemify/literal.rkt +++ b/racket/src/schemify/literal.rkt @@ -2,21 +2,46 @@ (require "wrap.rkt") (provide literal? - unwrap-literal) + unwrap-literal + wrap-literal) (define (literal? v) (define u (unwrap v)) (or (number? u) (boolean? u) + (eq? u 'eof) (and (pair? u) - (eq? (unwrap (car u)) 'quote) - (let ([u (unwrap (wrap-car (cdr u)))]) - (or (symbol? u) - (null? u)))))) + (let ([a (unwrap (car u))]) + (cond + [(eq? a 'quote) + (let ([u (unwrap (cadr u))]) + (or (symbol? u) + (null? u) + (char? u) + (void? u)))] + [(and (eq? a 'void) + (null? (cdr u))) + #t] + [else #f]))))) ;; Unwrap a literal so that it can be serialized +;; or constant-folded (define (unwrap-literal v) (define u (unwrap v)) - (if (pair? u) - `',(unwrap (wrap-car (cdr u))) - u)) + (cond + [(pair? u) + (let ([a (unwrap (car u))]) + (cond + [(eq? a 'quote) (unwrap (cadr u))] + [(eq? a 'void) (void)]))] + [(eq? u 'eof) eof] + [else u])) + +(define (wrap-literal x) + (cond + [(or (string? x) (bytes? x) (boolean? x) (number? x)) + x] + [(void? x) '(void)] + [(eof-object? x) 'eof] + [else + `(quote ,x)])) diff --git a/racket/src/schemify/optimize.rkt b/racket/src/schemify/optimize.rkt index fbbf7abec4..037c6948b0 100644 --- a/racket/src/schemify/optimize.rkt +++ b/racket/src/schemify/optimize.rkt @@ -5,7 +5,8 @@ "known.rkt" "find-known.rkt" "mutated-state.rkt" - "literal.rkt") + "literal.rkt" + "fold.rkt") (provide optimize optimize*) @@ -14,7 +15,7 @@ ;; on each schemified form, which means that subexpressions of the ;; immediate expression have already been optimized. -(define (optimize v prim-knowns knowns imports mutated) +(define (optimize v prim-knowns primitives knowns imports mutated) (match v [`(if ,t ,e1 ,e2) (if (literal? t) @@ -45,6 +46,19 @@ '#t v)] [else v])] + [`(,rator . ,rands) + (define u-rator (unwrap rator)) + (define k (and (symbol? u-rator) (hash-ref prim-knowns u-rator #f))) + (cond + [(and k + (or (known-procedure/folding? k) + (known-procedure/pure/folding? k) + (known-procedure/has-unsafe/folding? k)) + (for/and ([rand (in-list rands)]) + (literal? rand)) + (try-fold-primitive u-rator k rands prim-knowns primitives)) + => (lambda (l) (car l))] + [else v])] [`,_ (define u (unwrap v)) (cond @@ -53,7 +67,7 @@ (cond [(and (known-literal? k) (simple-mutated-state? (hash-ref mutated u #f))) - (known-literal-expr k)] + (wrap-literal (known-literal-value k))] ;; Note: we can't do `known-copy?` here, because a copy of ;; an imported or exported name will need to be schemified ;; to a different name @@ -67,7 +81,7 @@ ;; function that can be inlined (where converting away ;; `variable-reference-from-unsafe?` is particularly important) -(define (optimize* v prim-knowns knowns imports mutated unsafe-mode?) +(define (optimize* v prim-knowns primitives knowns imports mutated unsafe-mode?) (define (optimize* v) (define new-v (reannotate @@ -98,7 +112,7 @@ [`(,rator ,exps ...) `(,(optimize* rator) ,@(optimize*-body exps))] [`,_ v]))) - (optimize new-v prim-knowns knowns imports mutated)) + (optimize new-v prim-knowns primitives knowns imports mutated)) (define (optimize*-body body) (for/list ([v (in-wrap-list body)]) diff --git a/racket/src/schemify/schemify-demo.rkt b/racket/src/schemify/schemify-demo.rkt index 21d18ca006..7c0a0914ff 100644 --- a/racket/src/schemify/schemify-demo.rkt +++ b/racket/src/schemify/schemify-demo.rkt @@ -7,19 +7,37 @@ "schemify.rkt" "known.rkt") -(define prim-knowns +(define-values (prim-knowns primitives) ;; Register primitives (let ([ns (make-base-namespace)]) (parameterize ([current-namespace ns]) (namespace-require 'racket/unsafe/ops) (namespace-require 'racket/flonum) (namespace-require 'racket/fixnum)) - (for/hasheq ([s (in-list (namespace-mapped-symbols ns))] - #:when (with-handlers ([exn:fail? (lambda (x) #f)]) - (procedure? (eval s ns)))) - (values s (known-procedure (procedure-arity-mask (eval s ns))))))) + (define primitives + (for/hasheq ([s (in-list (namespace-mapped-symbols ns))] + #:when (with-handlers ([exn:fail? (lambda (x) #f)]) + (procedure? (eval s ns)))) + (values s (eval s ns)))) + (values + (for/hasheq ([(s v) (in-hash primitives)]) + (define a (procedure-arity-mask v)) + (values s (case s + [(+ - * /) + (known-procedure/folding a)] + [(fx+ fxlshift) + (known-procedure/folding/limited a 'fixnum)] + [(expt arithmetic-shift) + (known-procedure/folding/limited a 'expt)] + [(unsafe-fx+) + (known-procedure/pure/folding-unsafe a 'fx+)] + [else + (known-procedure a)]))) + primitives))) (define (wrap p) + p + #; (cond [(and (pair? p) (eq? (car p) 'define-values)) @@ -42,7 +60,7 @@ (define-values (schemified importss exports import-keys imports-abis exports-info) (schemify-linklet `(linklet () - (x y [z ext-z]) + (x y [z ext-z] w) . ,(map wrap @@ -51,9 +69,15 @@ (define-values (y) (make-s (lambda () x) 5)) (define-values (x) (lambda () y)) (x) + (define-values (w) (case-lambda [() (+ 1 7)] [(a) x])) (letrec-values ([(loop) (lambda () (loop))]) (loop)) (let-values ([(a) 1] [(b) 2]) (list a b)) - (let-values ([(a b) (values 1 2)]) (list a b)) + (let-values ([(a b) (values 1 (+ 2 3))]) + (list a + b + (arithmetic-shift 3 1000) + (fx+ 4 5) (fx+ 4 (expt 2 40)) (fx* (fxlshift 1 20) (fxlshift 1 20)) + (unsafe-fx+ 4 5) (unsafe-fx+ 4 (expt 2 40)))) (define-values (done) (z))))) #; (call-with-input-file "regexp.rktl" read) @@ -66,6 +90,7 @@ #t ; allow-inline? #f ; no-prompt? prim-knowns + primitives #f #f)) diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index e3bb243978..acacfa64c7 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -20,7 +20,8 @@ "inline.rkt" "letrec.rkt" "infer-name.rkt" - "ptr-ref-set.rkt") + "ptr-ref-set.rkt" + "literal.rkt") (provide schemify-linklet schemify-body) @@ -74,7 +75,7 @@ ;; means that a variable (which boxes a value) is expected. (define (schemify-linklet lk serializable? datum-intern? for-jitify? allow-set!-undefined? unsafe-mode? enforce-constant? allow-inline? no-prompt? - prim-knowns get-import-knowns import-keys) + prim-knowns primitives get-import-knowns import-keys) (define (im-int-id id) (unwrap (if (pair? id) (cadr id) id))) (define (im-ext-id id) (unwrap (if (pair? id) (car id) id))) (define (ex-int-id id) (unwrap (if (pair? id) (car id) id))) @@ -131,7 +132,7 @@ (define src-syms (get-definition-source-syms bodys)) ;; Schemify the body, collecting information about defined names: (define-values (new-body defn-info mutated) - (schemify-body* bodys/constants-lifted prim-knowns imports exports + (schemify-body* bodys/constants-lifted prim-knowns primitives imports exports for-jitify? allow-set!-undefined? add-import! #f unsafe-mode? enforce-constant? allow-inline? no-prompt?)) (define all-grps (append grps (reverse new-grps))) @@ -181,14 +182,14 @@ ;; ---------------------------------------- -(define (schemify-body l prim-knowns imports exports for-cify? unsafe-mode? no-prompt?) +(define (schemify-body l prim-knowns primitives imports exports for-cify? unsafe-mode? no-prompt?) (define-values (new-body defn-info mutated) - (schemify-body* l prim-knowns imports exports + (schemify-body* l prim-knowns primitives imports exports #f #f (lambda (im ext-id index) #f) for-cify? unsafe-mode? #t #t no-prompt?)) new-body) -(define (schemify-body* l prim-knowns imports exports +(define (schemify-body* l prim-knowns primitives imports exports for-jitify? allow-set!-undefined? add-import! for-cify? unsafe-mode? enforce-constant? allow-inline? no-prompt?) ;; Keep simple checking efficient by caching results @@ -202,6 +203,7 @@ (for/fold ([knowns (hasheq)]) ([form (in-list l)]) (define-values (new-knowns info) (find-definitions form prim-knowns knowns imports mutated simples unsafe-mode? + #:primitives primitives #:optimize? #t)) new-knowns)) ;; For non-exported definitions, we may need to create some variables @@ -241,7 +243,7 @@ [else (define form (car l)) (define schemified (schemify form - prim-knowns knowns mutated imports exports simples + prim-knowns primitives knowns mutated imports exports simples allow-set!-undefined? add-import! for-cify? for-jitify? @@ -404,7 +406,7 @@ ;; Non-simple `mutated` state overrides bindings in `knowns`; a ;; a 'too-early state in `mutated` for a `letrec`-bound variable can be ;; effectively canceled with a mapping in `knowns`. -(define (schemify v prim-knowns knowns mutated imports exports simples allow-set!-undefined? add-import! +(define (schemify v prim-knowns primitives knowns mutated imports exports simples allow-set!-undefined? add-import! for-cify? for-jitify? unsafe-mode? allow-inline? no-prompt?) (let schemify/knowns ([knowns knowns] [inline-fuel init-inline-fuel] [v v]) (define (schemify v) @@ -772,7 +774,7 @@ ;; We'd normally leave this to `optimize`, but ;; need to handle it here before generating a ;; reference to the renamed identifier - (known-literal-expr k)] + (wrap-literal (known-literal-value k))] [(and (known-copy? k) (hash-ref prim-knowns (known-copy-id k) #f)) ;; Directly reference primitive @@ -796,7 +798,7 @@ ;; a mapping that says the variable is ready by now `(check-not-unsafe-undefined ,v ',(too-early-mutated-state-name state u-v))] [else v])]))]))) - (optimize s-v prim-knowns knowns imports mutated)) + (optimize s-v prim-knowns primitives knowns imports mutated)) (define (schemify-body l) (for/list ([e (in-list l)]) diff --git a/racket/src/schemify/simple.rkt b/racket/src/schemify/simple.rkt index 9426f8f255..8bb6dbef66 100644 --- a/racket/src/schemify/simple.rkt +++ b/racket/src/schemify/simple.rkt @@ -52,6 +52,9 @@ (cached (for/and ([e (in-list es)]) (simple? e)))] + [`(set! ,_ ,e) + #:guard (not pure?) + (simple? e)] [`(values ,es ...) #:guard (not pure?) (cached @@ -65,7 +68,7 @@ (hash-ref prim-knowns proc #f))]) (and (if pure? (known-procedure/pure? v) - (known-procedure/succeeds? v)) + (known-procedure/no-prompt? v)) (bitwise-bit-set? (known-procedure-arity-mask v) (length args)))) (simple-mutated-state? (hash-ref mutated proc #f)) (for/and ([arg (in-list args)])