Name more internally-defined parameters and std library parameters.
This commit is contained in:
parent
a5abfa9a0d
commit
5147771b04
|
@ -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
|
||||||
|
|
|
@ -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))]
|
||||||
|
|
|
@ -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!)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
|
@ -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:
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
;; --------------------------------------------------
|
;; --------------------------------------------------
|
||||||
|
|
||||||
|
|
|
@ -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)])
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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)]
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)])
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user