tisp

commit 54618f7fc9df7df77ff09dd62ddb8b1185b31581
parent 9c817c76b1a5965203db65704be6770102d6cb0f
Author: Ed van Bruggen <edvb@uw.edu>
Date:   Mon,  4 Jan 2021 19:47:03 -0800

Fix unquote-splice for non pair values

Diffstat:
test.c
 | 
31
++++++++++++++++++-------------
tib/core.tsp
 | 
13
+++++++------

2 files changed, 25 insertions(+), 19 deletions(-)
diff --git a/test.c b/test.c
@@ -350,19 +350,24 @@ char *tests[][2] = {
 	{ "(member \"quux\" (list 4.2 3 'quux))",           "Nil"                 },
 	{ "(member 'qux '(foo bar baz))",                   "Nil"                 },
 
-	{ "quasiquote",          NULL              },
-	{ "`7.2",                "7.2"             },
-	{ "`cory",               "cory"            },
-	{ "`,foo",               "9"               },
-	{ "`(1 2 3)",            "(1 2 3)"         },
-	{ "`(\"sunnyvale\")",    "(sunnyvale)"     },
-	{ "`(1/2 . 2/1)",        "(1/2 . 2)"       },
-	{ "`(cory trevor)",      "(cory trevor)"   },
-	{ "`(foo bar quax)",     "(foo bar quax)"  },
-	{ "`(,foo ,bar)",        "(9 4)"           },
-	{ "`(,foo . ,bar)",      "(9 . 4)"         },
-	{ "`(,foo . ,bar)",      "(9 . 4)"         },
-	{ "`(foo bar ,foo fry)", "(foo bar 9 fry)" },
+	{ "quasiquote",               NULL              },
+	{ "`7.2",                     "7.2"             },
+	{ "`cory",                    "cory"            },
+	{ "`,foo",                    "9"               },
+	{ "`(1 2 3)",                 "(1 2 3)"         },
+	{ "`(\"sunnyvale\")",         "(sunnyvale)"     },
+	{ "`(1/2 . 2/1)",             "(1/2 . 2)"       },
+	{ "`(cory trevor)",           "(cory trevor)"   },
+	{ "`(foo bar quax)",          "(foo bar quax)"  },
+	{ "`(,foo ,bar)",             "(9 4)"           },
+	{ "`(,foo . ,bar)",           "(9 . 4)"         },
+	{ "`(,foo . ,bar)",           "(9 . 4)"         },
+	{ "`(foo bar ,foo fry)",      "(foo bar 9 fry)" },
+	{ "`(1 ,(+ 1 2) 5 ,(- 9 2))", "(1 3 5 7)"       },
+	{ "`(1 ,@(list 4 9))",        "(1 4 9)"         },
+	{ "`(3 ,@foo)",               "(3 . 9)"         },
+	{ "`(a b c ,@foo)",           "(a b c . 9)"     },
+	{ "`(0 ,@(list 1 2) 3 4)",    "(0 1 2 3 4)"     },
 
 	{ "stack",                                   NULL                 },
 	{ "(peek '(1 2 3 4 5 6))",                   "1"                  },
diff --git a/tib/core.tsp b/tib/core.tsp
@@ -130,11 +130,11 @@
 ; TODO `(0 ,@1) => (0 . 1)
 (defmacro (quasiquote expr)
   "Recursively quote the given expression
-  Automatically quotes each element in the expression, but evaluates the
-  element if it is labeled with the unquoted macro.
+  Automatically quotes each element within the expression, but evaluates the
+  element if it is labeled with the unquote macro.
   Can be shortened with the ` prefix.
   Also see quote, unquote, and unquote-splice"
-  (def (check form)
+  (def (check form) ; TODO don't redefine functions every call
     (unless (and (pair? (cdr form)) (nil? (cddr form)))
       (error (car form) "invalid form " form)))
   (def (quasicons a d)
@@ -151,6 +151,7 @@
       (list list* a d)))
   (recur f ((expr expr) (n 0))
     (cond
+      ((nil? expr) Nil)
       ((atom? expr) (list 'quote expr))
       ((= (car expr) 'quasiquote)
        (check expr)
@@ -168,9 +169,9 @@
       ((and (= n 0) (and (pair? (car expr)) (= (caar expr) 'unquote-splice)))
        (check (car expr))
        (let ((d (f (cdr expr) n)))
-         (if (= d '(quote nil))
-           (cadar expr)
-           (list 'append (cadar expr) d))))
+         (if d
+           (list 'append (cadar expr) d)
+           (cadar expr))))
       (else (quasicons (f (car expr) n) (f (cdr expr) n))))))
 
 (defmacro (unquote expr)