wisp
 
(Arne Babenhauserheide)
2014-09-02: this is the actual wisp-scheme. stable v0.6.4

this is the actual wisp-scheme.

diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,7 @@
+wisp 0.6.4 (2014-09-02):
+- an actually working wisp implementation for scheme (only) which uses the guile reader. This should be actually correct for scheme. And match-magic ☺
+- polishing.
+
 wisp 0.6.1 (2014-08-05):
 - simpler unicode handling
 - honor --quiet in bootstrapping
diff --git a/configure.ac b/configure.ac
--- a/configure.ac
+++ b/configure.ac
@@ -1,7 +1,7 @@
 dnl run `autoreconf -i` to generate a configure script. 
 dnl Then run ./configure to generate a Makefile.
 dnl Finally run make to generate the project.
-AC_INIT([wisp], [0.6.3],
+AC_INIT([wisp], [0.6.4],
         [arne_bab@web.de])
 # Check for programs I need for my build
 AC_CANONICAL_TARGET
diff --git a/wisp-scheme.w b/wisp-scheme.w
--- a/wisp-scheme.w
+++ b/wisp-scheme.w
@@ -14,7 +14,11 @@
 ;; directly create a list of codelines with indentation. For this we
 ;; then simply reuse the appropriate function from the generic wisp
 ;; preprocessor.
-
+;; 
+;; TODO: use match:
+;; (use-modules (ice-9 match))
+;; (define dot (call-with-input-string "." read))
+;; (match (list 'u 'v dot 'w) ((a ... b '#{.}# c) (append a (cons b c))) )
 
 define-module : wisp-scheme
    . #:export (wisp-scheme-read-chunk wisp-scheme-read-all 
@@ -25,6 +29,7 @@ use-modules
   srfi srfi-1
   srfi srfi-11 ; for let-values
   ice-9 rw ; for write-string/partial
+  ice-9 match
 
 ;; Helper functions for the indent-and-symbols data structure: '((indent token token ...) ...)
 define : line-indent line
@@ -42,9 +47,9 @@ define : line-code line
 
 ; literal values I need
 define readcolon 
-       call-with-input-string ":" read
+       string->symbol ":"
 define readdot
-       call-with-input-string "." read
+       string->symbol "."
 
 define : line-continues? line
          equal? readdot : car : line-code line
@@ -200,7 +205,7 @@ define : wisp-scheme-read-chunk-lines po
                    . currentsymbols
                    . emptylines
                         ; | cludge to appease the former wisp parser
-                        ; | which had a prblem with the literal comment
+                        ; | which had a problem with the literal comment
                         ; v char.
                : equal? (string-ref ";" 0) next-char
                  loop 
@@ -223,29 +228,6 @@ define : wisp-scheme-read-chunk-lines po
                    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"
@@ -434,76 +416,69 @@ define : wisp-scheme-strip-indentation-m
                   append processed : cdr : car unprocessed
                   cdr unprocessed
 
-define : wisp-scheme-recreate-incomeplete-lists expressions
+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 incomplete lists
+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 incomplete lists.
+code to recreate the improper lists.
 
-Traverse each list and sublist backwards, and if it contains a
-readdot, cons every element in the list on the last element.
+Match is awesome!"
+      let 
+        : 
+          improper
+            match code
+               : a ... b '#{.}# c
+                 append (map wisp-make-improper a) 
+                   cons (wisp-make-improper b) (wisp-make-improper c)
+               : a ...
+                 map wisp-make-improper a
+               a
+                 . a
+        define : syntax-error li
+                throw 'wisp-syntax-error (format #f "incorrect dot-syntax #{.}# in code: not a proper pair: ~A" li)
+        let check
+          : tocheck improper
+          match tocheck
+            ; lists with only one member
+            : '#{.}#
+              syntax-error tocheck
+            ; list with remaining dot.
+            : a ...
+              if : member readdot a
+                   syntax-error tocheck
+                   map check a
+            ; simple pair
+            : '#{.}# . c
+              syntax-error tocheck
+            ; simple pair, other way round
+            : a . '#{.}#
+              syntax-error tocheck
+            ; more complex pairs
+            : ? pair? a
+              let 
+                : head : drop-right a 1
+                  tail : last-pair a
+                cond
+                 : equal? readdot : car tail
+                   syntax-error tocheck
+                 : equal? readdot : cdr tail
+                   syntax-error tocheck
+                 : member readdot head
+                   syntax-error tocheck
+                 else
+                   . a
+            a
+              . a
 
-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
+              wisp-make-improper
+                wisp-scheme-indentation-to-parens lines
 
 define : wisp-scheme-read-all port
          . "Read all chunks from the given port"
@@ -511,7 +486,6 @@ define : wisp-scheme-read-all port
            : tokens '()
            cond
              : eof-object? : peek-char port
-               ; TODO: Join as string.
                . tokens
              else
                loop
@@ -526,30 +500,47 @@ define : wisp-scheme-read-file-chunk pat
 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
 
-; 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 
+
+;;;; Test improper lists
+;;;; Good cases
+; 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 
+;;;; Syntax Error cases
+; write
+;   wisp-scheme-read-string  "foo
+;   . . ."
+; newline 
+; write
+;   wisp-scheme-read-string  "moo : . . bar"
+; write
+;   wisp-scheme-read-string  "foo .
+;   . . bar"
+; newline 
+; write
+;   wisp-scheme-read-string  "moo
+;   foo
+;     . . bar baz
+; baz waz"
+; newline 
+;;;; stranger stuff
 ; write
 ;   wisp-scheme-read-string  "foo ; bar\n  ; nop \n\n; nup\n; nup \n  \n\n\nfoo : moo \"\n\" \n___ . goo . hoo"
 ; newline 
@@ -558,13 +549,13 @@ newline
 ; 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!
+; 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" ; actually runs wisp-guile.w with the arguments supplied to this script.
+; uncomment the previous line, then run the next line in the shell. If 1 and 2 are 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