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

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

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

Hi,


I just added the remaining tests from the Wisp reader testsuite to the
patch, squashed and rebased it again. The updated patch is attached.

As far as I know, all review comments are addressed and I hope this is
ready to be merged.

Test suite result:

Totals for this test run:
passes:                 36
failures:               0
unexpected passes:      0
expected failures:      0
unresolved test cases:  0
untested test cases:    0
unsupported test cases: 0
errors:                 0


The squashed patch:


[-- Attachment #1.2: 0001-Add-language-wisp-Wisp-tests-and-SRFI-119-documentat.patch --]
[-- Type: text/x-patch, Size: 61345 bytes --]

From 81e7cbbade4fd01e092a2c39a3af90e4abf7f684 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <arne_bab@web.de>
Date: Mon, 11 Mar 2024 06:34:52 +0100
Subject: [PATCH] Add language/wisp, Wisp tests, and SRFI-119 documentation

* doc/ref/srfi-modules.texi (srfi-119): add node
* module/language/wisp.scm: New file.
* module/language/wisp/spec.scm: New file.
* test-suite/tests/srfi-119.test: New file.
---
 am/bootstrap.am                |    3 +
 doc/ref/srfi-modules.texi      |   31 +
 module/language/wisp.scm       |  776 ++++++++++++++++++++++++
 module/language/wisp/spec.scm  |   70 +++
 test-suite/Makefile.am         |    3 +-
 test-suite/tests/srfi-119.test | 1040 ++++++++++++++++++++++++++++++++
 6 files changed, 1922 insertions(+), 1 deletion(-)
 create mode 100644 module/language/wisp.scm
 create mode 100644 module/language/wisp/spec.scm
 create mode 100644 test-suite/tests/srfi-119.test

diff --git a/am/bootstrap.am b/am/bootstrap.am
index a71946958..7c4b5d8a8 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -395,6 +395,9 @@ SOURCES =					\
 						\
   system/syntax.scm				\
 						\
+  language/wisp.scm				\
+  language/wisp/spec.scm			\
+						\
   system/xref.scm				\
 						\
   sxml/apply-templates.scm			\
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 09b591e89..329e74958 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -64,6 +64,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-98::                     Accessing environment variables.
 * SRFI-105::                    Curly-infix expressions.
 * SRFI-111::                    Boxes.
+* SRFI-119::                    Wisp: simpler indentation-sensitive Scheme.
 * SRFI-171::                    Transducers
 @end menu
 
@@ -5662,6 +5663,35 @@ Return the current contents of @var{box}.
 Set the contents of @var{box} to @var{value}.
 @end deffn
 
+@node SRFI-119
+@subsection SRFI-119 Wisp: simpler indentation-sensitive Scheme.
+@cindex SRFI-119
+@cindex wisp
+
+The languages shipped in Guile include SRFI-119, also referred to as
+@dfn{Wisp} (for ``Whitespace to Lisp''), an encoding of Scheme that
+allows replacing parentheses with equivalent indentation and inline
+colons.  See
+@uref{http://srfi.schemers.org/srfi-119/srfi-119.html, the specification
+of SRFI-119}.  Some examples:
+
+@example
+display "Hello World!"         @result{}  (display "Hello World!")
+@end example
+
+@example
+define : factorial n           @result{}  (define (factorial n)
+    if : zero? n               @result{}      (if (zero? n)
+       . 1                     @result{}          1
+       * n : factorial @{n - 1@} @result{}    (* n (factorial @{n - 1@}))))
+@end example
+
+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.
+
+
 @node SRFI-171
 @subsection Transducers
 @cindex SRFI-171
@@ -5705,6 +5735,7 @@ left-to-right, due to how transducers are initiated.
 * SRFI-171 Helpers::                  Utilities for writing your own transducers
 @end menu
 
+
 @node SRFI-171 General Discussion
 @subsubsection SRFI-171 General Discussion
 @cindex transducers discussion
diff --git a/module/language/wisp.scm b/module/language/wisp.scm
new file mode 100644
index 000000000..dae9642ae
--- /dev/null
+++ b/module/language/wisp.scm
@@ -0,0 +1,776 @@
+;;; Wisp
+
+;; Copyright (C) 2013, 2017, 2018, 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014--2023 Arne Babenhauserheide.
+;; Copyright (C) 2023 Maxime Devos <maximedevos@telenet.be>
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+
+;; Scheme-only implementation of a wisp-preprocessor which output a
+;; Scheme code tree to feed to a Scheme interpreter instead of a
+;; preprocessed file.
+
+;; Limitations:
+;; - in some cases the source line information is missing in backtraces.
+;;   check for set-source-property!
+
+;;; Code:
+
+(define-module (language wisp)
+  #:export (wisp-scheme-read-chunk wisp-scheme-read-all
+                                   wisp-scheme-read-file-chunk wisp-scheme-read-file
+                                   wisp-scheme-read-string)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11); for let-values
+  #:use-module (srfi srfi-9); for records
+  #:use-module (ice-9 rw); for write-string/partial
+  #:use-module (ice-9 match))
+
+;; use curly-infix by default
+(eval-when (expand load eval)
+  (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)
+
+(define (line-indent line)
+  (car line))
+
+(define (line-real-indent line)
+  "Get the indentation without the comment-marker for unindented lines (-1 is treated as 0)."
+  (let ((indent (line-indent line)))
+    (if (= -1 indent)
+        0
+        indent)))
+
+(define (line-code line)
+  "Strip the indentation markers from the beginning of the line and preserve source-properties"
+  (let ((code (cdr line)))
+    ;; propagate source properties
+    (when (not (null? code))
+      (wisp-add-source-properties-from/when-required line code))
+    code))
+
+;; literal values I need
+(define readcolon
+  (string->symbol ":"))
+
+(define wisp-uuid "e749c73d-c826-47e2-a798-c16c13cb89dd")
+;; define an intermediate dot replacement with UUID to avoid clashes.
+(define repr-dot ; .
+  (string->symbol (string-append "REPR-DOT-" wisp-uuid)))
+
+;; allow using reader additions as the first element on a line to prefix the list
+(define repr-quote ; '
+  (string->symbol (string-append "REPR-QUOTE-" wisp-uuid)))
+(define repr-unquote ; ,
+  (string->symbol (string-append "REPR-UNQUOTE-" wisp-uuid)))
+(define repr-quasiquote ; `
+  (string->symbol (string-append "REPR-QUASIQUOTE-" wisp-uuid)))
+(define repr-unquote-splicing ; ,@
+  (string->symbol (string-append "REPR-UNQUOTESPLICING-" wisp-uuid)))
+
+(define repr-syntax ; #'
+  (string->symbol (string-append "REPR-SYNTAX-" wisp-uuid)))
+(define repr-unsyntax ; #,
+  (string->symbol (string-append "REPR-UNSYNTAX-" wisp-uuid)))
+(define repr-quasisyntax ; #`
+  (string->symbol (string-append "REPR-QUASISYNTAX-" wisp-uuid)))
+(define repr-unsyntax-splicing ; #,@
+  (string->symbol (string-append "REPR-UNSYNTAXSPLICING-" wisp-uuid)))
+
+;; TODO: wrap the reader to return the repr of the syntax reader
+;; additions
+
+(define (equal-rest? chars . args)
+  (equal? chars args))
+
+(define (match-charlist-to-repr char-list)
+  (let ((chars (reverse char-list)))
+    (cond
+     ((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: 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))
+      (cond
+       ((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))
+              (cond
+               ((equal? '() remaining)
+                (read port)); let read to the work
+               (else
+                (unread-char (car remaining) port)
+                (unpeek (cdr remaining)))))))
+       (else
+        (let* ((next-char (read-char port))
+               (peeked (cons next-char peeked)))
+          (longpeek
+           peeked
+           (match-charlist-to-repr peeked))))))))
+
+
+
+(define (line-continues? line)
+  (equal? repr-dot (car (line-code line))))
+
+(define (line-only-colon? line)
+  (and
+   (equal? ":" (car (line-code line)))
+   (null? (cdr (line-code line)))))
+
+(define (line-empty-code? line)
+  (null? (line-code line)))
+
+(define (line-empty? line)
+  (and
+   ;; if indent is -1, we stripped a comment, so the line was not really empty.
+   (= 0 (line-indent line))
+   (line-empty-code? line)))
+
+(define (line-strip-continuation line)
+  (if (line-continues? line)
+      (apply make-line
+             (line-indent line)
+             (cdr (line-code line)))
+      line))
+
+(define (line-strip-indentation-marker line)
+  "Strip the indentation markers from the beginning of the line for line-finalize without propagating source-properties (those are propagated in a second step)"
+  (cdr line))
+
+(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))
+    (cond
+     ((= level (car newlevels))
+      (select-fun (list diff indentation-levels)))
+     ((< level (car newlevels))
+      (loop
+       (cdr newlevels)
+       (1+ diff)))
+     (else
+      (raise-exception (make-exception-from-throw 'wisp-syntax-error (list (format #f "Level ~A not found in the indentation-levels ~A." level indentation-levels))))))))
+
+(define (indent-level-difference indentation-levels level)
+  "Find how many indentation levels need to be popped off to find the given level."
+  (indent-level-reduction indentation-levels level
+                          (lambda (x); get the count
+                            (car x))))
+
+(define (indent-reduce-to-level indentation-levels level)
+  "Find how many indentation levels need to be popped off to find the given level."
+  (indent-level-reduction indentation-levels level
+                          (lambda (x); get the levels
+                            (car (cdr x)))))
+
+(define (chunk-ends-with-period currentsymbols next-char)
+  "Check whether indent-and-symbols ends with a period, indicating the end of a chunk."
+  (and (not (null? currentsymbols))
+       (equal? #\newline next-char)
+       (equal? repr-dot
+               (list-ref currentsymbols (- (length currentsymbols) 1)))))
+
+
+(define (wisp-scheme-read-chunk-lines port)
+  ;; 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
+      ;; before we look for new chars in the
+      ;; port to make execution in the REPL
+      ;; after two empty lines work
+      ;; (otherwise it shows one more line).
+      indent-and-symbols)
+     (else
+      (let ((next-char (peek-char port)))
+        (cond
+         ((eof-object? next-char)
+          (let ((line (apply make-line currentindent currentsymbols)))
+            (set-source-property! line 'filename (port-filename port))
+            (set-source-property! line 'line line-number)
+            (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))))
+          (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
+          ;; SRFI-119. Use it to end the line in the REPL without
+          ;; showing continuation dots (...).
+          (append indent-and-symbols (list (apply make-line currentindent (drop-right currentsymbols 1)))))
+         ((and in-indent? (equal? #\space next-char))
+          (read-char port); remove char
+          (loop
+           indent-and-symbols
+           #t ; in-indent?
+           #f ; in-underscoreindent?
+           #f ; in-comment?
+           (1+ currentindent)
+           currentsymbols
+           emptylines))
+         ((and in-underscoreindent? (equal? #\_ next-char))
+          (read-char port); remove char
+          (loop
+           indent-and-symbols
+           #t ; in-indent?
+           #t ; in-underscoreindent?
+           #f ; in-comment?
+           (1+ currentindent)
+           currentsymbols
+           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.
+         ((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)
+          (read-char port); remove the newline
+          (let*
+              ;; distinguish pure whitespace lines and lines
+              ;; with comment by giving the former zero
+              ;; indent. Lines with a comment at zero indent
+              ;; get indent -1 for the same reason - meaning
+              ;; not actually empty.
+              ((indent
+                (cond
+                 (in-comment?
+                  (if (= 0 currentindent); specialcase
+                      -1
+                      currentindent))
+                 ((not (null? currentsymbols)); pure whitespace
+                  currentindent)
+                 (else
+                  0)))
+               (parsedline (apply make-line indent currentsymbols))
+               (emptylines
+                (if (not (line-empty? parsedline))
+                    0
+                    (1+ emptylines))))
+            (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 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.
+            (loop
+             (append indent-and-symbols (list parsedline))
+             #t ; in-indent?
+             (if (<= 2 emptylines)
+                 #f ; chunk ends here
+                 (equal? #\_ (peek-char port))); are we in underscore indent?
+             #f ; in-comment?
+             0
+             '()
+             emptylines)))
+         ((equal? #t in-comment?)
+          (read-char port); remove one comment character
+          (loop
+           indent-and-symbols
+           #f ; in-indent?
+           #f ; in-underscoreindent?
+           #t ; in-comment?
+           currentindent
+           currentsymbols
+           emptylines))
+         ((or (equal? #\space next-char) (equal? #\tab next-char) (equal? #\return next-char)); remove whitespace when not in indent
+          (read-char port); remove char
+          (loop
+           indent-and-symbols
+           #f ; in-indent?
+           #f ; in-underscoreindent?
+           #f ; in-comment?
+           currentindent
+           currentsymbols
+           emptylines))
+         ;; | cludge to appease the former wisp parser
+         ;; | used for bootstrapping which has a
+         ;; v problem with the literal comment char
+         ((equal? (string-ref ";" 0) next-char)
+          (loop
+           indent-and-symbols
+           #f ; in-indent?
+           #f ; in-underscoreindent?
+           #t ; in-comment?
+           currentindent
+           currentsymbols
+           emptylines))
+         (else ; use the reader
+          (loop
+           indent-and-symbols
+           #f ; in-indent?
+           #f ; in-underscoreindent?
+           #f ; in-comment?
+           currentindent
+           ;; this also takes care of the hashbang and leading comments.
+           (append currentsymbols (list (wisp-read port)))
+           emptylines))))))))
+
+
+(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))
+    (cond
+     ((null? unprocessed)
+      ;; format #t "inline-colons processed line: ~A\n" processed
+      processed)
+     ;; replace : . with nothing
+     ((and (<= 2 (length unprocessed)) (equal? readcolon (car unprocessed)) (equal? repr-dot (car (cdr unprocessed))))
+      (loop
+       (append processed
+               (loop '() (cdr (cdr unprocessed))))
+       '()))
+     ((equal? readcolon (car unprocessed))
+      (loop
+       (append processed
+               (list (loop '() (cdr unprocessed))))
+       '()))
+     (else
+      (loop
+       (append processed
+               (list (car unprocessed)))
+       (cdr unprocessed))))))
+
+(define (line-replace-inline-colons line)
+  (cons
+   (line-indent line)
+   (line-code-replace-inline-colons (line-code line))))
+
+(define (line-strip-lone-colon line)
+  "A line consisting only of a colon is just a marked indentation level. We need to kill the colon before replacing inline colons."
+  (if (equal? (line-code line) (list readcolon))
+      (make-line (line-indent line))
+      line))
+
+(define (line-finalize line)
+  "Process all wisp-specific information in a line and strip it"
+  (let ((l (line-code-replace-inline-colons
+            (line-strip-indentation-marker
+             (line-strip-lone-colon
+              (line-strip-continuation line))))))
+    (when (not (null? (source-properties line)))
+      (catch #t
+        (lambda ()
+          (set-source-properties! l (source-properties line)))
+        (lambda (key . arguments)
+          #f)))
+    l))
+
+(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))
+    (cond
+     ((and (null? processed) (not (pair? unprocessed)) (not (list? unprocessed)))
+      unprocessed)
+     ((and (pair? unprocessed) (not (list? unprocessed)))
+      (cons
+       (wisp-propagate-source-properties (car unprocessed))
+       (wisp-propagate-source-properties (cdr unprocessed))))
+     ((null? unprocessed)
+      processed)
+     (else
+      (let ((line (car unprocessed)))
+        (wisp-add-source-properties-from/when-required line unprocessed)
+        (wisp-add-source-properties-from/when-required code unprocessed)
+        (wisp-add-source-properties-from/when-required unprocessed line)
+        (wisp-add-source-properties-from/when-required unprocessed code)
+        (let ((processed (append processed (list (wisp-propagate-source-properties line)))))
+          ;; must propagate from line, because unprocessed and code can be null, then they cannot keep source-properties.
+          (wisp-add-source-properties-from/when-required line processed)
+          (loop processed
+                (cdr unprocessed))))))))
+
+(define* (wisp-scheme-indentation-to-parens lines)
+  "Add parentheses to lines and remove the indentation markers"
+  (when
+      (and
+       (not (null? lines))
+       (not (line-empty-code? (car lines)))
+       (not (= 0 (line-real-indent (car lines))))); -1 is a line with a comment
+    (if (= 1 (line-real-indent (car lines)))
+        ;; accept a single space as indentation of the first line (and ignore the indentation) to support meta commands
+        (set! lines
+              (cons
+               (cons 0 (cdr (car lines)))
+               (cdr lines)))
+        (raise-exception
+         (make-exception-from-throw
+          'wisp-syntax-error
+          (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)))
+      ;; 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
+       ;; the real end: this is reported to the outside world.
+       ((and (null? unprocessed) (not (null? indentation-levels)) (null? (cdr indentation-levels)))
+        ;; reverse the processed lines, because I use cons.
+        processed)
+       ;; the recursion end-condition
+       ((and (null? unprocessed))
+        ;; this is the last step. Nothing more to do except
+        ;; for rolling up the indentation levels.  return the
+        ;; new processed and unprocessed lists: this is a
+        ;; side-recursion
+        (values processed unprocessed))
+       ((null? indentation-levels)
+        (raise-exception
+         (make-exception-from-throw
+          'wisp-programming-error
+          (list
+           "The indentation-levels are null but the current-line is null: Something killed the indentation-levels."))))
+       (else ; now we come to the line-comparisons and indentation-counting.
+        (cond
+         ((line-empty-code? current-line)
+          ;; We cannot process indentation without
+          ;; code. Just switch to the next line. This should
+          ;; only happen at the start of the recursion.
+          (loop
+           processed
+           (cdr unprocessed)
+           indentation-levels))
+         ((and (line-empty-code? next-line) (<= 2 (length unprocessed)))
+          ;; take out the next-line from unprocessed.
+          (loop
+           processed
+           (cons current-line
+                 (cdr (cdr unprocessed)))
+           indentation-levels))
+         ((> current-indentation current-line-indentation)
+          ;; this just steps back one level via the side-recursion.
+          (let ((previous-indentation (car (cdr indentation-levels))))
+            (if (<= current-line-indentation previous-indentation)
+                (values processed unprocessed)
+                (begin ;; not yet used level! TODO: maybe throw an error here instead of a warning.
+                  (let ((linenumber (- (length lines) (length unprocessed))))
+                    (format (current-error-port) ";;; WARNING:~A: used lower but undefined indentation level (line ~A of the current chunk: ~S). This makes refactoring much more error-prone, therefore it might become an error in a later version of Wisp.\n" (source-property current-line 'line) linenumber (cdr current-line)))
+                  (loop
+                   processed
+                   unprocessed
+                   (cons ; recursion via the indentation-levels
+                    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)))
+            (cond
+             ((>= current-line-indentation next-line-indentation)
+              ;; simple recursiive step to the next line
+              (loop
+               (append processed
+                       (if (line-continues? current-line)
+                           line
+                           (wisp-add-source-properties-from line (list line))))
+               (cdr unprocessed); recursion here
+               indentation-levels))
+             ((< current-line-indentation next-line-indentation)
+              ;; side-recursion via a sublist
+              (let-values
+                  (((sub-processed sub-unprocessed)
+                    (loop
+                     line
+                     (cdr unprocessed); recursion here
+                     indentation-levels)))
+                (loop
+                 (append processed (list sub-processed))
+                 sub-unprocessed ; simply use the recursion from the sub-recursion
+                 indentation-levels))))))
+         ((< current-indentation current-line-indentation)
+          (loop
+           processed
+           unprocessed
+           (cons ; recursion via the indentation-levels
+            current-line-indentation
+            indentation-levels)))
+         (else
+          (raise-exception
+           (make-exception-from-throw
+            'wisp-not-implemented
+            (list
+             (format #f "Need to implement further line comparison: current: ~A, next: ~A, processed: ~A."
+                     current-line next-line processed)))))))))))
+
+
+(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))
+    (if (null? unprocessed)
+        processed
+        (loop
+         (append processed (list (line-replace-inline-colons (car unprocessed))))
+         (cdr unprocessed)))))
+
+
+(define (wisp-scheme-strip-indentation-markers lines)
+  "Strip the indentation markers from the beginning of the lines"
+  (let loop ((processed '())
+             (unprocessed lines))
+    (if (null? unprocessed)
+        processed
+        (loop
+         (append processed (cdr (car unprocessed)))
+         (cdr unprocessed)))))
+
+(define (wisp-unescape-underscore-and-colon code)
+  "replace \\_ and \\: by _ and :"
+  (wisp-add-source-properties-from/when-required
+   code
+   (cond ((list? code) (map wisp-unescape-underscore-and-colon code))
+         ((eq? code '\:) ':)
+         ;; Look for symbols like \____ and remove the \.
+         ((symbol? code)
+          (let ((as-string (symbol->string code)))
+            (if (and (>= (string-length as-string) 2) ; at least a single underscore
+                     (char=? (string-ref as-string 0) #\\)
+                     (string-every #\_ (substring as-string 1)))
+                (string->symbol (substring as-string 1))
+                code)))
+         (#t code))))
+
+
+(define (wisp-replace-empty-eof code)
+  "replace ((#<eof>)) by ()"
+  ;; This is a hack which fixes a bug when the
+  ;; parser hits files with only hashbang and comments.
+  (if (and (not (null? code)) (pair? (car code)) (eof-object? (car (car code))) (null? (cdr code)) (null? (cdr (car code))))
+      (wisp-add-source-properties-from code (list))
+      code))
+
+
+(define (wisp-replace-paren-quotation-repr code)
+  "Replace lists starting with a quotation symbol by
+         quoted lists."
+  (wisp-add-source-properties-from/when-required
+   code
+   (match code
+     (('REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'quote (map wisp-replace-paren-quotation-repr a)))
+     ((a ... 'REPR-QUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b); this is the quoted empty list
+      (append
+       (map wisp-replace-paren-quotation-repr a)
+       (list (list 'quote (map wisp-replace-paren-quotation-repr b)))))
+     (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'quasiquote (list 'unquote (map wisp-replace-paren-quotation-repr a))))
+     (('REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'unquote (map wisp-replace-paren-quotation-repr a)))
+     ((a ... 'REPR-UNQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b)
+      (append
+       (map wisp-replace-paren-quotation-repr a)
+       (list (list 'unquote (map wisp-replace-paren-quotation-repr b)))))
+     (('REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'quasiquote (map wisp-replace-paren-quotation-repr a)))
+     ((a ... 'REPR-QUASIQUOTE-e749c73d-c826-47e2-a798-c16c13cb89dd b); this is the quoted empty list
+      (append
+       (map wisp-replace-paren-quotation-repr a)
+       (list (list 'quasiquote (map wisp-replace-paren-quotation-repr b)))))
+     (('REPR-UNQUOTESPLICING-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'unquote-splicing (map wisp-replace-paren-quotation-repr a)))
+     (('REPR-SYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'syntax (map wisp-replace-paren-quotation-repr a)))
+     (('REPR-UNSYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'unsyntax (map wisp-replace-paren-quotation-repr a)))
+     (('REPR-QUASISYNTAX-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'quasisyntax (map wisp-replace-paren-quotation-repr a)))
+     (('REPR-UNSYNTAXSPLICING-e749c73d-c826-47e2-a798-c16c13cb89dd a ...)
+      (list 'unsyntax-splicing (map wisp-replace-paren-quotation-repr a)))
+     ;; literal array as start of a line: # (a b) c -> (#(a b) c)
+     ((#\# a ...)
+      (with-input-from-string ;; hack to defer to read
+          (string-append "#"
+                         (with-output-to-string
+                           (λ ()
+                             (write (map wisp-replace-paren-quotation-repr a)
+                                    (current-output-port)))))
+        read))
+     ((a ...)
+      (map wisp-replace-paren-quotation-repr a))
+     (a
+      a))))
+
+(define (wisp-make-improper code)
+  "Turn (a #{.}# b) into the correct (a . b).
+
+read called on a single dot creates a variable named #{.}# (|.|
+in r7rs). Due to parsing the indentation before the list
+structure is known, the reader cannot create improper lists
+when it reads a dot. So we have to take another pass over the
+code to recreate the improper lists.
+
+Match is awesome!"
+  (define is-proper? #t)
+  ;; local alias
+  (define (add-prop/req form)
+    (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))))
+     (define (syntax-error li msg)
+       (raise-exception
+        (make-exception-from-throw
+         'wisp-syntax-error
+         (list (format #f "incorrect dot-syntax #{.}# in code: ~A: ~A" msg li)))))
+     (if is-proper?
+         improper
+         (let check ((tocheck improper))
+           (match tocheck
+             ;; lists with only one member
+             (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd)
+              (syntax-error tocheck "list with the period as only member"))
+             ;; list with remaining dot.
+             ((a ...)
+              (if (and (member repr-dot a))
+                  (syntax-error tocheck "leftover period in list")
+                  (map check a)))
+             ;; simple pair - this and the next do not work when parsed from wisp-scheme itself. Why?
+             (('REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd . c)
+              (syntax-error tocheck "dot as first element in already improper pair"))
+             ;; simple pair, other way round
+             ((a . 'REPR-DOT-e749c73d-c826-47e2-a798-c16c13cb89dd)
+              (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)))
+                (cond
+                 ((equal? repr-dot (car tail))
+                  (syntax-error tocheck "equal? repr-dot : car tail"))
+                 ((equal? repr-dot (cdr tail))
+                  (syntax-error tocheck "equal? repr-dot : cdr tail"))
+                 ((member repr-dot head)
+                  (syntax-error tocheck "member repr-dot head"))
+                 (else
+                  a))))
+             (a
+              a)))))))
+
+(define (wisp-scheme-read-chunk port)
+  "Read and parse one chunk of wisp-code"
+  (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedures)))
+    (read-hash-extend #\# (lambda args #\#))
+    (let ((lines (wisp-scheme-read-chunk-lines port)))
+      (wisp-make-improper
+       (wisp-replace-empty-eof
+        (wisp-unescape-underscore-and-colon
+         (wisp-replace-paren-quotation-repr
+          (wisp-propagate-source-properties
+           (wisp-scheme-indentation-to-parens lines)))))))))
+
+(define (wisp-scheme-read-all port)
+  "Read all chunks from the given port"
+  (let loop ((tokens '()))
+    (cond
+     ((eof-object? (peek-char port))
+      tokens)
+     (else
+      (loop
+       (append tokens (wisp-scheme-read-chunk port)))))))
+
+(define (wisp-scheme-read-file path)
+  (call-with-input-file path wisp-scheme-read-all))
+
+(define (wisp-scheme-read-file-chunk path)
+  (call-with-input-file path wisp-scheme-read-chunk))
+
+(define (wisp-scheme-read-string str)
+  (call-with-input-string str wisp-scheme-read-all))
+
+(define (wisp-scheme-read-string-chunk str)
+  (call-with-input-string str wisp-scheme-read-chunk))
diff --git a/module/language/wisp/spec.scm b/module/language/wisp/spec.scm
new file mode 100644
index 000000000..f7fd794e0
--- /dev/null
+++ b/module/language/wisp/spec.scm
@@ -0,0 +1,70 @@
+;;; Language interface for Wisp in Guile
+
+;; Copyright (C) 2005--2014 by David A. Wheeler and Alan Manuel K. Gloria
+;; Copyright (C) 2014--2023 Arne Babenhauserheide.
+;; Copyright (C) 2023 Maxime Devos <maximedevos@telenet.be>
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;; adapted from spec.scm: https://gitorious.org/nacre/guile-sweet/?p=nacre:guile-sweet.git;a=blob;f=sweet/spec.scm;hb=ae306867e371cb4b56e00bb60a50d9a0b8353109
+
+(define-module (language wisp spec)
+  #:use-module (language wisp)
+  #:use-module (system base compile)
+  #:use-module (system base language)
+  #:use-module (language scheme compile-tree-il)
+  #:use-module (language scheme decompile-tree-il)
+  #:export (wisp))
+
+;;;
+;;; Language definition
+;;;
+
+
+(define (read-one-wisp-sexp port env)
+  ;; Allow using "# foo" as #(foo).
+  ;; Don't use the globally-acting read-hash-extend, because this
+  ;; doesn't make much sense in parenthese-y (non-Wisp) Scheme.
+  ;; Instead, use fluids to temporarily add the extension.
+  (with-fluids ((%read-hash-procedures (fluid-ref %read-hash-procedures)))
+    (read-hash-extend #\# (lambda args #\# ))
+    ;; Read Wisp files as UTF-8, to support non-ASCII characters.
+    ;; TODO: would be nice to support ';; coding: whatever' lines
+    ;; like in parenthese-y Scheme.
+    (set-port-encoding! port "UTF-8")
+    (if (eof-object? (peek-char port))
+        (read-char port) ; return eof: we’re done
+        (let ((chunk (wisp-scheme-read-chunk port)))
+          (and (not (null? chunk)) ; <---- XXX: maybe (pair? chunk)
+               (car chunk))))))
+
+(define-language wisp
+  #:title "Wisp Scheme Syntax. See SRFI-119 for details"
+  ;; . #: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))
+  #:evaluator (lambda (x module) (primitive-eval x))
+  #:printer write ; TODO: backtransform to Wisp? Use source-properties?
+  #:make-default-environment
+  (lambda ()
+    ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
+    ;; `fluid-set!', etc. don't have any effect in the current environment.
+    (let ((m (make-fresh-user-module)))
+      ;; Provide a separate `current-reader' fluid so that
+      ;; compile-time changes to `current-reader' are
+      ;; limited to the current compilation unit.
+      (module-define! m 'current-reader (make-fluid))
+      m)))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 81e63bce2..247d97746 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -162,7 +162,8 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/srfi-98.test			\
 	    tests/srfi-105.test			\
 	    tests/srfi-111.test			\
-            tests/srfi-171.test                 \
+	    tests/srfi-119.test			\
+	    tests/srfi-171.test			\
 	    tests/srfi-4.test			\
 	    tests/srfi-9.test			\
 	    tests/statprof.test			\
diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test
new file mode 100644
index 000000000..5390a25b3
--- /dev/null
+++ b/test-suite/tests/srfi-119.test
@@ -0,0 +1,1040 @@
+;;;; srfi-119.test --- Test suite for Guile's SRFI-119 reader. -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2023 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(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)
+  (with-input-from-string s read))
+
+(define (with-read-options opts thunk)
+  (let ((saved-options (read-options)))
+    (dynamic-wind
+      (lambda ()
+        (read-options opts))
+      thunk
+      (lambda ()
+        (read-options saved-options)))))
+
+(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"))
+  (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 '(
+     (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
+
+concat \"I want \"
+    getwish from me
+    . \" - \" username
+"))
+
+  (pass-if-equal
+      '(
+        (define (a b c)
+          (d e
+             (f)
+             (g h)
+             i))
+
+        (define (_)
+          (display "hello\n"))
+
+        (_)) (wisp->list "
+define : a b c
+_ d e
+___ f
+___ g h
+__  . i
+
+define : _
+_  display \"hello\n\"
+
+\\_"))
+
+  ;; nesting with pairs
+  (pass-if-equal '((1 . 2)(3 4 (5 . 6)))
+      (wisp->list "1 . 2\n3 4\n   5 . 6")))
+
+(with-test-prefix "wisp-source-properties"
+  ;; 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")))))
+
+(with-test-prefix "btest"
+  (pass-if-equal '((display "b")
+(newline)
+
+
+) (wisp->list "
+display \"b\"
+newline
+")))
+
+(with-test-prefix "continuation"
+  (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
+
+concat \"I want \"
+    getwish from me
+    . \" - \" username
+
+")))
+
+(with-test-prefix "dotted-pair"
+  (pass-if-equal '((use-modules ((ice-9 popen) #:select ((open-input-pipe . oip))))
+
+
+                   ) (wisp->list "
+use-modules : (ice-9 popen) #:select ((open-input-pipe . oip))
+")))
+
+(with-test-prefix "example"
+  (pass-if-equal '((defun a (b c)
+  (let
+    (
+      (d "i am a string
+do not break me!")
+      (
+  ; comment: 0
+        (f)
+; comment : 1
+        `(g )); comment " : " 2
+      (
+        (h (I am in brackets:
+           do not : change "me"))
+        i)))
+  ,('j k)
+
+  l
+
+; comment
+
+  (a c))
+
+(defun b (:n o)
+  "second defun : with a docstring!"
+  (message "I am here")
+  t)
+
+(defun c (e f)
+  ((g))
+  (
+    (h
+      (i))
+    (j))
+  '(())
+  (k)
+  l
+  (m))
+
+(defun _ (:)
+
+   :)
+
+(_ b)
+
+(defun d ()
+      (let
+          ((a b)
+            (c d))))
+
+(a (((c))))
+
+(let
+    ((a b)
+      (c)))
+
+(let ((a b)))
+
+a
+
+
+
+) (wisp->list "
+defun a (b c)
+  let
+    :
+      d \"i am a string
+do not break me!\"
+      :
+  ; comment: 0
+        f
+; comment : 1
+        ` g ; comment \" : \" 2
+      :
+        h (I am in brackets:
+           do not : change \"me\")
+        . i
+  , 'j k
+
+  . l
+
+; comment
+
+  a c
+
+defun b : :n o
+  . \"second defun : with a docstring!\"
+  message \"I am here\"
+  . t
+
+defun c : e f
+  : g
+  :
+    h
+      i
+    j
+  ' :
+  k
+  . l
+  . : m
+
+defun _ : \\:
+__
+__ . \\:
+
+\\_ b
+
+defun d :
+      let
+          : a b
+            c d
+
+a : : : c
+
+let
+    : a b
+      c
+
+let : : a b
+
+. a
+
+")))
+
+(with-test-prefix "factorial"
+  (pass-if-equal '(;; short version
+; note: once you use one inline colon, all the following forms on that
+; line will get closed at the end of the line
+
+(define (factorial n)
+  (if (zero? n)
+    1
+    (* n (factorial (- n 1)))))
+
+(display (factorial 5 ))
+
+
+;; more vertical space, less colons
+(define (factorial n)
+  (if (zero? n)
+    1
+    (* n
+      (factorial
+        (- n 1)))))
+
+(display (factorial 5 ))
+
+
+
+) (wisp->list "
+;; short version
+; note: once you use one inline colon, all the following forms on that
+; line will get closed at the end of the line
+
+define : factorial n
+  if : zero? n
+    . 1
+    * n : factorial : - n 1
+
+display : factorial 5
+
+
+;; more vertical space, less colons
+define : factorial n
+  if : zero? n
+    . 1
+    * n
+      factorial
+        - n 1
+
+display : factorial 5
+
+")))
+
+(with-test-prefix "fast-sum"
+  (pass-if-equal '((use-modules (srfi srfi-1))
+
+; only for the nice test
+#!curly-infix
+
+(define-syntax fast-sum
+  (syntax-rules (iota)
+    ((fast-sum (iota count start))
+     (+ 1
+        (apply -
+          (map (lambda (x) (/ {x * {x + 1} } 2))
+                (list {count + {start - 1}} start)))))
+    ((fast-sum e)
+     (apply + e))))
+
+
+) (wisp->list "
+use-modules : srfi srfi-1
+
+; only for the nice test
+. #!curly-infix
+
+define-syntax fast-sum
+  syntax-rules : iota
+    : fast-sum : iota count start
+      + 1
+        apply -
+          map : lambda (x) : / {x * {x + 1} } 2
+                list {count + {start - 1}} start
+    : fast-sum e
+      apply + e
+")))
+
+(with-test-prefix "flexible-parameter-list"
+  (pass-if-equal '(; Test using a . as first parameter on a line by prefixing it with a second .
+(define
+  (a i
+    . b)
+  (unless (>= i (length b))
+    (display (number->string (length b )))
+    (display (list-ref b i))
+    (newline)
+    (apply a ( + i 1 ) b)))
+
+
+(a 0 "123" "345" "567")
+
+
+) (wisp->list "
+; Test using a . as first parameter on a line by prefixing it with a second .
+define
+  a i
+    . . b
+  unless : >= i : length b
+    display : number->string : length b
+    display : list-ref b i
+    newline
+    apply a ( + i 1 ) b
+
+
+a 0 \"123\" \"345\" \"567\"
+")))
+
+(with-test-prefix "hello"
+  (pass-if-equal '((define (hello who)
+  ;; include the newline
+  (format #t "~A ~A!\n"
+          "Hello" who))
+(hello "Wisp")
+
+) (wisp->list "
+define : hello who
+  ;; include the newline
+  format #t \"~A ~A!\\n\"
+          . \"Hello\" who
+hello \"Wisp\"
+")))
+
+(with-test-prefix "mtest"
+  (pass-if-equal '(#!/home/arne/wisp/wisp-multiline.sh  !#
+
+(display 1)
+
+
+) (wisp->list "
+#!/home/arne/wisp/wisp-multiline.sh  !#
+
+display 1
+")))
+
+(with-test-prefix "multiline-string"
+  (pass-if-equal '((display "
+  This is a
+  \"multi-line\"
+  string.
+  ")
+
+                   ) (wisp->list "
+display \"
+  This is a
+  \\\"multi-line\\\"
+  string.
+  \"
+")))
+
+(with-test-prefix "namedlet"
+  (pass-if-equal '(#!/home/arne/wisp/wisp-multiline.sh
+; !#
+(define (hello who)
+  (display who))
+
+(let hello
+  ((who 0))
+  (if (= who 5)
+    (display who)
+    (hello (+ 1 who))))
+
+
+) (wisp->list "
+#!/home/arne/wisp/wisp-multiline.sh
+; !#
+define : hello who
+  display who
+
+let hello
+  : who 0
+  if : = who 5
+    display who
+    hello : + 1 who
+")))
+
+;; the following is no error, but produces a warning because indentation is inconsistent.
+(with-test-prefix "partial-indent"
+  (pass-if-equal '((write
+ (list
+    (+ 1 2)
+   (+ 2 3)))
+(newline)
+
+(write
+ (list
+    (+ 1 2
+      (+ 3 4))
+   (+ 2 3)))
+(newline)
+
+
+) (wisp->list "
+write
+ list
+    + 1 2
+   + 2 3
+newline
+
+write
+ list
+    + 1 2
+      + 3 4
+   + 2 3
+newline
+")))
+
+(with-test-prefix "quotecolon"
+  (pass-if-equal '(#!/home/arne/wisp/wisp-multiline.sh
+; !#
+(define a 1 ); test whether ' : correctly gets turned into '(
+; and whether brackets in commments are treated correctly.
+
+(define a '(1 2 3))
+
+(define
+  (a b)
+  (c))
+
+(define a (quasiquote ,(+ 2 2)))
+) (wisp->list "
+#!/home/arne/wisp/wisp-multiline.sh
+; !#
+define a 1 ; test whether ' : correctly gets turned into '(
+; and whether brackets in commments are treated correctly.
+
+define a ' : 1 2 3
+
+define
+  a b
+  c
+
+define a : quasiquote , : + 2 2
+")))
+
+(with-test-prefix "range"
+  (pass-if-equal '((import (rnrs))
+
+(define range
+ (case-lambda
+   ((n ); one-argument syntax
+     (range 0 n 1))
+   ((n0 n ); two-argument syntax
+     (range n0 n 1))
+   ((n0 n s ); three-argument syntax
+     (assert
+         (and
+             (for-all number? (list n0 n s))
+             (not (zero? s))))
+     (let ((cmp (if (positive? s) >= <= )))
+       (let loop
+           ((i n0 )
+             (acc '()))
+           (if
+             (cmp i n )
+             (reverse acc)
+             (loop (+ i s) (cons i acc))))))))
+
+(display (apply string-append "" (map number->string (range 5))))
+(newline)
+
+) (wisp->list "
+import : rnrs
+
+define range
+ case-lambda
+   : n ; one-argument syntax
+     range 0 n 1
+   : n0 n ; two-argument syntax
+     range n0 n 1
+   : n0 n s ; three-argument syntax
+     assert
+         and
+             for-all number? : list n0 n s
+             not : zero? s
+     let : : cmp : if (positive? s) >= <=
+       let loop
+           : i n0
+             acc '()
+           if
+             cmp i n
+             reverse acc
+             loop (+ i s) (cons i acc)
+
+display : apply string-append \"\" : map number->string : range 5
+newline")))
+
+(with-test-prefix "readable-tests"
+  (pass-if-equal '((define (fibfast n)
+      (if (< n 2))
+      n
+      (fibup n 2 1 0 ))
+
+(define (fibup maxnum count n-1 n-2)
+       (if (= maxnum count)
+         (+ n-1  n-2)
+         (fibup maxnum
+               (+ count 1 )
+               (+ n-1 n-2 )
+               n-1)))
+
+(define (factorial n)
+       (if (<= n 1)
+         1
+         (* n
+           (factorial (- n 1)))))
+
+(define (gcd x y)
+       (if (= y 0))
+       x
+       (gcd y
+         (rem x y)))
+
+(define (add-if-all-numbers lst)
+       (call/cc
+         (lambda (exit)
+                (let loop
+                  (
+                    (lst lst )
+                    (sum 0))
+                  (if (null? lst)
+                     sum
+                     (if (not (number? (car lst)))
+                        (exit #f)
+                        (+ (car lst)
+                          (loop (cdr lst)))))))))
+
+) (wisp->list "
+define : fibfast n
+      if : < n 2
+      . n
+      fibup n 2 1 0
+
+define : fibup maxnum count n-1 n-2
+       if : = maxnum count
+         + n-1  n-2
+         fibup maxnum
+               + count 1
+               + n-1 n-2
+               . n-1
+
+define : factorial n
+       if : <= n 1
+         . 1
+         * n
+           factorial : - n 1
+
+define (gcd x y)
+       if (= y 0)
+       . x
+       gcd y
+         rem x y
+
+define : add-if-all-numbers lst
+       call/cc
+         lambda : exit
+                let loop
+                  :
+                    lst lst
+                    sum 0
+                  if : null? lst
+                     . sum
+                     if : not : number? : car lst
+                        exit #f
+                        + : car lst
+                          loop : cdr lst")))
+
+(with-test-prefix "receive"
+  (pass-if-equal '((import (ice-9 receive) (srfi srfi-1))
+(write
+    (receive (car cdr)
+        (car+cdr '(car . cdr))
+      car))
+) (wisp->list "
+import (ice-9 receive) (srfi srfi-1)
+write
+    receive : car cdr
+              car+cdr '(car . cdr)
+              . car
+")))
+
+(with-test-prefix "self-referencial"
+  (pass-if-equal '(; http://stackoverflow.com/questions/23167464/scheme-self-reference-lambda-macro
+; because this is as cool as things get
+(define-syntax slambda
+  (lambda (x)
+    (syntax-case x ()
+      ((slambda formals body0 body1 ...)
+        (with-syntax
+                    ((self (datum->syntax #'slambda 'self)))
+                    #'(letrec ((self (lambda formals body0 body1 ...)))
+                       self))))))
+
+
+
+(
+  (slambda (x) (+ x 1))
+  10)
+
+((slambda () self))
+
+
+
+) (wisp->list "
+; http://stackoverflow.com/questions/23167464/scheme-self-reference-lambda-macro
+; because this is as cool as things get
+define-syntax slambda
+  lambda : x
+    syntax-case x :
+      : slambda formals body0 body1 ...
+        with-syntax
+                    : self : datum->syntax #'slambda 'self
+                    #' letrec : : self : lambda formals body0 body1 ...
+                       . self
+
+
+
+:
+  slambda (x) : + x 1
+  . 10
+
+: slambda () self
+
+")))
+
+(with-test-prefix "shebang"
+  (pass-if-equal '(#!/usr/bin/wisp.py # !#
+; This tests shebang lines
+
+
+                                        ) (wisp->list "
+#!/usr/bin/wisp.py # !#
+; This tests shebang lines
+")))
+
+(with-test-prefix "strangecomments"
+  (pass-if-equal '((use-modules (wisp-scheme))
+; works
+(display
+  (call-with-input-string  "foo ; bar\n  ; nop \n\n; nup\n; nup \n  \n\n\n  foo : moo \"\n\" \n___ . goo . hoo" wisp-scheme-read-chunk))
+(newline)
+(display
+  (call-with-input-string  "foo \n___ . goo . hoo" wisp-scheme-read-chunk))
+(newline)
+
+) (wisp->list "
+use-modules : wisp-scheme
+; works
+display
+  call-with-input-string  \"foo ; bar\\n  ; nop \\n\\n; nup\\n; nup \\n  \\n\\n\\n  foo : moo \\\"\\n\\\" \\n___ . goo . hoo\" wisp-scheme-read-chunk
+newline
+display
+  call-with-input-string  \"foo \\n___ . goo . hoo\" wisp-scheme-read-chunk
+newline
+")))
+
+(with-test-prefix "sublist"
+(pass-if-equal '(; sublists allow to start single line function calls with a colon ( : ).
+
+(defun a (b c)
+  (let ((e . f))
+        g))
+
+
+) (wisp->list "
+; sublists allow to start single line function calls with a colon ( : ).
+;
+defun a : b c
+  let : : e . f
+        . g
+        ")))
+
+(with-test-prefix "sxml"
+(pass-if-equal '((use-modules (sxml simple))
+(use-modules (ice-9 match))
+
+; define a template
+(define template
+   (quote
+     (html
+         (head (title "test"))
+         (body
+             (h1 "test")
+             (message "the header")
+             (p "it " (em "works!")
+               (br)
+               (" it actually works!"))))))
+
+; transform it
+(define template2
+ (let loop
+  ((l template))
+  (match l
+    (('message a ...)
+      `(p (@ (style "margin-left: 2em"))
+            (strong ,(map loop a))))
+    ((a ...)
+      (map loop a ))
+    (a
+      a))))
+
+; write xml to the output port
+(sxml->xml template2)
+
+(newline)
+
+
+) (wisp->list "
+      use-modules : sxml simple
+use-modules : ice-9 match
+
+; define a template
+define template
+   quote
+     html
+         head : title \"test\"
+         body
+             h1 \"test\"
+             message \"the header\"
+             p \"it \" : em \"works!\"
+               br
+               \" it actually works!\"
+
+; transform it
+define template2
+ let loop
+  : l template
+  match l
+    : 'message a ...
+      ` p : @ : style \"margin-left: 2em\"
+            strong ,(map loop a)
+    : a ...
+      map loop a
+    a
+      . a
+
+; write xml to the output port
+sxml->xml template2
+
+newline
+")))
+
+(with-test-prefix "syntax-colon"
+(pass-if-equal '((let
+  (
+    (a 1)
+    (b 2))
+  (let
+    (
+      (
+        c 3))
+    (format #t "a: ~A, b: ~A, c: ~A"
+                 a      b      c)))
+
+((a))
+
+(define (hello)
+  (display "hello\n"))
+
+(let
+  ((a 1)
+    (b 2))
+  (format #t "a: ~A, b: ~A"
+               a      b))
+
+(let ((a '())))
+
+(let
+  (    ; foo
+    (a
+      '())))
+
+(
+  (a))
+
+(define (:)
+  (hello))
+
+(:)
+
+
+) (wisp->list "
+let
+  :
+    a 1
+    b 2
+  let
+    :
+      :
+        . c 3
+    format #t \"a: ~A, b: ~A, c: ~A\"
+              .    a      b      c
+
+: a
+
+define : hello
+  display \"hello\\n\"
+
+let
+  : a 1
+    b 2
+  format #t \"a: ~A, b: ~A\"
+            .    a      b
+
+let : : a ' :
+
+let
+  :    ; foo
+    a
+      '
+
+:
+  a
+
+define : \\:
+  hello
+
+\\:
+")))
+
+(with-test-prefix "syntax-dot"
+(pass-if-equal '((define (foo)
+  "bar")
+
+(define (bar)
+  '(1
+    . 2 )); pair
+
+(display (foo))
+(newline)
+(display (bar))
+(newline)
+
+
+) (wisp->list "
+define : foo
+  . \"bar\"
+
+define : bar
+  ' 1
+    . . 2 ; pair
+
+display : foo
+newline
+display : bar
+newline
+")))
+
+(with-test-prefix "syntax-empty"
+(pass-if-equal '() (wisp->list "
+")))
+
+(with-test-prefix "syntax-indent"
+(pass-if-equal '((define
+  (hello who)
+  (format #t "Hello ~A\n" who))
+
+(define
+    (let
+      (
+        (a 1)
+        (b 2)
+        (c 3))
+      (format #t "a: ~A, b: ~A, c: ~A"
+                   (+ a 2)
+                          b      c)))
+
+
+
+) (wisp->list "define
+  hello who
+  format #t \"Hello ~A\\n\" who
+
+define
+    let
+      :
+        a 1
+        b 2
+        c 3
+      format #t \"a: ~A, b: ~A, c: ~A\"
+                   + a 2
+                   .        b      c
+
+                   ")))
+
+(with-test-prefix "syntax-strings-parens"
+(pass-if-equal '(; Test linebreaks in strings and brackets
+
+"flubbub
+
+flabbab"
+
+(hrug (nadda
+madda gadda "shoktom
+ mee"  " sep
+ka"
+  hadda)
+    (gom))
+
+(flu)
+
+(sum [foo
+bar] barz {1 + [* 2 2]})
+
+(mara {
+li
++
+lo - (mabba)
+})
+) (wisp->list "
+; Test linebreaks in strings and brackets
+
+. \"flubbub
+
+flabbab\"
+
+hrug (nadda
+madda gadda \"shoktom
+ mee\"  \" sep
+ka\"
+  hadda)
+    gom
+
+flu
+
+sum [foo
+bar] barz {1 + [* 2 2]}
+
+mara {
+li
++
+lo - (mabba)
+}
+")))
+
+(with-test-prefix "syntax-underscore"
+(pass-if-equal '((define (a b c)
+  (d e
+    (f)
+    (g h)
+    i))
+
+(define (_)
+   (display "hello\n"))
+
+(_)
+
+
+) (wisp->list "
+define : a b c
+_ d e
+___ f
+___ g h
+__  . i
+
+define : _
+_  display \"hello\\n\"
+
+\\_
+")))
+
-- 
2.41.0


[-- Attachment #1.3: Type: text/plain, Size: 1382 bytes --]


"Dr. Arne Babenhauserheide" <arne_bab@web.de> writes:
> I just got the most beautiful feedback on Wisp as a Scheme primer, so I
> would like to nag about inclusion of SRFI-119 into Guile again:
>
>   »I tend to use [Wisp] as a Scheme primer for colleagues that are used
>   to Python but want to explore the realms of functional programming
>   without … having to break with known syntax and conventions … it makes
>   Scheme way more “approachable” while not drifting too much apart.
>   
>   Before using Wisp as an introduction, I got occasional feedback that
>   parens where seen as confusing/somewhat cluttery in terms of
>   readability; Wisp looks as clean, plain and readable as Python code;
>   which makes it relatively easy to awake interest for Scheme in folks
>   that are accustomed to Python already.« — Wilko
>   https://emacs.ch/@thees/111720771253976695
>
>
> Inclusion in Guile would make it much easier for them to just try Wisp
> on any of the supported platforms, so I think this is a strong indicator
> that inclusion of Wisp would help spread Guile Scheme.


=> Is the squashed patch ok to merge?


Since it’s already rebased and the copyright assignment is in place, I
only need a “go for it” to push it.


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 --]