wisp
 
(Arne Babenhauserheide)
2017-02-06: very unclean but working support for unquote-splicing (including a tip

very unclean but working support for unquote-splicing (including a list of words via ,@list-of-words).

diff --git a/examples/duel.w b/examples/duel.w
--- a/examples/duel.w
+++ b/examples/duel.w
@@ -34,11 +34,11 @@ define : list->textline L
 define : duel me other
   let*
     : challenge : random-challenge
-      tease : list->textline : car challenge
+      tease : car challenge
       answers : map list->textline : cdr challenge
     say-name other
     say-words
-      : ,tease
+      : ,@tease
     say-name ' : choose your answer
     ;; TODO: shuffle the answers, check whether the right one is given
     ;; (the first answer in the original ordering is the right one)
diff --git a/examples/enter-three-witches.w b/examples/enter-three-witches.w
--- a/examples/enter-three-witches.w
+++ b/examples/enter-three-witches.w
@@ -65,8 +65,9 @@ define : color col
 
 define-syntax say-words 
     lambda (x)
-        syntax-case x ()
-            : _ (((word words ...))) (() lines ...)
+        syntax-case x (fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0)
+            : _ (((word words ...))) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...)
+              ;; TODO: move out to a helper macro
               #` begin
                  let : : w `word
                    cond
@@ -77,23 +78,64 @@ define-syntax say-words
                      else
                        show " "
                        show : ->string w
-                 say-words (((words ...))) (() lines ...)
-            : _ ((())) (() lines ...)
+                 say-words (((words ...))) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...)
+            : _ ((())) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0  (() lines ...)
               #` begin
                  usleep 200000
                  newline
                  say-words (lines ...)
             ;; lines of form ,(...)
             : _ ((unq (word words ...)) lines ...)
-              #` begin if : equal 'unquote `unq
+              #` if : equal? 'unquote `unq ;; FIXME: This guard seems to not actually work
               #` begin ; add an extra level of parens
                  show " "
-                 say-words (((unq (word words ...)))) (() lines ...)
-            : _ ((word words ...) lines ...)
+                 say-words (((unq (word words ...)))) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...)
+            : _ (((unq word)) lines ...)
+              #` if : equal? 'unquote-splicing `unq ;; FIXME: This guard seems to not actually work
+              #` begin ; include the unquoting without extra level of parentheses
+                 ;; TODO: clean this up. This duplicates logic in the first case, and duplicates it again internally.
+                 show " "
+                 apply
+                     λ (unq x)
+                        cond
+                          : equal? 'unquote-splicing unq
+                            map (λ (x) (show " ")(show x))
+                                if : pair? x
+                                     map ->string x
+                                     . x
+                          : equal? 'unquote unq
+                            cond
+                              : equal? x #f
+                                . #f
+                              : equal? x '..
+                                show "."
+                              else
+                                show " "
+                                show : ->string x
+                          else
+                            cond
+                              : equal? unq #f
+                                . #f
+                              : equal? unq '..
+                                show "."
+                              else
+                                show " "
+                                show : ->string unq
+                            cond
+                              : equal? x #f
+                                . #f
+                              : equal? x '..
+                                show "."
+                              else
+                                show " "
+                                show : ->string x
+                     list 'unq word
+                 say-words ((())) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...)
+            : _ ((word words ...) lines ...) ; start of a line
               #` begin
                  show " "
-                 say-words (((word words ...))) (() lines ...)
-            : _ (() lines ...)
+                 say-words (((word words ...))) fdb6c10f-f8bf-4bb5-82c5-d3a5cd37b7c0 (() lines ...)
+            : _ (() lines ...) ; finished showing the line, show the next one
               #` say-words (lines ...)
             : _ (lines ...)
               #` begin