From 1595444335d764f0a107cec777c51e01ee788a93 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 25 Mar 1992 21:58:21 +0000
Subject: [PATCH] Add several new switches to control appearance of objects and
REPL.
---
v7/src/runtime/rep.scm | 9 +++++----
v7/src/runtime/runtime.pkg | 7 ++++++-
v7/src/runtime/unpars.scm | 26 ++++++++++++++++++--------
v8/src/runtime/runtime.pkg | 7 ++++++-
4 files changed, 35 insertions(+), 14 deletions(-)
diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm
index 5b3570ab3..e4906e66b 100644
--- a/v7/src/runtime/rep.scm
+++ b/v7/src/runtime/rep.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.25 1992/03/20 05:17:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.26 1992/03/25 21:57:48 cph Exp $
Copyright (c) 1988-92 Massachusetts Institute of Technology
@@ -37,8 +37,8 @@ MIT in each case. |#
(declare (usual-integrations))
-(define repl:allow-restart-notifications?
- true)
+(define repl:allow-restart-notifications? true)
+(define repl:write-result-hash-numbers? true)
(define (initialize-package!)
(set! *nearest-cmdl* false)
@@ -369,7 +369,8 @@ MIT in each case. |#
(define (default/repl-write repl object)
(port/write-result (cmdl/port repl)
object
- (and (object-pointer? object)
+ (and repl:write-result-hash-numbers?
+ (object-pointer? object)
(not (interned-symbol? object))
(not (number? object))
(object-hash object))))
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 5f2601339..e72a978bd 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.138 1992/03/20 05:17:56 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.139 1992/03/25 21:58:21 cph Exp $
Copyright (c) 1988-92 Massachusetts Institute of Technology
@@ -1727,6 +1727,7 @@ MIT in each case. |#
repl/start
repl/syntax-table
repl:allow-restart-notifications?
+ repl:write-result-hash-numbers?
repl?
restart
set-cmdl/state!
@@ -2266,6 +2267,10 @@ MIT in each case. |#
(files "unpars")
(parent ())
(export ()
+ *unparse-compound-procedure-names?*
+ *unparse-disambiguate-null-as-itself?*
+ *unparse-primitives-by-name?*
+ *unparse-uninterned-symbols-by-name?*
*unparse-with-maximum-readability?*
*unparser-list-breadth-limit*
*unparser-list-depth-limit*
diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm
index 6acc58f4f..2c937cd4e 100644
--- a/v7/src/runtime/unpars.scm
+++ b/v7/src/runtime/unpars.scm
@@ -1,8 +1,8 @@
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.25 1991/12/10 23:30:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.26 1992/03/25 21:58:07 cph Exp $
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-92 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
@@ -48,6 +48,8 @@ MIT in each case. |#
(set! *unparse-primitives-by-name?* false)
(set! *unparse-uninterned-symbols-by-name?* false)
(set! *unparse-with-maximum-readability?* false)
+ (set! *unparse-disambiguate-null-as-itself?* true)
+ (set! *unparse-compound-procedure-names?* true)
(set! system-global-unparser-table (make-system-global-unparser-table))
(set-current-unparser-table! system-global-unparser-table))
@@ -58,6 +60,8 @@ MIT in each case. |#
(define *unparse-primitives-by-name?*)
(define *unparse-uninterned-symbols-by-name?*)
(define *unparse-with-maximum-readability?*)
+(define *unparse-disambiguate-null-as-itself?*)
+(define *unparse-compound-procedure-names?*)
(define system-global-unparser-table)
(define *current-unparser-table*)
@@ -273,12 +277,17 @@ MIT in each case. |#
(SEQUENCE-3 . SEQUENCE)))
(define (unparse/null object)
- (cond ((eq? object '()) (*unparse-string "()"))
- ((eq? object #F) (*unparse-string "#F"))
- (else (unparse/default object))))
+ (if (eq? object '())
+ (if (and (eq? object #f)
+ (not *unparse-disambiguate-null-as-itself?*))
+ (*unparse-string "#f")
+ (*unparse-string "()"))
+ (if (eq? object #f)
+ (*unparse-string "#f")
+ (unparse/default object))))
(define (unparse/true object)
- (cond ((eq? object true) (*unparse-string "#T"))
+ (cond ((eq? object #t) (*unparse-string "#t"))
((undefined-value? object) (*unparse-string "#[undefined-value]"))
((eq? object lambda-optional-tag) (*unparse-string "#!optional"))
((eq? object lambda-rest-tag) (*unparse-string "#!rest"))
@@ -484,7 +493,8 @@ MIT in each case. |#
(lambda-components* (procedure-lambda procedure)
(lambda (name required optional rest body)
required optional rest body
- (and (not (eq? name lambda-tag:unnamed))
+ (and *unparse-compound-procedure-names?*
+ (not (eq? name lambda-tag:unnamed))
(lambda () (*unparse-object name)))))))
(define (unparse/primitive-procedure procedure)
@@ -520,7 +530,7 @@ MIT in each case. |#
(begin
(if name
(*unparse-char #\Space))
- (*unparse-object (pathname-name (->pathname filename)))
+ (*unparse-object (pathname-name filename))
(if block-number
(begin
(*unparse-char #\Space)
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index e3aed4834..ea7b2d52d 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.138 1992/03/20 05:17:56 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.139 1992/03/25 21:58:21 cph Exp $
Copyright (c) 1988-92 Massachusetts Institute of Technology
@@ -1727,6 +1727,7 @@ MIT in each case. |#
repl/start
repl/syntax-table
repl:allow-restart-notifications?
+ repl:write-result-hash-numbers?
repl?
restart
set-cmdl/state!
@@ -2266,6 +2267,10 @@ MIT in each case. |#
(files "unpars")
(parent ())
(export ()
+ *unparse-compound-procedure-names?*
+ *unparse-disambiguate-null-as-itself?*
+ *unparse-primitives-by-name?*
+ *unparse-uninterned-symbols-by-name?*
*unparse-with-maximum-readability?*
*unparser-list-breadth-limit*
*unparser-list-depth-limit*
--
2.25.1