From 046beafb15037b52d33c8e32830ab53103005228 Mon Sep 17 00:00:00 2001
From: Timo Wilken
Date: Sat, 4 Nov 2023 21:34:47 +0100
Subject: Reduce nesting in `ppscm'

---
 tw/home/files/ppscm | 34 ++++++++++++++++------------------
 1 file changed, 16 insertions(+), 18 deletions(-)

(limited to 'tw')

diff --git a/tw/home/files/ppscm b/tw/home/files/ppscm
index 326ebbb6..26edb39f 100755
--- a/tw/home/files/ppscm
+++ b/tw/home/files/ppscm
@@ -4,23 +4,21 @@
              (ice-9 popen)
              (ice-9 pretty-print))
 
-(define (main input-file)
-  (call-with-input-file input-file
-    (lambda (iport)
-      (let ((highlighter (open-output-pipe "source-highlight -s scheme -f esc | $PAGER")))
-        (with-exception-handler
-            (lambda (exn)
-              (close-pipe highlighter)   ; make sure $PAGER doesn't mess up the terminal
-              (raise-exception exn))     ; re-raise exception
-          (lambda ()
-            (let loop ((thing (read iport)))
-              (cond
-               ((eof-object? thing)
-                (close-pipe highlighter))
-               (#t
-                (pretty-print thing highlighter)
-                (newline highlighter)
-                (loop (read iport)))))))))))
+(define (main input-port)
+  (define highlighter
+    (open-output-pipe "source-highlight -s scheme -f esc | $PAGER"))
+  (define (exn-handler exn)
+    (close-pipe highlighter)   ; make sure $PAGER doesn't mess up the terminal
+    (raise-exception exn))     ; re-raise exception
+  (define (pretty-printer)
+    (match (read input-port)
+      ((? eof-object? _)
+       (close-pipe highlighter))
+      (thing
+       (pretty-print thing highlighter)
+       (newline highlighter)   ; add empty line between top-level forms
+       (pretty-printer))))
+  (with-exception-handler exn-handler pretty-printer))
 
 (define (help-message program-name)
   (string-append "\
@@ -43,7 +41,7 @@ arguments:
    (display (help-message program-name)))
 
   ((_ input-file)
-   (main input-file))
+   (call-with-input-file input-file main))
 
   ((program-name . _)
    (display "error: invalid number of arguments\n\n"
-- 
cgit v1.2.3