cs: add names for primitive parameters

racket/src/cs/rumble/error.ss

@@ -46,7 +46,8 @@
                                       (>= v 3))
                            :contract "(and/c exact-integer? (>=/c 3))"
                            v)
-                    v)))
+                    v)
+                  'error-print-width))
 
 (define/who error-value->string-handler
   (make-parameter (lambda (v len)
@@ -60,13 +61,15 @@
                       "[?error-value->string-handler not ready?]"]))
                   (lambda (v)
                     (check who (procedure-arity-includes/c 2) v)
-                    v)))
+                    v)
+                  'error-value->string-handler))
 
 (define/who error-print-context-length
   (make-parameter 16
                   (lambda (v)
                     (check who exact-nonnegative-integer? v)
-                    v)))
+                    v)
+                  'error-print-context-length))
 
 ;; ----------------------------------------
 
@@ -748,19 +751,22 @@
   (make-parameter default-uncaught-exception-handler
                   (lambda (v)
                     (check who (procedure-arity-includes/c 1) v)
-                    v)))
+                    v)
+                  'uncaught-exception-handler))
 
 (define/who error-display-handler
   (make-parameter default-error-display-handler
                   (lambda (v)
                     (check who (procedure-arity-includes/c 2) v)
-                    v)))
+                    v)
+                  'error-display-handler))
 
 (define/who error-escape-handler
   (make-parameter default-error-escape-handler
                   (lambda (v)
                     (check who (procedure-arity-includes/c 0) v)
-                    v)))
+                    v)
+                  'error-escape-handler))
 
 (define (set-no-locate-source!)
   ;; Disable searching through the filesystem to convert a source +

racket/src/cs/rumble/random.ss

@@ -241,7 +241,8 @@
   (make-parameter (make-pseudo-random-generator)
                   (lambda (v)
                     (check who pseudo-random-generator? v)
-                    v)))
+                    v)
+                  'current-pseudo-random-generator))
 
 (define/who random
   (case-lambda

racket/src/io/envvar/main.rkt

@@ -23,7 +23,8 @@
   (make-parameter (environment-variables #f)
                   (lambda (v)
                     (check who environment-variables? v)
-                    v)))
+                    v)
+                  'current-environment-variables))
 
 (define/who (make-environment-variables . args)
   (let loop ([args args] [ht #hash()])

racket/src/io/error/main.rkt

@@ -47,7 +47,7 @@
     (raise-argument-error who "(or/c symbol? string?)" init)]))
 
 (define error-print-source-location
-  (make-parameter #t (lambda (v) (and v #t))))
+  (make-parameter #t (lambda (v) (and v #t)) 'error-print-source-location))
 
 ;; Install the default error-value->string handler,
 ;; replacing the non-working primitive placeholder

racket/src/io/file/parameter.rkt

@@ -3,5 +3,5 @@
 (provide current-force-delete-permissions)
 
 (define current-force-delete-permissions
-  (make-parameter #t (lambda (v) (and v #t))))
+  (make-parameter #t (lambda (v) (and v #t)) 'current-force-delete-permissions))
 

racket/src/io/foreign/main.rkt

@@ -98,4 +98,5 @@
   (make-parameter default-load-extension
                   (lambda (p)
                     (check who (procedure-arity-includes/c 2) p)
-                    p)))
+                    p)
+                  'current-load-extension))

racket/src/io/locale/parameter.rkt

@@ -19,7 +19,8 @@
                   (lambda (v)
                     (unless (or (not v) (string? v))
                       (raise-argument-error 'current-locale "(or/c #f string?)" v))
-                    (and v (string->immutable-string v)))))
+                    (and v (string->immutable-string v)))
+                  'current-locale))
 
 (define-place-local installed-locale #f)
 

racket/src/io/logger/main.rkt

@@ -39,7 +39,8 @@
                   (lambda (l)
                     (unless (logger? l)
                       (raise-argument-error 'current-logger "logger?" l))
-                    l)))
+                    l)
+                  'current-logger))
 
 (define (logger-init!)
   (set! root-logger (make-root-logger))

racket/src/io/path/parameter.rkt

@@ -15,12 +15,14 @@
 		    [(unix) (path #"/" 'unix)]
 		    [(windows) (path #"C:\\" 'windows)])
                   (lambda (v)
-                    (check-directory-path who v))))
+                    (check-directory-path who v))
+                  'current-directory))
 
 (define/who current-directory-for-user
   (make-parameter (current-directory)
                   (lambda (v)
-                    (check-directory-path who v))))
+                    (check-directory-path who v))
+                  'current-directory-for-user))
 
 
 (define/who current-load-relative-directory
@@ -28,7 +30,8 @@
                   (lambda (v)
                     (check who path-string? #:or-false v)
                     (and v
-                         (path->complete-path v (current-directory))))))
+                         (path->complete-path v (current-directory))))
+                  'current-load-relative-directory))
 
 (define (check-directory-path who v)
   (check who path-string? v)

racket/src/io/port/parameter.rkt

@@ -48,7 +48,8 @@
                       (raise-argument-error 'current-input-port
                                             "input-port?"
                                             v))
-                    v)))
+                    v)
+                  'current-input-port))
 
 (define current-output-port
   (make-parameter orig-output-port
@@ -57,7 +58,8 @@
                       (raise-argument-error 'current-output-port
                                             "output-port?"
                                             v))
-                    v)))
+                    v)
+                  'current-output-port))
 
 (define current-error-port
   (make-parameter orig-error-port
@@ -66,7 +68,8 @@
                       (raise-argument-error 'current-error-port
                                             "output-port?"
                                             v))
-                    v)))
+                    v)
+                  'current-error-port))
 
 (define (init-current-ports! in-fd out-fd err-fd cust plumber)
   (set! orig-input-port (open-input-fd in-fd "stdin"

racket/src/io/print/parameter.rkt

@@ -9,7 +9,7 @@
 (define-syntax-rule (define-boolean-parameter print-x init-val)
   (begin
     (provide print-x)
-    (define print-x (make-parameter init-val (lambda (v) (and v #t))))))
+    (define print-x (make-parameter init-val (lambda (v) (and v #t)) 'print-x))))
 
 (define-boolean-parameter print-graph #f)
 (define-boolean-parameter print-struct #t)
@@ -46,7 +46,8 @@
                        (cond
                          [(string? v) (->path v)]
                          [(pair? v) (cons (->path (car v)) (->path (cdr v)))]
-                         [else v]))))
+                         [else v]))
+                  'current-write-relative-directory))
 
 (define print-syntax-width
   (make-parameter 32 (lambda (v)
@@ -56,6 +57,7 @@
                          (raise-argument-error 'print-syntax-width
                                                "(or/c +inf.0 0 (and/c exact-integer? (>/c 3)))"
                                                v))
-                       v)))
+                       v)
+                  'print-syntax-width))
 
 

racket/src/io/run/main.rkt

@@ -17,7 +17,8 @@
 (define/who executable-yield-handler
   (make-parameter void (lambda (p)
                          (check who (procedure-arity-includes/c 1) p)
-                         p)))
+                         p)
+                  'executable-yield-handler))
 
 (define/who current-command-line-arguments
   (make-parameter '#() (lambda (v)
@@ -26,7 +27,8 @@
                          (unless (and (vector? v)
                                       (andmap string? l))
                            (raise-argument-error who "(vectorof string?)" l))
-                         (list->vector (map string->immutable-string l)))))
+                         (list->vector (map string->immutable-string l)))
+                  'current-command-line-arguments))
 
 (define/who current-print
   (make-parameter (lambda (v)
@@ -35,7 +37,8 @@
                       (newline)))
                   (lambda (p)
                     (check who (procedure-arity-includes/c 1) p)
-                    p)))
+                    p)
+                  'current-print))
 
 (define/who current-read-interaction
   (make-parameter (lambda (src in)
@@ -44,7 +47,8 @@
                       (installed-read-syntax src in)))
                   (lambda (p)
                     (check who (procedure-arity-includes/c 2) p)
-                    p)))
+                    p)
+                  'current-read-interaction))
 
 (define/who current-prompt-read
   (make-parameter (lambda ()
@@ -53,13 +57,15 @@
                       ((current-read-interaction) (object-name in) in)))
                   (lambda (p)
                     (check who (procedure-arity-includes/c 0) p)
-                    p)))
+                    p)
+                  'current-prompt-read))
 
 (define/who current-get-interaction-input-port
   (make-parameter (lambda () (current-input-port))
                   (lambda (p)
                     (check who (procedure-arity-includes/c 0) p)
-                    p)))
+                    p)
+                  'current-get-interaction-input-port))
 
 ;; ----------------------------------------
 

racket/src/io/security/main.rkt

@@ -26,7 +26,8 @@
   (make-parameter root-security-guard
                   (lambda (v)
                     (check who security-guard? v)
-                    v)))
+                    v)
+                  'current-security-guard))
 
 (define/who (make-security-guard parent
                                  file-guard

racket/src/io/subprocess/main.rkt

@@ -255,10 +255,11 @@
   (make-parameter #f (lambda (v)
                        (unless (or (not v) (eq? v 'kill) (eq? v 'interrupt))
                          (raise-argument-error who "(or/c #f 'kill 'interrupt)" v))
-                       v)))
+                       v)
+                  'current-subprocess-custodian-mode))
 
 (define subprocess-group-enabled
-  (make-parameter #f (lambda (v) (and v #t))))
+  (make-parameter #f (lambda (v) (and v #t)) 'subprocess-group-enabled))
 
 ;; ----------------------------------------
 

racket/src/thread/custodian.rkt

@@ -74,7 +74,8 @@
   (make-parameter root-custodian
                   (lambda (v)
                     (check who custodian? v)
-                    v)))
+                    v)
+                  'current-custodian))
 
 ;; To initialize a new place:
 (define (set-root-custodian! c)

racket/src/thread/exit.rkt

@@ -14,7 +14,8 @@
                       (force-exit v)))
                   (lambda (p)
                     (check who (procedure-arity-includes/c 1) p)
-                    p)))
+                    p)
+                  'exit-handler))
 
 ;; In a non-main place, must be called only in the scheduler:
 (define (force-exit v)

racket/src/thread/plumber.rkt

@@ -23,7 +23,8 @@
   (make-parameter (make-plumber)
                   (lambda (v)
                     (check who plumber? v)
-                    v)))
+                    v)
+                  'current-plumber))
 
 (struct plumber-flush-handle (plumber))
 

racket/src/thread/stack-size.rkt

@@ -9,4 +9,5 @@
   (make-parameter 64
                   (lambda (v)
                     (check who exact-positive-integer? v)
-                    v)))
+                    v)
+                  'current-thread-initial-stack-size))

racket/src/thread/thread-group.rkt

@@ -44,7 +44,8 @@
   (make-parameter root-thread-group
                   (lambda (v)
                     (check who thread-group? v)
-                    v)))
+                    v)
+                  'current-thread-group))
 
 (define (make-another-initial-thread-group)
   (set! root-thread-group (make-root-thread-group)))