Fix parameterization in pp.scm.

diff --git a/src/6001/make.scm b/src/6001/make.scm
index 8cd6fe0b2782d52a29e199abfabe1577ac7a8ae7..9ee440bc3ab47b1be0a436b7a80a5034b591b031 100644 (file)
--- a/src/6001/make.scm
+++ b/src/6001/make.scm
@@ -39,8 +39,8 @@ USA.
 ;;; Customize the runtime system:
 (set! repl:allow-restart-notifications? #f)
 (set! repl:write-result-hash-numbers? #f)
-(*pp-default-as-code?* #t)
-(*pp-named-lambda->define?* 'LAMBDA)
+(param:pp-default-as-code? #t)
+(param:pp-named-lambda->define? 'LAMBDA)
 (set! x-graphics:auto-raise? #t)
 (set! (access write-result:undefined-value-is-special?
              (->environment '(RUNTIME USER-INTERFACE)))

diff --git a/src/compiler/base/debug.scm b/src/compiler/base/debug.scm
index dbe10b2e12a7cd46e9a3c326fcba41735526694d..c4e490133db931aa4119b58b844d8ae078f75e7c 100644 (file)
--- a/src/compiler/base/debug.scm
+++ b/src/compiler/base/debug.scm
@@ -111,7 +111,7 @@ USA.
 
 (define (pp-instructions thunk)
   (fluid-let ((*show-instruction* pretty-print))
-    (parameterize* (list (cons *pp-primitives-by-name* #f)
+    (parameterize* (list (cons param:pp-primitives-by-name? #f)
                         (cons param:unparser-radix 16)
                         (cons param:unparse-uninterned-symbols-by-name? #t))
       thunk)))

diff --git a/src/compiler/machines/C/compiler.pkg b/src/compiler/machines/C/compiler.pkg
index 92c3906cbb7f3aed2fef9765d0910b742b0c3217..459baff999a85da6e90a66142a80ee1b3b1cb780 100644 (file)
--- a/src/compiler/machines/C/compiler.pkg
+++ b/src/compiler/machines/C/compiler.pkg
@@ -305,8 +305,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/compiler/machines/alpha/compiler.pkg b/src/compiler/machines/alpha/compiler.pkg
index 50314a077e9ba694ee040eb8133ba98645ece394..11313de50ee823d65a5ec33143a35258b9015dcc 100644 (file)
--- a/src/compiler/machines/alpha/compiler.pkg
+++ b/src/compiler/machines/alpha/compiler.pkg
@@ -262,8 +262,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/compiler/machines/bobcat/compiler.pkg b/src/compiler/machines/bobcat/compiler.pkg
index 5effd1c62960ff1627c2295145d8dcb80ea43fb0..624d7b887d5bbb044b5971295f9c8d9710df0b82 100644 (file)
--- a/src/compiler/machines/bobcat/compiler.pkg
+++ b/src/compiler/machines/bobcat/compiler.pkg
@@ -268,8 +268,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/compiler/machines/i386/compiler.pkg b/src/compiler/machines/i386/compiler.pkg
index 503ba51a6c1e9a5534415f86e669b7b53c2bf256..6e14f041401574d623346a90d0351262d71296ec 100644 (file)
--- a/src/compiler/machines/i386/compiler.pkg
+++ b/src/compiler/machines/i386/compiler.pkg
@@ -291,8 +291,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/compiler/machines/mips/compiler.pkg b/src/compiler/machines/mips/compiler.pkg
index ee0e0c62c703ee6957d16bda7a64f0d38395b43a..e1064d6a4d7ceb66214badbf842738fd880fda0d 100644 (file)
--- a/src/compiler/machines/mips/compiler.pkg
+++ b/src/compiler/machines/mips/compiler.pkg
@@ -268,8 +268,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/compiler/machines/spectrum/compiler.pkg b/src/compiler/machines/spectrum/compiler.pkg
index 7cc516c9665ad57aad2899fd6c1eaf160927b242..1cd820bcc8a98a4c12a07187d539035475e5dc24 100644 (file)
--- a/src/compiler/machines/spectrum/compiler.pkg
+++ b/src/compiler/machines/spectrum/compiler.pkg
@@ -272,8 +272,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/compiler/machines/svm/compiler.pkg b/src/compiler/machines/svm/compiler.pkg
index e04381a8557b39784cd6981a56e500ba4e751bbb..a8535c1d778c19dc4f67c53d95018f5b7359e2ec 100644 (file)
--- a/src/compiler/machines/svm/compiler.pkg
+++ b/src/compiler/machines/svm/compiler.pkg
@@ -299,8 +299,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/compiler/machines/vax/compiler.pkg b/src/compiler/machines/vax/compiler.pkg
index d591471465203c1856924e16a8f3325f34a322b9..6ca510f37e0ecf51109b3eb4f7cbcf4faa2ba9c5 100644 (file)
--- a/src/compiler/machines/vax/compiler.pkg
+++ b/src/compiler/machines/vax/compiler.pkg
@@ -263,8 +263,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/compiler/machines/x86-64/compiler.pkg b/src/compiler/machines/x86-64/compiler.pkg
index 24c1849f3e76c0b11503ffd1802aaece4f295bf8..9455f7f371ff332595fd1927cb6923fb6618e48e 100644 (file)
--- a/src/compiler/machines/x86-64/compiler.pkg
+++ b/src/compiler/machines/x86-64/compiler.pkg
@@ -291,8 +291,6 @@ USA.
          show-fg-node
          show-rtl
          write-rtl-instructions)
-  (import (runtime pretty-printer)
-         *pp-primitives-by-name*)
   (import (runtime unparser)
          param:unparse-uninterned-symbols-by-name?))
 

diff --git a/src/edwin/artdebug.scm b/src/edwin/artdebug.scm
index 32d7552e7161de0a959a35148b220ec3797baac9..be38f9f581fb0ad83757ed769b6d98064b8cfd75 100644 (file)
--- a/src/edwin/artdebug.scm
+++ b/src/edwin/artdebug.scm
@@ -681,7 +681,8 @@ Move to the last subproblem if the subproblem number is too high."
                        (if (or argument
                                (invalid-subexpression? sub))
                            (pp exp)
-                           (parameterize* (list (cons *pp-no-highlights?* #f))
+                           (parameterize* (list (cons param:pp-no-highlights?
+                                                      #f))
                              do-hairy)))
                       ((debugging-info/noise? exp)
                        (message ((debugging-info/noise exp) #t)))

diff --git a/src/edwin/debug.scm b/src/edwin/debug.scm
index a309884e1cca789f130537ab2085214cdbdd568a..e03527d0a3dbf6d82eff6f34a473802f9692caf1 100644 (file)
--- a/src/edwin/debug.scm
+++ b/src/edwin/debug.scm
@@ -46,10 +46,10 @@ USA.
   (highlight-region (make-region start end) (default-face)))
 
 (define (debugger-pp-highlight-subexpression expression subexpression
-                                            indentation port)
+                                            indentation port)
   (let ((start-mark #f)
-       (end-mark #f))
-    (parameterize* (list (cons *pp-no-highlights?* #f))
+       (end-mark #f))
+    (parameterize* (list (cons param:pp-no-highlights? #f))
       (lambda ()
        (debugger-pp
         (unsyntax-with-substitutions
@@ -70,7 +70,7 @@ USA.
         indentation
         port)))
     (if (and start-mark end-mark)
-       (highlight-region-excluding-indentation
+       (highlight-region-excluding-indentation
         (make-region start-mark end-mark)
         (highlight-face)))
     (if start-mark (mark-temporary! start-mark))
@@ -1586,7 +1586,7 @@ once it has been renamed, it will not be deleted automatically.")
            (else
             (let ((separator " = "))
               (write-string separator port)
-              (let ((indentation 
+              (let ((indentation
                      (+ (string-length name1)
                         (string-length separator))))
                 (write-string (string-tail

diff --git a/src/pcsample/pcsdisp.scm b/src/pcsample/pcsdisp.scm
index 9d33c59f7bc2b7db322dc44063aa2e4b9f2602ab..705f3f0842fb169d7b4eeffeba88559ea60fc533 100644 (file)
--- a/src/pcsample/pcsdisp.scm
+++ b/src/pcsample/pcsdisp.scm
@@ -142,7 +142,7 @@ USA.
 
 (define (display-sample-list sample-list) ; not integrated so can play w/ it
   ;; for now: just pp as code, but maybe opt for wizzy graphics later
-  (parameterize* (list (cons *pp-default-as-code?* #t)
+  (parameterize* (list (cons param:pp-default-as-code? #t)
     (lambda ()                           ;
       (pp sample-list))))
 

diff --git a/src/runtime/pp.scm b/src/runtime/pp.scm
index e39f320f5dd847b79e124427100a590453b05e23..1176019468674010ba994a59be33e0e6e1069f08 100644 (file)
--- a/src/runtime/pp.scm
+++ b/src/runtime/pp.scm
@@ -29,18 +29,37 @@ USA.
 
 (declare (usual-integrations))
 \f
+(define param:pp-arity-dispatched-procedure-style)
+(define param:pp-auto-highlighter)
+(define param:pp-avoid-circularity?)
+(define param:pp-default-as-code?)
+(define param:pp-forced-x-size)
+(define param:pp-lists-as-tables?)
+(define param:pp-named-lambda->define?)
+(define param:pp-no-highlights?)
+(define param:pp-primitives-by-name?)
+(define param:pp-save-vertical-space?)
+(define param:pp-uninterned-symbols-by-name?)
+
 (define (initialize-package!)
-  (set! *pp-named-lambda->define?* (make-parameter #f))
-  (set! *pp-primitives-by-name* (make-parameter #t))
-  (set! *pp-uninterned-symbols-by-name* (make-parameter #t))
-  (set! *pp-no-highlights?* (make-parameter #t))
-  (set! *pp-save-vertical-space?* (make-parameter #f))
-  (set! *pp-lists-as-tables?* (make-parameter #t))
-  (set! *pp-forced-x-size* (make-parameter #f))
-  (set! *pp-avoid-circularity?* (make-parameter #f))
-  (set! *pp-default-as-code?* (make-parameter #t))
-  (set! *pp-auto-highlighter* (make-parameter #f))
-  (set! *pp-arity-dispatched-procedure-style* (make-parameter 'FULL))
+  ;; Controls the appearance of procedures in the CASE statement used
+  ;; to describe an arity dispatched procedure:
+  ;;  FULL:  full bodies of procedures
+  ;;  NAMED: just name if the procedure is a named lambda, like FULL if unnamed
+  ;;  SHORT: procedures appear in #[...] unparser syntax
+  (set! param:pp-arity-dispatched-procedure-style
+       (make-settable-parameter 'FULL))
+  (set! param:pp-auto-highlighter (make-settable-parameter #f))
+  (set! param:pp-avoid-circularity? (make-settable-parameter #f))
+  (set! param:pp-default-as-code? (make-settable-parameter #t))
+  (set! param:pp-forced-x-size (make-settable-parameter #f))
+  (set! param:pp-lists-as-tables? (make-settable-parameter #t))
+  (set! param:pp-named-lambda->define? (make-settable-parameter #f))
+  (set! param:pp-no-highlights? (make-settable-parameter #t))
+  (set! param:pp-primitives-by-name? (make-settable-parameter #t))
+  (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! pp-description (make-generic-procedure 1 'PP-DESCRIPTION))
@@ -72,18 +91,74 @@ USA.
   (set! dispatch-default (make-parameter print-combination))
   (set! cocked-object (generate-uninterned-symbol))
   unspecific)
-
-(define *pp-named-lambda->define?*)
-(define *pp-primitives-by-name*)
-(define *pp-uninterned-symbols-by-name*)
-(define *pp-no-highlights?*)
-(define *pp-save-vertical-space?*)
-(define *pp-lists-as-tables?*)
-(define *pp-forced-x-size*)
-(define *pp-avoid-circularity?*)
-(define *pp-default-as-code?*)
-(define *pp-auto-highlighter*)
-
+\f
+(define *pp-arity-dispatched-procedure-style* #!default)
+(define *pp-auto-highlighter* #!default)
+(define *pp-avoid-circularity?* #!default)
+(define *pp-default-as-code?* #!default)
+(define *pp-forced-x-size* #!default)
+(define *pp-lists-as-tables?* #!default)
+(define *pp-named-lambda->define?* #!default)
+(define *pp-no-highlights?* #!default)
+(define *pp-primitives-by-name* #!default)
+(define *pp-save-vertical-space?* #!default)
+(define *pp-uninterned-symbols-by-name* #!default)
+
+(define (get-param:pp-arity-dispatched-procedure-style)
+  (if (default-object? *pp-arity-dispatched-procedure-style*)
+      (param:pp-arity-dispatched-procedure-style)
+      *pp-arity-dispatched-procedure-style*))
+
+(define (get-param:pp-named-lambda->define?)
+  (if (default-object? *pp-named-lambda->define?*)
+      (param:pp-named-lambda->define?)
+      *pp-named-lambda->define?*))
+
+(define (get-param:pp-primitives-by-name?)
+  (if (default-object? *pp-primitives-by-name*)
+      (param:pp-primitives-by-name?)
+      *pp-primitives-by-name*))
+
+(define (get-param:pp-uninterned-symbols-by-name?)
+  (if (default-object? *pp-uninterned-symbols-by-name*)
+      (param:pp-uninterned-symbols-by-name?)
+      *pp-uninterned-symbols-by-name*))
+
+(define (get-param:pp-no-highlights?)
+  (if (default-object? *pp-no-highlights?*)
+      (param:pp-no-highlights?)
+      *pp-no-highlights?*))
+
+(define (get-param:pp-save-vertical-space?)
+  (if (default-object? *pp-save-vertical-space?*)
+      (param:pp-save-vertical-space?)
+      *pp-save-vertical-space?*))
+
+(define (get-param:pp-lists-as-tables?)
+  (if (default-object? *pp-lists-as-tables?*)
+      (param:pp-lists-as-tables?)
+      *pp-lists-as-tables?*))
+
+(define (get-param:pp-forced-x-size)
+  (if (default-object? *pp-forced-x-size*)
+      (param:pp-forced-x-size)
+      *pp-forced-x-size*))
+
+(define (get-param:pp-avoid-circularity?)
+  (if (default-object? *pp-avoid-circularity?*)
+      (param:pp-avoid-circularity?)
+      *pp-avoid-circularity?*))
+
+(define (get-param:pp-default-as-code?)
+  (if (default-object? *pp-default-as-code?*)
+      (param:pp-default-as-code?)
+      *pp-default-as-code?*))
+
+(define (get-param:pp-auto-highlighter)
+  (if (default-object? *pp-auto-highlighter*)
+      (param:pp-auto-highlighter)
+      *pp-auto-highlighter*))
+\f
 (define (pp object #!optional port . rest)
   (let ((port (if (default-object? port) (current-output-port) port)))
     (let ((pretty-print
@@ -120,16 +195,9 @@ USA.
        (else
         #f)))
 \f
-;;; Controls the appearance of procedures in the CASE statement used
-;;; to describe an arity dispatched procedure:
-;;;  FULL:  full bodies of procedures
-;;;  NAMED: just name if the procedure is a named lambda, like FULL if unnamed
-;;;  SHORT: procedures appear in #[...] unparser syntax
-(define *pp-arity-dispatched-procedure-style*)
-
 (define (unsyntax-entity object)
   (define (unsyntax-entry procedure)
-    (case (*pp-arity-dispatched-procedure-style*)
+    (case (get-param:pp-arity-dispatched-procedure-style)
       ((FULL)  (unsyntax-entity procedure))
       ((NAMED)
        (let ((text (unsyntax-entity procedure)))
@@ -166,7 +234,7 @@ USA.
 (define (pretty-print object #!optional port as-code? indentation)
   (let ((as-code?
         (if (default-object? as-code?)
-            (let ((default (*pp-default-as-code?*)))
+            (let ((default (get-param:pp-default-as-code?)))
               (if (boolean? default)
                   default
                   (not (scode-constant? object))))
@@ -178,9 +246,9 @@ USA.
                    (if (and as-code?
                             (pair? sexp)
                             (eq? (car sexp) 'NAMED-LAMBDA)
-                            (*pp-named-lambda->define?*))
+                            (get-param:pp-named-lambda->define?))
                        (if (and (eq? 'LAMBDA
-                                     (*pp-named-lambda->define?*))
+                                     (get-param:pp-named-lambda->define?))
                                 (pair? (cdr sexp))
                                 (pair? (cadr sexp)))
                            `(LAMBDA ,(cdadr sexp) ,@(cddr sexp))
@@ -231,17 +299,18 @@ USA.
 
 (define (pp-top-level expression port as-code? indentation list-depth)
   (parameterize* (list (cons x-size
-                            (- (or (*pp-forced-x-size*)
-                                   (output-port/x-size port)) 1))
+                            (- (or (get-param:pp-forced-x-size)
+                                   (output-port/x-size port))
+                               1))
                       (cons output-port port)
                       (cons param:unparse-uninterned-symbols-by-name?
-                            (*pp-uninterned-symbols-by-name*))
+                            (get-param:pp-uninterned-symbols-by-name?))
                       (cons param:unparse-abbreviate-quotations?
                             (or as-code?
                                 (param:unparse-abbreviate-quotations?))))
     (lambda ()
       (let* ((numerical-walk
-             (if (*pp-avoid-circularity?*)
+             (if (get-param:pp-avoid-circularity?)
                  numerical-walk-avoid-circularities
                  numerical-walk))
             (node (numerical-walk expression list-depth)))
@@ -276,7 +345,7 @@ USA.
 (define (print-non-code-node node column depth)
   (parameterize* (list (cons dispatch-list '())
                       (cons dispatch-default
-                            (if (*pp-lists-as-tables?*)
+                            (if (get-param:pp-lists-as-tables?)
                                 print-data-table
                                 print-data-column)))
     (lambda ()
@@ -332,7 +401,7 @@ USA.
         (*unparse-string node))))
 
 (define (print-list-node node column depth)
-  (if (and (*pp-save-vertical-space?*)
+  (if (and (get-param:pp-save-vertical-space?)
           (fits-within? node column depth))
       (print-guaranteed-list-node node)
       (let* ((subnodes (node-subnodes node))
@@ -662,7 +731,7 @@ USA.
                       (walk-custom unparser object list-depth)
                       (walk-pair object list-depth))))))
          ((symbol? object)
-          (if (or (*pp-uninterned-symbols-by-name*)
+          (if (or (get-param:pp-uninterned-symbols-by-name?)
                   (interned-symbol? object))
               object
               (walk-custom unparse-object object list-depth)))
@@ -686,7 +755,7 @@ USA.
                                       (walk-pair (vector->list object)
                                                  list-depth))))))
          ((primitive-procedure? object)
-          (if (*pp-primitives-by-name*)
+          (if (get-param:pp-primitives-by-name?)
               (primitive-procedure-name object)
               (walk-custom unparse-object object list-depth)))
          (else
@@ -699,7 +768,7 @@ USA.
   ;; otherwise we would get infinite recursion when the `unwrapped'
   ;; object REST is re-auto-highlighted by the test below.
 
-  (cond ((let ((highlighter (*pp-auto-highlighter*)))
+  (cond ((let ((highlighter (get-param:pp-auto-highlighter)))
           (and highlighter
                (not (pretty-printer-highlight? object))
                (highlighter object)))
@@ -753,7 +822,7 @@ USA.
                                              list-depth)))))))))))))
 
 (define-integrable (no-highlights? object)
-  (or (*pp-no-highlights?*)
+  (or (get-param:pp-no-highlights?)
       (not (partially-highlighted? object))))
 
 (define (partially-highlighted? object)
@@ -828,7 +897,7 @@ USA.
                     (walk-pair-terminating object half-pointer/queue
                                            list-depth))))))
        ((symbol? object)
-        (if (or (*pp-uninterned-symbols-by-name*)
+        (if (or (get-param:pp-uninterned-symbols-by-name?)
                 (interned-symbol? object))
             object
             (walk-custom unparse-object object list-depth)))
@@ -851,7 +920,7 @@ USA.
                     (vector->list object)
                     half-pointer/queue list-depth))))))
        ((primitive-procedure? object)
-        (if (*pp-primitives-by-name*)
+        (if (get-param:pp-primitives-by-name?)
             (primitive-procedure-name object)
             (walk-custom unparse-object object list-depth)))
        (else

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 5a2c28574318fc6c5df42d82d703908ebb37c987..d729778b685bb1abb086390dcb80d58f646767e8 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3260,6 +3260,16 @@ USA.
          *pp-save-vertical-space?*
          *pp-uninterned-symbols-by-name*
          make-pretty-printer-highlight
+         param:pp-named-lambda->define?
+         param:pp-primitives-by-name?
+         param:pp-uninterned-symbols-by-name?
+         param:pp-no-highlights?
+         param:pp-save-vertical-space?
+         param:pp-lists-as-tables?
+         param:pp-forced-x-size
+         param:pp-avoid-circularity?
+         param:pp-default-as-code?
+         param:pp-auto-highlighter
          pp
          pp-description
          pretty-print)

diff --git a/src/runtime/stack-sample.scm b/src/runtime/stack-sample.scm
index b8a0e25daab27f2dc70ad15ab32ac4bf8186e63a..daa4f28c9c60684c0a8ac73474590e4fb8c5fbdf 100644 (file)
--- a/src/runtime/stack-sample.scm
+++ b/src/runtime/stack-sample.scm
@@ -401,7 +401,7 @@
                       (cons param:unparser-list-depth-limit 3)
                       (cons param:unparser-string-length-limit 40)
                       (cons param:unparse-primitives-by-name? #t)
-                      (cons *pp-save-vertical-space?* #t)
-                      (cons *pp-default-as-code?* #t))
+                      (cons param:pp-save-vertical-space? #t)
+                      (cons param:pp-default-as-code? #t))
     (lambda ()
       (pp expression output-port))))
\ No newline at end of file

diff --git a/src/sf/cgen.scm b/src/sf/cgen.scm
index f145c88378d84992000da6089a7b9a0f1dbc77cf..635a349fc7827b78153225bd58d11c1a9fcd4907 100644 (file)
--- a/src/sf/cgen.scm
+++ b/src/sf/cgen.scm
@@ -243,8 +243,8 @@ USA.
 \f
 ;;; Debugging utility
 (define (pp-expression form #!optional port)
-  (parameterize* (list (cons *pp-primitives-by-name* #f)
-                      (cons *pp-uninterned-symbols-by-name* #f)
+  (parameterize* (list (cons param:pp-primitives-by-name? #f)
+                      (cons param:pp-uninterned-symbols-by-name? #f)
                       (cons param:unparse-abbreviate-quotations? #t))
     (lambda ()
       (pp (cgen/external-with-declarations form) port))))
\ No newline at end of file