From a8f09e3f9eb44272e6de00e37bef3c464c19bf23 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 28 Feb 2016 21:12:57 -0800 Subject: [PATCH] Explicitly specify settability of all parameters. --- src/runtime/advice.scm | 9 +++++---- src/runtime/debug.scm | 4 ++-- src/runtime/dosdir.scm | 3 ++- src/runtime/dragon4.scm | 8 ++++---- src/runtime/error.scm | 8 ++++---- src/runtime/infutl.scm | 2 +- src/runtime/ntdir.scm | 3 ++- src/runtime/option.scm | 4 ++-- src/runtime/os2dir.scm | 3 ++- src/runtime/pathnm.scm | 2 +- src/runtime/pp.scm | 12 ++++++------ src/runtime/prgcop.scm | 4 ++-- src/runtime/savres.scm | 2 +- src/runtime/stack-sample.scm | 2 +- src/runtime/structure-parser.scm | 3 ++- src/runtime/swank.scm | 8 ++++---- src/runtime/syntax-output.scm | 2 +- src/runtime/thread.scm | 2 +- src/runtime/unsyn.scm | 2 +- src/runtime/unxdir.scm | 3 ++- src/runtime/usrint.scm | 2 +- 21 files changed, 47 insertions(+), 41 deletions(-) diff --git a/src/runtime/advice.scm b/src/runtime/advice.scm index 766c4ff10..6ddbd7942 100644 --- a/src/runtime/advice.scm +++ b/src/runtime/advice.scm @@ -35,10 +35,11 @@ USA. (define (initialize-package!) (set! entry-advice-population (make-population)) (set! exit-advice-population (make-population)) - (set! advice-continuation (make-parameter #f)) - (set! the-arguments (make-parameter #f)) - (set! the-procedure (make-parameter #f)) - (set! the-result (make-parameter #f))) + (set! advice-continuation (make-unsettable-parameter #f)) + (set! the-arguments (make-unsettable-parameter #f)) + (set! the-procedure (make-unsettable-parameter #f)) + (set! the-result (make-unsettable-parameter #f)) + unspecific) (define the-arguments) (define the-procedure) diff --git a/src/runtime/debug.scm b/src/runtime/debug.scm index c5c908235..be2961702 100644 --- a/src/runtime/debug.scm +++ b/src/runtime/debug.scm @@ -162,8 +162,8 @@ USA. (stack-frame/reductions (dstate/subproblem dstate))) (define (initialize-package!) - (set! *dstate* (make-parameter 'UNBOUND)) - (set! *port* (make-parameter 'UNBOUND)) + (set! *dstate* (make-unsettable-parameter 'UNBOUND)) + (set! *port* (make-unsettable-parameter 'UNBOUND)) (set! command-set (make-command-set diff --git a/src/runtime/dosdir.scm b/src/runtime/dosdir.scm index 94b3d6593..e5def82be 100644 --- a/src/runtime/dosdir.scm +++ b/src/runtime/dosdir.scm @@ -33,7 +33,8 @@ USA. (define *expand-directory-prefixes?*) (define (initialize-package!) - (set! *expand-directory-prefixes?* (make-parameter true))) + (set! *expand-directory-prefixes?* (make-unsettable-parameter #t)) + unspecific) (define (directory-read pattern #!optional sort?) (if (if (default-object? sort?) true sort?) diff --git a/src/runtime/dragon4.scm b/src/runtime/dragon4.scm index f98dbec8b..c99c7cc40 100644 --- a/src/runtime/dragon4.scm +++ b/src/runtime/dragon4.scm @@ -51,10 +51,10 @@ not much different to numbers within a few orders of magnitude of 1. (define (initialize-dragon4!) (set! param:flonum-unparser-cutoff - (make-parameter 'NORMAL - (lambda (cutoff) - (guarantee-cutoff-spec cutoff) - cutoff))) + (make-settable-parameter 'NORMAL + (lambda (cutoff) + (guarantee-cutoff-spec cutoff) + cutoff))) (set! expt-radix (let ((v (make-initialized-vector 310 (lambda (i) (expt 10 i))))) (lambda (base exponent) diff --git a/src/runtime/error.scm b/src/runtime/error.scm index b132d71da..f230122f4 100644 --- a/src/runtime/error.scm +++ b/src/runtime/error.scm @@ -778,10 +778,10 @@ USA. (memq condition-type:error (%condition-type/generalizations type))) (define (initialize-package!) - (set! param:bound-restarts (make-parameter '())) - (set! static-handler-frames (make-parameter '())) - (set! dynamic-handler-frames (make-parameter '())) - (set! break-on-signals-types (make-parameter '())) + (set! param:bound-restarts (make-unsettable-parameter '())) + (set! static-handler-frames (make-settable-parameter '())) + (set! dynamic-handler-frames (make-unsettable-parameter '())) + (set! break-on-signals-types (make-settable-parameter '())) (set! param:standard-error-hook (make-settable-parameter #f)) (set! param:standard-warning-hook (make-settable-parameter #f)) (set! hook/invoke-condition-handler default/invoke-condition-handler) diff --git a/src/runtime/infutl.scm b/src/runtime/infutl.scm index 48ad7a655..465a467cf 100644 --- a/src/runtime/infutl.scm +++ b/src/runtime/infutl.scm @@ -37,7 +37,7 @@ USA. (,lambda-tag:internal-lexpr . LAMBDA) (,lambda-tag:let . LET) (,lambda-tag:fluid-let . FLUID-LET))) - (set! directory-rewriting-rules (make-parameter '())) + (set! directory-rewriting-rules (make-settable-parameter '())) (set! wrappers-with-memoized-debugging-info (make-serial-population)) (add-secondary-gc-daemon! discard-debugging-info!)) diff --git a/src/runtime/ntdir.scm b/src/runtime/ntdir.scm index 4fc60ff49..02ca643e5 100644 --- a/src/runtime/ntdir.scm +++ b/src/runtime/ntdir.scm @@ -32,7 +32,8 @@ USA. (define *expand-directory-prefixes?*) (define (initialize-package!) - (set! *expand-directory-prefixes?* (make-parameter #t))) + (set! *expand-directory-prefixes?* (make-unsettable-parameter #t)) + unspecific) (define (directory-read pattern #!optional sort? full?) (let ((sort? (if (default-object? sort?) #t sort?)) diff --git a/src/runtime/option.scm b/src/runtime/option.scm index 9b2732440..5f08f7547 100644 --- a/src/runtime/option.scm +++ b/src/runtime/option.scm @@ -94,8 +94,8 @@ USA. (define *initial-options-file* #f) (define (initialize-package!) - (set! *options* (make-parameter '())) - (set! *parent* (make-parameter initial-load-options))) + (set! *options* (make-settable-parameter '())) + (set! *parent* (make-settable-parameter initial-load-options))) (define (dummy-option-loader) unspecific) diff --git a/src/runtime/os2dir.scm b/src/runtime/os2dir.scm index 10b04bc86..0a25c8056 100644 --- a/src/runtime/os2dir.scm +++ b/src/runtime/os2dir.scm @@ -32,7 +32,8 @@ USA. (define *expand-directory-prefixes?*) (define (initialize-package!) - (set! *expand-directory-prefixes?* (make-parameter #t))) + (set! *expand-directory-prefixes?* (make-unsettable-parameter #t)) + unspecific) (define (directory-read pattern #!optional sort?) (if (if (default-object? sort?) #t sort?) diff --git a/src/runtime/pathnm.scm b/src/runtime/pathnm.scm index f03504685..cc9a3131f 100644 --- a/src/runtime/pathnm.scm +++ b/src/runtime/pathnm.scm @@ -736,7 +736,7 @@ these rules: (set! param:default-pathname-defaults (make-param:default-pathname-defaults)) (param:default-pathname-defaults (make-pathname local-host #f #f #f #f #f)) (set! library-directory-path - (make-parameter + (make-unsettable-parameter (map pathname-as-directory (vector->list ((ucode-primitive microcode-library-path 0)))))) unspecific) diff --git a/src/runtime/pp.scm b/src/runtime/pp.scm index 117601946..25fcb0c90 100644 --- a/src/runtime/pp.scm +++ b/src/runtime/pp.scm @@ -60,8 +60,8 @@ USA. (set! param:pp-save-vertical-space? (make-settable-parameter #f)) (set! param:pp-uninterned-symbols-by-name? (make-settable-parameter #t)) - (set! x-size (make-parameter #f)) - (set! output-port (make-parameter #f)) + (set! x-size (make-unsettable-parameter #f)) + (set! output-port (make-unsettable-parameter #f)) (set! pp-description (make-generic-procedure 1 'PP-DESCRIPTION)) (set-generic-procedure-default-generator! pp-description (lambda (generic tags) @@ -73,7 +73,7 @@ USA. (set! print-let-expression (special-printer kernel/print-let-expression)) (set! print-case-expression (special-printer kernel/print-case-expression)) (set! code-dispatch-list - (make-parameter + (make-unsettable-parameter `((COND . ,forced-indentation) (CASE . ,print-case-expression) (IF . ,forced-indentation) @@ -87,8 +87,8 @@ USA. (DEFINE-INTEGRABLE . ,print-procedure) (LAMBDA . ,print-procedure) (NAMED-LAMBDA . ,print-procedure)))) - (set! dispatch-list (make-parameter (code-dispatch-list))) - (set! dispatch-default (make-parameter print-combination)) + (set! dispatch-list (make-unsettable-parameter (code-dispatch-list))) + (set! dispatch-default (make-unsettable-parameter print-combination)) (set! cocked-object (generate-uninterned-symbol)) unspecific) @@ -352,7 +352,7 @@ USA. (print-node node column depth)))) (define (print-code-node node column depth) - (parameterize* (list (cons dispatch-list code-dispatch-list) + (parameterize* (list (cons dispatch-list (code-dispatch-list)) (cons dispatch-default print-combination)) (lambda () (print-node node column depth)))) diff --git a/src/runtime/prgcop.scm b/src/runtime/prgcop.scm index d80984128..6ec6c70fd 100644 --- a/src/runtime/prgcop.scm +++ b/src/runtime/prgcop.scm @@ -33,8 +33,8 @@ USA. (object-new-type primitive-object-new-type 2)) (define (initialize-package!) - (set! *copy-constants?* (make-parameter 'UNBOUND)) - (set! *object-copies* (make-parameter 'UNBOUND)) + (set! *copy-constants?* (make-unsettable-parameter 'UNBOUND)) + (set! *object-copies* (make-unsettable-parameter 'UNBOUND)) (set! copier/scode-walker (make-scode-walker copy-constant diff --git a/src/runtime/savres.scm b/src/runtime/savres.scm index 0f9c13faa..bafc97e31 100644 --- a/src/runtime/savres.scm +++ b/src/runtime/savres.scm @@ -45,7 +45,7 @@ USA. (define *within-restore-window?*) (define (initialize-package!) - (set! *within-restore-window?* (make-parameter #f))) + (set! *within-restore-window?* (make-unsettable-parameter #f))) (define (disk-save filename #!optional id) (let ((filename (->namestring (merge-pathnames filename))) diff --git a/src/runtime/stack-sample.scm b/src/runtime/stack-sample.scm index daa4f28c9..68cf21987 100644 --- a/src/runtime/stack-sample.scm +++ b/src/runtime/stack-sample.scm @@ -84,7 +84,7 @@ (define event-return-address 'UNINITIALIZED) (define (initialize-package!) - (set! stack-sampling-return-address (make-parameter #f)) + (set! stack-sampling-return-address (make-unsettable-parameter #f)) (let ((blocked? (block-thread-events))) (signal-thread-event (current-thread) (lambda () diff --git a/src/runtime/structure-parser.scm b/src/runtime/structure-parser.scm index ba54f28fc..e2b0d1895 100644 --- a/src/runtime/structure-parser.scm +++ b/src/runtime/structure-parser.scm @@ -786,7 +786,8 @@ USA. (define name-counters) (define (initialize-package!) - (set! name-counters (make-parameter unspecific))) + (set! name-counters (make-unsettable-parameter unspecific)) + unspecific) ;;;; Optimizer diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm index 10ee4025e..24f7051be 100644 --- a/src/runtime/swank.scm +++ b/src/runtime/swank.scm @@ -316,10 +316,10 @@ USA. (define repl-port-type) (define (initialize-package!) - (set! *top-level-restart* (make-parameter unspecific)) - (set! *sldb-state* (make-parameter #f)) - (set! *index* (make-parameter unspecific)) - (set! *buffer-pstring* (make-parameter unspecific)) + (set! *top-level-restart* (make-unsettable-parameter unspecific)) + (set! *sldb-state* (make-unsettable-parameter #f)) + (set! *index* (make-unsettable-parameter unspecific)) + (set! *buffer-pstring* (make-unsettable-parameter unspecific)) (set! repl-port-type (make-port-type `((WRITE-CHAR diff --git a/src/runtime/syntax-output.scm b/src/runtime/syntax-output.scm index 7b9f879bf..e4a752909 100644 --- a/src/runtime/syntax-output.scm +++ b/src/runtime/syntax-output.scm @@ -404,7 +404,7 @@ USA. (define *rename-database*) (define (initialize-package!) - (set! *rename-database* (make-parameter 'UNBOUND))) + (set! *rename-database* (make-unsettable-parameter 'UNBOUND))) (define-structure (rename-database (constructor initial-rename-database ()) (conc-name rename-database/)) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index f86953c08..bd4eb666d 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -126,7 +126,7 @@ USA. (define (initialize-high!) ;; Called later in the cold load, when more of the runtime is initialized. - (set! root-continuation-default (make-parameter #f)) + (set! root-continuation-default (make-unsettable-parameter #f)) (initialize-error-conditions!) (reset-threads-high!) (record-start-times! first-running-thread) diff --git a/src/runtime/unsyn.scm b/src/runtime/unsyn.scm index 7c7e3aa3b..bffb670f2 100644 --- a/src/runtime/unsyn.scm +++ b/src/runtime/unsyn.scm @@ -30,7 +30,7 @@ USA. (declare (usual-integrations)) (define (initialize-package!) - (set! substitutions (make-parameter '())) + (set! substitutions (make-unsettable-parameter '())) (set! unsyntaxer/scode-walker (make-scode-walker unsyntax-constant `((ACCESS ,unsyntax-ACCESS-object) diff --git a/src/runtime/unxdir.scm b/src/runtime/unxdir.scm index 198b580d1..f7b59c0a6 100644 --- a/src/runtime/unxdir.scm +++ b/src/runtime/unxdir.scm @@ -32,7 +32,8 @@ USA. (define *expand-directory-prefixes?*) (define (initialize-package!) - (set! *expand-directory-prefixes?* (make-parameter true))) + (set! *expand-directory-prefixes?* (make-unsettable-parameter #t)) + unspecific) (define (directory-read pattern #!optional sort?) (if (if (default-object? sort?) true sort?) diff --git a/src/runtime/usrint.scm b/src/runtime/usrint.scm index 0dbae5f70..f37b505e2 100644 --- a/src/runtime/usrint.scm +++ b/src/runtime/usrint.scm @@ -499,7 +499,7 @@ USA. (define wrapped-notification-port-type) (define (initialize-package!) - (set! *notification-depth* (make-parameter 0)) + (set! *notification-depth* (make-unsettable-parameter 0)) (set! indentation-atom " ") (set! wrapped-notification-port-type (make-wrapped-notification-port-type)) unspecific) \ No newline at end of file -- 2.25.1