From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Fri, 13 Jan 1995 18:39:16 +0000 (+0000)
Subject: Added pretty printer method for CASE which works like this:
X-Git-Tag: 20090517-FFI~6746
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=00f86ab32d07f3a4a2165f61c1ff3ddd7ff190a6;p=mit-scheme.git
Added pretty printer method for CASE which works like this:
(case will-fit-on-line
clause
clause)
or
(case
wont-fit-on-line
clause
clause)
---
diff --git a/v7/src/runtime/pp.scm b/v7/src/runtime/pp.scm
index 26c382674..7c75db7bb 100644
--- a/v7/src/runtime/pp.scm
+++ b/v7/src/runtime/pp.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: pp.scm,v 14.31 1994/12/02 16:38:29 adams Exp $
+$Id: pp.scm,v 14.32 1995/01/13 18:39:16 adams Exp $
Copyright (c) 1988-94 Massachusetts Institute of Technology
@@ -42,8 +42,10 @@ MIT in each case. |#
(set! pressured-indentation (special-printer kernel/pressured-indentation))
(set! print-procedure (special-printer kernel/print-procedure))
(set! print-let-expression (special-printer kernel/print-let-expression))
+ (set! print-case-expression (special-printer kernel/print-case-expression))
(set! code-dispatch-list
`((COND . ,forced-indentation)
+ (CASE . ,print-case-expression)
(IF . ,forced-indentation)
(OR . ,forced-indentation)
(AND . ,forced-indentation)
@@ -512,6 +514,23 @@ MIT in each case. |#
;; ordinary let
(print-node (car nodes) optimistic 0)
(print-body (cdr nodes))))))
+
+(define print-case-expression)
+(define (kernel/print-case-expression nodes optimistic pessimistic depth)
+ (define (print-cases nodes)
+ (if (not (null? nodes))
+ (begin
+ (tab-to pessimistic)
+ (print-column nodes pessimistic depth))))
+ (cond ((null? (cdr nodes))
+ (print-node (car nodes) optimistic depth))
+ ((fits-within? (car nodes) optimistic 0)
+ (print-guaranteed-node (car nodes))
+ (print-cases (cdr nodes)))
+ (else
+ (tab-to (+ pessimistic 2))
+ (print-node (car nodes) optimistic 0)
+ (print-cases (cdr nodes)))))
;;;; Alignment