Name more internally-defined parameters and std library parameters.

This commit is contained in:
Sam Tobin-Hochstadt 2019-09-05 14:01:28 -04:00 committed by Sam Tobin-Hochstadt
parent a5abfa9a0d
commit 5147771b04
30 changed files with 85 additions and 55 deletions

View File

@ -29,7 +29,7 @@
;; current version only works until 2099 CE Gregorian ;; current version only works until 2099 CE Gregorian
(define date-display-format (define date-display-format
(make-parameter 'american)) (make-parameter 'american #f 'date-display-format))
(define (month/number->string x) (define (month/number->string x)
(case x (case x

View File

@ -45,7 +45,9 @@
(define current-yielder (define current-yielder
(make-parameter (make-parameter
(lambda (v) (lambda (v)
(error 'yield "must be called in the context of a generator")))) (error 'yield "must be called in the context of a generator"))
#f
'current-yielder))
(define yield (define yield
(case-lambda [() ((current-yielder))] (case-lambda [() ((current-yielder))]

View File

@ -12,10 +12,10 @@
(provide compile*) (provide compile*)
;; should we reorder stuff? ;; should we reorder stuff?
(define can-reorder? (make-parameter #t)) (define can-reorder? (make-parameter #t #f 'can-reorder?))
;; for non-linear patterns ;; for non-linear patterns
(define vars-seen (make-parameter null)) (define vars-seen (make-parameter null #f 'vars-seen))
(define (hash-on f elems #:equal? [eql #t]) (define (hash-on f elems #:equal? [eql #t])
(define-values (ht h-ref h-set!) (define-values (ht h-ref h-set!)

View File

@ -10,7 +10,7 @@
match-expander-transform trans-match trans-match* parse-struct match-expander-transform trans-match trans-match* parse-struct
dd-parse parse-quote parse-id in-splicing?) dd-parse parse-quote parse-id in-splicing?)
(define in-splicing? (make-parameter #f)) (define in-splicing? (make-parameter #f #f 'in-splicing?))
;; parse x as a match variable ;; parse x as a match variable
;; x : identifier ;; x : identifier

View File

@ -188,7 +188,7 @@
(foldr (λ (pat vars) (append (bound-vars (parse-id pat)) vars)) '() pats) (foldr (λ (pat vars) (append (bound-vars (parse-id pat)) vars)) '() pats)
bound-identifier=?)) bound-identifier=?))
(define current-renaming (make-parameter (make-free-identifier-mapping))) (define current-renaming (make-parameter (make-free-identifier-mapping) #f 'current-renaming))
(define (copy-mapping ht) (define (copy-mapping ht)
(define new-ht (make-free-identifier-mapping)) (define new-ht (make-free-identifier-mapping))

View File

@ -14,7 +14,7 @@
(define match-prompt-tag (make-continuation-prompt-tag 'match)) (define match-prompt-tag (make-continuation-prompt-tag 'match))
(define match-equality-test (make-parameter equal?)) (define match-equality-test (make-parameter equal? #f 'match-equality-test))
(define-struct (exn:misc:match exn:fail) (value srclocs) (define-struct (exn:misc:match exn:fail) (value srclocs)
#:property prop:exn:srclocs (lambda (ex) (exn:misc:match-srclocs ex)) #:property prop:exn:srclocs (lambda (ex) (exn:misc:match-srclocs ex))

View File

@ -2,7 +2,7 @@
(provide (all-defined-out)) (provide (all-defined-out))
(define match-...-nesting (make-parameter 0)) (define match-...-nesting (make-parameter 0 #f 'match-...-nesting))
(struct acc-prop (n acc)) (struct acc-prop (n acc))

View File

@ -99,7 +99,9 @@
s)) s))
(define deserialize-module-guard (make-parameter (lambda (mod-path sym) (define deserialize-module-guard (make-parameter (lambda (mod-path sym)
(void)))) (void))
#f
'deserialize-module-guard))
(define varref (#%variable-reference varref)) (define varref (#%variable-reference varref))
(define (collapse/resolve-module-path-index mpi deser-path->relative-path) (define (collapse/resolve-module-path-index mpi deser-path->relative-path)

View File

@ -7,7 +7,7 @@
(define bind-at #f) (define bind-at #f)
(define error-syntax (make-parameter #f)) (define error-syntax (make-parameter #f #f 'error-syntax))
(define raise-stx-err (define raise-stx-err
(case-lambda (case-lambda
((msg) (raise-syntax-error #f msg (error-syntax))) ((msg) (raise-syntax-error #f msg (error-syntax)))

View File

@ -83,7 +83,8 @@
(raise-argument-error 'current-require-module-path (raise-argument-error 'current-require-module-path
"(or/c module-path-index? #f)" "(or/c module-path-index? #f)"
v)) v))
v))) v)
'current-require-module-path))
;; a simplified version of `collapse-module-path-index', where ;; a simplified version of `collapse-module-path-index', where
;; we don't have to normalize: ;; we don't have to normalize:

View File

@ -60,7 +60,7 @@
;; == Disappeared uses == ;; == Disappeared uses ==
(define current-recorded-disappeared-uses (make-parameter #f)) (define current-recorded-disappeared-uses (make-parameter #f #f 'current-recorded-disappeared-uses))
(define-syntax-rule (with-disappeared-uses body-expr ... stx-expr) (define-syntax-rule (with-disappeared-uses body-expr ... stx-expr)
(let-values ([(stx disappeared-uses) (let-values ([(stx disappeared-uses)
@ -164,7 +164,8 @@
(raise-argument-error 'current-syntax-context (raise-argument-error 'current-syntax-context
"(or/c syntax? #f)" "(or/c syntax? #f)"
new-value)) new-value))
new-value))) new-value)
'current-syntax-context))
(define (wrong-syntax stx #:extra [extras null] format-string . args) (define (wrong-syntax stx #:extra [extras null] format-string . args)
(unless (or (eq? stx #f) (syntax? stx)) (unless (or (eq? stx #f) (syntax? stx))

View File

@ -13,8 +13,8 @@
(define max-dash-space-depth 10) (define max-dash-space-depth 10)
(define number-nesting-depth 6) (define number-nesting-depth 6)
(define current-prefix-out (make-parameter "<")) (define current-prefix-out (make-parameter "<" #f 'current-prefix-out))
(define current-prefix-in (make-parameter ">")) (define current-prefix-in (make-parameter ">" #f 'current-prefix-in))
(define (as-spaces s) (define (as-spaces s)
(make-string (string-length s) #\space)) (make-string (string-length s) #\space))
@ -70,7 +70,8 @@
(raise-argument-error 'current-trace-notify (raise-argument-error 'current-trace-notify
"(any/c . -> . any)" "(any/c . -> . any)"
p)) p))
p))) p)
'current-trace-notify))
(define (as-trace-notify thunk) (define (as-trace-notify thunk)
(let ([p (open-output-bytes)]) (let ([p (open-output-bytes)])
@ -130,7 +131,9 @@
[else [else
;; In non-expression mode, just use `write': ;; In non-expression mode, just use `write':
(pretty-write (append (cons name args) (pretty-write (append (cons name args)
(apply append (map list kws kw-vals))))])))))) (apply append (map list kws kw-vals))))]))))
#f
'current-trace-print-args))
(define -:trace-print-results (define -:trace-print-results
(lambda (name results level) (lambda (name results level)

View File

@ -1105,13 +1105,13 @@
(include "linklet/cross-compile.ss") (include "linklet/cross-compile.ss")
(define compile-enforce-module-constants (define compile-enforce-module-constants
(make-parameter #t (lambda (v) (and v #t)))) (make-parameter #t (lambda (v) (and v #t)) 'compile-enforce-module-constants))
(define compile-context-preservation-enabled (define compile-context-preservation-enabled
(make-parameter #f (lambda (v) (and v #t)))) (make-parameter #f (lambda (v) (and v #t)) 'compile-context-preservation-enabled))
(define compile-allow-set!-undefined (define compile-allow-set!-undefined
(make-parameter #f (lambda (v) (and v #t)))) (make-parameter #f (lambda (v) (and v #t)) 'compile-allow-set!-undefined))
(define current-compile-target-machine (define current-compile-target-machine
(make-parameter (machine-type) (lambda (v) (make-parameter (machine-type) (lambda (v)
@ -1121,7 +1121,8 @@
(raise-argument-error 'current-compile-target-machine (raise-argument-error 'current-compile-target-machine
"(or/c #f (and/c symbol? compile-target-machine?))" "(or/c #f (and/c symbol? compile-target-machine?))"
v)) v))
v))) v)
'current-compile-target-machine))
(define (compile-target-machine? v) (define (compile-target-machine? v)
(unless (symbol? v) (unless (symbol? v)
@ -1131,10 +1132,10 @@
#t))) #t)))
(define eval-jit-enabled (define eval-jit-enabled
(make-parameter #t (lambda (v) (and v #t)))) (make-parameter #t (lambda (v) (and v #t)) 'eval-jit-enabled))
(define load-on-demand-enabled (define load-on-demand-enabled
(make-parameter #t (lambda (v) (and v #t)))) (make-parameter #t (lambda (v) (and v #t)) 'load-on-demand-enabled))
;; -------------------------------------------------- ;; --------------------------------------------------

View File

@ -15,7 +15,8 @@
(raise-argument-error 'read-on-demand-source (raise-argument-error 'read-on-demand-source
"(or/c #f #t (and/c path? complete-path?))" "(or/c #f #t (and/c path? complete-path?))"
v)) v))
v))) v)
'read-on-demand-source))
(define (adjust-linklet-bundle-laziness-and-paths ht) (define (adjust-linklet-bundle-laziness-and-paths ht)
(let loop ([i (hash-iterate-first ht)]) (let loop ([i (hash-iterate-first ht)])

View File

@ -463,7 +463,8 @@
(raise-argument-error 'current-module-name-resolver (raise-argument-error 'current-module-name-resolver
"(and/c (procedure-arity-includes/c 2) (procedure-arity-includes/c 4))" "(and/c (procedure-arity-includes/c 2) (procedure-arity-includes/c 4))"
v)) v))
v))) v)
'current-module-name-resolver))
;; ---------------------------------------- ;; ----------------------------------------
@ -475,7 +476,8 @@
(raise-argument-error 'current-module-declare-name (raise-argument-error 'current-module-declare-name
"(or/c #f resolved-module-path?)" "(or/c #f resolved-module-path?)"
r)) r))
r))) r)
'current-module-declare-name))
(define current-module-declare-source (define current-module-declare-source
(make-parameter #f (make-parameter #f
@ -486,7 +488,8 @@
(raise-argument-error 'current-module-declare-source (raise-argument-error 'current-module-declare-source
"(or/c #f symbol? (and/c path? complete-path?))" "(or/c #f symbol? (and/c path? complete-path?))"
s)) s))
s))) s)
'current-module-declare-source))
(define (substitute-module-declare-name default-name) (define (substitute-module-declare-name default-name)
(define current-name (current-module-declare-name)) (define current-name (current-module-declare-name))

View File

@ -33,7 +33,7 @@
;; Modules that are defined via `embedded-load` can be "predefined", ;; Modules that are defined via `embedded-load` can be "predefined",
;; because they can be defined in every place as the embedded load ;; because they can be defined in every place as the embedded load
;; is replayed in each place ;; is replayed in each place
(define current-module-declare-as-predefined (make-parameter #f)) (define current-module-declare-as-predefined (make-parameter #f #f 'current-module-declare-as-predefined))
(define (eval-module c (define (eval-module c
#:namespace [ns (current-namespace)] #:namespace [ns (current-namespace)]

View File

@ -24,25 +24,29 @@
(make-parameter (replace-me who) (make-parameter (replace-me who)
(lambda (p) (lambda (p)
(check who (procedure-arity-includes/c 1) p) (check who (procedure-arity-includes/c 1) p)
p))) p)
'current-eval))
(define/who current-compile (define/who current-compile
(make-parameter (replace-me who) (make-parameter (replace-me who)
(lambda (p) (lambda (p)
(check who (procedure-arity-includes/c 2) p) (check who (procedure-arity-includes/c 2) p)
p))) p)
'current-compile))
(define/who current-load (define/who current-load
(make-parameter (replace-me who) (make-parameter (replace-me who)
(lambda (p) (lambda (p)
(check who (procedure-arity-includes/c 2) p) (check who (procedure-arity-includes/c 2) p)
p))) p)
'current-load))
(define/who current-load/use-compiled (define/who current-load/use-compiled
(make-parameter (replace-me who) (make-parameter (replace-me who)
(lambda (p) (lambda (p)
(check who (procedure-arity-includes/c 2) p) (check who (procedure-arity-includes/c 2) p)
p))) p)
'current-load/use-compiled))
(define/who current-library-collection-paths (define/who current-library-collection-paths
(make-parameter null (make-parameter null
@ -52,7 +56,8 @@
(andmap complete-path-string? l))) (andmap complete-path-string? l)))
#:contract "(listof (and/c path-string? complete-path?))" #:contract "(listof (and/c path-string? complete-path?))"
l) l)
(map to-path l)))) (map to-path l))
'current-library-collection-paths))
(define/who current-library-collection-links (define/who current-library-collection-links
(make-parameter null (make-parameter null
@ -84,7 +89,8 @@
[else [else
(for/hash ([(k v) (in-hash p)]) (for/hash ([(k v) (in-hash p)])
(values k (to-path v)))])) (values k (to-path v)))]))
l)))) l))
'current-library-collection-links))
(define/who use-compiled-file-paths (define/who use-compiled-file-paths
(make-parameter (list (string->path "compiled")) (make-parameter (list (string->path "compiled"))
@ -94,7 +100,8 @@
(andmap relative-path-string? l))) (andmap relative-path-string? l)))
#:contract "(listof (and/c path-string? relative-path?))" #:contract "(listof (and/c path-string? relative-path?))"
l) l)
(map to-path l)))) (map to-path l))
'use-compiled-file-paths))
(define/who current-compiled-file-roots (define/who current-compiled-file-roots
(make-parameter '(same) (make-parameter '(same)
@ -107,7 +114,8 @@
l))) l)))
#:contract "(listof (or/c path-string? 'same))" #:contract "(listof (or/c path-string? 'same))"
l) l)
(map to-path l)))) (map to-path l))
'current-compiled-file-roots))
(define/who use-compiled-file-check (define/who use-compiled-file-check
(make-parameter 'modify-seconds (make-parameter 'modify-seconds
@ -115,13 +123,14 @@
(check who (lambda (v) (or (eq? v 'modify-seconds) (eq? v 'exists))) (check who (lambda (v) (or (eq? v 'modify-seconds) (eq? v 'exists)))
#:contract "(or/c 'modify-seconds 'exists)" #:contract "(or/c 'modify-seconds 'exists)"
v) v)
v))) v)
'use-compiled-file-check))
(define use-collection-link-paths (define use-collection-link-paths
(make-parameter #t (lambda (v) (and v #t)))) (make-parameter #t (lambda (v) (and v #t)) 'use-collection-link-paths))
(define use-user-specific-search-paths (define use-user-specific-search-paths
(make-parameter #t (lambda (v) (and v #t)))) (make-parameter #t (lambda (v) (and v #t)) 'use-user-specific-search-paths))
(define (complete-path-string? p) (define (complete-path-string? p)
(and (path-string? p) (complete-path? p))) (and (path-string? p) (complete-path? p)))

View File

@ -159,7 +159,8 @@
(raise-argument-error 'current-expand-observe (raise-argument-error 'current-expand-observe
"(or/c (procedure-arity-includes/c 2) #f)" "(or/c (procedure-arity-includes/c 2) #f)"
v)) v))
v))) v)
'current-expand-observe))
;; ---------------------------------------- ;; ----------------------------------------

View File

@ -47,7 +47,8 @@
" (and/c syntax? (lambda (stx) (module-path? (syntax->datum stx))))" " (and/c syntax? (lambda (stx) (module-path? (syntax->datum stx))))"
" #f)") " #f)")
v)) v))
v))) v)
'current-module-path-for-load))
(define (maybe-raise-missing-module name filename pre rel post errstr) (define (maybe-raise-missing-module name filename pre rel post errstr)
(define path (current-module-path-for-load)) (define path (current-module-path-for-load))

View File

@ -130,7 +130,8 @@
(raise-argument-error 'current-namespace (raise-argument-error 'current-namespace
"namespace?" "namespace?"
v)) v))
v))) v)
'current-namespace))
(define (namespace-get-root-expand-ctx ns) (define (namespace-get-root-expand-ctx ns)
(force (unbox (namespace-root-expand-ctx ns)))) (force (unbox (namespace-root-expand-ctx ns))))

View File

@ -11,12 +11,13 @@
(raise-argument-error 'current-reader-guard (raise-argument-error 'current-reader-guard
"(procedure-arity-includes/c 1)" "(procedure-arity-includes/c 1)"
v)) v))
v))) v)
'current-reader-guard))
(define-syntax-rule (define-boolean-parameter id val) (define-syntax-rule (define-boolean-parameter id val)
(begin (begin
(provide id) (provide id)
(define id (make-parameter val (lambda (v) (and v #t)))))) (define id (make-parameter val (lambda (v) (and v #t)) 'id))))
;; (define-boolean-parameter read-case-sensitive #t) - shared with printer ;; (define-boolean-parameter read-case-sensitive #t) - shared with printer
(define-boolean-parameter read-square-bracket-as-paren #t) (define-boolean-parameter read-square-bracket-as-paren #t)

View File

@ -10,4 +10,5 @@
(define/who current-readtable (make-parameter #f (define/who current-readtable (make-parameter #f
(lambda (v) (lambda (v)
(check who prop:readtable? #:or-false v) (check who prop:readtable? #:or-false v)
v))) v)
'current-readtable))

View File

@ -24,7 +24,7 @@
dependencies) ; list of key dependencies) ; list of key
#:prefab) #:prefab)
(define current-cache-layer (make-parameter #f)) (define current-cache-layer (make-parameter #f #f 'current-cache-layer))
;; A cache later collects immediate dependencies ;; A cache later collects immediate dependencies
;; for a module as it is compiled ;; for a module as it is compiled

View File

@ -310,7 +310,7 @@
(define orig-eval (current-eval)) (define orig-eval (current-eval))
(define orig-compile (current-compile)) (define orig-compile (current-compile))
(define linklet-compile-to-s-expr (make-parameter #f)) (define linklet-compile-to-s-expr (make-parameter #f #f 'linklet-compile-to-s-expr))
;; Compile to a serializable form ;; Compile to a serializable form
(define (compile-linklet c [name #f] [import-keys #f] [get-import (lambda (key) (values #f #f))] [options '(serializable)]) (define (compile-linklet c [name #f] [import-keys #f] [get-import (lambda (key) (values #f #f))] [options '(serializable)])

View File

@ -54,7 +54,7 @@
(if (tamper-armed? t) 'armed t)) (if (tamper-armed? t) 'armed t))
;; Set during deserialize to select a code inspector: ;; Set during deserialize to select a code inspector:
(define current-arm-inspectors (make-parameter (seteq))) (define current-arm-inspectors (make-parameter (seteq) #f 'current-arm-inspectors))
(define (deserialize-tamper t) (define (deserialize-tamper t)
(if (eq? t 'armed) (current-arm-inspectors) t)) (if (eq? t 'armed) (current-arm-inspectors) t))

View File

@ -49,13 +49,13 @@
(thread (lambda () (sync nack) ((control-state-evt-abandon cse)))) (thread (lambda () (sync nack) ((control-state-evt-abandon cse))))
(control-state-evt-evt cse))))) (control-state-evt-evt cse)))))
(define current-async-semaphore (make-parameter #f)) (define current-async-semaphore (make-parameter #f #f 'current-async-semaphore))
(define (async-evt) (define (async-evt)
(or (current-async-semaphore) (or (current-async-semaphore)
(error 'async-evt "not in a `poller` callback"))) (error 'async-evt "not in a `poller` callback")))
(define current-kill-callbacks (make-parameter '())) (define current-kill-callbacks (make-parameter '() #f 'current-kill-callbacks))
(define (thread-push-kill-callback! p) (define (thread-push-kill-callback! p)
(current-kill-callbacks (cons p (current-kill-callbacks)))) (current-kill-callbacks (cons p (current-kill-callbacks))))

View File

@ -24,7 +24,7 @@
port-count-byte-all!) port-count-byte-all!)
(define port-count-lines-enabled (define port-count-lines-enabled
(make-parameter #f (lambda (v) (and v #t)))) (make-parameter #f (lambda (v) (and v #t)) 'port-count-lines-enabled))
(define (finish-port/count p) (define (finish-port/count p)
(when (port-count-lines-enabled) (when (port-count-lines-enabled)

View File

@ -142,7 +142,8 @@
p) p)
(if (procedure-arity-includes? p 3) (if (procedure-arity-includes? p 3)
p p
(lambda (v o [quote-depth 0]) (p v o)))))) (lambda (v o [quote-depth 0]) (p v o))))
'global-port-print-handler))
(void (install-do-global-print! global-port-print-handler (void (install-do-global-print! global-port-print-handler
default-global-port-print-handler)) default-global-port-print-handler))

View File

@ -151,7 +151,7 @@
[(v) (unsafe-place-local-set! l v)])) [(v) (unsafe-place-local-set! l v)]))
(define initial-place-local-table (make-hasheq)) (define initial-place-local-table (make-hasheq))
(define place-local-table (make-parameter initial-place-local-table)) (define place-local-table (make-parameter initial-place-local-table #f 'place-local-table))
(define (unsafe-make-place-local v) (define (unsafe-make-place-local v)
(define key (vector v 'place-locale)) (define key (vector v 'place-locale))

View File

@ -672,7 +672,8 @@
(make-parameter (make-pseudo-random-generator) (make-parameter (make-pseudo-random-generator)
(lambda (v) (lambda (v)
(check who pseudo-random-generator? v) (check who pseudo-random-generator? v)
v))) v)
'current-evt-pseudo-random-generator))
;; rotates the order of syncers in `s` to implement fair selection: ;; rotates the order of syncers in `s` to implement fair selection:
(define (random-rotate-syncing! s) (define (random-rotate-syncing! s)