From ec9c967d74b450ef274ed08fcf57c0fba6034eb8 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 21 Sep 1992 20:35:24 +0000
Subject: [PATCH] Add hack to eliminate (lambda #f ...).

---
 v7/src/6001/make.scm       |  5 +++--
 v7/src/runtime/runtime.pkg |  3 ++-
 v7/src/runtime/unpars.scm  | 23 +++++++++++++++++++----
 v8/src/runtime/runtime.pkg |  3 ++-
 4 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/v7/src/6001/make.scm b/v7/src/6001/make.scm
index cc2fb3f05..ed48e3edb 100644
--- a/v7/src/6001/make.scm
+++ b/v7/src/6001/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 15.19 1992/09/14 23:18:10 cph Exp $
+$Id: make.scm,v 15.20 1992/09/21 20:35:24 cph Exp $
 
 Copyright (c) 1991-92 Massachusetts Institute of Technology
 
@@ -39,12 +39,13 @@ MIT in each case. |#
 (package/system-loader "6001" '() 'QUERY)
 (load '("edextra" "floppy") (->environment '(edwin)))
 ((access initialize-package! (->environment '(student scode-rewriting))))
-(add-system! (make-system "6.001" 15 19 '()))
+(add-system! (make-system "6.001" 15 20 '()))
 
 ;;; Customize the runtime system:
 (set! repl:allow-restart-notifications? false)
 (set! repl:write-result-hash-numbers? false)
 (set! *unparse-disambiguate-null-as-itself?* false)
+(set! *unparse-disambiguate-null-lambda-list?* true)
 (set! *unparse-compound-procedure-names?* false)
 (set! *pp-default-as-code?* true)
 (set! *pp-named-lambda->define?* 'LAMBDA)
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 40dd7ca20..c4d11bcf3 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.160 1992/09/18 19:05:24 cph Exp $
+$Id: runtime.pkg,v 14.161 1992/09/21 20:34:43 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -2324,6 +2324,7 @@ MIT in each case. |#
   (export ()
 	  *unparse-compound-procedure-names?*
 	  *unparse-disambiguate-null-as-itself?*
+	  *unparse-disambiguate-null-lambda-list?*
 	  *unparse-primitives-by-name?*
 	  *unparse-uninterned-symbols-by-name?*
 	  *unparse-with-maximum-readability?*
diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm
index 11b113362..93cc9b6b1 100644
--- a/v7/src/runtime/unpars.scm
+++ b/v7/src/runtime/unpars.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.27 1992/07/21 04:26:40 cph Exp $
+$Id: unpars.scm,v 14.28 1992/09/21 20:33:45 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -49,6 +49,7 @@ MIT in each case. |#
   (set! *unparse-uninterned-symbols-by-name?* false)
   (set! *unparse-with-maximum-readability?* false)
   (set! *unparse-disambiguate-null-as-itself?* true)
+  (set! *unparse-disambiguate-null-lambda-list?* false)
   (set! *unparse-compound-procedure-names?* true)
   (set! system-global-unparser-table (make-system-global-unparser-table))
   (set-current-unparser-table! system-global-unparser-table))
@@ -61,6 +62,7 @@ MIT in each case. |#
 (define *unparse-uninterned-symbols-by-name?*)
 (define *unparse-with-maximum-readability?*)
 (define *unparse-disambiguate-null-as-itself?*)
+(define *unparse-disambiguate-null-lambda-list?*)
 (define *unparse-compound-procedure-names?*)
 (define system-global-unparser-table)
 (define *current-unparser-table*)
@@ -433,9 +435,22 @@ MIT in each case. |#
     (if prefix
 	(unparse-list/prefix-pair prefix pair)
 	(let ((method (unparse-list/unparser pair)))
-	  (if method
-	      (invoke-user-method method pair)
-	      (unparse-list pair))))))
+	  (cond (method
+		 (invoke-user-method method pair))
+		((and *unparse-disambiguate-null-lambda-list?*
+		      (eq? (car pair) 'LAMBDA)
+		      (pair? (cdr pair))
+		      (null? (cadr pair))
+		      (pair? (cddr pair)))
+		 (limit-unparse-depth
+		  (lambda ()
+		    (*unparse-char #\()
+		    (*unparse-object (car pair))
+		    (*unparse-string " ()")
+		    (unparse-tail (cddr pair) 3)
+		    (*unparse-char #\)))))
+		(else
+		 (unparse-list pair)))))))
 
 (define (unparse-list list)
   (limit-unparse-depth
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 40dd7ca20..c4d11bcf3 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.160 1992/09/18 19:05:24 cph Exp $
+$Id: runtime.pkg,v 14.161 1992/09/21 20:34:43 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -2324,6 +2324,7 @@ MIT in each case. |#
   (export ()
 	  *unparse-compound-procedure-names?*
 	  *unparse-disambiguate-null-as-itself?*
+	  *unparse-disambiguate-null-lambda-list?*
 	  *unparse-primitives-by-name?*
 	  *unparse-uninterned-symbols-by-name?*
 	  *unparse-with-maximum-readability?*
-- 
2.25.1