(Arne Babenhauserheide)
2014-09-02: merge wisp-scheme. merge wisp-scheme.
diff --git a/.bugs/bugs b/.bugs/bugs
--- a/.bugs/bugs
+++ b/.bugs/bugs
@@ -1,3 +1,4 @@
+testsuite: to pass, the tree-il has to match, not the emitted string. This allows for reader-only implementations. | owner:, open:True, id:00b74a730bbf076e73166e817ca7b0a273b376d4, time:1408224636.42
fails when I add stuff at the end of end of example.w | owner:, open:False, id:08c68e1ce0c9798184c01806d2661a3220bff3cd, time:1363789693.79
wisp-mode in quoted lists only the first item is colorized as data, but all words up to the last paren should be colorized. | owner:, open:True, id:1675ca3f894ed8470fa292149a476a2fa0d17140, time:1397196957.45
add a testsuite for wisp parsers. | owner:, open:False, id:1c05d27ac916e1a823b8985a094947907c3c19af, time:1379064922.74
@@ -19,6 +20,7 @@ the repl does not require 3 returns when
wisp-guile.w breaks on ";" and complex brackets with bracket char literals. See wisp-guile.w::91 | owner:, open:False, id:9d8b6f87fa5365733fc8655614dbf2a9ba5bd054, time:1377533321.27
FIX regression: empty line with only : does not remove the :. It transforms to (:, it should transform to ( | owner:, open:False, id:a2323d347612425bc5af577c939916c8b60ec1c9, time:1389631450.78
wisp-mode: handle lines starting with underscores: currently sees the underscores as function call. | owner:Arne Babenhauserheide <bab@draketo.de>, open:True, id:b2c3755e1deb8355655a334d569679e2e62d2836, time:1376612093.55
+parens in comments can throw off the parser. | owner:, open:True, id:ce28d6c0d1f9894c9b946e56b17934473800edfe, time:1408224406.79
make this work: let : : origfile ( open-file : nth 1 : command-line ) r | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:d6de2074a5017f1f29f34d142ce797981ed270a0, time:1366529287.67
wisp.py breaks on \ - quote, escaped backslash, quote. Ignored, because wisp.py is only needed for bootstrapping. | owner:Arne Babenhauserheide <bab@draketo.de>, open:False, id:d75a93ca58ade5b3e3e51f1e7ee9782e743ac131, time:1377424552.02
comments containing a closing parenthesis can break the parser. | owner:, open:False, id:d9147504868960e5fbc2648474d48ce5c9bd1a02, time:1374838747.22
diff --git a/.bugs/details/ce28d6c0d1f9894c9b946e56b17934473800edfe.txt b/.bugs/details/ce28d6c0d1f9894c9b946e56b17934473800edfe.txt
new file mode 100644
--- /dev/null
+++ b/.bugs/details/ce28d6c0d1f9894c9b946e56b17934473800edfe.txt
@@ -0,0 +1,26 @@
+# Lines starting with '#' and sections without content
+# are not displayed by a call to 'details'
+#
+[paths]
+# Paths related to this bug.
+# suggested format: REPO_PATH:LINENUMBERS
+see tests/strangecomments.w tests/strangecomments.scm
+
+[details]
+# Additional details
+
+
+[expected]
+# The expected result
+
+
+[actual]
+# What happened instead
+
+
+[reproduce]
+# Reproduction steps
+
+
+[comments]
+# Comments and updates - leave your name
diff --git a/examples/d20world.w b/examples/d20world.w
--- a/examples/d20world.w
+++ b/examples/d20world.w
@@ -187,6 +187,27 @@ define : d20-advect world advection-dire
define φ : * (/ 1 2) : 1+ : sqrt 5
+define : latlon2cellidx lat lon
+ . "Convert a position given as latitude and longitude into the correct cell index."
+ ; cell 1 (index 0) is on top, cell 20 at the bottom. The right
+ ; border of cell 2 is situated at longitude 0. With that, the
+ ; left corner of cell 19 is at longitude 180. Top and bottom
+ ; are point-symmetric. We can cleanly divide the upper part of
+ ; the icosaeder into 3 regions by longitude. Let's do that.
+ let*
+ : upper : > lat 0
+ ; we start by switching to a symmetric longitude
+ slon : if upper lon : + lon 180
+ ; the sector number is defined by the uppermost triangle
+ ; in it.
+ sector : if (< slon 120) 4 (if (< slon 270) 3 2)
+ ; we start by calculating the fraction inside the sector
+ lonsectorfraction : modulo slon 120
+ ; we can further subdivide the sector by longitude into two subsectors
+ subseclon : if (< lon 60) lon (-120 lon)
+ ; TODO find some more symmetry or start nontrivial geometry.
+ . #t
+
display : d20-as-text world
newline
diff --git a/tests/strangecomments.scm b/tests/strangecomments.scm
new file mode 100644
--- /dev/null
+++ b/tests/strangecomments.scm
@@ -0,0 +1,19 @@
+; 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)
+
+; broken
+; expected:
+; ((2 (foo)) (2) (0) (0) (2 foo : moo
+; ) (4 #{.}# [goo #{.}# hoo]))
+(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)
+
diff --git a/tests/strangecomments.w b/tests/strangecomments.w
new file mode 100644
--- /dev/null
+++ b/tests/strangecomments.w
@@ -0,0 +1,18 @@
+; 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
+
+; broken
+; expected:
+; ((2 (foo)) (2) (0) (0) (2 foo : moo
+; ) (4 #{.}# [goo #{.}# hoo]))
+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
diff --git a/wisp-guile.w b/wisp-guile.w
--- a/wisp-guile.w
+++ b/wisp-guile.w
@@ -69,8 +69,8 @@ Ends with three consecutive linebreaks o
not
or : eof-object? nextchar
and
- or (char=? nextchar #\linefeed ) (char=? nextchar #\newline )
- or (char=? lastchar #\linefeed ) (char=? lastchar #\newline )
+ or (char=? nextchar #\newline ) (char=? nextchar #\return )
+ or (char=? lastchar #\newline ) (char=? lastchar #\return )
string-suffix? "\n\n" text ; text includes lastchar
; incommentfirstchar is only valid for exactly one char
when incommentfirstchar : set! incommentfirstchar #f
@@ -90,7 +90,7 @@ Ends with three consecutive linebreaks o
when : >= incharform 2
if : or (char=? nextchar #\space) (char=?
- nextchar #\linefeed ) (char=? nextchar #\newline )
+ nextchar #\newline ) (char=? nextchar #\return )
begin
; format #t "2: set incharform 0: lastchar ~a nextchar ~a instring ~a incomment ~a incharform ~a" lastchar nextchar instring incomment incharform
; newline
@@ -113,8 +113,8 @@ Ends with three consecutive linebreaks o
; not : equal? #f : string-match "\\([^\\]\\)+\\(\\\\\\\\\\)*[\\]$" text ; matches [^\](\\)*\$ - non-backslash + arbitrary number of pairs of backslashes + final backslash which undoes the escaping from the lastchar (by actually escaping the lastchar)
endsinunevenbackslashes text
char=? lastchar #\space ; when the last char was a space, I can get into a string
- char=? lastchar #\linefeed ; same for newline chars
- char=? lastchar #\newline
+ char=? lastchar #\newline ; same for newline chars
+ char=? lastchar #\return
and : not instring ; outside of strings, brackets are pseudo-whitespace, too
or
char=? lastchar #\(
@@ -141,8 +141,8 @@ Ends with three consecutive linebreaks o
when
and incomment
or
+ char=? nextchar #\return
char=? nextchar #\newline
- char=? nextchar #\linefeed
set! incomment #f
; check for the beginning of a charform
@@ -176,11 +176,11 @@ Ends with three consecutive linebreaks o
when : or (equal? "}" (string nextchar)) (equal? ")" (string nextchar)) (equal? "]" (string nextchar))
set! inbrackets : - inbrackets 1
if : or instring : > inbrackets 0
- if : char=? nextchar #\linefeed
+ if : char=? nextchar #\newline
; we have to actually construct the escape
; sequence here to be able to parse ourselves.
set! text : string-append text : string-append "\\LINE_" "BREAK_N"
- if : char=? nextchar #\newline
+ if : char=? nextchar #\return
set! text : string-append text : string-append "\\LINE_" "BREAK_R"
; else
set! text : string-append text : string nextchar
@@ -207,7 +207,7 @@ define : splitlines inport
nextchar : read-char inport
nextline ""
while : not : eof-object? nextchar
- if : not : or (char=? nextchar #\newline ) (char=? nextchar #\linefeed )
+ if : not : or (char=? nextchar #\return ) (char=? nextchar #\newline )
set! nextline : string-append nextline : string nextchar
begin
set! lines : append lines (list nextline)
@@ -239,7 +239,7 @@ define : line-only-colon? line
equal? ":" : string-trim-right : line-content line
define : line-only-prefix? line prefix
- . "Check whether the line content consists only of a colon and whitespace."
+ . "Check whether the line content consists only of a given prefix and whitespace."
equal? prefix : string-trim-right : line-content line
define : line-merge-comment line
@@ -490,7 +490,7 @@ Also unescape \\: to :.
linebracketizer instring inbrackets bracketstoadd
. (string-append (string-drop-right unprocessed 5) "#,@,")
. processed
- : . else ; just go on
+ else ; just go on
linebracketizer instring inbrackets bracketstoadd
. (string-drop-right unprocessed 1)
. (string-append lastletter processed)
@@ -746,9 +746,9 @@ define : unescape-linebreaks text
. "unescape linebreaks"
string-replace-substring
; we have to construct the placeholders here to avoid unescaping them when we parse ourselves…
- string-replace-substring text (string-append "\\LINE_" "BREAK_N") : string #\linefeed
+ string-replace-substring text (string-append "\\LINE_" "BREAK_N") : string #\newline
string-append "\\LINE_" "BREAK_R"
- string #\newline
+ string #\return
define : unescape-comments text
diff --git a/wisp-scheme.w b/wisp-scheme.w
new file mode 100755
--- /dev/null
+++ b/wisp-scheme.w
@@ -0,0 +1,570 @@
+#!/home/arne/wisp/wisp-multiline.sh
+; !#
+
+;; Scheme-only implementation of a wisp-preprocessor which output a
+;; scheme Tree IL to feed to a scheme interpreter instead of a
+;; preprocessed file.
+
+;; Plan:
+;; read reads the first expression from a string. It ignores comments,
+;; so we have to treat these specially. Our wisp-reader only needs to
+;; worry about whitespace.
+;;
+;; So we can skip all the string and bracket linebreak escaping and
+;; directly create a list of codelines with indentation. For this we
+;; then simply reuse the appropriate function from the generic wisp
+;; preprocessor.
+
+
+define-module : wisp-scheme
+ . #:export (wisp-scheme-read-chunk wisp-scheme-read-all
+ wisp-scheme-read-file-chunk wisp-scheme-read-file
+ wisp-scheme-read-string)
+
+use-modules
+ srfi srfi-1
+ srfi srfi-11 ; for let-values
+ ice-9 rw ; for write-string/partial
+
+;; Helper functions for the indent-and-symbols data structure: '((indent token token ...) ...)
+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
+ cdr line
+
+; literal values I need
+define readcolon
+ call-with-input-string ":" read
+define readdot
+ call-with-input-string "." read
+
+define : line-continues? line
+ equal? readdot : 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
+ append
+ list
+ line-indent line
+ cdr : line-code line
+ . line
+
+define : line-strip-indentation-marker line
+ ' "Strip the indentation markers from the beginning of the line"
+ 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
+ throw 'wisp-syntax-error "Level ~A not found in the indentation-levels ~A."
+
+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 : wisp-scheme-read-chunk-lines port
+ let loop
+ : indent-and-symbols : list ; '((5 "(foobar)" "\"yobble\"")(3 "#t"))
+ inindent #t
+ inunderscoreindent : equal? #\_ : peek-char port
+ incomment #f
+ currentindent 0
+ currentsymbols '()
+ emptylines 0
+ let : : next-char : peek-char port
+ cond
+ : eof-object? next-char
+ append indent-and-symbols : list : append (list currentindent) currentsymbols
+ : <= 2 emptylines
+ . indent-and-symbols
+ : and inindent : equal? #\space next-char
+ read-char port ; remove char
+ loop
+ . indent-and-symbols
+ . #t ; inindent
+ . #f ; inunderscoreindent
+ . #f ; incomment
+ 1+ currentindent
+ . currentsymbols
+ . emptylines
+ : and inunderscoreindent : equal? #\_ next-char
+ read-char port ; remove char
+ loop
+ . indent-and-symbols
+ . #t ; inindent
+ . #t ; inunderscoreindent
+ . #f ; incomment
+ 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.
+ : and inunderscoreindent : not : equal? #\space next-char
+ throw 'wisp-syntax-error "initial underscores without following whitespace at beginning of the line after" : last indent-and-symbols
+ : or (equal? #\newline next-char) (equal? #\return next-char)
+ read-char port ; remove the newline
+ ; TODO: Check whether when or if should be preferred here. guile 1.8 only has if.
+ if : and (equal? #\newline next-char) : equal? #\return : peek-char port
+ read-char port ; remove a full \n\r. Damn special cases...
+ 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
+ incomment
+ if : = 0 currentindent ; specialcase
+ . -1
+ . currentindent
+ : not : null? currentsymbols ; pure whitespace
+ . currentindent
+ else
+ . 0
+ parsedline : append (list indent) currentsymbols
+ ; 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 ; inindent
+ equal? #\_ : peek-char port
+ . #f ; incomment
+ . 0
+ . '()
+ if : line-empty? parsedline
+ 1+ emptylines
+ . 0
+ : equal? #t incomment
+ read-char port ; remove one comment character
+ loop
+ . indent-and-symbols
+ . #f ; inindent
+ . #f ; inunderscoreindent
+ . #t ; incomment
+ . currentindent
+ . currentsymbols
+ . emptylines
+ : or (equal? #\space next-char) (equal? #\tab next-char) ; remove whitespace when not in indent
+ read-char port ; remove char
+ loop
+ . indent-and-symbols
+ . #f ; inindent
+ . #f ; inunderscoreindent
+ . #f ; incomment
+ . currentindent
+ . currentsymbols
+ . emptylines
+ ; | cludge to appease the former wisp parser
+ ; | which had a prblem with the literal comment
+ ; v char.
+ : equal? (string-ref ";" 0) next-char
+ loop
+ . indent-and-symbols
+ . #f ; inindent
+ . #f ; inunderscoreindent
+ . #t ; incomment
+ . currentindent
+ . currentsymbols
+ . emptylines
+ else ; use the reader
+ loop
+ . indent-and-symbols
+ . #f ; inindent
+ . #f ; inunderscoreindent
+ . #f ; incomment
+ . currentindent
+ ; this also takes care of the hashbang and leading comments.
+ ; TODO: If used from Guile, activate curly infix via read-options.
+ append currentsymbols : list : read port
+ . emptylines
+
+define : line-append-n-parens n line
+ . "Append N parens at the end of the line"
+ let loop : (rest n) (l line)
+ cond
+ : = 0 rest
+ . l
+ else
+ loop (1- rest) (append l '(")"))
+
+define : line-prepend-n-parens n line
+ . "Prepend N parens at the beginning of the line, but after the indentation-marker"
+ let loop : (rest n) (l line)
+ cond
+ : = 0 rest
+ . l
+ else
+ loop
+ 1- rest
+ append
+ list : car l
+ . '("(")
+ cdr l
+
+
+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
+ : equal? readcolon : car unprocessed
+ loop
+ ; FIXME: This should turn unprocessed into a list.
+ 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
+ list : line-indent line
+ . line
+
+define : line-finalize line
+ . "Process all wisp-specific information in a line and strip it"
+ line-code-replace-inline-colons
+ line-strip-indentation-marker
+ line-strip-lone-colon
+ line-strip-continuation line
+
+
+define : wisp-scheme-indentation-to-parens lines
+ . "Add parentheses to lines and remove the indentation markers"
+ ; FIXME: Find new algorithm which mostly uses current-line
+ ; and the indentation-levels for tracking. The try I have in
+ ; here right now is wrong.
+ 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
+ throw 'wisp-syntax-error
+ 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
+ list 0 ; empty code
+ next-line
+ if : <= 2 : length unprocessed
+ car : cdr unprocessed
+ list 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))
+ ; display "done\n"
+ ; reverse the processed lines, because I use cons.
+ . processed
+ ; the recursion end-condition
+ : and (null? unprocessed)
+ ; display "last step\n"
+ ; 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
+ ; display "indentation-levels null\n"
+ throw 'wisp-programming-error "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
+ ; display "current-line empty\n"
+ ; We cannot process indentation without
+ ; code. Just switch to the next line. This should
+ ; only happen at the start of the recursion.
+ ; TODO: Somehow preserve the line-numbers.
+ loop
+ . processed
+ cdr unprocessed
+ . indentation-levels
+ : and (line-empty-code? next-line) : <= 2 : length unprocessed
+ ; display "next-line empty\n"
+ ; TODO: Somehow preserve the line-numbers.
+ ; take out the next-line from unprocessed.
+ loop
+ . processed
+ cons current-line
+ cdr : cdr unprocessed
+ . indentation-levels
+ : > current-indentation current-line-indentation
+ ; display "current-indent > next-line\n"
+ ; this just steps back one level via the side-recursion.
+ values processed unprocessed
+ : = current-indentation current-line-indentation
+ ; display "current-indent = next-line\n"
+ 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
+ ; display "current-line-indent >= next-line-indent\n"
+ loop
+ append processed
+ if : line-continues? current-line
+ . line
+ list line
+ cdr unprocessed ; recursion here
+ . indentation-levels
+ : < current-line-indentation next-line-indentation
+ ; display "current-line-indent < next-line-indent\n"
+ ; format #t "line: ~A\n" line
+ ; side-recursion via a sublist
+ let-values
+ :
+ : sub-processed sub-unprocessed
+ loop
+ . line
+ cdr unprocessed ; recursion here
+ . indentation-levels
+ ; format #t "side-recursion:\n sub-processed: ~A\n processed: ~A\n\n" sub-processed processed
+ loop
+ append processed : list sub-processed
+ . sub-unprocessed ; simply use the recursion from the sub-recursion
+ . indentation-levels
+ : < current-indentation current-line-indentation
+ ; display "current-indent < next-line\n"
+ loop
+ . processed
+ . unprocessed
+ cons ; recursion via the indentation-levels
+ . current-line-indentation
+ . indentation-levels
+ else
+ throw 'wisp-not-implemented
+ 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-scheme-recreate-incomeplete-lists expressions
+ . "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 incomplete lists
+when it reads a dot. So we have to take another pass over the
+code to recreate the incomplete lists.
+
+Traverse each list and sublist backwards, and if it contains a
+readdot, cons every element in the list on the last element.
+
+TODO: Find out how I can do that, when the second element is a
+function call (a list). Problem: (cons 1 '(2)) -> '(1 2).
+
+TODO: Find out whether this would actually be legal scheme code.
+ (write (1 . (+ 1 2))) -> error
+ (write . (+ 1 2)) -> strange
+ (write (list 1 . (+ 1 2))) -> (1 #<procedure + (#:optional _ _ . _)> 1 2) ???
+ (list 1 . (list 2 3)) -> (1 #<procedure list _> 2 3)
+ (list . (list 2 3)) -> (#<procedure list _> 2 3) == (list list 2 3)"
+ ; FIXME: Implement recreating incomplete lists!
+ let loop
+ : processed '()
+ unprocessed-reversed expressions
+ cond
+ : null? unprocessed-reversed
+ . processed
+ : not : list? unprocessed-reversed
+ ; FIXME: This requires unlimited amounts of memory.
+ cons unprocessed-reversed processed
+ : not : member readdot unprocessed-reversed
+ cond
+ : list? : car unprocessed-reversed
+ loop
+ cons
+ loop '() : car unprocessed-reversed
+ . processed
+ . unprocessed-reversed
+ else
+ loop
+ cons (car unprocessed-reversed) processed
+ cdr unprocessed-reversed
+ else ; cons unprocessed on its tail
+ let conser
+ : proc-reversed : car unprocessed-reversed
+ unproc : cdr unprocessed-reversed
+ cond
+ : null? unproc
+ ; back to the main loop
+ loop
+ . processed
+ . proc-reversed
+ : equal? readdot : car unproc ; just skip the dot. It is why we cons.
+ conser
+ . proc-reversed
+ cdr unproc
+ else
+ conser
+ cons (car unproc) proc-reversed
+ cdr unproc
+
+define : wisp-scheme-read-chunk port
+ . "Read and parse one chunk of wisp-code"
+ let : : lines : wisp-scheme-read-chunk-lines port
+ ; display lines
+ ; newline
+ ; FIXME: incmoplete list recreation does not work yet
+ ; wisp-scheme-recreate-incomeplete-lists
+ 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
+ ; TODO: Join as string.
+ . 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
+
+
+; TODO: Recreate incomplete lists.
+write
+ wisp-scheme-read-string "foo . bar"
+newline
+write
+ wisp-scheme-read-string "foo .
+ . bar"
+newline
+write
+ wisp-scheme-read-string "foo
+ . . bar"
+newline
+write
+ wisp-scheme-read-string "moo
+ foo
+ . . bar
+baz waz"
+newline
+; systax error
+write
+ wisp-scheme-read-string "foo .
+ . . bar"
+newline
+; write
+; wisp-scheme-read-string "foo ; bar\n ; nop \n\n; nup\n; nup \n \n\n\nfoo : moo \"\n\" \n___ . goo . hoo"
+; newline
+; display
+; wisp-scheme-read-string " foo ; bar\n ; nop \n\n; nup\n; nup \n \n\n\nfoo : moo"
+; newline
+; write : wisp-scheme-read-file-chunk "wisp-scheme.w"
+; newline
+; run all chunks in wisp-guile.w as parsed by wisp-scheme.w. Give wisp-guile.w to parse as argument.
+; map primitive-eval : wisp-scheme-read-file "wisp-guile.w"
+; call-with-output-file "wisp-guile.scm"
+; lambda : port
+; map
+; lambda : chunk
+; write chunk port
+; wisp-scheme-read-file "wisp-guile.w"
+; pipe the output into 1, then compare it with the output of wisp.scm. If it is equal, this parser works!
+; guile wisp.scm wisp-scheme.w > wisp-scheme.scm; guile wisp-scheme.scm wisp-guile.w > 1; guile wisp.scm wisp-guile.w > 2; diff 1 2