From 361c00fc77a3cd8621be47a37fca18265ae59310 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Fri, 18 Aug 2023 19:14:07 +0200
Subject: [PATCH 17/21] SRFI-119 (Wisp): improve let and let* formatting

* module/language/wisp.scm (wisp-read, wisp-scheme-read-chunk-lines):
  clean up let and let* arguments
---
 module/language/wisp.scm | 133 +++++++++++++++++++--------------------
 1 file changed, 64 insertions(+), 69 deletions(-)

diff --git a/module/language/wisp.scm b/module/language/wisp.scm
index 96429218d..3b14eba54 100644
--- a/module/language/wisp.scm
+++ b/module/language/wisp.scm
@@ -117,15 +117,15 @@
 (define (wisp-read port)
   "Wrap read to catch list prefixes: read one or several chars from PORT and return read symbols or replacement-symbols as representation for special forms."
   (let ((prefix-maxlen 4))
-    (let longpeek
-        ((peeked '())
-         (repr-symbol #f))
+    (let longpeek ((peeked '()) (repr-symbol #f))
       (cond
-       ((or (< prefix-maxlen (length peeked)) (eof-object? (peek-char port)) (equal? #\space (peek-char port)) (equal? #\newline (peek-char port)))
+       ((or (< prefix-maxlen (length peeked))
+            (eof-object? (peek-char port))
+            (equal? #\space (peek-char port))
+            (equal? #\newline (peek-char port)))
         (if repr-symbol ; found a special symbol, return it.
             repr-symbol
-            (let unpeek
-                ((remaining peeked))
+            (let unpeek ((remaining peeked))
               (cond
                ((equal? '() remaining)
                 (read port)); let read to the work
@@ -133,9 +133,8 @@
                 (unread-char (car remaining) port)
                 (unpeek (cdr remaining)))))))
        (else
-        (let*
-            ((next-char (read-char port))
-             (peeked (cons next-char peeked)))
+        (let* ((next-char (read-char port))
+               (peeked (cons next-char peeked)))
           (longpeek
            peeked
            (match-charlist-to-repr peeked))))))))
@@ -172,9 +171,8 @@
 
 (define (indent-level-reduction indentation-levels level select-fun)
   "Reduce the INDENTATION-LEVELS to the given LEVEL and return the value selected by SELECT-FUN"
-  (let loop
-      ((newlevels indentation-levels)
-       (diff 0))
+  (let loop ((newlevels indentation-levels)
+             (diff 0))
     (cond
      ((= level (car newlevels))
       (select-fun (list diff indentation-levels)))
@@ -230,7 +228,14 @@
             (set-source-property! line 'filename (port-filename port))
             (set-source-property! line 'line (port-line port))
             (append indent-and-symbols (list line))))
-         ((and in-indent? (zero? currentindent) (not in-comment?) (not (null? indent-and-symbols)) (not in-underscoreindent?) (not (or (equal? #\space next-char) (equal? #\newline next-char) (equal? (string-ref ";" 0) next-char))))
+         ((and in-indent?
+               (zero? currentindent)
+               (not in-comment?)
+               (not (null? indent-and-symbols))
+               (not in-underscoreindent?)
+               (not (or (equal? #\space next-char)
+                        (equal? #\newline next-char)
+                        (equal? (string-ref ";" 0) next-char))))
           (append indent-and-symbols)); top-level form ends chunk
          ((chunk-ends-with-period currentsymbols next-char)
           ;; the line ends with a period. This is forbidden in
@@ -259,9 +264,10 @@
            emptylines))
          ;; any char but whitespace *after* underscoreindent is
          ;; an error. This is stricter than the current wisp
-         ;; syntax definition. TODO: Fix the definition. Better
-         ;; start too strict. FIXME: breaks on lines with only
-         ;; underscores which should be empty lines.
+         ;; syntax definition.
+         ;; TODO: Fix the definition. Better start too strict.
+         ;; FIXME: breaks on lines with only underscores which should be
+         ;; empty lines.
          ((and in-underscoreindent? (and (not (equal? #\space next-char)) (not (equal? #\newline next-char))))
           (raise-exception (make-exception-from-throw 'wisp-syntax-error (list "initial underscores without following whitespace at beginning of the line after" (last indent-and-symbols)))))
          ((equal? #\newline next-char)
@@ -351,9 +357,8 @@
 (define (line-code-replace-inline-colons line)
   "Replace inline colons by opening parens which close at the end of the line"
   ;; format #t "replace inline colons for line ~A\n" line
-  (let loop
-      ((processed '())
-       (unprocessed line))
+  (let loop ((processed '())
+             (unprocessed line))
     (cond
      ((null? unprocessed)
       ;; format #t "inline-colons processed line: ~A\n" processed
@@ -417,9 +422,8 @@
 
 (define (wisp-propagate-source-properties code)
   "Propagate the source properties from the sourrounding list into every part of the code."
-  (let loop
-      ((processed '())
-       (unprocessed code))
+  (let loop ((processed '())
+             (unprocessed code))
     (cond
      ((and (null? processed) (not (pair? unprocessed)) (not (list? unprocessed)))
       unprocessed)
@@ -460,22 +464,20 @@
           (list
            (format #f "The first symbol in a chunk must start at zero indentation. Indentation and line: ~A"
                    (car lines)))))))
-  (let loop
-      ((processed '())
-       (unprocessed lines)
-       (indentation-levels '(0)))
-    (let*
-        ((current-line
-          (if (<= 1 (length unprocessed))
-              (car unprocessed)
-              (make-line 0))); empty code
-         (next-line
-          (if (<= 2 (length unprocessed))
-              (car (cdr unprocessed))
-              (make-line 0))); empty code
-         (current-indentation
-          (car indentation-levels))
-         (current-line-indentation (line-real-indent current-line)))
+  (let loop ((processed '())
+             (unprocessed lines)
+             (indentation-levels '(0)))
+    (let* ((current-line
+            (if (<= 1 (length unprocessed))
+                (car unprocessed)
+                (make-line 0))); empty code
+           (next-line
+            (if (<= 2 (length unprocessed))
+                (car (cdr unprocessed))
+                (make-line 0))); empty code
+           (current-indentation
+            (car indentation-levels))
+           (current-line-indentation (line-real-indent current-line)))
       ;; format #t "processed: ~A\ncurrent-line: ~A\nnext-line: ~A\nunprocessed: ~A\nindentation-levels: ~A\ncurrent-indentation: ~A\n\n"
       ;;     . processed current-line next-line unprocessed indentation-levels current-indentation
       (cond
@@ -528,9 +530,8 @@
                     current-line-indentation
                     (cdr indentation-levels)))))))
          ((= current-indentation current-line-indentation)
-          (let
-              ((line (line-finalize current-line))
-               (next-line-indentation (line-real-indent next-line)))
+          (let ((line (line-finalize current-line))
+                (next-line-indentation (line-real-indent next-line)))
             (cond
              ((>= current-line-indentation next-line-indentation)
               ;; simple recursiive step to the next line
@@ -571,9 +572,8 @@
 
 (define (wisp-scheme-replace-inline-colons lines)
   "Replace inline colons by opening parens which close at the end of the line"
-  (let loop
-      ((processed '())
-       (unprocessed lines))
+  (let loop ((processed '())
+             (unprocessed lines))
     (if (null? unprocessed)
         processed
         (loop
@@ -583,9 +583,8 @@
 
 (define (wisp-scheme-strip-indentation-markers lines)
   "Strip the indentation markers from the beginning of the lines"
-  (let loop
-      ((processed '())
-       (unprocessed lines))
+  (let loop ((processed '())
+             (unprocessed lines))
     (if (null? unprocessed)
         processed
         (loop
@@ -684,21 +683,20 @@ Match is awesome!"
     (wisp-add-source-properties-from/when-required code form))
   (wisp-add-source-properties-from/when-required
    code
-   (let
-       ((improper
-         (match code
-           ((a ... b 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd c)
-            (set! is-proper? #f)
-            (wisp-add-source-properties-from/when-required
-             code
-             (append (map wisp-make-improper (map add-prop/req a))
-                     (cons (wisp-make-improper (add-prop/req b))
-                           (wisp-make-improper (add-prop/req c))))))
-           ((a ...)
-            (add-prop/req
-             (map wisp-make-improper (map add-prop/req a))))
-           (a
-            a))))
+   (let ((improper
+          (match code
+            ((a ... b 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd c)
+             (set! is-proper? #f)
+             (wisp-add-source-properties-from/when-required
+              code
+              (append (map wisp-make-improper (map add-prop/req a))
+                      (cons (wisp-make-improper (add-prop/req b))
+                            (wisp-make-improper (add-prop/req c))))))
+            ((a ...)
+             (add-prop/req
+              (map wisp-make-improper (map add-prop/req a))))
+            (a
+             a))))
      (define (syntax-error li msg)
        (raise-exception
         (make-exception-from-throw
@@ -706,8 +704,7 @@ Match is awesome!"
          (list (format #f "incorrect dot-syntax #{.}# in code: ~A: ~A" msg li)))))
      (if is-proper?
          improper
-         (let check
-             ((tocheck improper))
+         (let check ((tocheck improper))
            (match tocheck
              ;; lists with only one member
              (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd)
@@ -725,9 +722,8 @@ Match is awesome!"
               (syntax-error tocheck "dot as last element in already improper pair"))
              ;; more complex pairs
              ((? pair? a)
-              (let
-                  ((head (drop-right a 1))
-                   (tail (last-pair a)))
+              (let ((head (drop-right a 1))
+                    (tail (last-pair a)))
                 (cond
                  ((equal? repr-dot (car tail))
                   (syntax-error tocheck "equal? repr-dot : car tail"))
@@ -754,8 +750,7 @@ Match is awesome!"
 
 (define (wisp-scheme-read-all port)
   "Read all chunks from the given port"
-  (let loop
-      ((tokens '()))
+  (let loop ((tokens '()))
     (cond
      ((eof-object? (peek-char port))
       tokens)
-- 
2.41.0