From 00f86ab32d07f3a4a2165f61c1ff3ddd7ff190a6 Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Fri, 13 Jan 1995 18:39:16 +0000 Subject: [PATCH] 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) --- v7/src/runtime/pp.scm | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) 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 -- 2.25.1