Re: [PATCH] add SRFI-119 / language/wisp to Guile? (new patch, squashed)

["Dr. Arne Babenhauserheide" <arne_bab@web.de>]

[-- Attachment #1.1: Type: text/plain, Size: 283 bytes --]


"Dr. Arne Babenhauserheide" <arne_bab@web.de> writes:
> I’m attaching the new squashed patch again here and will add the patches
> for the review changes to a second email.

Attached are the promised patches of the additional review changes.

Thank you for your review!


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0012-SRFI-119-Wisp-Fix-capitalize-Wisp.patch --]
[-- Type: text/x-patch, Size: 1013 bytes --]

From 3d9b452137911e1948586657edb1ea614d8a70c0 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Tue, 15 Aug 2023 00:43:53 +0200
Subject: [PATCH 12/21] SRFI-119 (Wisp): Fix: capitalize Wisp

* doc/ref/srfi-modules.texi (srfi-119): capitalize Wisp
---
 doc/ref/srfi-modules.texi | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 5b82f8070..0ffc01252 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -5686,7 +5686,7 @@ define : factorial n           @result{}  (define (factorial n)
        * n : factorial @{n - 1@} @result{}    (* n (factorial @{n - 1@}))))
 @end example
 
-To execute a file with wisp code, select the language and filename
+To execute a file with Wisp code, select the language and filename
 extension @code{.w} vie @code{guile --language=wisp -x .w}.
 
 In files using Wisp, @xref{SRFI-105} (Curly Infix) is always activated.
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0013-SRFI-119-Wisp-Fix-capitalize-Scheme.patch --]
[-- Type: text/x-patch, Size: 841 bytes --]

From d8585c6380cbdba2ad0f6c56aaf6637826cd5b93 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Tue, 15 Aug 2023 00:46:53 +0200
Subject: [PATCH 13/21] SRFI-119 (Wisp): Fix: capitalize Scheme

* modules/language/wisp.scm (comments): capitalize Scheme
---
 module/language/wisp.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/language/wisp.scm b/module/language/wisp.scm
index b4e885eec..f3127c9d3 100644
--- a/module/language/wisp.scm
+++ b/module/language/wisp.scm
@@ -21,7 +21,7 @@
 ;;; Commentary:
 
 ;; Scheme-only implementation of a wisp-preprocessor which output a
-;; scheme code tree to feed to a scheme interpreter instead of a
+;; Scheme code tree to feed to a Scheme interpreter instead of a
 ;; preprocessed file.
 
 ;; Limitations:
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.4: 0014-SRFI-119-Wisp-Fix-capitalize-Wisp.patch --]
[-- Type: text/x-patch, Size: 1028 bytes --]

From 44344fa738cb51b034bb03791a6e1ee828390a42 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Tue, 15 Aug 2023 00:56:07 +0200
Subject: [PATCH 14/21] SRFI-119 (Wisp): Fix: capitalize Wisp

* modules/language/wisp/spec.scm (define-language): capitalize Wisp
---
 module/language/wisp/spec.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm
index 1efd3e8b2..5f8feca9a 100644
--- a/module/language/wisp/spec.scm
+++ b/module/language/wisp/spec.scm
@@ -57,7 +57,7 @@
   #:compilers `((tree-il . ,compile-tree-il))
   #:decompilers `((tree-il . ,decompile-tree-il))
   #:evaluator (lambda (x module) (primitive-eval x))
-  #:printer write ; TODO: backtransform to wisp? Use source-properties?
+  #:printer write ; TODO: backtransform to Wisp? Use source-properties?
   #:make-default-environment
   (lambda ()
     ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.5: 0015-SRFI-119-Wisp-cleanup-char-list-cond.patch --]
[-- Type: text/x-patch, Size: 2104 bytes --]

From 16967e979262f7f3d86e194295a1a3f5a7f68cd0 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Fri, 18 Aug 2023 19:06:23 +0200
Subject: [PATCH 15/21] SRFI-119 (Wisp): cleanup char-list cond

* module/language/wisp.scm (match-charlist-to-repr): use helper and re-indent
---
 module/language/wisp.scm | 38 +++++++++++++++-----------------------
 1 file changed, 15 insertions(+), 23 deletions(-)

diff --git a/module/language/wisp.scm b/module/language/wisp.scm
index f3127c9d3..3ac128df2 100644
--- a/module/language/wisp.scm
+++ b/module/language/wisp.scm
@@ -97,30 +97,22 @@
 ;; TODO: wrap the reader to return the repr of the syntax reader
 ;; additions
 
-(define (match-charlist-to-repr charlist)
-  (let
-      ((chlist (reverse charlist)))
+(define (equal-rest? chars . args)
+  (equal? chars args))
+
+(define (match-charlist-to-repr char-list)
+  (let ((chars (reverse char-list)))
     (cond
-     ((equal? chlist (list #\.))
-      repr-dot)
-     ((equal? chlist (list #\'))
-      repr-quote)
-     ((equal? chlist (list #\,))
-      repr-unquote)
-     ((equal? chlist (list #\`))
-      repr-quasiquote)
-     ((equal? chlist (list #\, #\@))
-      repr-unquote-splicing)
-     ((equal? chlist (list #\# #\'))
-      repr-syntax)
-     ((equal? chlist (list #\# #\,))
-      repr-unsyntax)
-     ((equal? chlist (list #\# #\`))
-      repr-quasisyntax)
-     ((equal? chlist (list #\# #\, #\@))
-      repr-unsyntax-splicing)
-     (else
-      #f))))
+     ((equal-rest? chars #\.) repr-dot)
+     ((equal-rest? chars #\') repr-quote)
+     ((equal-rest? chars #\,) repr-unquote)
+     ((equal-rest? chars #\`) repr-quasiquote)
+     ((equal-rest? chars #\, #\@) repr-unquote-splicing)
+     ((equal-rest? chars #\# #\') repr-syntax)
+     ((equal-rest? chars #\# #\,) repr-unsyntax)
+     ((equal-rest? chars #\# #\`) repr-quasisyntax)
+     ((equal-rest? chars #\# #\, #\@) repr-unsyntax-splicing)
+     (else #f))))
 
 (define (wisp-read port)
   "wrap read to catch list prefixes."
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.6: 0016-SRFI-119-Wisp-improve-docstring.patch --]
[-- Type: text/x-patch, Size: 891 bytes --]

From a74e63f65e6f02c9aeff76bf1d6a93043fa95c45 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Fri, 18 Aug 2023 19:10:07 +0200
Subject: [PATCH 16/21] SRFI-119 (Wisp): improve docstring

* module/language/wisp.scm (wisp-read): improve docstring
---
 module/language/wisp.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/language/wisp.scm b/module/language/wisp.scm
index 3ac128df2..96429218d 100644
--- a/module/language/wisp.scm
+++ b/module/language/wisp.scm
@@ -115,7 +115,7 @@
      (else #f))))
 
 (define (wisp-read port)
-  "wrap read to catch list prefixes."
+  "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 '())
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.7: 0017-SRFI-119-Wisp-improve-let-and-let-formatting.patch --]
[-- Type: text/x-patch, Size: 10900 bytes --]

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.8: 0018-SRFI-119-Wisp-Fix-comment-syntax-and-trailing-whites.patch --]
[-- Type: text/x-patch, Size: 1185 bytes --]

From 0ca2a934c96d657c996d8b2f0241cc7e38ae2a0e Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Fri, 18 Aug 2023 19:15:20 +0200
Subject: [PATCH 18/21] SRFI-119 (Wisp): Fix comment syntax and trailing
 whitespace

* module/language/wisp/spec.scm (define-language): comment with ;;,
  strip trailing lines
---
 module/language/wisp/spec.scm | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm
index 5f8feca9a..f7fd794e0 100644
--- a/module/language/wisp/spec.scm
+++ b/module/language/wisp/spec.scm
@@ -52,7 +52,7 @@
 
 (define-language wisp
   #:title "Wisp Scheme Syntax. See SRFI-119 for details"
-  ; . #:reader read-one-wisp-sexp
+  ;; . #:reader read-one-wisp-sexp
   #:reader read-one-wisp-sexp ; : lambda (port env) : let ((x (read-one-wisp-sexp port env))) (display x)(newline) x ;
   #:compilers `((tree-il . ,compile-tree-il))
   #:decompilers `((tree-il . ,decompile-tree-il))
@@ -68,6 +68,3 @@
       ;; limited to the current compilation unit.
       (module-define! m 'current-reader (make-fluid))
       m)))
-
-
-
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.9: 0019-SRFI-119-Wisp-reindent-test.patch --]
[-- Type: text/x-patch, Size: 1206 bytes --]

From 7de03c8ce421e809afb95823037d655aa9a47fd2 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Fri, 18 Aug 2023 19:17:25 +0200
Subject: [PATCH 19/21] SRFI-119 (Wisp): reindent test

* test-suite/tests/srfi-119.test (with-read-options, wisp->list): M-x indent-region
---
 test-suite/tests/srfi-119.test | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test
index f4a19a0a7..6fe87f2b2 100644
--- a/test-suite/tests/srfi-119.test
+++ b/test-suite/tests/srfi-119.test
@@ -27,14 +27,14 @@
 (define (with-read-options opts thunk)
   (let ((saved-options (read-options)))
     (dynamic-wind
-        (lambda ()
-          (read-options opts))
-        thunk
-        (lambda ()
-          (read-options saved-options)))))
+      (lambda ()
+        (read-options opts))
+      thunk
+      (lambda ()
+        (read-options saved-options)))))
 
 (define (wisp->list str)
-        (wisp-scheme-read-string str))
+  (wisp-scheme-read-string str))
 
 (with-test-prefix "wisp-read-simple"
   (pass-if (equal? (wisp->list "<= n 5")    '((<= n 5))))
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.10: 0020-SRFI-119-Wisp-use-pass-if-equal-instead-of-pass-if-e.patch --]
[-- Type: text/x-patch, Size: 2557 bytes --]

From 8cd856e060840277b1a8b30892d6ef4f55fe5c7a Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Fri, 18 Aug 2023 19:19:40 +0200
Subject: [PATCH 20/21] SRFI-119 (Wisp): use pass-if-equal instead of pass-if
 (equal? ...)

* test-suite/tests/srfi-119.test (wisp-read-simple, wisp-read-complex):
  use pass-if-equal and invert conditions to improve error messages
---
 test-suite/tests/srfi-119.test | 54 ++++++++++++++++++----------------
 1 file changed, 29 insertions(+), 25 deletions(-)

diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test
index 6fe87f2b2..64ccc2ff6 100644
--- a/test-suite/tests/srfi-119.test
+++ b/test-suite/tests/srfi-119.test
@@ -37,11 +37,21 @@
   (wisp-scheme-read-string str))
 
 (with-test-prefix "wisp-read-simple"
-  (pass-if (equal? (wisp->list "<= n 5")    '((<= n 5))))
-  (pass-if (equal? (wisp->list ". 5") '(5)))
-  (pass-if (equal? (wisp->list "+ 1 : * 2 3") '((+ 1 (* 2 3))))))
+  (pass-if-equal '((<= n 5))
+      (wisp->list "<= n 5"))
+  (pass-if-equal '(5)
+    (wisp->list ". 5"))
+  (pass-if-equal '((+ 1 (* 2 3)))
+      (wisp->list "+ 1 : * 2 3")))
 (with-test-prefix "wisp-read-complex"
-  (pass-if (equal? (wisp->list "
+  (pass-if-equal '(
+     (a b c d e
+        f g h
+        i j k)
+
+     (concat "I want "
+             (getwish from me)
+             " - " username)) (wisp->list "
 a b c d e
   . f g h
   . i j k
@@ -49,16 +59,20 @@ a b c d e
 concat \"I want \"
     getwish from me
     . \" - \" username
-") '(
-(a b c d e
-  f g h
-  i j k)
+"))
+
+  (pass-if-equal
+      '(
+        (define (a b c)
+          (d e
+             (f)
+             (g h)
+             i))
 
-(concat "I want "
-    (getwish from me)
-    " - " username))))
+        (define (_)
+          (display "hello\n"))
 
-  (pass-if (equal? (wisp->list "
+        (_)) (wisp->list "
 define : a b c
 _ d e
 ___ f
@@ -68,21 +82,11 @@ __  . i
 define : _
 _  display \"hello\n\"
 
-\\_") '(
-(define (a b c)
-  (d e
-    (f)
-    (g h)
-    i))
-
-(define (_)
-   (display "hello\n"))
-
-(_))))
+\\_"))
 
   ;; nesting with pairs
-  (pass-if (equal? (wisp->list "1 . 2\n3 4\n   5 . 6")
-                   '((1 . 2)(3 4 (5 . 6))))))
+  (pass-if-equal '((1 . 2)(3 4 (5 . 6)))
+      (wisp->list "1 . 2\n3 4\n   5 . 6")))
 
 (with-test-prefix "wisp-source-properties"
   (pass-if (not (find null? (map source-properties (wisp->list "1 . 2\n3 4\n   5 . 6")))))
-- 
2.41.0


[-- Attachment #1.11: 0021-SRFI-119-Wisp-add-tests-for-equality-of-source-prope.patch --]
[-- Type: text/x-patch, Size: 6683 bytes --]

From e120fc39aca45d55ede90b4200b7b9e39bc83e1e Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Fri, 18 Aug 2023 19:25:59 +0200
Subject: [PATCH 21/21] SRFI-119 (Wisp): add tests for equality of
 source-properties and fix them

* test-suite/tests/srfi-119.test (scheme->list): new procedure
* test-suite/tests/srfi-119.test (wisp-source-properties): use
  pass-if (every pair? ...) for the existance test. Use scheme->list to
  compare source-properties from regular Scheme read and wisp read.

* module/language/wisp.scm (line-code): replace custom logic with
  wisp-add-source-properties-from/when-required

* module/language/wisp.scm (wisp-scheme-read-chunk-lines): set the
  line-number from the start of the chunk as source-property instead of
  the line number from the end of the chunk.
---
 module/language/wisp.scm       | 57 ++++++++++++++++++----------------
 test-suite/tests/srfi-119.test | 19 ++++++++++--
 2 files changed, 48 insertions(+), 28 deletions(-)

diff --git a/module/language/wisp.scm b/module/language/wisp.scm
index 3b14eba54..dae9642ae 100644
--- a/module/language/wisp.scm
+++ b/module/language/wisp.scm
@@ -45,6 +45,24 @@
   (read-enable 'curly-infix))
 
 
+;; Helpers to preserver source properties
+
+(define (wisp-add-source-properties-from source target)
+  "Copy the source properties from source into the target and return the target."
+  (catch #t
+    (lambda ()
+      (set-source-properties! target (source-properties source)))
+    (lambda (key . arguments)
+      #f))
+  target)
+
+(define (wisp-add-source-properties-from/when-required source target)
+  "Copy the source properties if target has none."
+  (if (null? (source-properties target))
+      (wisp-add-source-properties-from source target)
+      target))
+
+
 ;; Helper functions for the indent-and-symbols data structure: '((indent token token ...) ...)
 (define make-line list)
 
@@ -63,7 +81,7 @@
   (let ((code (cdr line)))
     ;; propagate source properties
     (when (not (null? code))
-      (set-source-properties! code (source-properties line)))
+      (wisp-add-source-properties-from/when-required line code))
     code))
 
 ;; literal values I need
@@ -204,14 +222,16 @@
 
 
 (define (wisp-scheme-read-chunk-lines port)
-  (let loop
-      ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3 "#t"))
-       (in-indent? #t)
-       (in-underscoreindent? (equal? #\_ (peek-char port)))
-       (in-comment? #f)
-       (currentindent 0)
-       (currentsymbols '())
-       (emptylines 0))
+  ;; the line number for this chunk is the line number when starting to read it
+  ;; a top-level form stops processing, so we only need to retrieve this here.
+  (define line-number (port-line port))
+  (let loop ((indent-and-symbols (list)); '((5 "(foobar)" "\"yobble\"")(3 "#t"))
+             (in-indent? #t)
+             (in-underscoreindent? (equal? #\_ (peek-char port)))
+             (in-comment? #f)
+             (currentindent 0)
+             (currentsymbols '())
+             (emptylines 0))
     (cond
      ((>= emptylines 2)
       ;; the chunk end has to be checked
@@ -226,7 +246,7 @@
          ((eof-object? next-char)
           (let ((line (apply make-line currentindent currentsymbols)))
             (set-source-property! line 'filename (port-filename port))
-            (set-source-property! line 'line (port-line port))
+            (set-source-property! line 'line line-number)
             (append indent-and-symbols (list line))))
          ((and in-indent?
                (zero? currentindent)
@@ -296,7 +316,7 @@
             (when (not (= 0 (length (line-code parsedline))))
               ;; set the source properties to parsedline so we can try to add them later.
               (set-source-property! parsedline 'filename (port-filename port))
-              (set-source-property! parsedline 'line (port-line port)))
+              (set-source-property! parsedline 'line line-number))
             ;; TODO: If the line is empty. Either do it here and do not add it, just
             ;; increment the empty line counter, or strip it later. Replace indent
             ;; -1 by indent 0 afterwards.
@@ -405,21 +425,6 @@
           #f)))
     l))
 
-(define (wisp-add-source-properties-from source target)
-  "Copy the source properties from source into the target and return the target."
-  (catch #t
-    (lambda ()
-      (set-source-properties! target (source-properties source)))
-    (lambda (key . arguments)
-      #f))
-  target)
-
-(define (wisp-add-source-properties-from/when-required source target)
-  "Copy the source properties if target has none."
-  (if (null? (source-properties target))
-      (wisp-add-source-properties-from source target)
-      target))
-
 (define (wisp-propagate-source-properties code)
   "Propagate the source properties from the sourrounding list into every part of the code."
   (let loop ((processed '())
diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test
index 64ccc2ff6..60e1e0377 100644
--- a/test-suite/tests/srfi-119.test
+++ b/test-suite/tests/srfi-119.test
@@ -19,6 +19,7 @@
 (define-module (test-srfi-119)
   #:use-module (test-suite lib)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26) ;; cut
   #:use-module (language wisp))
 
 (define (read-string s)
@@ -36,6 +37,14 @@
 (define (wisp->list str)
   (wisp-scheme-read-string str))
 
+(define (scheme->list str)
+  (with-input-from-string str
+    (λ ()
+      (let loop ((result '()))
+        (if (eof-object? (peek-char))
+            (reverse! result)
+            (loop (cons (read) result)))))))
+
 (with-test-prefix "wisp-read-simple"
   (pass-if-equal '((<= n 5))
       (wisp->list "<= n 5"))
@@ -89,5 +98,11 @@ _  display \"hello\n\"
       (wisp->list "1 . 2\n3 4\n   5 . 6")))
 
 (with-test-prefix "wisp-source-properties"
-  (pass-if (not (find null? (map source-properties (wisp->list "1 . 2\n3 4\n   5 . 6")))))
-  (pass-if (not (find null? (map source-properties (wisp->list "1 2\n3 4\n   5 6"))))))
+  ;; has properties
+  (pass-if (every pair? (map source-properties (wisp->list "1 . 2\n3 4\n   5 . 6"))))
+  (pass-if (every pair? (map source-properties (wisp->list "1 2\n3 4\n   5 6"))))
+  ;; has the same properties
+  (pass-if-equal
+      (map source-properties (scheme->list "(1 . 2)\n(3 4\n   (5 . 6))\n(1 4)\n\n(7 8)"))
+      (map (cut cons '(filename . #f) <>)
+           (map source-properties (wisp->list "1 . 2\n3 4\n   5 . 6\n1 4\n\n7 8")))))
-- 
2.41.0


[-- Attachment #1.12: Type: text/plain, Size: 101 bytes --]


Best wishes,
Arne
-- 
Unpolitisch sein
heißt politisch sein,
ohne es zu merken.
draketo.de

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 1125 bytes --]