Add qq (, uq and uqs) for a quasiquote macro.

quasiquoting is not (yet) supported as a special
form and has no syntactic sugar.

Makefile

@@ -160,7 +160,6 @@ test: $(JANET_TARGET) $(TEST_PROGRAMS)
 	./$(JANET_TARGET) test/suite0.janet
 	./$(JANET_TARGET) test/suite1.janet
 	./$(JANET_TARGET) test/suite2.janet
-	./$(JANET_TARGET) test/suite3.janet
 
 valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
 	valgrind --leak-check=full -v ctest/system_test.out
@@ -170,7 +169,6 @@ valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
 	valgrind --leak-check=full -v ./$(JANET_TARGET) test/suite0.janet
 	valgrind --leak-check=full -v ./$(JANET_TARGET) test/suite1.janet
 	valgrind --leak-check=full -v ./$(JANET_TARGET) test/suite2.janet
-	valgrind --leak-check=full -v ./$(JANET_TARGET) test/suite3.janet
 
 ###################
 ##### Natives #####

README.md

@@ -30,7 +30,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
 * First class closures
 * Garbage collection
 * First class green threads (continuations)
-* Python style generators
+* Python style generators (implemented as a plain macro)
 * Mutable and immutable arrays (array/tuple)
 * Mutable and immutable hashtables (table/struct)
 * Mutable and immutable strings (buffer/string)
@@ -43,7 +43,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
 * Lexical scoping
 * Imperative programming as well as functional
 * REPL
-* 300+ functions in the core library
+    * 300+ functions and macros in the core library
 * Interactive environment with detailed stack traces
 
 ## Documentation

src/core/core.janet

@@ -776,7 +776,6 @@ value, one key will be ignored."
     (put res keys@i vals@i))
   res)
 
-
 (defn update
   "Accepts a key argument and passes its' associated value to a function.
   The key then, is associated to the function's return value"
@@ -999,14 +998,14 @@ value, one key will be ignored."
       x))
   ret)
 
-(defn all? [xs]
+(defn all? [pred xs]
   (var good true)
-  (loop [x :in xs :while good] (if x nil (:= good false)))
+  (loop [x :in xs :while good] (if (pred x) nil (:= good false)))
   good)
 
-(defn some? [xs]
+(defn some? [pred xs]
   (var bad true)
-  (loop [x :in xs :while bad] (if x (:= bad false)))
+  (loop [x :in xs :while bad] (if (pred x) (:= bad false)))
   (not bad))
 
 (defn deep-not= [x y]
@@ -1016,8 +1015,8 @@ value, one key will be ignored."
   (or
     (not= tx (type y))
     (case tx
-      :tuple (or (not= (length x) (length y)) (some? (map deep-not= x y)))
-      :array (or (not= (length x) (length y)) (some? (map deep-not= x y)))
+      :tuple (or (not= (length x) (length y)) (some? identity (map deep-not= x y)))
+      :array (or (not= (length x) (length y)) (some? identity (map deep-not= x y)))
       :struct (deep-not= (pairs x) (pairs y))
       :table (deep-not= (table.to-struct x) (table.to-struct y))
       :buffer (not= (string x) (string y))
@@ -1333,3 +1332,23 @@ value, one key will be ignored."
          k :keys envi]
     (:= symbol-set@k true))
   (sort (keys symbol-set)))
+
+(defmacro qq
+  "Quasiquote."
+  [x]
+  (defn- uqs? [x]
+    (and (tuple? x) (= x@0 'uqs)))
+  (defn- uqs [x]
+    (if (uqs? x)
+      (tuple apply array x@1)
+      @[(qq x)]))
+  (case (type x)
+    :symbol (tuple 'quote x)
+    :tuple (cond 
+             (= x@0 'uq) x@1
+             (some? uqs? x) (tuple  tuple.slice (tuple.prepend (map uqs x) array.concat))
+             (apply tuple tuple (map qq x)))
+    :array (apply array (map qq x))
+    :struct (apply struct (interleave (map qq (keys x)) (map qq (values x))))
+    :table (apply table (interleave (map qq (keys x)) (map qq (values x))))
+    x))

test/suite3.janet

@@ -1,50 +0,0 @@
-# Copyright (c) 2018 Calvin Rose
-#
-# Permission is hereby granted, free of charge, to any person obtaining a copy
-# of this software and associated documentation files (the "Software"), to
-# deal in the Software without restriction, including without limitation the
-# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-# sell copies of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be included in
-# all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-# IN THE SOFTWARE.
-
-(import test.helper :prefix "" :exit true)
-(start-suite 3)
-
-# Class stuff
-(defclass Car)
-
-(defnew Car
-  "Make a new car."
-  [color]
-  (put self :color color))
-
-(defm Car:honk
-  "Honk the horn."
-  []
-  (string "Honk! from a " (get self :color) " car!"))
-
-(def redcar (Car:new :red))
-(def greencar (Car:new :green))
-
-(assert (= (call redcar:honk) ($ redcar:honk)) "$ alias for call 1")
-(assert (= (call greencar:honk) ($ greencar:honk)) "$ alias for call 2")
-
-(assert (= (call redcar:honk) "Honk! from a :red car!") "method call 1")
-(assert (= (call greencar:honk) "Honk! from a :green car!") "method call 2")
-
-(def wrapper (wrap-call redcar:honk))
-(assert (= (call redcar:honk) (wrapper)) "wrap-call")
-
-(end-suite)
-