Change quasiquote algorithm

- Add a `vec` built-in function in step7 so that `quasiquote` does not
  require `apply` from step9.
- Introduce quasiquoteexpand special in order to help debugging step7.
  This may also prepare newcomers to understand step8.
- Add soft tests.
- Do not quote numbers, strings and so on.

Should ideally have been in separate commits:
- elisp: simplify and fix (keyword :k)
- factor: fix copy/paste error in let*/step7, simplify eval-ast.
- guile: improve list/vector types
- haskell: revert evaluation during quasiquote
- logo, make: cosmetic issues

docs/exercises.md

@@ -37,7 +37,7 @@ make REGRESS=1 TEST_OPTS='--hard --pre-eval=\(load-file\ \"../answer.mal\"\)' te
 
 - Implement `>`, `<=` and `>=` with `<`.
 
-- Implement `list`, `prn`, `hash-map` and `swap!` as non-recursive
+- Implement `list`, `vec`, `prn`, `hash-map` and `swap!` as non-recursive
   functions.
 
 - Implement `count`, `nth`, `map`, `concat` and `conj` with the empty

examples/exercises.mal

@@ -23,6 +23,7 @@
 (def! >= (fn* [a b] (not (< a b))))
 
 (def! list (fn* [& xs] xs))
+(def! vec (fn* [xs] (apply vector xs)))
 (def! prn (fn* [& xs] (println (apply pr-str xs))))
 (def! hash-map (fn* [& xs] (apply assoc {} xs)))
 (def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs))))
@@ -48,7 +49,7 @@
 (def! conj
   (fn* [xs & ys]
     (if (vector? xs)
-      (apply vector (concat xs ys))
+      (vec (concat xs ys))
       (reduce (fn* [acc x] (cons x acc)) xs ys))))
 
 (def! do2 (fn* [& xs] (nth xs (- (count xs) 1))))
@@ -69,8 +70,7 @@
       (first (rest ast))
       (foldr _quasiquote_iter () ast))
     (if (vector? ast)
-      ;; TODO: once tests are fixed, replace 'list with 'vector.
-      (list 'apply 'list (foldr _quasiquote_iter () ast))
+      (list 'vec (foldr _quasiquote_iter () ast))
       (list 'quote ast)))))
 
 ;; Interpret kvs as [k1 v1 k2 v2 ... kn vn] and returns

impls/ada.2/core.adb

@@ -256,6 +256,7 @@ package body Core is
       P ("throw",       Err.Throw'Access);
       P ("time-ms",     Time_Ms'Access);
       P ("vals",        Types.Maps.Vals'Access);
+      P ("vec",         Types.Sequences.Vec'Access);
       P ("vector",      Types.Sequences.Vector'Access);
       P ("with-meta",   With_Meta'Access);
    end NS_Add_To_Repl;

impls/ada.2/step7_quote.adb

@@ -1,5 +1,4 @@
 with Ada.Command_Line;
-with Ada.Containers.Vectors;
 with Ada.Environment_Variables;
 with Ada.Text_IO.Unbounded_IO;
 
@@ -23,7 +22,6 @@ procedure Step7_Quote is
    use all type Types.Kind_Type;
    use type Types.Strings.Instance;
    package ACL renames Ada.Command_Line;
-   package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
 
    function Read return Types.T_Array with Inline;
 
@@ -32,12 +30,7 @@ procedure Step7_Quote is
    function Eval_Builtin (Args : in Types.T_Array) return Types.T;
    --  The built-in variant needs to see the Repl variable.
 
-   function Quasiquote (Ast : in Types.T;
-                        Env : in Envs.Ptr) return Types.T;
-   --  Mergeing quote and quasiquote into eval with a flag triggering
-   --  a different behaviour as done for macros in step8 would improve
-   --  the performances significantly, but Kanaka finds that it breaks
-   --  too much the step structure shared by all implementations.
+   function Quasiquote (Ast : in Types.T) return Types.T;
 
    procedure Print (Ast : in Types.T) with Inline;
 
@@ -174,9 +167,13 @@ procedure Step7_Quote is
                   Ast    => Ast.Sequence.all.Data (3),
                   Env    => Env));
             end;
+         elsif First.Str.all = "quasiquoteexpand" then
+            Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
+            return Quasiquote (Ast.Sequence.all.Data (2));
          elsif First.Str.all = "quasiquote" then
             Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
-            return Quasiquote (Ast.Sequence.all.Data (2), Env);
+            Ast := Quasiquote (Ast.Sequence.all.Data (2));
+            goto Restart;
          else
             --  Equivalent to First := Eval (First, Env)
             --  except that we already know enough to spare a recursive call.
@@ -266,62 +263,54 @@ procedure Step7_Quote is
       Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
    end Print;
 
-   function Quasiquote (Ast : in Types.T;
-                        Env : in Envs.Ptr) return Types.T
-   is
+   function Quasiquote (Ast : in Types.T) return Types.T is
 
-      function Quasiquote_List (List : in Types.T_Array) return Types.T;
-      --  Handle vectors and lists not starting with unquote.
+      function Qq_Seq return Types.T;
+      function Starts_With (Sequence : Types.T_Array;
+                            Symbol   : String) return Boolean;
 
-      function Quasiquote_List (List : in Types.T_Array) return Types.T is
-         Vector : Vectors.Vector; --  buffer for concatenation
-         Tmp    : Types.T;
+      function Qq_Seq return Types.T is
+         Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
       begin
-         for Elt of List loop
-            if Elt.Kind in Kind_List
-              and then 0 < Elt.Sequence.all.Length
-              and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
-              and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
+         for Elt of reverse Ast.Sequence.all.Data loop
+            if Elt.Kind = Kind_List
+              and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
             then
                Err.Check (Elt.Sequence.all.Length = 2,
                           "splice-unquote expects 1 parameter");
-               Tmp := Eval (Elt.Sequence.all.Data (2), Env);
-               Err.Check (Tmp.Kind = Kind_List,
-                          "splice_unquote expects a list");
-               for Sub_Elt of Tmp.Sequence.all.Data loop
-                  Vector.Append (Sub_Elt);
-               end loop;
+               Result := Types.Sequences.List
+                 (((Kind_Symbol, Types.Strings.Alloc ("concat")),
+                   Elt.Sequence.all.Data (2), Result));
             else
-               Vector.Append (Quasiquote (Elt, Env));
+               Result := Types.Sequences.List
+                 (((Kind_Symbol, Types.Strings.Alloc ("cons")),
+                   Quasiquote (Elt), Result));
             end if;
          end loop;
-         --  Now that we know the number of elements, convert to a list.
-         declare
-            Sequence : constant Types.Sequence_Ptr
-              := Types.Sequences.Constructor (Natural (Vector.Length));
-         begin
-            for I in 1 .. Natural (Vector.Length) loop
-               Sequence.all.Data (I) := Vector (I);
-            end loop;
-            return (Kind_List, Sequence);
-         end;
-      end Quasiquote_List;
+         return Result;
+      end Qq_Seq;
 
-   begin                                --  Quasiquote
+      function Starts_With (Sequence : Types.T_Array;
+                            Symbol   : String) return Boolean is
+         (0 < Sequence'Length
+            and then Sequence (Sequence'First).Kind = Kind_Symbol
+            and then Sequence (Sequence'First).Str.all = Symbol);
+
+   begin
       case Ast.Kind is
-         when Kind_Vector =>
-            --  When the test is updated, replace Kind_List with Kind_Vector.
-            return Quasiquote_List (Ast.Sequence.all.Data);
          when Kind_List =>
-            if 0 < Ast.Sequence.all.Length
-              and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
-              and then Ast.Sequence.all.Data (1).Str.all = "unquote"
-            then
+            if Starts_With (Ast.Sequence.all.Data, "unquote") then
                Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
-               return Eval (Ast.Sequence.all.Data (2), Env);
+               return Ast.Sequence.all.Data (2);
             else
-               return Quasiquote_List (Ast.Sequence.all.Data);
+               return Qq_Seq;
             end if;
+         when Kind_Vector =>
+            return Types.Sequences.List
+              (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq));
+         when Kind_Map | Kind_Symbol =>
+            return Types.Sequences.List
+              (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast));
          when others =>
             return Ast;
       end case;

impls/ada.2/step8_macros.adb

@@ -1,5 +1,4 @@
 with Ada.Command_Line;
-with Ada.Containers.Vectors;
 with Ada.Environment_Variables;
 with Ada.Text_IO.Unbounded_IO;
 
@@ -23,7 +22,6 @@ procedure Step8_Macros is
    use all type Types.Kind_Type;
    use type Types.Strings.Instance;
    package ACL renames Ada.Command_Line;
-   package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
 
    function Read return Types.T_Array with Inline;
 
@@ -32,12 +30,7 @@ procedure Step8_Macros is
    function Eval_Builtin (Args : in Types.T_Array) return Types.T;
    --  The built-in variant needs to see the Repl variable.
 
-   function Quasiquote (Ast : in Types.T;
-                        Env : in Envs.Ptr) return Types.T;
-   --  Mergeing quote and quasiquote into eval with a flag triggering
-   --  a different behaviour as done for macros in step8 would improve
-   --  the performances significantly, but Kanaka finds that it breaks
-   --  too much the step structure shared by all implementations.
+   function Quasiquote (Ast : in Types.T) return Types.T;
 
    procedure Print (Ast : in Types.T) with Inline;
 
@@ -195,9 +188,13 @@ procedure Step8_Macros is
             Macroexpanding := True;
             Ast := Ast.Sequence.all.Data (2);
             goto Restart;
+         elsif First.Str.all = "quasiquoteexpand" then
+            Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
+            return Quasiquote (Ast.Sequence.all.Data (2));
          elsif First.Str.all = "quasiquote" then
             Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
-            return Quasiquote (Ast.Sequence.all.Data (2), Env);
+            Ast := Quasiquote (Ast.Sequence.all.Data (2));
+            goto Restart;
          else
             --  Equivalent to First := Eval (First, Env)
             --  except that we already know enough to spare a recursive call.
@@ -315,62 +312,54 @@ procedure Step8_Macros is
       Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
    end Print;
 
-   function Quasiquote (Ast : in Types.T;
-                        Env : in Envs.Ptr) return Types.T
-   is
+   function Quasiquote (Ast : in Types.T) return Types.T is
 
-      function Quasiquote_List (List : in Types.T_Array) return Types.T;
-      --  Handle vectors and lists not starting with unquote.
+      function Qq_Seq return Types.T;
+      function Starts_With (Sequence : Types.T_Array;
+                            Symbol   : String) return Boolean;
 
-      function Quasiquote_List (List : in Types.T_Array) return Types.T is
-         Vector : Vectors.Vector; --  buffer for concatenation
-         Tmp    : Types.T;
+      function Qq_Seq return Types.T is
+         Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
       begin
-         for Elt of List loop
-            if Elt.Kind in Kind_List
-              and then 0 < Elt.Sequence.all.Length
-              and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
-              and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
+         for Elt of reverse Ast.Sequence.all.Data loop
+            if Elt.Kind = Kind_List
+              and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
             then
                Err.Check (Elt.Sequence.all.Length = 2,
                           "splice-unquote expects 1 parameter");
-               Tmp := Eval (Elt.Sequence.all.Data (2), Env);
-               Err.Check (Tmp.Kind = Kind_List,
-                          "splice_unquote expects a list");
-               for Sub_Elt of Tmp.Sequence.all.Data loop
-                  Vector.Append (Sub_Elt);
-               end loop;
+               Result := Types.Sequences.List
+                 (((Kind_Symbol, Types.Strings.Alloc ("concat")),
+                   Elt.Sequence.all.Data (2), Result));
             else
-               Vector.Append (Quasiquote (Elt, Env));
+               Result := Types.Sequences.List
+                 (((Kind_Symbol, Types.Strings.Alloc ("cons")),
+                   Quasiquote (Elt), Result));
             end if;
          end loop;
-         --  Now that we know the number of elements, convert to a list.
-         declare
-            Sequence : constant Types.Sequence_Ptr
-              := Types.Sequences.Constructor (Natural (Vector.Length));
-         begin
-            for I in 1 .. Natural (Vector.Length) loop
-               Sequence.all.Data (I) := Vector (I);
-            end loop;
-            return (Kind_List, Sequence);
-         end;
-      end Quasiquote_List;
+         return Result;
+      end Qq_Seq;
 
-   begin                                --  Quasiquote
+      function Starts_With (Sequence : Types.T_Array;
+                            Symbol   : String) return Boolean is
+         (0 < Sequence'Length
+            and then Sequence (Sequence'First).Kind = Kind_Symbol
+            and then Sequence (Sequence'First).Str.all = Symbol);
+
+   begin
       case Ast.Kind is
-         when Kind_Vector =>
-            --  When the test is updated, replace Kind_List with Kind_Vector.
-            return Quasiquote_List (Ast.Sequence.all.Data);
          when Kind_List =>
-            if 0 < Ast.Sequence.all.Length
-              and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
-              and then Ast.Sequence.all.Data (1).Str.all = "unquote"
-            then
+            if Starts_With (Ast.Sequence.all.Data, "unquote") then
                Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
-               return Eval (Ast.Sequence.all.Data (2), Env);
+               return Ast.Sequence.all.Data (2);
             else
-               return Quasiquote_List (Ast.Sequence.all.Data);
+               return Qq_Seq;
             end if;
+         when Kind_Vector =>
+            return Types.Sequences.List
+              (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq));
+         when Kind_Map | Kind_Symbol =>
+            return Types.Sequences.List
+              (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast));
          when others =>
             return Ast;
       end case;

impls/ada.2/step9_try.adb

@@ -1,5 +1,4 @@
 with Ada.Command_Line;
-with Ada.Containers.Vectors;
 with Ada.Environment_Variables;
 with Ada.Text_IO.Unbounded_IO;
 
@@ -23,7 +22,6 @@ procedure Step9_Try is
    use all type Types.Kind_Type;
    use type Types.Strings.Instance;
    package ACL renames Ada.Command_Line;
-   package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
 
    function Read return Types.T_Array with Inline;
 
@@ -32,12 +30,7 @@ procedure Step9_Try is
    function Eval_Builtin (Args : in Types.T_Array) return Types.T;
    --  The built-in variant needs to see the Repl variable.
 
-   function Quasiquote (Ast : in Types.T;
-                        Env : in Envs.Ptr) return Types.T;
-   --  Mergeing quote and quasiquote into eval with a flag triggering
-   --  a different behaviour as done for macros in step8 would improve
-   --  the performances significantly, but Kanaka finds that it breaks
-   --  too much the step structure shared by all implementations.
+   function Quasiquote (Ast : in Types.T) return Types.T;
 
    procedure Print (Ast : in Types.T) with Inline;
 
@@ -195,9 +188,13 @@ procedure Step9_Try is
             Macroexpanding := True;
             Ast := Ast.Sequence.all.Data (2);
             goto Restart;
+         elsif First.Str.all = "quasiquoteexpand" then
+            Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
+            return Quasiquote (Ast.Sequence.all.Data (2));
          elsif First.Str.all = "quasiquote" then
             Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
-            return Quasiquote (Ast.Sequence.all.Data (2), Env);
+            Ast := Quasiquote (Ast.Sequence.all.Data (2));
+            goto Restart;
          elsif First.Str.all = "try*" then
             if Ast.Sequence.all.Length = 2 then
                Ast := Ast.Sequence.all.Data (2);
@@ -345,62 +342,54 @@ procedure Step9_Try is
       Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
    end Print;
 
-   function Quasiquote (Ast : in Types.T;
-                        Env : in Envs.Ptr) return Types.T
-   is
+   function Quasiquote (Ast : in Types.T) return Types.T is
 
-      function Quasiquote_List (List : in Types.T_Array) return Types.T;
-      --  Handle vectors and lists not starting with unquote.
+      function Qq_Seq return Types.T;
+      function Starts_With (Sequence : Types.T_Array;
+                            Symbol   : String) return Boolean;
 
-      function Quasiquote_List (List : in Types.T_Array) return Types.T is
-         Vector : Vectors.Vector; --  buffer for concatenation
-         Tmp    : Types.T;
+      function Qq_Seq return Types.T is
+         Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
       begin
-         for Elt of List loop
-            if Elt.Kind in Kind_List
-              and then 0 < Elt.Sequence.all.Length
-              and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
-              and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
+         for Elt of reverse Ast.Sequence.all.Data loop
+            if Elt.Kind = Kind_List
+              and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
             then
                Err.Check (Elt.Sequence.all.Length = 2,
                           "splice-unquote expects 1 parameter");
-               Tmp := Eval (Elt.Sequence.all.Data (2), Env);
-               Err.Check (Tmp.Kind = Kind_List,
-                          "splice_unquote expects a list");
-               for Sub_Elt of Tmp.Sequence.all.Data loop
-                  Vector.Append (Sub_Elt);
-               end loop;
+               Result := Types.Sequences.List
+                 (((Kind_Symbol, Types.Strings.Alloc ("concat")),
+                   Elt.Sequence.all.Data (2), Result));
             else
-               Vector.Append (Quasiquote (Elt, Env));
+               Result := Types.Sequences.List
+                 (((Kind_Symbol, Types.Strings.Alloc ("cons")),
+                   Quasiquote (Elt), Result));
             end if;
          end loop;
-         --  Now that we know the number of elements, convert to a list.
-         declare
-            Sequence : constant Types.Sequence_Ptr
-              := Types.Sequences.Constructor (Natural (Vector.Length));
-         begin
-            for I in 1 .. Natural (Vector.Length) loop
-               Sequence.all.Data (I) := Vector (I);
-            end loop;
-            return (Kind_List, Sequence);
-         end;
-      end Quasiquote_List;
+         return Result;
+      end Qq_Seq;
 
-   begin                                --  Quasiquote
+      function Starts_With (Sequence : Types.T_Array;
+                            Symbol   : String) return Boolean is
+         (0 < Sequence'Length
+            and then Sequence (Sequence'First).Kind = Kind_Symbol
+            and then Sequence (Sequence'First).Str.all = Symbol);
+
+   begin
       case Ast.Kind is
-         when Kind_Vector =>
-            --  When the test is updated, replace Kind_List with Kind_Vector.
-            return Quasiquote_List (Ast.Sequence.all.Data);
          when Kind_List =>
-            if 0 < Ast.Sequence.all.Length
-              and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
-              and then Ast.Sequence.all.Data (1).Str.all = "unquote"
-            then
+            if Starts_With (Ast.Sequence.all.Data, "unquote") then
                Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
-               return Eval (Ast.Sequence.all.Data (2), Env);
+               return Ast.Sequence.all.Data (2);
             else
-               return Quasiquote_List (Ast.Sequence.all.Data);
+               return Qq_Seq;
             end if;
+         when Kind_Vector =>
+            return Types.Sequences.List
+              (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq));
+         when Kind_Map | Kind_Symbol =>
+            return Types.Sequences.List
+              (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast));
          when others =>
             return Ast;
       end case;

impls/ada.2/stepa_mal.adb

@@ -1,5 +1,4 @@
 with Ada.Command_Line;
-with Ada.Containers.Vectors;
 with Ada.Environment_Variables;
 with Ada.Text_IO.Unbounded_IO;
 
@@ -24,7 +23,6 @@ procedure StepA_Mal is
    use all type Types.Kind_Type;
    use type Types.Strings.Instance;
    package ACL renames Ada.Command_Line;
-   package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
 
    function Read return Types.T_Array with Inline;
 
@@ -33,12 +31,7 @@ procedure StepA_Mal is
    function Eval_Builtin (Args : in Types.T_Array) return Types.T;
    --  The built-in variant needs to see the Repl variable.
 
-   function Quasiquote (Ast : in Types.T;
-                        Env : in Envs.Ptr) return Types.T;
-   --  Mergeing quote and quasiquote into eval with a flag triggering
-   --  a different behaviour as done for macros in step8 would improve
-   --  the performances significantly, but Kanaka finds that it breaks
-   --  too much the step structure shared by all implementations.
+   function Quasiquote (Ast : in Types.T) return Types.T;
 
    procedure Print (Ast : in Types.T) with Inline;
 
@@ -196,9 +189,13 @@ procedure StepA_Mal is
             Macroexpanding := True;
             Ast := Ast.Sequence.all.Data (2);
             goto Restart;
+         elsif First.Str.all = "quasiquoteexpand" then
+            Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
+            return Quasiquote (Ast.Sequence.all.Data (2));
          elsif First.Str.all = "quasiquote" then
             Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
-            return Quasiquote (Ast.Sequence.all.Data (2), Env);
+            Ast := Quasiquote (Ast.Sequence.all.Data (2));
+            goto Restart;
          elsif First.Str.all = "try*" then
             if Ast.Sequence.all.Length = 2 then
                Ast := Ast.Sequence.all.Data (2);
@@ -351,62 +348,54 @@ procedure StepA_Mal is
       Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
    end Print;
 
-   function Quasiquote (Ast : in Types.T;
-                        Env : in Envs.Ptr) return Types.T
-   is
+   function Quasiquote (Ast : in Types.T) return Types.T is
 
-      function Quasiquote_List (List : in Types.T_Array) return Types.T;
-      --  Handle vectors and lists not starting with unquote.
+      function Qq_Seq return Types.T;
+      function Starts_With (Sequence : Types.T_Array;
+                            Symbol   : String) return Boolean;
 
-      function Quasiquote_List (List : in Types.T_Array) return Types.T is
-         Vector : Vectors.Vector; --  buffer for concatenation
-         Tmp    : Types.T;
+      function Qq_Seq return Types.T is
+         Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
       begin
-         for Elt of List loop
-            if Elt.Kind in Kind_List
-              and then 0 < Elt.Sequence.all.Length
-              and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
-              and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
+         for Elt of reverse Ast.Sequence.all.Data loop
+            if Elt.Kind = Kind_List
+              and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
             then
                Err.Check (Elt.Sequence.all.Length = 2,
                           "splice-unquote expects 1 parameter");
-               Tmp := Eval (Elt.Sequence.all.Data (2), Env);
-               Err.Check (Tmp.Kind = Kind_List,
-                          "splice_unquote expects a list");
-               for Sub_Elt of Tmp.Sequence.all.Data loop
-                  Vector.Append (Sub_Elt);
-               end loop;
+               Result := Types.Sequences.List
+                 (((Kind_Symbol, Types.Strings.Alloc ("concat")),
+                   Elt.Sequence.all.Data (2), Result));
             else
-               Vector.Append (Quasiquote (Elt, Env));
+               Result := Types.Sequences.List
+                 (((Kind_Symbol, Types.Strings.Alloc ("cons")),
+                   Quasiquote (Elt), Result));
             end if;
          end loop;
-         --  Now that we know the number of elements, convert to a list.
-         declare
-            Sequence : constant Types.Sequence_Ptr
-              := Types.Sequences.Constructor (Natural (Vector.Length));
-         begin
-            for I in 1 .. Natural (Vector.Length) loop
-               Sequence.all.Data (I) := Vector (I);
-            end loop;
-            return (Kind_List, Sequence);
-         end;
-      end Quasiquote_List;
+         return Result;
+      end Qq_Seq;
 
-   begin                                --  Quasiquote
+      function Starts_With (Sequence : Types.T_Array;
+                            Symbol   : String) return Boolean is
+         (0 < Sequence'Length
+            and then Sequence (Sequence'First).Kind = Kind_Symbol
+            and then Sequence (Sequence'First).Str.all = Symbol);
+
+   begin
       case Ast.Kind is
-         when Kind_Vector =>
-            --  When the test is updated, replace Kind_List with Kind_Vector.
-            return Quasiquote_List (Ast.Sequence.all.Data);
          when Kind_List =>
-            if 0 < Ast.Sequence.all.Length
-              and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
-              and then Ast.Sequence.all.Data (1).Str.all = "unquote"
-            then
+            if Starts_With (Ast.Sequence.all.Data, "unquote") then
                Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
-               return Eval (Ast.Sequence.all.Data (2), Env);
+               return Ast.Sequence.all.Data (2);
             else
-               return Quasiquote_List (Ast.Sequence.all.Data);
+               return Qq_Seq;
             end if;
+         when Kind_Vector =>
+            return Types.Sequences.List
+              (((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq));
+         when Kind_Map | Kind_Symbol =>
+            return Types.Sequences.List
+              (((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast));
          when others =>
             return Ast;
       end case;

impls/ada.2/types-sequences.adb

@@ -208,6 +208,14 @@ package body Types.Sequences is
       end case;
    end Rest;
 
+   function Vec (Args : in T_Array) return T is
+   begin
+      Err.Check (Args'Length = 1
+                   and then Args (Args'First).Kind in Kind_Sequence,
+                 "expects a sequence");
+      return (Kind_Vector, Args (Args'First).Sequence);
+   end Vec;
+
    function Vector (Args : in T_Array) return T
    is
       Ref : constant Sequence_Ptr := Constructor (Args'Length);

impls/ada.2/types-sequences.ads

@@ -24,6 +24,7 @@ package Types.Sequences is
    function Map      (Args : in T_Array) return T;
    function Nth      (Args : in T_Array) return T;
    function Rest     (Args : in T_Array) return T;
+   function Vec      (Args : in T_Array) return T;
    function Vector   (Args : in T_Array) return T;
 
    --  New instances must be created via this constructor.

impls/ada/core.adb

@@ -645,6 +645,25 @@ package body Core is
    end New_Vector;
 
 
+   function Vec (Rest_Handle : Mal_Handle)
+   return Types.Mal_Handle is
+      First_Param : Mal_Handle;
+   begin
+      First_Param := Car (Deref_List (Rest_Handle).all);
+      if Deref (First_Param).Sym_Type /= List then
+         raise Runtime_Exception with "Expecting a sequence";
+      end if;
+      case Deref_List_Class (First_Param).Get_List_Type is
+      when Hashed_List =>
+         raise Runtime_Exception with "Expecting a sequence";
+      when Vector_List =>
+         return First_Param;
+      when List_List =>
+         return New_Vector (First_Param);
+      end case;
+   end Vec;
+
+
    function New_Map (Rest_Handle : Mal_Handle)
    return Types.Mal_Handle is
       Rest_List : List_Mal_Type;
@@ -1059,6 +1078,10 @@ package body Core is
            "list?",
            New_Func_Mal_Type ("list?", Is_List'access));
 
+      Envs.Set (Repl_Env,
+           "vec",
+           New_Func_Mal_Type ("vec", Vec'access));
+
       Envs.Set (Repl_Env,
            "vector",
            New_Func_Mal_Type ("vector", New_Vector'access));

impls/ada/step7_quote.adb

@@ -100,85 +100,78 @@ procedure Step7_Quote is
 
    end Eval_Ast;
 
+   function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
+      A0 : Mal_Handle;
+   begin
+      if Deref (Ast).Sym_Type /= List
+        or else Deref_List_Class (Ast).Get_List_Type /= List_List
+        or else Deref_List (Ast).Is_Null
+      then
+         return False;
+      end if;
+      A0 := Deref_List (Ast).Car;
+      return Deref (A0).Sym_Type = Sym
+        and then Deref_Sym (A0).Get_Sym = Symbol;
+   end Starts_With;
 
    function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
-      Res, First_Elem, FE_0 : Mal_Handle;
+      Res, Elt, New_Res : Mal_Handle;
       L : List_Ptr;
-      D_Ptr, Ast_P : List_Class_Ptr;
    begin
 
       if Debug then
          Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
       end if;
 
-      -- Create a New List for the result...
-      Res := New_List_Mal_Type (List_List);
-      L := Deref_List (Res);
+      if Deref (Param).Sym_Type not in Sym | List then
+         --  No need to quote, Eval would not affect these anyway.
+         return Param;
+      end if;
 
-      -- This is the equivalent of Is_Pair
       if Deref (Param).Sym_Type /= List or else
-         Is_Null (Deref_List_Class (Param).all) then
+        Deref_List_Class (Param).Get_List_Type = Hashed_List then
 
          -- return a new list containing: a symbol named "quote" and ast.
+         Res := New_List_Mal_Type (List_List);
+         L := Deref_List (Res);
          L.Append (New_Symbol_Mal_Type ("quote"));
          L.Append (Param);
          return Res;
 
       end if;
 
-      -- Ast is a non-empty list at this point.
-
-      Ast_P := Deref_List_Class (Param);
-
-      First_Elem := Car (Ast_P.all);
-
       -- if the first element of ast is a symbol named "unquote":
-      if Deref (First_Elem).Sym_Type = Sym and then
-         Deref_Sym (First_Elem).Get_Sym = "unquote" then
-
+      if Starts_With (Param, "unquote") then
          -- return the second element of ast.`
-         D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
-         return Car (D_Ptr.all);
+         return Deref_List_Class (Param).Nth (1);
 
       end if;
 
-      -- if the first element of first element of `ast` (`ast[0][0]`)
-      -- is a symbol named "splice-unquote"
-      if Deref (First_Elem).Sym_Type = List and then
-         not Is_Null (Deref_List_Class (First_Elem).all) then
+      Res := New_List_Mal_Type (List_List);
 
-         D_Ptr := Deref_List_Class (First_Elem);
-         FE_0 := Car (D_Ptr.all);
-
-         if Deref (FE_0).Sym_Type = Sym and then
-            Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
-
-            -- return a new list containing: a symbol named "concat",
+      for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
+         Elt := Deref_List_Class (Param).Nth (I);
+         New_Res := New_List_Mal_Type (List_List);
+         L := Deref_List (New_Res);
+         if Starts_With (Elt, "splice-unquote") then
             L.Append (New_Symbol_Mal_Type ("concat"));
-
-            -- the second element of first element of ast (ast[0][1]),
-            D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
-            L.Append (Car (D_Ptr.all));
-
-            -- and the result of calling quasiquote with
-            -- the second through last element of ast.
-            L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
-
-            return Res;
-
+            L.Append (Deref_List (Elt).Nth (1));
+         else
+            L.Append (New_Symbol_Mal_Type ("cons"));
+            L.Append (Quasi_Quote_Processing (Elt));
          end if;
+         L.Append (Res);
+         Res := New_Res;
+      end loop;
 
+      if Deref_List_Class (Param).Get_List_Type = Vector_List then
+         New_Res := New_List_Mal_Type (List_List);
+         L := Deref_List (New_Res);
+         L.Append (New_Symbol_Mal_Type ("vec"));
+         L.Append (Res);
+         Res := New_Res;
       end if;
 
-      -- otherwise: return a new list containing: a symbol named "cons",
-      L.Append (New_Symbol_Mal_Type ("cons"));
-
-      -- the result of calling quasiquote on first element of ast (ast[0]),
-      L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
-
-      -- and result of calling quasiquote with the second through last element of ast.
-      L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
-
       return Res;
 
    end Quasi_Quote_Processing;
@@ -312,6 +305,11 @@ procedure Step7_Quote is
 
             return Car (Rest_List);
 
+         elsif Deref (First_Param).Sym_Type = Sym and then
+               Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then
+
+            return Quasi_Quote_Processing (Car (Rest_List));
+
          elsif Deref (First_Param).Sym_Type = Sym and then
                Deref_Sym (First_Param).Get_Sym = "quasiquote" then
 

impls/ada/step8_macros.adb

@@ -164,85 +164,78 @@ procedure Step8_Macros is
 
    end Eval_Ast;
 
+   function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
+      A0 : Mal_Handle;
+   begin
+      if Deref (Ast).Sym_Type /= List
+        or else Deref_List_Class (Ast).Get_List_Type /= List_List
+        or else Deref_List (Ast).Is_Null
+      then
+         return False;
+      end if;
+      A0 := Deref_List (Ast).Car;
+      return Deref (A0).Sym_Type = Sym
+        and then Deref_Sym (A0).Get_Sym = Symbol;
+   end Starts_With;
 
    function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
-      Res, First_Elem, FE_0 : Mal_Handle;
+      Res, Elt, New_Res : Mal_Handle;
       L : List_Ptr;
-      D_Ptr, Ast_P : List_Class_Ptr;
    begin
 
       if Debug then
          Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
       end if;
 
-      -- Create a New List for the result...
-      Res := New_List_Mal_Type (List_List);
-      L := Deref_List (Res);
+      if Deref (Param).Sym_Type not in Sym | List then
+         --  No need to quote, Eval would not affect these anyway.
+         return Param;
+      end if;
 
-      -- This is the equivalent of Is_Pair
       if Deref (Param).Sym_Type /= List or else
-         Is_Null (Deref_List_Class (Param).all) then
+        Deref_List_Class (Param).Get_List_Type = Hashed_List then
 
          -- return a new list containing: a symbol named "quote" and ast.
+         Res := New_List_Mal_Type (List_List);
+         L := Deref_List (Res);
          L.Append (New_Symbol_Mal_Type ("quote"));
          L.Append (Param);
          return Res;
 
       end if;
 
-      -- Ast is a non-empty list at this point.
-
-      Ast_P := Deref_List_Class (Param);
-
-      First_Elem := Car (Ast_P.all);
-
       -- if the first element of ast is a symbol named "unquote":
-      if Deref (First_Elem).Sym_Type = Sym and then
-         Deref_Sym (First_Elem).Get_Sym = "unquote" then
-
+      if Starts_With (Param, "unquote") then
          -- return the second element of ast.`
-         D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
-         return Car (D_Ptr.all);
+         return Deref_List_Class (Param).Nth (1);
 
       end if;
 
-      -- if the first element of first element of `ast` (`ast[0][0]`)
-      -- is a symbol named "splice-unquote"
-      if Deref (First_Elem).Sym_Type = List and then
-         not Is_Null (Deref_List_Class (First_Elem).all) then
+      Res := New_List_Mal_Type (List_List);
 
-         D_Ptr := Deref_List_Class (First_Elem);
-         FE_0 := Car (D_Ptr.all);
-
-         if Deref (FE_0).Sym_Type = Sym and then
-            Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
-
-            -- return a new list containing: a symbol named "concat",
+      for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
+         Elt := Deref_List_Class (Param).Nth (I);
+         New_Res := New_List_Mal_Type (List_List);
+         L := Deref_List (New_Res);
+         if Starts_With (Elt, "splice-unquote") then
             L.Append (New_Symbol_Mal_Type ("concat"));
-
-            -- the second element of first element of ast (ast[0][1]),
-            D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
-            L.Append (Car (D_Ptr.all));
-
-            -- and the result of calling quasiquote with
-            -- the second through last element of ast.
-            L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
-
-            return Res;
-
+            L.Append (Deref_List (Elt).Nth (1));
+         else
+            L.Append (New_Symbol_Mal_Type ("cons"));
+            L.Append (Quasi_Quote_Processing (Elt));
          end if;
+         L.Append (Res);
+         Res := New_Res;
+      end loop;
 
+      if Deref_List_Class (Param).Get_List_Type = Vector_List then
+         New_Res := New_List_Mal_Type (List_List);
+         L := Deref_List (New_Res);
+         L.Append (New_Symbol_Mal_Type ("vec"));
+         L.Append (Res);
+         Res := New_Res;
       end if;
 
-      -- otherwise: return a new list containing: a symbol named "cons",
-      L.Append (New_Symbol_Mal_Type ("cons"));
-
-      -- the result of calling quasiquote on first element of ast (ast[0]),
-      L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
-
-      -- and result of calling quasiquote with the second through last element of ast.
-      L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
-
       return Res;
 
    end Quasi_Quote_Processing;
@@ -388,6 +381,11 @@ procedure Step8_Macros is
 
             return Car (Rest_List);
 
+         elsif Deref (First_Param).Sym_Type = Sym and then
+               Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then
+
+            return Quasi_Quote_Processing (Car (Rest_List));
+
          elsif Deref (First_Param).Sym_Type = Sym and then
                Deref_Sym (First_Param).Get_Sym = "quasiquote" then
 

impls/ada/step9_try.adb

@@ -164,85 +164,78 @@ procedure Step9_Try is
 
    end Eval_Ast;
 
+   function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
+      A0 : Mal_Handle;
+   begin
+      if Deref (Ast).Sym_Type /= List
+        or else Deref_List_Class (Ast).Get_List_Type /= List_List
+        or else Deref_List (Ast).Is_Null
+      then
+         return False;
+      end if;
+      A0 := Deref_List (Ast).Car;
+      return Deref (A0).Sym_Type = Sym
+        and then Deref_Sym (A0).Get_Sym = Symbol;
+   end Starts_With;
 
    function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
-      Res, First_Elem, FE_0 : Mal_Handle;
+      Res, Elt, New_Res : Mal_Handle;
       L : List_Ptr;
-      D_Ptr, Ast_P : List_Class_Ptr;
    begin
 
       if Debug then
          Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
       end if;
 
-      -- Create a New List for the result...
-      Res := New_List_Mal_Type (List_List);
-      L := Deref_List (Res);
+      if Deref (Param).Sym_Type not in Sym | List then
+         --  No need to quote, Eval would not affect these anyway.
+         return Param;
+      end if;
 
-      -- This is the equivalent of Is_Pair
       if Deref (Param).Sym_Type /= List or else
-         Is_Null (Deref_List_Class (Param).all) then
+        Deref_List_Class (Param).Get_List_Type = Hashed_List then
 
          -- return a new list containing: a symbol named "quote" and ast.
+         Res := New_List_Mal_Type (List_List);
+         L := Deref_List (Res);
          L.Append (New_Symbol_Mal_Type ("quote"));
          L.Append (Param);
          return Res;
 
       end if;
 
-      -- Ast is a non-empty list at this point.
-
-      Ast_P := Deref_List_Class (Param);
-
-      First_Elem := Car (Ast_P.all);
-
       -- if the first element of ast is a symbol named "unquote":
-      if Deref (First_Elem).Sym_Type = Sym and then
-         Deref_Sym (First_Elem).Get_Sym = "unquote" then
-
+      if Starts_With (Param, "unquote") then
          -- return the second element of ast.`
-         D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
-         return Car (D_Ptr.all);
+         return Deref_List_Class (Param).Nth (1);
 
       end if;
 
-      -- if the first element of first element of `ast` (`ast[0][0]`)
-      -- is a symbol named "splice-unquote"
-      if Deref (First_Elem).Sym_Type = List and then
-         not Is_Null (Deref_List_Class (First_Elem).all) then
+      Res := New_List_Mal_Type (List_List);
 
-         D_Ptr := Deref_List_Class (First_Elem);
-         FE_0 := Car (D_Ptr.all);
-
-         if Deref (FE_0).Sym_Type = Sym and then
-            Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
-
-            -- return a new list containing: a symbol named "concat",
+      for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
+         Elt := Deref_List_Class (Param).Nth (I);
+         New_Res := New_List_Mal_Type (List_List);
+         L := Deref_List (New_Res);
+         if Starts_With (Elt, "splice-unquote") then
             L.Append (New_Symbol_Mal_Type ("concat"));
-
-            -- the second element of first element of ast (ast[0][1]),
-            D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
-            L.Append (Car (D_Ptr.all));
-
-            -- and the result of calling quasiquote with
-            -- the second through last element of ast.
-            L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
-
-            return Res;
-
+            L.Append (Deref_List (Elt).Nth (1));
+         else
+            L.Append (New_Symbol_Mal_Type ("cons"));
+            L.Append (Quasi_Quote_Processing (Elt));
          end if;
+         L.Append (Res);
+         Res := New_Res;
+      end loop;
 
+      if Deref_List_Class (Param).Get_List_Type = Vector_List then
+         New_Res := New_List_Mal_Type (List_List);
+         L := Deref_List (New_Res);
+         L.Append (New_Symbol_Mal_Type ("vec"));
+         L.Append (Res);
+         Res := New_Res;
       end if;
 
-      -- otherwise: return a new list containing: a symbol named "cons",
-      L.Append (New_Symbol_Mal_Type ("cons"));
-
-      -- the result of calling quasiquote on first element of ast (ast[0]),
-      L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
-
-      -- and result of calling quasiquote with the second through last element of ast.
-      L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
-
       return Res;
 
    end Quasi_Quote_Processing;
@@ -414,6 +407,11 @@ procedure Step9_Try is
 
             return Car (Rest_List);
 
+         elsif Deref (First_Param).Sym_Type = Sym and then
+               Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then
+
+            return Quasi_Quote_Processing (Car (Rest_List));
+
          elsif Deref (First_Param).Sym_Type = Sym and then
                Deref_Sym (First_Param).Get_Sym = "quasiquote" then
 

impls/ada/stepa_mal.adb

@@ -164,85 +164,78 @@ procedure StepA_Mal is
 
    end Eval_Ast;
 
+   function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
+      A0 : Mal_Handle;
+   begin
+      if Deref (Ast).Sym_Type /= List
+        or else Deref_List_Class (Ast).Get_List_Type /= List_List
+        or else Deref_List (Ast).Is_Null
+      then
+         return False;
+      end if;
+      A0 := Deref_List (Ast).Car;
+      return Deref (A0).Sym_Type = Sym
+        and then Deref_Sym (A0).Get_Sym = Symbol;
+   end Starts_With;
 
    function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
-      Res, First_Elem, FE_0 : Mal_Handle;
+      Res, Elt, New_Res : Mal_Handle;
       L : List_Ptr;
-      D_Ptr, Ast_P : List_Class_Ptr;
    begin
 
       if Debug then
          Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
       end if;
 
-      -- Create a New List for the result...
-      Res := New_List_Mal_Type (List_List);
-      L := Deref_List (Res);
+      if Deref (Param).Sym_Type not in Sym | List then
+         --  No need to quote, Eval would not affect these anyway.
+         return Param;
+      end if;
 
-      -- This is the equivalent of Is_Pair
       if Deref (Param).Sym_Type /= List or else
-         Is_Null (Deref_List_Class (Param).all) then
+        Deref_List_Class (Param).Get_List_Type = Hashed_List then
 
          -- return a new list containing: a symbol named "quote" and ast.
+         Res := New_List_Mal_Type (List_List);
+         L := Deref_List (Res);
          L.Append (New_Symbol_Mal_Type ("quote"));
          L.Append (Param);
          return Res;
 
       end if;
 
-      -- Ast is a non-empty list at this point.
-
-      Ast_P := Deref_List_Class (Param);
-
-      First_Elem := Car (Ast_P.all);
-
       -- if the first element of ast is a symbol named "unquote":
-      if Deref (First_Elem).Sym_Type = Sym and then
-         Deref_Sym (First_Elem).Get_Sym = "unquote" then
-
+      if Starts_With (Param, "unquote") then
          -- return the second element of ast.`
-         D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
-         return Car (D_Ptr.all);
+         return Deref_List_Class (Param).Nth (1);
 
       end if;
 
-      -- if the first element of first element of `ast` (`ast[0][0]`)
-      -- is a symbol named "splice-unquote"
-      if Deref (First_Elem).Sym_Type = List and then
-         not Is_Null (Deref_List_Class (First_Elem).all) then
+      Res := New_List_Mal_Type (List_List);
 
-         D_Ptr := Deref_List_Class (First_Elem);
-         FE_0 := Car (D_Ptr.all);
-
-         if Deref (FE_0).Sym_Type = Sym and then
-            Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
-
-            -- return a new list containing: a symbol named "concat",
+      for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
+         Elt := Deref_List_Class (Param).Nth (I);
+         New_Res := New_List_Mal_Type (List_List);
+         L := Deref_List (New_Res);
+         if Starts_With (Elt, "splice-unquote") then
             L.Append (New_Symbol_Mal_Type ("concat"));
-
-            -- the second element of first element of ast (ast[0][1]),
-            D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
-            L.Append (Car (D_Ptr.all));
-
-            -- and the result of calling quasiquote with
-            -- the second through last element of ast.
-            L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
-
-            return Res;
-
+            L.Append (Deref_List (Elt).Nth (1));
+         else
+            L.Append (New_Symbol_Mal_Type ("cons"));
+            L.Append (Quasi_Quote_Processing (Elt));
          end if;
+         L.Append (Res);
+         Res := New_Res;
+      end loop;
 
+      if Deref_List_Class (Param).Get_List_Type = Vector_List then
+         New_Res := New_List_Mal_Type (List_List);
+         L := Deref_List (New_Res);
+         L.Append (New_Symbol_Mal_Type ("vec"));
+         L.Append (Res);
+         Res := New_Res;
       end if;
 
-      -- otherwise: return a new list containing: a symbol named "cons",
-      L.Append (New_Symbol_Mal_Type ("cons"));
-
-      -- the result of calling quasiquote on first element of ast (ast[0]),
-      L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
-
-      -- and result of calling quasiquote with the second through last element of ast.
-      L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
-
       return Res;
 
    end Quasi_Quote_Processing;
@@ -414,6 +407,11 @@ procedure StepA_Mal is
 
             return Car (Rest_List);
 
+         elsif Deref (First_Param).Sym_Type = Sym and then
+               Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then
+
+            return Quasi_Quote_Processing (Car (Rest_List));
+
          elsif Deref (First_Param).Sym_Type = Sym and then
                Deref_Sym (First_Param).Get_Sym = "quasiquote" then
 

impls/awk/core.awk

@@ -628,6 +628,24 @@ function core_concat(idx,    new_idx, new_len, len, i, lst, lst_idx, lst_len, j)
 	return "(" new_idx
 }
 
+function core_vec(idx,    new_idx, len)
+{
+	len = types_heap[idx]["len"]
+	if (len != 2)
+		return "!\"Invalid argument length for builtin function 'vec'. Expects exactly 1 argument, supplied " (len - 1) "."
+	idx = types_heap[idx][1]
+	if (idx !~ /^[([]/) {
+		return "!\"Incompatible type for argument 1 of builtin function 'vec'. Expects list or vector, supplied " types_typename(idx) "."
+	}
+	idx = substr(idx, 2)
+	len = types_heap[idx]["len"]
+	new_idx = types_allocate()
+	types_heap[new_idx]["len"] = len
+	while (len--)
+		types_addref(types_heap[new_idx][len] = types_heap[idx][len])
+	return "[" new_idx
+}
+
 function core_nth(idx,    lst, num, n, lst_idx)
 {
 	if (types_heap[idx]["len"] != 3) {
@@ -1078,6 +1096,7 @@ function core_init()
 
 	core_ns["'list"] = "&core_list"
 	core_ns["'list?"] = "&core_listp"
+	core_ns["'vec"] = "&core_vec"
 	core_ns["'vector"] = "&core_vector"
 	core_ns["'vector?"] = "&core_vectorp"
 	core_ns["'hash-map"] = "&core_hash_map"

impls/awk/step7_quote.awk

@@ -9,69 +9,82 @@ function READ(str)
 	return reader_read_str(str)
 }
 
-function is_pair(ast)
+# Return 0, an error or the unquote argument (second element of ast).
+function starts_with(ast, sym,    idx, len)
 {
-	return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
+	if (ast !~ /^\(/)
+		return 0
+	idx = substr(ast, 2)
+	len = types_heap[idx]["len"]
+	if (!len || types_heap[idx][0] != sym)
+		return 0
+	if (len != 2)
+		return  "!\"'" sym "' expects 1 argument, not " (len - 1) "."
+	return types_heap[idx][1]
 }
 
-function quasiquote(ast,    i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
+function quasiquote(ast,    new_idx, ret, ast_idx, elt_i, elt, previous)
 {
-	if (!is_pair(ast)) {
+	if (ast !~ /^[(['{]/) {
+		return ast
+	}
+	if (ast ~ /['\{]/) {
 		new_idx = types_allocate()
 		types_heap[new_idx][0] = "'quote"
 		types_heap[new_idx][1] = ast
 		types_heap[new_idx]["len"] = 2
 		return "(" new_idx
 	}
-	idx = substr(ast, 2)
-	first = types_heap[idx][0]
-	if (first == "'unquote") {
-		if (types_heap[idx]["len"] != 2) {
-			len = types_heap[idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(ret = types_heap[idx][1])
+	ret = starts_with(ast, "'unquote")
+	if (ret ~ /^!/) {
 		types_release(ast)
 		return ret
 	}
-
-	first_idx = substr(first, 2)
-	if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
-		if (types_heap[first_idx]["len"] != 2) {
-			len = types_heap[first_idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(first = types_heap[first_idx][1])
-		verb = "'concat"
-	} else {
-		types_addref(first)
-		first = quasiquote(first)
-		if (first ~ /^!/) {
-			types_release(ast)
-			return first
-		}
-		verb = "'cons"
-	}
-	lst_idx = types_allocate()
-	len = types_heap[idx]["len"]
-	for (i = 1; i < len; ++i) {
-		types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
-	}
-	types_heap[lst_idx]["len"] = len - 1
-	types_release(ast)
-	ret = quasiquote("(" lst_idx)
-	if (ret ~ /^!/) {
-		types_release(first)
+	if (ret) {
+		types_addref(ret)
+		types_release(ast)
 		return ret
 	}
-
 	new_idx = types_allocate()
-	types_heap[new_idx][0] = verb
-	types_heap[new_idx][1] = first
-	types_heap[new_idx][2] = ret
-	types_heap[new_idx]["len"] = 3
+	types_heap[new_idx]["len"] = 0
+	ast_idx = substr(ast, 2)
+	for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
+		elt = types_heap[ast_idx][elt_i]
+		ret = starts_with(elt, "'splice-unquote")
+		if (ret ~ /^!/) {
+			types_release("(" new_idx)
+			types_release(ast)
+			return ret
+		}
+		if (ret) {
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'concat"
+			types_heap[new_idx][1] = types_addref(ret)
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		} else {
+			ret = quasiquote(types_addref(elt))
+			if (ret ~ /^!/) {
+				types_release(ast)
+				return ret
+			}
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'cons"
+			types_heap[new_idx][1] = ret
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		}
+	}
+	if (ast ~ /^\[/) {
+		previous = "(" new_idx
+		new_idx = types_allocate()
+		types_heap[new_idx][0] = "'vec"
+		types_heap[new_idx][1] = previous
+		types_heap[new_idx]["len"] = 2
+	}
+	types_release(ast)
 	return "(" new_idx
 }
 
@@ -316,6 +329,15 @@ function EVAL(ast, env,    body, new_ast, ret, idx, len, f, f_idx, ret_env)
 			types_release(ast)
 			env_release(env)
 			return body
+		case "'quasiquoteexpand":
+			env_release(env)
+			if (len != 2) {
+				types_release(ast)
+				return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
+			}
+			types_addref(body = types_heap[idx][1])
+			types_release(ast)
+			return quasiquote(body)
 		case "'quasiquote":
 			if (len != 2) {
 				types_release(ast)

impls/awk/step8_macros.awk

@@ -9,81 +9,93 @@ function READ(str)
 	return reader_read_str(str)
 }
 
-function is_pair(ast)
+# Return 0, an error or the unquote argument (second element of ast).
+function starts_with(ast, sym,    idx, len)
 {
-	return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
+	if (ast !~ /^\(/)
+		return 0
+	idx = substr(ast, 2)
+	len = types_heap[idx]["len"]
+	if (!len || types_heap[idx][0] != sym)
+		return 0
+	if (len != 2)
+		return  "!\"'" sym "' expects 1 argument, not " (len - 1) "."
+	return types_heap[idx][1]
 }
 
-function quasiquote(ast,    i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
+function quasiquote(ast,    new_idx, ret, ast_idx, elt_i, elt, previous)
 {
-	if (!is_pair(ast)) {
+	if (ast !~ /^[(['{]/) {
+		return ast
+	}
+	if (ast ~ /['\{]/) {
 		new_idx = types_allocate()
 		types_heap[new_idx][0] = "'quote"
 		types_heap[new_idx][1] = ast
 		types_heap[new_idx]["len"] = 2
 		return "(" new_idx
 	}
-	idx = substr(ast, 2)
-	first = types_heap[idx][0]
-	if (first == "'unquote") {
-		if (types_heap[idx]["len"] != 2) {
-			len = types_heap[idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(ret = types_heap[idx][1])
+	ret = starts_with(ast, "'unquote")
+	if (ret ~ /^!/) {
 		types_release(ast)
 		return ret
 	}
-
-	first_idx = substr(first, 2)
-	if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
-		if (types_heap[first_idx]["len"] != 2) {
-			len = types_heap[first_idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(first = types_heap[first_idx][1])
-		verb = "'concat"
-	} else {
-		types_addref(first)
-		first = quasiquote(first)
-		if (first ~ /^!/) {
-			types_release(ast)
-			return first
-		}
-		verb = "'cons"
-	}
-	lst_idx = types_allocate()
-	len = types_heap[idx]["len"]
-	for (i = 1; i < len; ++i) {
-		types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
-	}
-	types_heap[lst_idx]["len"] = len - 1
-	types_release(ast)
-	ret = quasiquote("(" lst_idx)
-	if (ret ~ /^!/) {
-		types_release(first)
+	if (ret) {
+		types_addref(ret)
+		types_release(ast)
 		return ret
 	}
-
 	new_idx = types_allocate()
-	types_heap[new_idx][0] = verb
-	types_heap[new_idx][1] = first
-	types_heap[new_idx][2] = ret
-	types_heap[new_idx]["len"] = 3
+	types_heap[new_idx]["len"] = 0
+	ast_idx = substr(ast, 2)
+	for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
+		elt = types_heap[ast_idx][elt_i]
+		ret = starts_with(elt, "'splice-unquote")
+		if (ret ~ /^!/) {
+			types_release("(" new_idx)
+			types_release(ast)
+			return ret
+		}
+		if (ret) {
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'concat"
+			types_heap[new_idx][1] = types_addref(ret)
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		} else {
+			ret = quasiquote(types_addref(elt))
+			if (ret ~ /^!/) {
+				types_release(ast)
+				return ret
+			}
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'cons"
+			types_heap[new_idx][1] = ret
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		}
+	}
+	if (ast ~ /^\[/) {
+		previous = "(" new_idx
+		new_idx = types_allocate()
+		types_heap[new_idx][0] = "'vec"
+		types_heap[new_idx][1] = previous
+		types_heap[new_idx]["len"] = 2
+	}
+	types_release(ast)
 	return "(" new_idx
 }
 
-function is_macro_call(ast, env,    sym, ret, f)
+function is_macro_call(ast, env,    idx, len, sym, f)
 {
-	if (!is_pair(ast)) {
-		return 0
-	}
-	sym = types_heap[substr(ast, 2)][0]
-	if (sym !~ /^'/) {
-		return 0
-	}
+	if (ast !~ /^\(/) return 0
+	idx = substr(ast, 2)
+	len = types_heap[idx]["len"]
+	if (len == 0) return 0
+	sym = types_heap[idx][0]
+	if (sym !~ /^'/) return 0
 	f = env_get(env, sym)
 	return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
 }
@@ -393,6 +405,15 @@ function EVAL(ast, env,    body, new_ast, ret, idx, len, f, f_idx, ret_env)
 			types_release(ast)
 			env_release(env)
 			return body
+		case "'quasiquoteexpand":
+			env_release(env)
+			if (len != 2) {
+				types_release(ast)
+				return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
+			}
+			types_addref(body = types_heap[idx][1])
+			types_release(ast)
+			return quasiquote(body)
 		case "'quasiquote":
 			if (len != 2) {
 				types_release(ast)

impls/awk/step9_try.awk

@@ -9,81 +9,93 @@ function READ(str)
 	return reader_read_str(str)
 }
 
-function is_pair(ast)
+# Return 0, an error or the unquote argument (second element of ast).
+function starts_with(ast, sym,    idx, len)
 {
-	return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
+	if (ast !~ /^\(/)
+		return 0
+	idx = substr(ast, 2)
+	len = types_heap[idx]["len"]
+	if (!len || types_heap[idx][0] != sym)
+		return 0
+	if (len != 2)
+		return  "!\"'" sym "' expects 1 argument, not " (len - 1) "."
+	return types_heap[idx][1]
 }
 
-function quasiquote(ast,    i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
+function quasiquote(ast,    new_idx, ret, ast_idx, elt_i, elt, previous)
 {
-	if (!is_pair(ast)) {
+	if (ast !~ /^[(['{]/) {
+		return ast
+	}
+	if (ast ~ /['\{]/) {
 		new_idx = types_allocate()
 		types_heap[new_idx][0] = "'quote"
 		types_heap[new_idx][1] = ast
 		types_heap[new_idx]["len"] = 2
 		return "(" new_idx
 	}
-	idx = substr(ast, 2)
-	first = types_heap[idx][0]
-	if (first == "'unquote") {
-		if (types_heap[idx]["len"] != 2) {
-			len = types_heap[idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(ret = types_heap[idx][1])
+	ret = starts_with(ast, "'unquote")
+	if (ret ~ /^!/) {
 		types_release(ast)
 		return ret
 	}
-
-	first_idx = substr(first, 2)
-	if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
-		if (types_heap[first_idx]["len"] != 2) {
-			len = types_heap[first_idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(first = types_heap[first_idx][1])
-		verb = "'concat"
-	} else {
-		types_addref(first)
-		first = quasiquote(first)
-		if (first ~ /^!/) {
-			types_release(ast)
-			return first
-		}
-		verb = "'cons"
-	}
-	lst_idx = types_allocate()
-	len = types_heap[idx]["len"]
-	for (i = 1; i < len; ++i) {
-		types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
-	}
-	types_heap[lst_idx]["len"] = len - 1
-	types_release(ast)
-	ret = quasiquote("(" lst_idx)
-	if (ret ~ /^!/) {
-		types_release(first)
+	if (ret) {
+		types_addref(ret)
+		types_release(ast)
 		return ret
 	}
-
 	new_idx = types_allocate()
-	types_heap[new_idx][0] = verb
-	types_heap[new_idx][1] = first
-	types_heap[new_idx][2] = ret
-	types_heap[new_idx]["len"] = 3
+	types_heap[new_idx]["len"] = 0
+	ast_idx = substr(ast, 2)
+	for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
+		elt = types_heap[ast_idx][elt_i]
+		ret = starts_with(elt, "'splice-unquote")
+		if (ret ~ /^!/) {
+			types_release("(" new_idx)
+			types_release(ast)
+			return ret
+		}
+		if (ret) {
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'concat"
+			types_heap[new_idx][1] = types_addref(ret)
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		} else {
+			ret = quasiquote(types_addref(elt))
+			if (ret ~ /^!/) {
+				types_release(ast)
+				return ret
+			}
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'cons"
+			types_heap[new_idx][1] = ret
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		}
+	}
+	if (ast ~ /^\[/) {
+		previous = "(" new_idx
+		new_idx = types_allocate()
+		types_heap[new_idx][0] = "'vec"
+		types_heap[new_idx][1] = previous
+		types_heap[new_idx]["len"] = 2
+	}
+	types_release(ast)
 	return "(" new_idx
 }
 
-function is_macro_call(ast, env,    sym, ret, f)
+function is_macro_call(ast, env,    idx, len, sym, f)
 {
-	if (!is_pair(ast)) {
-		return 0
-	}
-	sym = types_heap[substr(ast, 2)][0]
-	if (sym !~ /^'/) {
-		return 0
-	}
+	if (ast !~ /^\(/) return 0
+	idx = substr(ast, 2)
+	len = types_heap[idx]["len"]
+	if (len == 0) return 0
+	sym = types_heap[idx][0]
+	if (sym !~ /^'/) return 0
 	f = env_get(env, sym)
 	return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
 }
@@ -447,6 +459,15 @@ function EVAL(ast, env,    body, new_ast, ret, idx, len, f, f_idx, ret_body, ret
 			types_release(ast)
 			env_release(env)
 			return body
+		case "'quasiquoteexpand":
+			env_release(env)
+			if (len != 2) {
+				types_release(ast)
+				return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
+			}
+			types_addref(body = types_heap[idx][1])
+			types_release(ast)
+			return quasiquote(body)
 		case "'quasiquote":
 			if (len != 2) {
 				types_release(ast)

impls/awk/stepA_mal.awk

@@ -9,81 +9,93 @@ function READ(str)
 	return reader_read_str(str)
 }
 
-function is_pair(ast)
+# Return 0, an error or the unquote argument (second element of ast).
+function starts_with(ast, sym,    idx, len)
 {
-	return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
+	if (ast !~ /^\(/)
+		return 0
+	idx = substr(ast, 2)
+	len = types_heap[idx]["len"]
+	if (!len || types_heap[idx][0] != sym)
+		return 0
+	if (len != 2)
+		return  "!\"'" sym "' expects 1 argument, not " (len - 1) "."
+	return types_heap[idx][1]
 }
 
-function quasiquote(ast,    i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
+function quasiquote(ast,    new_idx, ret, ast_idx, elt_i, elt, previous)
 {
-	if (!is_pair(ast)) {
+	if (ast !~ /^[(['{]/) {
+		return ast
+	}
+	if (ast ~ /['\{]/) {
 		new_idx = types_allocate()
 		types_heap[new_idx][0] = "'quote"
 		types_heap[new_idx][1] = ast
 		types_heap[new_idx]["len"] = 2
 		return "(" new_idx
 	}
-	idx = substr(ast, 2)
-	first = types_heap[idx][0]
-	if (first == "'unquote") {
-		if (types_heap[idx]["len"] != 2) {
-			len = types_heap[idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(ret = types_heap[idx][1])
+	ret = starts_with(ast, "'unquote")
+	if (ret ~ /^!/) {
 		types_release(ast)
 		return ret
 	}
-
-	first_idx = substr(first, 2)
-	if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
-		if (types_heap[first_idx]["len"] != 2) {
-			len = types_heap[first_idx]["len"]
-			types_release(ast)
-			return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
-		}
-		types_addref(first = types_heap[first_idx][1])
-		verb = "'concat"
-	} else {
-		types_addref(first)
-		first = quasiquote(first)
-		if (first ~ /^!/) {
-			types_release(ast)
-			return first
-		}
-		verb = "'cons"
-	}
-	lst_idx = types_allocate()
-	len = types_heap[idx]["len"]
-	for (i = 1; i < len; ++i) {
-		types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
-	}
-	types_heap[lst_idx]["len"] = len - 1
-	types_release(ast)
-	ret = quasiquote("(" lst_idx)
-	if (ret ~ /^!/) {
-		types_release(first)
+	if (ret) {
+		types_addref(ret)
+		types_release(ast)
 		return ret
 	}
-
 	new_idx = types_allocate()
-	types_heap[new_idx][0] = verb
-	types_heap[new_idx][1] = first
-	types_heap[new_idx][2] = ret
-	types_heap[new_idx]["len"] = 3
+	types_heap[new_idx]["len"] = 0
+	ast_idx = substr(ast, 2)
+	for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
+		elt = types_heap[ast_idx][elt_i]
+		ret = starts_with(elt, "'splice-unquote")
+		if (ret ~ /^!/) {
+			types_release("(" new_idx)
+			types_release(ast)
+			return ret
+		}
+		if (ret) {
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'concat"
+			types_heap[new_idx][1] = types_addref(ret)
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		} else {
+			ret = quasiquote(types_addref(elt))
+			if (ret ~ /^!/) {
+				types_release(ast)
+				return ret
+			}
+			previous = "(" new_idx
+			new_idx = types_allocate()
+			types_heap[new_idx][0] = "'cons"
+			types_heap[new_idx][1] = ret
+			types_heap[new_idx][2] = previous
+			types_heap[new_idx]["len"] = 3
+		}
+	}
+	if (ast ~ /^\[/) {
+		previous = "(" new_idx
+		new_idx = types_allocate()
+		types_heap[new_idx][0] = "'vec"
+		types_heap[new_idx][1] = previous
+		types_heap[new_idx]["len"] = 2
+	}
+	types_release(ast)
 	return "(" new_idx
 }
 
-function is_macro_call(ast, env,    sym, ret, f)
+function is_macro_call(ast, env,    idx, len, sym, f)
 {
-	if (!is_pair(ast)) {
-		return 0
-	}
-	sym = types_heap[substr(ast, 2)][0]
-	if (sym !~ /^'/) {
-		return 0
-	}
+	if (ast !~ /^\(/) return 0
+	idx = substr(ast, 2)
+	len = types_heap[idx]["len"]
+	if (len == 0) return 0
+	sym = types_heap[idx][0]
+	if (sym !~ /^'/) return 0
 	f = env_get(env, sym)
 	return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
 }
@@ -447,6 +459,15 @@ function EVAL(ast, env,    body, new_ast, ret, idx, len, f, f_idx, ret_body, ret
 			types_release(ast)
 			env_release(env)
 			return body
+		case "'quasiquoteexpand":
+			env_release(env)
+			if (len != 2) {
+				types_release(ast)
+				return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
+			}
+			types_addref(body = types_heap[idx][1])
+			types_release(ast)
+			return quasiquote(body)
 		case "'quasiquote":
 			if (len != 2) {
 				types_release(ast)

impls/bash/core.sh

@@ -402,6 +402,7 @@ declare -A core_ns=(
     [sequential?]=sequential?
     [cons]=cons
     [concat]=concat
+    [vec]=vec
     [nth]=nth
     [first]=_first
     [rest]=_rest

impls/bash/step7_quote.sh

@@ -12,42 +12,47 @@ READ () {
 }
 
 # eval
-IS_PAIR () {
-    if _sequential? "${1}"; then
-        _count "${1}"
-        [[ "${r}" > 0 ]] && return 0
-    fi
-    return 1
+starts_with () {
+    _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
 }
 
 QUASIQUOTE () {
-    if ! IS_PAIR "${1}"; then
-        _symbol quote
-        _list "${r}" "${1}"
-        return
+    _obj_type "$1"
+    case "$r" in
+        list)
+            if starts_with "$1" unquote; then
+                _nth "$1" 1
+            else
+                qqIter "$1"
+            fi ;;
+        vector)
+            _symbol vec;  local a="$r"
+            qqIter "$1"
+            _list "$a" "$r" ;;
+        symbol|hash_map)
+            _symbol quote
+            _list "$r" "$1" ;;
+        *)
+            r="$1" ;;
+    esac
+}
+
+qqIter () {
+    if _empty? "$1"; then
+        _list
     else
-        _nth "${1}" 0; local a0="${r}"
-        if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
-            _nth "${1}" 1
-            return
-        elif IS_PAIR "${a0}"; then
-            _nth "${a0}" 0; local a00="${r}"
-            if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
-                _symbol concat; local a="${r}"
-                _nth "${a0}" 1; local b="${r}"
-                _rest "${1}"
-                QUASIQUOTE "${r}"; local c="${r}"
-                _list "${a}" "${b}" "${c}"
-                return
-            fi
+        _nth "${1}" 0;        local a0="$r"
+        if starts_with "$a0" splice-unquote; then
+            _symbol concat;   local a="$r"
+            _nth "$a0" 1;     local b="$r"
+        else
+            _symbol cons;     local a="$r"
+            QUASIQUOTE "$a0"; local b="$r"
         fi
+        _rest "$1"
+        qqIter "$r"
+        _list "$a" "$b" "$r"
     fi
-    _symbol cons; local a="${r}"
-    QUASIQUOTE "${a0}"; local b="${r}"
-    _rest "${1}"
-    QUASIQUOTE "${r}"; local c="${r}"
-    _list "${a}" "${b}" "${c}"
-    return
 }
 
 EVAL_AST () {
@@ -115,6 +120,9 @@ EVAL () {
         quote)
               r="${a1}"
               return ;;
+        quasiquoteexpand)
+              QUASIQUOTE "${a1}"
+              return ;;
         quasiquote)
               QUASIQUOTE "${a1}"
               ast="${r}"

impls/bash/step8_macros.sh

@@ -12,42 +12,47 @@ READ () {
 }
 
 # eval
-IS_PAIR () {
-    if _sequential? "${1}"; then
-        _count "${1}"
-        [[ "${r}" > 0 ]] && return 0
-    fi
-    return 1
+starts_with () {
+    _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
 }
 
 QUASIQUOTE () {
-    if ! IS_PAIR "${1}"; then
-        _symbol quote
-        _list "${r}" "${1}"
-        return
+    _obj_type "$1"
+    case "$r" in
+        list)
+            if starts_with "$1" unquote; then
+                _nth "$1" 1
+            else
+                qqIter "$1"
+            fi ;;
+        vector)
+            _symbol vec;  local a="$r"
+            qqIter "$1"
+            _list "$a" "$r" ;;
+        symbol|hash_map)
+            _symbol quote
+            _list "$r" "$1" ;;
+        *)
+            r="$1" ;;
+    esac
+}
+
+qqIter () {
+    if _empty? "$1"; then
+        _list
     else
-        _nth "${1}" 0; local a0="${r}"
-        if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
-            _nth "${1}" 1
-            return
-        elif IS_PAIR "${a0}"; then
-            _nth "${a0}" 0; local a00="${r}"
-            if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
-                _symbol concat; local a="${r}"
-                _nth "${a0}" 1; local b="${r}"
-                _rest "${1}"
-                QUASIQUOTE "${r}"; local c="${r}"
-                _list "${a}" "${b}" "${c}"
-                return
-            fi
+        _nth "${1}" 0;        local a0="$r"
+        if starts_with "$a0" splice-unquote; then
+            _symbol concat;   local a="$r"
+            _nth "$a0" 1;     local b="$r"
+        else
+            _symbol cons;     local a="$r"
+            QUASIQUOTE "$a0"; local b="$r"
         fi
+        _rest "$1"
+        qqIter "$r"
+        _list "$a" "$b" "$r"
     fi
-    _symbol cons; local a="${r}"
-    QUASIQUOTE "${a0}"; local b="${r}"
-    _rest "${1}"
-    QUASIQUOTE "${r}"; local c="${r}"
-    _list "${a}" "${b}" "${c}"
-    return
 }
 
 IS_MACRO_CALL () {
@@ -148,6 +153,9 @@ EVAL () {
         quote)
               r="${a1}"
               return ;;
+        quasiquoteexpand)
+              QUASIQUOTE "${a1}"
+              return ;;
         quasiquote)
               QUASIQUOTE "${a1}"
               ast="${r}"

impls/bash/step9_try.sh

@@ -12,42 +12,47 @@ READ () {
 }
 
 # eval
-IS_PAIR () {
-    if _sequential? "${1}"; then
-        _count "${1}"
-        [[ "${r}" > 0 ]] && return 0
-    fi
-    return 1
+starts_with () {
+    _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
 }
 
 QUASIQUOTE () {
-    if ! IS_PAIR "${1}"; then
-        _symbol quote
-        _list "${r}" "${1}"
-        return
+    _obj_type "$1"
+    case "$r" in
+        list)
+            if starts_with "$1" unquote; then
+                _nth "$1" 1
+            else
+                qqIter "$1"
+            fi ;;
+        vector)
+            _symbol vec;  local a="$r"
+            qqIter "$1"
+            _list "$a" "$r" ;;
+        symbol|hash_map)
+            _symbol quote
+            _list "$r" "$1" ;;
+        *)
+            r="$1" ;;
+    esac
+}
+
+qqIter () {
+    if _empty? "$1"; then
+        _list
     else
-        _nth "${1}" 0; local a0="${r}"
-        if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
-            _nth "${1}" 1
-            return
-        elif IS_PAIR "${a0}"; then
-            _nth "${a0}" 0; local a00="${r}"
-            if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
-                _symbol concat; local a="${r}"
-                _nth "${a0}" 1; local b="${r}"
-                _rest "${1}"
-                QUASIQUOTE "${r}"; local c="${r}"
-                _list "${a}" "${b}" "${c}"
-                return
-            fi
+        _nth "${1}" 0;        local a0="$r"
+        if starts_with "$a0" splice-unquote; then
+            _symbol concat;   local a="$r"
+            _nth "$a0" 1;     local b="$r"
+        else
+            _symbol cons;     local a="$r"
+            QUASIQUOTE "$a0"; local b="$r"
         fi
+        _rest "$1"
+        qqIter "$r"
+        _list "$a" "$b" "$r"
     fi
-    _symbol cons; local a="${r}"
-    QUASIQUOTE "${a0}"; local b="${r}"
-    _rest "${1}"
-    QUASIQUOTE "${r}"; local c="${r}"
-    _list "${a}" "${b}" "${c}"
-    return
 }
 
 IS_MACRO_CALL () {
@@ -148,6 +153,9 @@ EVAL () {
         quote)
               r="${a1}"
               return ;;
+        quasiquoteexpand)
+              QUASIQUOTE "${a1}"
+              return ;;
         quasiquote)
               QUASIQUOTE "${a1}"
               ast="${r}"

impls/bash/stepA_mal.sh

@@ -12,42 +12,47 @@ READ () {
 }
 
 # eval
-IS_PAIR () {
-    if _sequential? "${1}"; then
-        _count "${1}"
-        [[ "${r}" > 0 ]] && return 0
-    fi
-    return 1
+starts_with () {
+    _list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
 }
 
 QUASIQUOTE () {
-    if ! IS_PAIR "${1}"; then
-        _symbol quote
-        _list "${r}" "${1}"
-        return
+    _obj_type "$1"
+    case "$r" in
+        list)
+            if starts_with "$1" unquote; then
+                _nth "$1" 1
+            else
+                qqIter "$1"
+            fi ;;
+        vector)
+            _symbol vec;  local a="$r"
+            qqIter "$1"
+            _list "$a" "$r" ;;
+        symbol|hash_map)
+            _symbol quote
+            _list "$r" "$1" ;;
+        *)
+            r="$1" ;;
+    esac
+}
+
+qqIter () {
+    if _empty? "$1"; then
+        _list
     else
-        _nth "${1}" 0; local a0="${r}"
-        if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
-            _nth "${1}" 1
-            return
-        elif IS_PAIR "${a0}"; then
-            _nth "${a0}" 0; local a00="${r}"
-            if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
-                _symbol concat; local a="${r}"
-                _nth "${a0}" 1; local b="${r}"
-                _rest "${1}"
-                QUASIQUOTE "${r}"; local c="${r}"
-                _list "${a}" "${b}" "${c}"
-                return
-            fi
+        _nth "${1}" 0;        local a0="$r"
+        if starts_with "$a0" splice-unquote; then
+            _symbol concat;   local a="$r"
+            _nth "$a0" 1;     local b="$r"
+        else
+            _symbol cons;     local a="$r"
+            QUASIQUOTE "$a0"; local b="$r"
         fi
+        _rest "$1"
+        qqIter "$r"
+        _list "$a" "$b" "$r"
     fi
-    _symbol cons; local a="${r}"
-    QUASIQUOTE "${a0}"; local b="${r}"
-    _rest "${1}"
-    QUASIQUOTE "${r}"; local c="${r}"
-    _list "${a}" "${b}" "${c}"
-    return
 }
 
 IS_MACRO_CALL () {
@@ -148,6 +153,9 @@ EVAL () {
         quote)
               r="${a1}"
               return ;;
+        quasiquoteexpand)
+              QUASIQUOTE "${a1}"
+              return ;;
         quasiquote)
               QUASIQUOTE "${a1}"
               ast="${r}"

impls/bash/types.sh

@@ -209,6 +209,12 @@ _vector () {
 }
 _vector? () { [[ ${1} =~ ^vector_ ]]; }
 
+vec () {
+    __new_obj_hash_code
+    r="vector_$r"
+    ANON["$r"]=${ANON["$1"]}
+}
+
 
 # hash maps (associative arrays)
 

impls/basic/core.in.bas

@@ -173,7 +173,7 @@ DO_FUNCTION:
 
   REM Switch on the function number
   REM MEMORY DEBUGGING:
-  REM IF G>59 THEN ER=-1:E$="unknown function"+STR$(G):RETURN
+  REM IF G>60 THEN ER=-1:E$="unknown function"+STR$(G):RETURN
   ON INT(G/10)+1 GOTO DO_1_9,DO_10_19,DO_20_29,DO_30_39,DO_40_49,DO_50_59,DO_60_69
 
   DO_1_9:
@@ -189,7 +189,7 @@ DO_FUNCTION:
   DO_50_59:
   ON G-49 GOTO DO_CONJ,DO_SEQ,DO_WITH_META,DO_META,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_EVAL,DO_READ_FILE
   DO_60_69:
-  ON G-59 GOTO DO_PR_MEMORY_SUMMARY
+  ON G-59 GOTO DO_VEC,DO_PR_MEMORY_SUMMARY
 
   DO_EQUAL_Q:
     GOSUB EQUAL_Q
@@ -333,8 +333,7 @@ DO_FUNCTION:
     GOSUB LIST_Q
     GOTO RETURN_TRUE_FALSE
   DO_VECTOR:
-    A=AR:T=7:GOSUB FORCE_SEQ_TYPE
-    RETURN
+    A=AR:T=7:GOTO FORCE_SEQ_TYPE
   DO_VECTOR_Q:
     GOSUB TYPE_A
     R=T=7
@@ -457,6 +456,8 @@ DO_FUNCTION:
       GOSUB POP_R: REM pop return value
       GOSUB POP_Q: REM pop current
       RETURN
+  DO_VEC:
+    T=7:GOTO FORCE_SEQ_TYPE
 
   DO_NTH:
     B=B1
@@ -625,7 +626,8 @@ INIT_CORE_NS:
 
   B$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=58
   B$="read-file":GOSUB INIT_CORE_SET_FUNCTION: REM A=59
-  B$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=60
+  B$="vec":GOSUB INIT_CORE_SET_FUNCTION: REM A=60
+  B$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=61
 
   REM these are in DO_TCO_FUNCTION
   A=65

impls/basic/step4_if_fn_do.in.bas

@@ -234,9 +234,9 @@ SUB EVAL
 
       EVAL_DO_FUNCTION:
         REM regular function
-        IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+        IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
         REM for recur functions (apply, map, swap!), use GOTO
-        IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
+        IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
         EVAL_DO_FUNCTION_SKIP:
 
         REM pop and release f/args

impls/basic/step5_tco.in.bas

@@ -258,9 +258,9 @@ SUB EVAL
 
       EVAL_DO_FUNCTION:
         REM regular function
-        IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+        IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
         REM for recur functions (apply, map, swap!), use GOTO
-        IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
+        IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
         EVAL_DO_FUNCTION_SKIP:
 
         REM pop and release f/args

impls/basic/step6_file.in.bas

@@ -258,9 +258,9 @@ SUB EVAL
 
       EVAL_DO_FUNCTION:
         REM regular function
-        IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+        IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
         REM for recur functions (apply, map, swap!), use GOTO
-        IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
+        IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
         EVAL_DO_FUNCTION_SKIP:
 
         REM pop and release f/args

impls/basic/step7_quote.in.bas

@@ -17,74 +17,114 @@ MAL_READ:
 
 REM QUASIQUOTE(A) -> R
 SUB QUASIQUOTE
-  REM pair?
   GOSUB TYPE_A
-  IF T<6 OR T>7 THEN GOTO QQ_QUOTE
-  IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
+  IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
+  IF T=5 OR T=8 THEN GOTO QQ_QUOTE
+  IF T=7 THEN GOTO QQ_VECTOR
+  IF (Z%(A+1)=0) THEN GOTO QQ_LIST
+  R=Z%(A+2)
+  IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
+  IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
   GOTO QQ_UNQUOTE
 
+  QQ_UNCHANGED:
+    R=A
+    GOSUB INC_REF_R
+
+    GOTO QQ_DONE
+
   QQ_QUOTE:
     REM ['quote, ast]
     B$="quote":T=5:GOSUB STRING
-    B=R:A=A:GOSUB LIST2
+    B=R:GOSUB LIST2
+    AY=B:GOSUB RELEASE
+
+    GOTO QQ_DONE
+
+  QQ_VECTOR:
+    REM ['vec, (qq_foldr ast)]
+    CALL QQ_FOLDR
+    A=R
+    B$="vec":T=5:GOSUB STRING:B=R
+    GOSUB LIST2
+    AY=A:GOSUB RELEASE
     AY=B:GOSUB RELEASE
 
     GOTO QQ_DONE
 
   QQ_UNQUOTE:
-    R=Z%(A+2)
-    IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
-    IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
-      REM [ast[1]]
-      R=Z%(Z%(A+1)+2)
-      GOSUB INC_REF_R
+    REM [ast[1]]
+    R=Z%(Z%(A+1)+2)
+    GOSUB INC_REF_R
 
-      GOTO QQ_DONE
+    GOTO QQ_DONE
 
-  QQ_SPLICE_UNQUOTE:
+  QQ_LIST:
+    CALL QQ_FOLDR
+
+QQ_DONE:
+END SUB
+
+REM Quasiquote right fold (A) -> R.
+REM Used for unquoted lists (GOTO), vectors (GOSUB),
+REM and recursively (GOSUB).
+SUB QQ_FOLDR
+  IF A=0 THEN GOTO QQ_EMPTY
+  IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
+  GOTO QQ_NOTEMPTY
+
+  QQ_EMPTY:
+    REM empty list/vector -> empty list
+    R=6
+    GOSUB INC_REF_R
+
+    GOTO QQ_FOLDR_DONE
+
+  QQ_NOTEMPTY:
+    REM Execute QQ_FOLDR recursively with (rest A)
     GOSUB PUSH_A
-    REM rest of cases call quasiquote on ast[1..]
-    A=Z%(A+1):CALL QUASIQUOTE
-    W=R
+    A=Z%(A+1):CALL QQ_FOLDR
     GOSUB POP_A
 
-    REM set A to ast[0] for last two cases
+    REM Set A to elt = (first A)
     A=Z%(A+2)
 
-    REM pair?
-    GOSUB TYPE_A
-    IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
-    IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
+    REM Quasiquote transition function:
+    REM A: current element, R: accumulator -> R: new accumulator
 
+    REM check if A is a list starting with splice-unquote
+    GOSUB TYPE_A
+    IF T<>6 THEN GOTO QQ_DEFAULT
+    IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
     B=Z%(A+2)
     IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
-    IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
-      REM ['concat, ast[0][1], quasiquote(ast[1..])]
+    IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
 
+    REM ('concat, A[1], R)
       B=Z%(Z%(A+1)+2)
+      A=R
       B$="concat":T=5:GOSUB STRING:C=R
-      A=W:GOSUB LIST3
+      GOSUB LIST3
       REM release inner quasiquoted since outer list takes ownership
       AY=A:GOSUB RELEASE
       AY=C:GOSUB RELEASE
-      GOTO QQ_DONE
 
-  QQ_DEFAULT:
-    REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
+      GOTO QQ_FOLDR_DONE
 
-    Q=W:GOSUB PUSH_Q
-    REM A set above to ast[0]
-    CALL QUASIQUOTE
-    B=R
-    GOSUB POP_Q:W=Q
+    QQ_DEFAULT:
+      REM ('cons, quasiquote(A), R)
+      GOSUB PUSH_R
+      CALL QUASIQUOTE
+      B=R
+      B$="cons":T=5:GOSUB STRING:C=R
+      GOSUB POP_A
+      GOSUB LIST3
+      REM release inner quasiquoted since outer list takes ownership
+      AY=A:GOSUB RELEASE
+      AY=B:GOSUB RELEASE
+      AY=C:GOSUB RELEASE
 
-    B$="cons":T=5:GOSUB STRING:C=R
-    A=W:GOSUB LIST3
-    REM release inner quasiquoted since outer list takes ownership
-    AY=A:GOSUB RELEASE
-    AY=B:GOSUB RELEASE
-    AY=C:GOSUB RELEASE
-  QQ_DONE:
+QQ_FOLDR_DONE:
 END SUB
 
 
@@ -198,6 +238,7 @@ SUB EVAL
     IF A$="def!" THEN GOTO EVAL_DEF
     IF A$="let*" THEN GOTO EVAL_LET
     IF A$="quote" THEN GOTO EVAL_QUOTE
+    IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
     IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
     IF A$="do" THEN GOTO EVAL_DO
     IF A$="if" THEN GOTO EVAL_IF
@@ -290,6 +331,11 @@ SUB EVAL
       GOSUB INC_REF_R
       GOTO EVAL_RETURN
 
+    EVAL_QUASIQUOTEEXPAND:
+      R=Z%(Z%(A+1)+2)
+      A=R:CALL QUASIQUOTE
+      GOTO EVAL_RETURN
+
     EVAL_QUASIQUOTE:
       R=Z%(Z%(A+1)+2)
       A=R:CALL QUASIQUOTE
@@ -348,9 +394,9 @@ SUB EVAL
 
       EVAL_DO_FUNCTION:
         REM regular function
-        IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+        IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
         REM for recur functions (apply, map, swap!), use GOTO
-        IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
+        IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
         EVAL_DO_FUNCTION_SKIP:
 
         REM pop and release f/args

impls/basic/step8_macros.in.bas

@@ -17,74 +17,114 @@ MAL_READ:
 
 REM QUASIQUOTE(A) -> R
 SUB QUASIQUOTE
-  REM pair?
   GOSUB TYPE_A
-  IF T<6 OR T>7 THEN GOTO QQ_QUOTE
-  IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
+  IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
+  IF T=5 OR T=8 THEN GOTO QQ_QUOTE
+  IF T=7 THEN GOTO QQ_VECTOR
+  IF (Z%(A+1)=0) THEN GOTO QQ_LIST
+  R=Z%(A+2)
+  IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
+  IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
   GOTO QQ_UNQUOTE
 
+  QQ_UNCHANGED:
+    R=A
+    GOSUB INC_REF_R
+
+    GOTO QQ_DONE
+
   QQ_QUOTE:
     REM ['quote, ast]
     B$="quote":T=5:GOSUB STRING
-    B=R:A=A:GOSUB LIST2
+    B=R:GOSUB LIST2
+    AY=B:GOSUB RELEASE
+
+    GOTO QQ_DONE
+
+  QQ_VECTOR:
+    REM ['vec, (qq_foldr ast)]
+    CALL QQ_FOLDR
+    A=R
+    B$="vec":T=5:GOSUB STRING:B=R
+    GOSUB LIST2
+    AY=A:GOSUB RELEASE
     AY=B:GOSUB RELEASE
 
     GOTO QQ_DONE
 
   QQ_UNQUOTE:
-    R=Z%(A+2)
-    IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
-    IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
-      REM [ast[1]]
-      R=Z%(Z%(A+1)+2)
-      GOSUB INC_REF_R
+    REM [ast[1]]
+    R=Z%(Z%(A+1)+2)
+    GOSUB INC_REF_R
 
-      GOTO QQ_DONE
+    GOTO QQ_DONE
 
-  QQ_SPLICE_UNQUOTE:
+  QQ_LIST:
+    CALL QQ_FOLDR
+
+QQ_DONE:
+END SUB
+
+REM Quasiquote right fold (A) -> R.
+REM Used for unquoted lists (GOTO), vectors (GOSUB),
+REM and recursively (GOSUB).
+SUB QQ_FOLDR
+  IF A=0 THEN GOTO QQ_EMPTY
+  IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
+  GOTO QQ_NOTEMPTY
+
+  QQ_EMPTY:
+    REM empty list/vector -> empty list
+    R=6
+    GOSUB INC_REF_R
+
+    GOTO QQ_FOLDR_DONE
+
+  QQ_NOTEMPTY:
+    REM Execute QQ_FOLDR recursively with (rest A)
     GOSUB PUSH_A
-    REM rest of cases call quasiquote on ast[1..]
-    A=Z%(A+1):CALL QUASIQUOTE
-    W=R
+    A=Z%(A+1):CALL QQ_FOLDR
     GOSUB POP_A
 
-    REM set A to ast[0] for last two cases
+    REM Set A to elt = (first A)
     A=Z%(A+2)
 
-    REM pair?
-    GOSUB TYPE_A
-    IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
-    IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
+    REM Quasiquote transition function:
+    REM A: current element, R: accumulator -> R: new accumulator
 
+    REM check if A is a list starting with splice-unquote
+    GOSUB TYPE_A
+    IF T<>6 THEN GOTO QQ_DEFAULT
+    IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
     B=Z%(A+2)
     IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
-    IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
-      REM ['concat, ast[0][1], quasiquote(ast[1..])]
+    IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
 
+    REM ('concat, A[1], R)
       B=Z%(Z%(A+1)+2)
+      A=R
       B$="concat":T=5:GOSUB STRING:C=R
-      A=W:GOSUB LIST3
+      GOSUB LIST3
       REM release inner quasiquoted since outer list takes ownership
       AY=A:GOSUB RELEASE
       AY=C:GOSUB RELEASE
-      GOTO QQ_DONE
 
-  QQ_DEFAULT:
-    REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
+      GOTO QQ_FOLDR_DONE
 
-    Q=W:GOSUB PUSH_Q
-    REM A set above to ast[0]
-    CALL QUASIQUOTE
-    B=R
-    GOSUB POP_Q:W=Q
+    QQ_DEFAULT:
+      REM ('cons, quasiquote(A), R)
+      GOSUB PUSH_R
+      CALL QUASIQUOTE
+      B=R
+      B$="cons":T=5:GOSUB STRING:C=R
+      GOSUB POP_A
+      GOSUB LIST3
+      REM release inner quasiquoted since outer list takes ownership
+      AY=A:GOSUB RELEASE
+      AY=B:GOSUB RELEASE
+      AY=C:GOSUB RELEASE
 
-    B$="cons":T=5:GOSUB STRING:C=R
-    A=W:GOSUB LIST3
-    REM release inner quasiquoted since outer list takes ownership
-    AY=A:GOSUB RELEASE
-    AY=B:GOSUB RELEASE
-    AY=C:GOSUB RELEASE
-  QQ_DONE:
+QQ_FOLDR_DONE:
 END SUB
 
 REM MACROEXPAND(A, E) -> A:
@@ -238,6 +278,7 @@ SUB EVAL
     IF A$="def!" THEN GOTO EVAL_DEF
     IF A$="let*" THEN GOTO EVAL_LET
     IF A$="quote" THEN GOTO EVAL_QUOTE
+    IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
     IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
     IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
     IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
@@ -332,6 +373,11 @@ SUB EVAL
       GOSUB INC_REF_R
       GOTO EVAL_RETURN
 
+    EVAL_QUASIQUOTEEXPAND:
+      R=Z%(Z%(A+1)+2)
+      A=R:CALL QUASIQUOTE
+      GOTO EVAL_RETURN
+
     EVAL_QUASIQUOTE:
       R=Z%(Z%(A+1)+2)
       A=R:CALL QUASIQUOTE
@@ -415,9 +461,9 @@ SUB EVAL
 
       EVAL_DO_FUNCTION:
         REM regular function
-        IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+        IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
         REM for recur functions (apply, map, swap!), use GOTO
-        IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
+        IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
         EVAL_DO_FUNCTION_SKIP:
 
         REM pop and release f/args

impls/basic/step9_try.in.bas

@@ -17,74 +17,114 @@ MAL_READ:
 
 REM QUASIQUOTE(A) -> R
 SUB QUASIQUOTE
-  REM pair?
   GOSUB TYPE_A
-  IF T<6 OR T>7 THEN GOTO QQ_QUOTE
-  IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
+  IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
+  IF T=5 OR T=8 THEN GOTO QQ_QUOTE
+  IF T=7 THEN GOTO QQ_VECTOR
+  IF (Z%(A+1)=0) THEN GOTO QQ_LIST
+  R=Z%(A+2)
+  IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
+  IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
   GOTO QQ_UNQUOTE
 
+  QQ_UNCHANGED:
+    R=A
+    GOSUB INC_REF_R
+
+    GOTO QQ_DONE
+
   QQ_QUOTE:
     REM ['quote, ast]
     B$="quote":T=5:GOSUB STRING
-    B=R:A=A:GOSUB LIST2
+    B=R:GOSUB LIST2
+    AY=B:GOSUB RELEASE
+
+    GOTO QQ_DONE
+
+  QQ_VECTOR:
+    REM ['vec, (qq_foldr ast)]
+    CALL QQ_FOLDR
+    A=R
+    B$="vec":T=5:GOSUB STRING:B=R
+    GOSUB LIST2
+    AY=A:GOSUB RELEASE
     AY=B:GOSUB RELEASE
 
     GOTO QQ_DONE
 
   QQ_UNQUOTE:
-    R=Z%(A+2)
-    IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
-    IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
-      REM [ast[1]]
-      R=Z%(Z%(A+1)+2)
-      GOSUB INC_REF_R
+    REM [ast[1]]
+    R=Z%(Z%(A+1)+2)
+    GOSUB INC_REF_R
 
-      GOTO QQ_DONE
+    GOTO QQ_DONE
 
-  QQ_SPLICE_UNQUOTE:
+  QQ_LIST:
+    CALL QQ_FOLDR
+
+QQ_DONE:
+END SUB
+
+REM Quasiquote right fold (A) -> R.
+REM Used for unquoted lists (GOTO), vectors (GOSUB),
+REM and recursively (GOSUB).
+SUB QQ_FOLDR
+  IF A=0 THEN GOTO QQ_EMPTY
+  IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
+  GOTO QQ_NOTEMPTY
+
+  QQ_EMPTY:
+    REM empty list/vector -> empty list
+    R=6
+    GOSUB INC_REF_R
+
+    GOTO QQ_FOLDR_DONE
+
+  QQ_NOTEMPTY:
+    REM Execute QQ_FOLDR recursively with (rest A)
     GOSUB PUSH_A
-    REM rest of cases call quasiquote on ast[1..]
-    A=Z%(A+1):CALL QUASIQUOTE
-    W=R
+    A=Z%(A+1):CALL QQ_FOLDR
     GOSUB POP_A
 
-    REM set A to ast[0] for last two cases
+    REM Set A to elt = (first A)
     A=Z%(A+2)
 
-    REM pair?
-    GOSUB TYPE_A
-    IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
-    IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
+    REM Quasiquote transition function:
+    REM A: current element, R: accumulator -> R: new accumulator
 
+    REM check if A is a list starting with splice-unquote
+    GOSUB TYPE_A
+    IF T<>6 THEN GOTO QQ_DEFAULT
+    IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
     B=Z%(A+2)
     IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
-    IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
-      REM ['concat, ast[0][1], quasiquote(ast[1..])]
+    IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
 
+    REM ('concat, A[1], R)
       B=Z%(Z%(A+1)+2)
+      A=R
       B$="concat":T=5:GOSUB STRING:C=R
-      A=W:GOSUB LIST3
+      GOSUB LIST3
       REM release inner quasiquoted since outer list takes ownership
       AY=A:GOSUB RELEASE
       AY=C:GOSUB RELEASE
-      GOTO QQ_DONE
 
-  QQ_DEFAULT:
-    REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
+      GOTO QQ_FOLDR_DONE
 
-    Q=W:GOSUB PUSH_Q
-    REM A set above to ast[0]
-    CALL QUASIQUOTE
-    B=R
-    GOSUB POP_Q:W=Q
+    QQ_DEFAULT:
+      REM ('cons, quasiquote(A), R)
+      GOSUB PUSH_R
+      CALL QUASIQUOTE
+      B=R
+      B$="cons":T=5:GOSUB STRING:C=R
+      GOSUB POP_A
+      GOSUB LIST3
+      REM release inner quasiquoted since outer list takes ownership
+      AY=A:GOSUB RELEASE
+      AY=B:GOSUB RELEASE
+      AY=C:GOSUB RELEASE
 
-    B$="cons":T=5:GOSUB STRING:C=R
-    A=W:GOSUB LIST3
-    REM release inner quasiquoted since outer list takes ownership
-    AY=A:GOSUB RELEASE
-    AY=B:GOSUB RELEASE
-    AY=C:GOSUB RELEASE
-  QQ_DONE:
+QQ_FOLDR_DONE:
 END SUB
 
 REM MACROEXPAND(A, E) -> A:
@@ -238,6 +278,7 @@ SUB EVAL
     IF A$="def!" THEN GOTO EVAL_DEF
     IF A$="let*" THEN GOTO EVAL_LET
     IF A$="quote" THEN GOTO EVAL_QUOTE
+    IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
     IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
     IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
     IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
@@ -333,6 +374,11 @@ SUB EVAL
       GOSUB INC_REF_R
       GOTO EVAL_RETURN
 
+    EVAL_QUASIQUOTEEXPAND:
+      R=Z%(Z%(A+1)+2)
+      A=R:CALL QUASIQUOTE
+      GOTO EVAL_RETURN
+
     EVAL_QUASIQUOTE:
       R=Z%(Z%(A+1)+2)
       A=R:CALL QUASIQUOTE
@@ -448,9 +494,9 @@ SUB EVAL
 
       EVAL_DO_FUNCTION:
         REM regular function
-        IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+        IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
         REM for recur functions (apply, map, swap!), use GOTO
-        IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
+        IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
         EVAL_DO_FUNCTION_SKIP:
 
         REM pop and release f/args

impls/basic/stepA_mal.in.bas

@@ -14,74 +14,114 @@ REM READ is inlined in RE
 
 REM QUASIQUOTE(A) -> R
 SUB QUASIQUOTE
-  REM pair?
   GOSUB TYPE_A
-  IF T<6 OR T>7 THEN GOTO QQ_QUOTE
-  IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
+  IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
+  IF T=5 OR T=8 THEN GOTO QQ_QUOTE
+  IF T=7 THEN GOTO QQ_VECTOR
+  IF (Z%(A+1)=0) THEN GOTO QQ_LIST
+  R=Z%(A+2)
+  IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
+  IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
   GOTO QQ_UNQUOTE
 
+  QQ_UNCHANGED:
+    R=A
+    GOSUB INC_REF_R
+
+    GOTO QQ_DONE
+
   QQ_QUOTE:
     REM ['quote, ast]
     B$="quote":T=5:GOSUB STRING
-    B=R:A=A:GOSUB LIST2
+    B=R:GOSUB LIST2
+    AY=B:GOSUB RELEASE
+
+    GOTO QQ_DONE
+
+  QQ_VECTOR:
+    REM ['vec, (qq_foldr ast)]
+    CALL QQ_FOLDR
+    A=R
+    B$="vec":T=5:GOSUB STRING:B=R
+    GOSUB LIST2
+    AY=A:GOSUB RELEASE
     AY=B:GOSUB RELEASE
 
     GOTO QQ_DONE
 
   QQ_UNQUOTE:
-    R=Z%(A+2)
-    IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
-    IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
-      REM [ast[1]]
-      R=Z%(Z%(A+1)+2)
-      GOSUB INC_REF_R
+    REM [ast[1]]
+    R=Z%(Z%(A+1)+2)
+    GOSUB INC_REF_R
 
-      GOTO QQ_DONE
+    GOTO QQ_DONE
 
-  QQ_SPLICE_UNQUOTE:
+  QQ_LIST:
+    CALL QQ_FOLDR
+
+QQ_DONE:
+END SUB
+
+REM Quasiquote right fold (A) -> R.
+REM Used for unquoted lists (GOTO), vectors (GOSUB),
+REM and recursively (GOSUB).
+SUB QQ_FOLDR
+  IF A=0 THEN GOTO QQ_EMPTY
+  IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
+  GOTO QQ_NOTEMPTY
+
+  QQ_EMPTY:
+    REM empty list/vector -> empty list
+    R=6
+    GOSUB INC_REF_R
+
+    GOTO QQ_FOLDR_DONE
+
+  QQ_NOTEMPTY:
+    REM Execute QQ_FOLDR recursively with (rest A)
     GOSUB PUSH_A
-    REM rest of cases call quasiquote on ast[1..]
-    A=Z%(A+1):CALL QUASIQUOTE
-    W=R
+    A=Z%(A+1):CALL QQ_FOLDR
     GOSUB POP_A
 
-    REM set A to ast[0] for last two cases
+    REM Set A to elt = (first A)
     A=Z%(A+2)
 
-    REM pair?
-    GOSUB TYPE_A
-    IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
-    IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
+    REM Quasiquote transition function:
+    REM A: current element, R: accumulator -> R: new accumulator
 
+    REM check if A is a list starting with splice-unquote
+    GOSUB TYPE_A
+    IF T<>6 THEN GOTO QQ_DEFAULT
+    IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
     B=Z%(A+2)
     IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
-    IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
-      REM ['concat, ast[0][1], quasiquote(ast[1..])]
+    IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
 
+    REM ('concat, A[1], R)
       B=Z%(Z%(A+1)+2)
+      A=R
       B$="concat":T=5:GOSUB STRING:C=R
-      A=W:GOSUB LIST3
+      GOSUB LIST3
       REM release inner quasiquoted since outer list takes ownership
       AY=A:GOSUB RELEASE
       AY=C:GOSUB RELEASE
-      GOTO QQ_DONE
 
-  QQ_DEFAULT:
-    REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
+      GOTO QQ_FOLDR_DONE
 
-    Q=W:GOSUB PUSH_Q
-    REM A set above to ast[0]
-    CALL QUASIQUOTE
-    B=R
-    GOSUB POP_Q:W=Q
+    QQ_DEFAULT:
+      REM ('cons, quasiquote(A), R)
+      GOSUB PUSH_R
+      CALL QUASIQUOTE
+      B=R
+      B$="cons":T=5:GOSUB STRING:C=R
+      GOSUB POP_A
+      GOSUB LIST3
+      REM release inner quasiquoted since outer list takes ownership
+      AY=A:GOSUB RELEASE
+      AY=B:GOSUB RELEASE
+      AY=C:GOSUB RELEASE
 
-    B$="cons":T=5:GOSUB STRING:C=R
-    A=W:GOSUB LIST3
-    REM release inner quasiquoted since outer list takes ownership
-    AY=A:GOSUB RELEASE
-    AY=B:GOSUB RELEASE
-    AY=C:GOSUB RELEASE
-  QQ_DONE:
+QQ_FOLDR_DONE:
 END SUB
 
 REM MACROEXPAND(A, E) -> A:
@@ -235,6 +275,7 @@ SUB EVAL
     IF A$="def!" THEN GOTO EVAL_DEF
     IF A$="let*" THEN GOTO EVAL_LET
     IF A$="quote" THEN GOTO EVAL_QUOTE
+    IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
     IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
     IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
     IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
@@ -330,6 +371,11 @@ SUB EVAL
       GOSUB INC_REF_R
       GOTO EVAL_RETURN
 
+    EVAL_QUASIQUOTEEXPAND:
+      R=Z%(Z%(A+1)+2)
+      A=R:CALL QUASIQUOTE
+      GOTO EVAL_RETURN
+
     EVAL_QUASIQUOTE:
       R=Z%(Z%(A+1)+2)
       A=R:CALL QUASIQUOTE
@@ -445,9 +491,9 @@ SUB EVAL
 
       EVAL_DO_FUNCTION:
         REM regular function
-        IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+        IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
         REM for recur functions (apply, map, swap!), use GOTO
-        IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
+        IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
         EVAL_DO_FUNCTION_SKIP:
 
         REM pop and release f/args

impls/bbc-basic/core.bas

@@ -286,6 +286,10 @@ DEF FNcore_call(fn%, args%)
     WHEN 60
       PROCcore_prepare_args("?", "seq")
       =FNcore_seq(args%(0))
+    DATA vec, 61
+    WHEN 61
+      PROCcore_prepare_args("l", "vec")
+      =FNas_vector(args%(0))
     DATA "", -1
   ENDCASE
 ERROR &40E809F1, "Call to non-existent core function"

impls/bbc-basic/step7_quote.bas

@@ -53,25 +53,33 @@ END
 DEF FNREAD(a$)
 =FNread_str(FNalloc_string(a$))
 
-DEF FNis_pair(val%)
-=FNis_seq(val%) AND NOT FNis_empty(val%)
+DEF FNstarts_with(ast%, sym$)
+  LOCAL a0%
+  IF NOT FNis_list(ast%) THEN =FALSE
+  a0% = FNfirst(ast%)
+  IF NOT FNis_symbol(a0%) THEN =FALSE
+  =FNunbox_symbol(a0%) = sym$
+
+DEF FNqq_elts(seq%)
+  LOCAL elt%, acc%
+  IF FNis_empty(seq%) THEN =FNempty
+  elt% = FNfirst(seq%)
+  acc% = FNqq_elts(FNrest(seq%))
+  IF FNstarts_with(elt%, "splice-unquote") THEN
+    =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%)
+  ENDIF
+  =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%)
 
 DEF FNquasiquote(ast%)
-  LOCAL car%, caar%
-  IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
-  car% = FNfirst(ast%)
-  IF FNis_symbol(car%) THEN
-    IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
+  IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
+  IF FNis_list(ast%) THEN =FNqq_elts(ast%)
+  IF FNis_vector(ast%) THEN
+    =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
   ENDIF
-  IF FNis_pair(car%) THEN
-    caar% = FNfirst(car%)
-    IF FNis_symbol(caar%) THEN
-      IF FNunbox_symbol(caar%) = "splice-unquote" THEN
-        =FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%)))
-      ENDIF
-    ENDIF
+  IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
+    =FNalloc_list2(FNalloc_symbol("quote"), ast%)
   ENDIF
-=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
+  =ast%
 
 DEF FNEVAL(ast%, env%)
   PROCgc_enter
@@ -124,6 +132,8 @@ DEF FNEVAL_(ast%, env%)
           =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
         WHEN "quote"
           =FNnth(ast%, 1)
+        WHEN "quasiquoteexpand"
+          = FNquasiquote(FNnth(ast%, 1))
         WHEN "quasiquote"
           ast% = FNquasiquote(FNnth(ast%, 1))
           REM  Loop round for tail-call optimisation

impls/bbc-basic/step8_macros.bas

@@ -54,25 +54,33 @@ END
 DEF FNREAD(a$)
 =FNread_str(FNalloc_string(a$))
 
-DEF FNis_pair(val%)
-=FNis_seq(val%) AND NOT FNis_empty(val%)
+DEF FNstarts_with(ast%, sym$)
+  LOCAL a0%
+  IF NOT FNis_list(ast%) THEN =FALSE
+  a0% = FNfirst(ast%)
+  IF NOT FNis_symbol(a0%) THEN =FALSE
+  =FNunbox_symbol(a0%) = sym$
+
+DEF FNqq_elts(seq%)
+  LOCAL elt%, acc%
+  IF FNis_empty(seq%) THEN =FNempty
+  elt% = FNfirst(seq%)
+  acc% = FNqq_elts(FNrest(seq%))
+  IF FNstarts_with(elt%, "splice-unquote") THEN
+    =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%)
+  ENDIF
+  =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%)
 
 DEF FNquasiquote(ast%)
-  LOCAL car%, caar%
-  IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
-  car% = FNfirst(ast%)
-  IF FNis_symbol(car%) THEN
-    IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
+  IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
+  IF FNis_list(ast%) THEN =FNqq_elts(ast%)
+  IF FNis_vector(ast%) THEN
+    =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
   ENDIF
-  IF FNis_pair(car%) THEN
-    caar% = FNfirst(car%)
-    IF FNis_symbol(caar%) THEN
-      IF FNunbox_symbol(caar%) = "splice-unquote" THEN
-        =FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%)))
-      ENDIF
-    ENDIF
+  IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
+    =FNalloc_list2(FNalloc_symbol("quote"), ast%)
   ENDIF
-=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
+  =ast%
 
 DEF FNis_macro_call(ast%, env%)
   LOCAL car%, val%
@@ -153,6 +161,8 @@ DEF FNEVAL_(ast%, env%)
           =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
         WHEN "quote"
           =FNnth(ast%, 1)
+        WHEN "quasiquoteexpand"
+          = FNquasiquote(FNnth(ast%, 1))
         WHEN "quasiquote"
           ast% = FNquasiquote(FNnth(ast%, 1))
           REM  Loop round for tail-call optimisation

impls/bbc-basic/step9_try.bas

@@ -54,25 +54,33 @@ END
 DEF FNREAD(a$)
 =FNread_str(FNalloc_string(a$))
 
-DEF FNis_pair(val%)
-=FNis_seq(val%) AND NOT FNis_empty(val%)
+DEF FNstarts_with(ast%, sym$)
+  LOCAL a0%
+  IF NOT FNis_list(ast%) THEN =FALSE
+  a0% = FNfirst(ast%)
+  IF NOT FNis_symbol(a0%) THEN =FALSE
+  =FNunbox_symbol(a0%) = sym$
+
+DEF FNqq_elts(seq%)
+  LOCAL elt%, acc%
+  IF FNis_empty(seq%) THEN =FNempty
+  elt% = FNfirst(seq%)
+  acc% = FNqq_elts(FNrest(seq%))
+  IF FNstarts_with(elt%, "splice-unquote") THEN
+    =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%)
+  ENDIF
+  =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%)
 
 DEF FNquasiquote(ast%)
-  LOCAL car%, caar%
-  IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
-  car% = FNfirst(ast%)
-  IF FNis_symbol(car%) THEN
-    IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
+  IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
+  IF FNis_list(ast%) THEN =FNqq_elts(ast%)
+  IF FNis_vector(ast%) THEN
+    =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
   ENDIF
-  IF FNis_pair(car%) THEN
-    caar% = FNfirst(car%)
-    IF FNis_symbol(caar%) THEN
-      IF FNunbox_symbol(caar%) = "splice-unquote" THEN
-        =FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%)))
-      ENDIF
-    ENDIF
+  IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
+    =FNalloc_list2(FNalloc_symbol("quote"), ast%)
   ENDIF
-=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
+  =ast%
 
 DEF FNis_macro_call(ast%, env%)
   LOCAL car%, val%
@@ -195,6 +203,8 @@ DEF FNEVAL_(ast%, env%)
           =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
         WHEN "quote"
           =FNnth(ast%, 1)
+        WHEN "quasiquoteexpand"
+          = FNquasiquote(FNnth(ast%, 1))
         WHEN "quasiquote"
           ast% = FNquasiquote(FNnth(ast%, 1))
           REM  Loop round for tail-call optimisation

impls/bbc-basic/stepA_mal.bas

@@ -56,25 +56,33 @@ END
 DEF FNREAD(a$)
 =FNread_str(FNalloc_string(a$))
 
-DEF FNis_pair(val%)
-=FNis_seq(val%) AND NOT FNis_empty(val%)
+DEF FNstarts_with(ast%, sym$)
+  LOCAL a0%
+  IF NOT FNis_list(ast%) THEN =FALSE
+  a0% = FNfirst(ast%)
+  IF NOT FNis_symbol(a0%) THEN =FALSE
+  =FNunbox_symbol(a0%) = sym$
+
+DEF FNqq_elts(seq%)
+  LOCAL elt%, acc%
+  IF FNis_empty(seq%) THEN =FNempty
+  elt% = FNfirst(seq%)
+  acc% = FNqq_elts(FNrest(seq%))
+  IF FNstarts_with(elt%, "splice-unquote") THEN
+    =FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%)
+  ENDIF
+  =FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%)
 
 DEF FNquasiquote(ast%)
-  LOCAL car%, caar%
-  IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
-  car% = FNfirst(ast%)
-  IF FNis_symbol(car%) THEN
-    IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
+  IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
+  IF FNis_list(ast%) THEN =FNqq_elts(ast%)
+  IF FNis_vector(ast%) THEN
+    =FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
   ENDIF
-  IF FNis_pair(car%) THEN
-    caar% = FNfirst(car%)
-    IF FNis_symbol(caar%) THEN
-      IF FNunbox_symbol(caar%) = "splice-unquote" THEN
-        =FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%)))
-      ENDIF
-    ENDIF
+  IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
+    =FNalloc_list2(FNalloc_symbol("quote"), ast%)
   ENDIF
-=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
+  =ast%
 
 DEF FNis_macro_call(ast%, env%)
   LOCAL car%, val%
@@ -197,6 +205,8 @@ DEF FNEVAL_(ast%, env%)
           =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
         WHEN "quote"
           =FNnth(ast%, 1)
+        WHEN "quasiquoteexpand"
+          = FNquasiquote(FNnth(ast%, 1))
         WHEN "quasiquote"
           ast% = FNquasiquote(FNnth(ast%, 1))
           REM  Loop round for tail-call optimisation

impls/c/core.c

@@ -330,6 +330,24 @@ MalVal *concat(MalVal *args) {
     return lst;
 }
 
+MalVal *vec(MalVal *seq) {
+    switch(seq->type) {
+    case MAL_VECTOR:
+        return seq;
+    case MAL_LIST: {
+        const GArray * const src = seq->val.array;
+        const int len = src->len;
+        GArray * const dst = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len);
+        int i;
+        for (i=0; i<len; i++)
+            g_array_append_val(dst, g_array_index(seq->val.array, MalVal*, i));
+        return malval_new_list(MAL_VECTOR, dst);
+    }
+    default:
+        _error("vec called with non-sequential");
+    }
+}
+
 MalVal *nth(MalVal *seq, MalVal *idx) {
     return _nth(seq, idx->val.intnum);
 }
@@ -505,7 +523,7 @@ MalVal *swap_BANG(MalVal *args) {
 
 
 
-core_ns_entry core_ns[61] = {
+core_ns_entry core_ns[] = {
     {"=", (void*(*)(void*))equal_Q, 2},
     {"throw", (void*(*)(void*))throw, 1},
     {"nil?", (void*(*)(void*))nil_Q, 1},
@@ -553,6 +571,7 @@ core_ns_entry core_ns[61] = {
     {"sequential?", (void*(*)(void*))sequential_Q, 1},
     {"cons", (void*(*)(void*))cons, 2},
     {"concat", (void*(*)(void*))concat, -1},
+    {"vec", (void*(*)(void*))vec, 1},
     {"nth", (void*(*)(void*))nth, 2},
     {"first", (void*(*)(void*))_first, 1},
     {"rest", (void*(*)(void*))_rest, 1},

impls/c/core.h

@@ -10,6 +10,6 @@ typedef struct {
     int arg_cnt;
 } core_ns_entry;
 
-extern core_ns_entry core_ns[61];
+extern core_ns_entry core_ns[62];
 
 #endif

impls/c/step7_quote.c

@@ -10,6 +10,7 @@
 
 // Declarations
 MalVal *EVAL(MalVal *ast, Env *env);
+MalVal *quasiquote(MalVal *ast);
 
 // read
 MalVal *READ(char prompt[], char *str) {
@@ -30,30 +31,40 @@ MalVal *READ(char prompt[], char *str) {
 }
 
 // eval
-int is_pair(MalVal *x) {
-    return _sequential_Q(x) && (_count(x) > 0);
+int starts_with(MalVal *ast, const char *sym) {
+    if (ast->type != MAL_LIST)
+        return 0;
+    const MalVal * const a0 = _first(ast);
+    return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string);
+}
+
+MalVal *qq_iter(GArray *xs) {
+    MalVal *acc = _listX(0);
+    int i;
+    for (i=xs->len-1; 0<=i; i--) {
+        MalVal * const elt = g_array_index(xs, MalVal*, i);
+        if (starts_with(elt, "splice-unquote"))
+            acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc);
+        else
+            acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc);
+    }
+    return acc;
 }
 
 MalVal *quasiquote(MalVal *ast) {
-    if (!is_pair(ast)) {
-        return _listX(2, malval_new_symbol("quote"), ast);
-    } else {
-        MalVal *a0 = _nth(ast, 0);
-        if ((a0->type & MAL_SYMBOL) &&
-            strcmp("unquote", a0->val.string) == 0) {
+    switch (ast->type) {
+    case MAL_LIST:
+        if (starts_with(ast, "unquote"))
             return _nth(ast, 1);
-        } else if (is_pair(a0)) {
-            MalVal *a00 = _nth(a0, 0);
-            if ((a00->type & MAL_SYMBOL) &&
-                strcmp("splice-unquote", a00->val.string) == 0) {
-                return _listX(3, malval_new_symbol("concat"),
-                                 _nth(a0, 1),
-                                 quasiquote(_rest(ast)));
-            }
-        }
-        return _listX(3, malval_new_symbol("cons"),
-                         quasiquote(a0),
-                         quasiquote(_rest(ast)));
+        else
+            return qq_iter(ast->val.array);
+    case MAL_VECTOR:
+        return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
+    case MAL_HASH_MAP:
+    case MAL_SYMBOL:
+        return _listX(2, malval_new_symbol("quote"), ast);
+    default:
+        return ast;
     }
 }
 
@@ -137,6 +148,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
                strcmp("quote", a0->val.string) == 0) {
         //g_print("eval apply quote\n");
         return _nth(ast, 1);
+    } else if ((a0->type & MAL_SYMBOL) &&
+               strcmp("quasiquoteexpand", a0->val.string) == 0) {
+        return quasiquote(_nth(ast, 1));
     } else if ((a0->type & MAL_SYMBOL) &&
                strcmp("quasiquote", a0->val.string) == 0) {
         //g_print("eval apply quasiquote\n");

impls/c/step8_macros.c

@@ -10,6 +10,7 @@
 
 // Declarations
 MalVal *EVAL(MalVal *ast, Env *env);
+MalVal *quasiquote(MalVal *ast);
 MalVal *macroexpand(MalVal *ast, Env *env);
 
 // read
@@ -31,30 +32,40 @@ MalVal *READ(char prompt[], char *str) {
 }
 
 // eval
-int is_pair(MalVal *x) {
-    return _sequential_Q(x) && (_count(x) > 0);
+int starts_with(MalVal *ast, const char *sym) {
+    if (ast->type != MAL_LIST)
+        return 0;
+    const MalVal * const a0 = _first(ast);
+    return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string);
+}
+
+MalVal *qq_iter(GArray *xs) {
+    MalVal *acc = _listX(0);
+    int i;
+    for (i=xs->len-1; 0<=i; i--) {
+        MalVal * const elt = g_array_index(xs, MalVal*, i);
+        if (starts_with(elt, "splice-unquote"))
+            acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc);
+        else
+            acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc);
+    }
+    return acc;
 }
 
 MalVal *quasiquote(MalVal *ast) {
-    if (!is_pair(ast)) {
-        return _listX(2, malval_new_symbol("quote"), ast);
-    } else {
-        MalVal *a0 = _nth(ast, 0);
-        if ((a0->type & MAL_SYMBOL) &&
-            strcmp("unquote", a0->val.string) == 0) {
+    switch (ast->type) {
+    case MAL_LIST:
+        if (starts_with(ast, "unquote"))
             return _nth(ast, 1);
-        } else if (is_pair(a0)) {
-            MalVal *a00 = _nth(a0, 0);
-            if ((a00->type & MAL_SYMBOL) &&
-                strcmp("splice-unquote", a00->val.string) == 0) {
-                return _listX(3, malval_new_symbol("concat"),
-                                 _nth(a0, 1),
-                                 quasiquote(_rest(ast)));
-            }
-        }
-        return _listX(3, malval_new_symbol("cons"),
-                         quasiquote(a0),
-                         quasiquote(_rest(ast)));
+        else
+            return qq_iter(ast->val.array);
+    case MAL_VECTOR:
+        return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
+    case MAL_HASH_MAP:
+    case MAL_SYMBOL:
+        return _listX(2, malval_new_symbol("quote"), ast);
+    default:
+        return ast;
     }
 }
 
@@ -163,6 +174,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
                strcmp("quote", a0->val.string) == 0) {
         //g_print("eval apply quote\n");
         return _nth(ast, 1);
+    } else if ((a0->type & MAL_SYMBOL) &&
+               strcmp("quasiquoteexpand", a0->val.string) == 0) {
+        return quasiquote(_nth(ast, 1));
     } else if ((a0->type & MAL_SYMBOL) &&
                strcmp("quasiquote", a0->val.string) == 0) {
         //g_print("eval apply quasiquote\n");

impls/c/step9_try.c

@@ -11,6 +11,7 @@
 
 // Declarations
 MalVal *EVAL(MalVal *ast, Env *env);
+MalVal *quasiquote(MalVal *ast);
 MalVal *macroexpand(MalVal *ast, Env *env);
 
 // read
@@ -32,30 +33,40 @@ MalVal *READ(char prompt[], char *str) {
 }
 
 // eval
-int is_pair(MalVal *x) {
-    return _sequential_Q(x) && (_count(x) > 0);
+int starts_with(MalVal *ast, const char *sym) {
+    if (ast->type != MAL_LIST)
+        return 0;
+    const MalVal * const a0 = _first(ast);
+    return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string);
+}
+
+MalVal *qq_iter(GArray *xs) {
+    MalVal *acc = _listX(0);
+    int i;
+    for (i=xs->len-1; 0<=i; i--) {
+        MalVal * const elt = g_array_index(xs, MalVal*, i);
+        if (starts_with(elt, "splice-unquote"))
+            acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc);
+        else
+            acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc);
+    }
+    return acc;
 }
 
 MalVal *quasiquote(MalVal *ast) {
-    if (!is_pair(ast)) {
-        return _listX(2, malval_new_symbol("quote"), ast);
-    } else {
-        MalVal *a0 = _nth(ast, 0);
-        if ((a0->type & MAL_SYMBOL) &&
-            strcmp("unquote", a0->val.string) == 0) {
+    switch (ast->type) {
+    case MAL_LIST:
+        if (starts_with(ast, "unquote"))
             return _nth(ast, 1);
-        } else if (is_pair(a0)) {
-            MalVal *a00 = _nth(a0, 0);
-            if ((a00->type & MAL_SYMBOL) &&
-                strcmp("splice-unquote", a00->val.string) == 0) {
-                return _listX(3, malval_new_symbol("concat"),
-                                 _nth(a0, 1),
-                                 quasiquote(_rest(ast)));
-            }
-        }
-        return _listX(3, malval_new_symbol("cons"),
-                         quasiquote(a0),
-                         quasiquote(_rest(ast)));
+        else
+            return qq_iter(ast->val.array);
+    case MAL_VECTOR:
+        return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
+    case MAL_HASH_MAP:
+    case MAL_SYMBOL:
+        return _listX(2, malval_new_symbol("quote"), ast);
+    default:
+        return ast;
     }
 }
 
@@ -164,6 +175,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
                strcmp("quote", a0->val.string) == 0) {
         //g_print("eval apply quote\n");
         return _nth(ast, 1);
+    } else if ((a0->type & MAL_SYMBOL) &&
+               strcmp("quasiquoteexpand", a0->val.string) == 0) {
+        return quasiquote(_nth(ast, 1));
     } else if ((a0->type & MAL_SYMBOL) &&
                strcmp("quasiquote", a0->val.string) == 0) {
         //g_print("eval apply quasiquote\n");

impls/c/stepA_mal.c

@@ -11,6 +11,7 @@
 
 // Declarations
 MalVal *EVAL(MalVal *ast, Env *env);
+MalVal *quasiquote(MalVal *ast);
 MalVal *macroexpand(MalVal *ast, Env *env);
 
 // read
@@ -32,30 +33,40 @@ MalVal *READ(char prompt[], char *str) {
 }
 
 // eval
-int is_pair(MalVal *x) {
-    return _sequential_Q(x) && (_count(x) > 0);
+int starts_with(MalVal *ast, const char *sym) {
+    if (ast->type != MAL_LIST)
+        return 0;
+    const MalVal * const a0 = _first(ast);
+    return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string);
+}
+
+MalVal *qq_iter(GArray *xs) {
+    MalVal *acc = _listX(0);
+    int i;
+    for (i=xs->len-1; 0<=i; i--) {
+        MalVal * const elt = g_array_index(xs, MalVal*, i);
+        if (starts_with(elt, "splice-unquote"))
+            acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc);
+        else
+            acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc);
+    }
+    return acc;
 }
 
 MalVal *quasiquote(MalVal *ast) {
-    if (!is_pair(ast)) {
-        return _listX(2, malval_new_symbol("quote"), ast);
-    } else {
-        MalVal *a0 = _nth(ast, 0);
-        if ((a0->type & MAL_SYMBOL) &&
-            strcmp("unquote", a0->val.string) == 0) {
+    switch (ast->type) {
+    case MAL_LIST:
+        if (starts_with(ast, "unquote"))
             return _nth(ast, 1);
-        } else if (is_pair(a0)) {
-            MalVal *a00 = _nth(a0, 0);
-            if ((a00->type & MAL_SYMBOL) &&
-                strcmp("splice-unquote", a00->val.string) == 0) {
-                return _listX(3, malval_new_symbol("concat"),
-                                 _nth(a0, 1),
-                                 quasiquote(_rest(ast)));
-            }
-        }
-        return _listX(3, malval_new_symbol("cons"),
-                         quasiquote(a0),
-                         quasiquote(_rest(ast)));
+        else
+            return qq_iter(ast->val.array);
+    case MAL_VECTOR:
+        return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
+    case MAL_HASH_MAP:
+    case MAL_SYMBOL:
+        return _listX(2, malval_new_symbol("quote"), ast);
+    default:
+        return ast;
     }
 }
 
@@ -164,6 +175,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
                strcmp("quote", a0->val.string) == 0) {
         //g_print("eval apply quote\n");
         return _nth(ast, 1);
+    } else if ((a0->type & MAL_SYMBOL) &&
+               strcmp("quasiquoteexpand", a0->val.string) == 0) {
+        return quasiquote(_nth(ast, 1));
     } else if ((a0->type & MAL_SYMBOL) &&
                strcmp("quasiquote", a0->val.string) == 0) {
         //g_print("eval apply quasiquote\n");

impls/chuck/core.ck

@@ -10,7 +10,7 @@ public class Core
  "pr-str", "str", "prn", "println",
  "read-string", "slurp",
  "atom", "atom?", "deref", "reset!", "swap!",
- "cons", "concat",
+ "vec", "cons", "concat",
  "nth", "first", "rest",
  "throw",
  "apply", "map",
@@ -52,6 +52,7 @@ new MalDeref @=> Core.ns["deref"];
 new MalDoReset @=> Core.ns["reset!"];
 new MalDoSwap @=> Core.ns["swap!"];
 
+new MalVec @=> Core.ns["vec"];
 new MalCons @=> Core.ns["cons"];
 new MalConcat @=> Core.ns["concat"];
 

impls/chuck/step7_quote.ck

@@ -27,50 +27,52 @@ fun MalObject READ(string input)
     return Reader.read_str(input);
 }
 
-fun int isPair(MalObject m)
+fun int starts_with(MalObject a[], string sym)
 {
-    if( (m.type == "list" || m.type == "vector") &&
-        Util.sequenceToMalObjectArray(m).size() > 0 )
-    {
-        return true;
-    }
-    else
+    if (a.size() != 2)
     {
         return false;
     }
+    a[0] @=> MalObject a0;
+    return a0.type == "symbol" && (a0$MalSymbol).value() == sym;
+}
+fun MalList qq_loop(MalObject elt, MalList acc)
+{
+    if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") )
+    {
+        return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]);
+    }
+    return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]);
+}
+fun MalList qq_foldr(MalObject a[])
+{
+    MalObject empty[0];  //  empty, but typed
+    MalList.create(empty) @=> MalList acc;
+    for( a.size() - 1 => int i; 0 <= i; i-- )
+    {
+        qq_loop(a[i], acc) @=> acc;
+    }
+    return acc;
 }
-
 fun MalObject quasiquote(MalObject ast)
 {
-    if( !isPair(ast) )
+    ast.type => string type;
+    if (type == "list") {
+        if (starts_with((ast$MalList).value(), "unquote"))
+        {
+            return (ast$MalList).value()[1];
+        }
+        return qq_foldr((ast$MalList).value());
+    }
+    if (type == "vector")
+    {
+        return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]);
+    }
+    if (type == "symbol" || type == "hashmap")
     {
         return MalList.create([MalSymbol.create("quote"), ast]);
     }
-
-    Util.sequenceToMalObjectArray(ast) @=> MalObject a[];
-    a[0] @=> MalObject a0;
-
-    if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" )
-    {
-        return a[1];
-    }
-
-    if( isPair(a0) )
-    {
-        Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[];
-        a0_[0] @=> MalObject a0_0;
-
-        if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" )
-        {
-            return MalList.create(
-                [MalSymbol.create("concat"), a0_[1],
-                 quasiquote(MalList.create(MalObject.slice(a, 1)))]);
-        }
-    }
-
-    return MalList.create(
-        [MalSymbol.create("cons"), quasiquote(a[0]),
-         quasiquote(MalList.create(MalObject.slice(a, 1)))]);
+    return ast;
 }
 
 fun MalObject EVAL(MalObject m, Env env)
@@ -132,6 +134,10 @@ fun MalObject EVAL(MalObject m, Env env)
             {
                 return ast[1];
             }
+            else if( a0 == "quasiquoteexpand" )
+            {
+                return quasiquote(ast[1]);
+            }
             else if( a0 == "quasiquote" )
             {
                 quasiquote(ast[1]) @=> m;

impls/chuck/step8_macros.ck

@@ -27,50 +27,52 @@ fun MalObject READ(string input)
     return Reader.read_str(input);
 }
 
-fun int isPair(MalObject m)
+fun int starts_with(MalObject a[], string sym)
 {
-    if( (m.type == "list" || m.type == "vector") &&
-        Util.sequenceToMalObjectArray(m).size() > 0 )
-    {
-        return true;
-    }
-    else
+    if (a.size() != 2)
     {
         return false;
     }
+    a[0] @=> MalObject a0;
+    return a0.type == "symbol" && (a0$MalSymbol).value() == sym;
+}
+fun MalList qq_loop(MalObject elt, MalList acc)
+{
+    if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") )
+    {
+        return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]);
+    }
+    return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]);
+}
+fun MalList qq_foldr(MalObject a[])
+{
+    MalObject empty[0];  //  empty, but typed
+    MalList.create(empty) @=> MalList acc;
+    for( a.size() - 1 => int i; 0 <= i; i-- )
+    {
+        qq_loop(a[i], acc) @=> acc;
+    }
+    return acc;
 }
-
 fun MalObject quasiquote(MalObject ast)
 {
-    if( !isPair(ast) )
+    ast.type => string type;
+    if (type == "list") {
+        if (starts_with((ast$MalList).value(), "unquote"))
+        {
+            return (ast$MalList).value()[1];
+        }
+        return qq_foldr((ast$MalList).value());
+    }
+    if (type == "vector")
+    {
+        return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]);
+    }
+    if (type == "symbol" || type == "hashmap")
     {
         return MalList.create([MalSymbol.create("quote"), ast]);
     }
-
-    Util.sequenceToMalObjectArray(ast) @=> MalObject a[];
-    a[0] @=> MalObject a0;
-
-    if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" )
-    {
-        return a[1];
-    }
-
-    if( isPair(a0) )
-    {
-        Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[];
-        a0_[0] @=> MalObject a0_0;
-
-        if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" )
-        {
-            return MalList.create(
-                [MalSymbol.create("concat"), a0_[1],
-                 quasiquote(MalList.create(MalObject.slice(a, 1)))]);
-        }
-    }
-
-    return MalList.create(
-        [MalSymbol.create("cons"), quasiquote(a[0]),
-         quasiquote(MalList.create(MalObject.slice(a, 1)))]);
+    return ast;
 }
 
 fun int isMacroCall(MalObject ast, Env env)
@@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
             {
                 return ast[1];
             }
+            else if( a0 == "quasiquoteexpand" )
+            {
+                return quasiquote(ast[1]);
+            }
             else if( a0 == "quasiquote" )
             {
                 quasiquote(ast[1]) @=> m;

impls/chuck/step9_try.ck

@@ -27,50 +27,52 @@ fun MalObject READ(string input)
     return Reader.read_str(input);
 }
 
-fun int isPair(MalObject m)
+fun int starts_with(MalObject a[], string sym)
 {
-    if( (m.type == "list" || m.type == "vector") &&
-        Util.sequenceToMalObjectArray(m).size() > 0 )
-    {
-        return true;
-    }
-    else
+    if (a.size() != 2)
     {
         return false;
     }
+    a[0] @=> MalObject a0;
+    return a0.type == "symbol" && (a0$MalSymbol).value() == sym;
+}
+fun MalList qq_loop(MalObject elt, MalList acc)
+{
+    if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") )
+    {
+        return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]);
+    }
+    return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]);
+}
+fun MalList qq_foldr(MalObject a[])
+{
+    MalObject empty[0];  //  empty, but typed
+    MalList.create(empty) @=> MalList acc;
+    for( a.size() - 1 => int i; 0 <= i; i-- )
+    {
+        qq_loop(a[i], acc) @=> acc;
+    }
+    return acc;
 }
-
 fun MalObject quasiquote(MalObject ast)
 {
-    if( !isPair(ast) )
+    ast.type => string type;
+    if (type == "list") {
+        if (starts_with((ast$MalList).value(), "unquote"))
+        {
+            return (ast$MalList).value()[1];
+        }
+        return qq_foldr((ast$MalList).value());
+    }
+    if (type == "vector")
+    {
+        return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]);
+    }
+    if (type == "symbol" || type == "hashmap")
     {
         return MalList.create([MalSymbol.create("quote"), ast]);
     }
-
-    Util.sequenceToMalObjectArray(ast) @=> MalObject a[];
-    a[0] @=> MalObject a0;
-
-    if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" )
-    {
-        return a[1];
-    }
-
-    if( isPair(a0) )
-    {
-        Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[];
-        a0_[0] @=> MalObject a0_0;
-
-        if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" )
-        {
-            return MalList.create(
-                [MalSymbol.create("concat"), a0_[1],
-                 quasiquote(MalList.create(MalObject.slice(a, 1)))]);
-        }
-    }
-
-    return MalList.create(
-        [MalSymbol.create("cons"), quasiquote(a[0]),
-         quasiquote(MalList.create(MalObject.slice(a, 1)))]);
+    return ast;
 }
 
 fun int isMacroCall(MalObject ast, Env env)
@@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
             {
                 return ast[1];
             }
+            else if( a0 == "quasiquoteexpand" )
+            {
+                return quasiquote(ast[1]);
+            }
             else if( a0 == "quasiquote" )
             {
                 quasiquote(ast[1]) @=> m;

impls/chuck/stepA_mal.ck

@@ -27,50 +27,52 @@ fun MalObject READ(string input)
     return Reader.read_str(input);
 }
 
-fun int isPair(MalObject m)
+fun int starts_with(MalObject a[], string sym)
 {
-    if( (m.type == "list" || m.type == "vector") &&
-        Util.sequenceToMalObjectArray(m).size() > 0 )
-    {
-        return true;
-    }
-    else
+    if (a.size() != 2)
     {
         return false;
     }
+    a[0] @=> MalObject a0;
+    return a0.type == "symbol" && (a0$MalSymbol).value() == sym;
+}
+fun MalList qq_loop(MalObject elt, MalList acc)
+{
+    if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") )
+    {
+        return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]);
+    }
+    return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]);
+}
+fun MalList qq_foldr(MalObject a[])
+{
+    MalObject empty[0];  //  empty, but typed
+    MalList.create(empty) @=> MalList acc;
+    for( a.size() - 1 => int i; 0 <= i; i-- )
+    {
+        qq_loop(a[i], acc) @=> acc;
+    }
+    return acc;
 }
-
 fun MalObject quasiquote(MalObject ast)
 {
-    if( !isPair(ast) )
+    ast.type => string type;
+    if (type == "list") {
+        if (starts_with((ast$MalList).value(), "unquote"))
+        {
+            return (ast$MalList).value()[1];
+        }
+        return qq_foldr((ast$MalList).value());
+    }
+    if (type == "vector")
+    {
+        return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]);
+    }
+    if (type == "symbol" || type == "hashmap")
     {
         return MalList.create([MalSymbol.create("quote"), ast]);
     }
-
-    Util.sequenceToMalObjectArray(ast) @=> MalObject a[];
-    a[0] @=> MalObject a0;
-
-    if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" )
-    {
-        return a[1];
-    }
-
-    if( isPair(a0) )
-    {
-        Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[];
-        a0_[0] @=> MalObject a0_0;
-
-        if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" )
-        {
-            return MalList.create(
-                [MalSymbol.create("concat"), a0_[1],
-                 quasiquote(MalList.create(MalObject.slice(a, 1)))]);
-        }
-    }
-
-    return MalList.create(
-        [MalSymbol.create("cons"), quasiquote(a[0]),
-         quasiquote(MalList.create(MalObject.slice(a, 1)))]);
+    return ast;
 }
 
 fun int isMacroCall(MalObject ast, Env env)
@@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
             {
                 return ast[1];
             }
+            else if( a0 == "quasiquoteexpand" )
+            {
+                return quasiquote(ast[1]);
+            }
             else if( a0 == "quasiquote" )
             {
                 quasiquote(ast[1]) @=> m;

impls/chuck/types/subr/MalVec.ck

@@ -0,0 +1,15 @@
+public class MalVec extends MalSubr
+{
+    fun MalObject call(MalObject args[])
+    {
+        if (args.size() == 1) {
+            args[0] @=> MalObject a0;
+            if (a0.type == "vector") {
+                return a0;
+            } else if (a0.type == "list") {
+                return MalVector.create((a0$MalList).value());
+            }
+        }
+        return MalError.create(MalString.create("vec: wrong arguments"));
+    }
+}

impls/clojure/src/mal/core.cljc

@@ -72,6 +72,7 @@
    ['vals (fn [hm] (let [vs (vals hm)] (if (nil? vs) '() vs)))]
 
    ['sequential? sequential?]
+   ['vec vec]
    ['cons cons]
    ['concat #(apply list (apply concat %&))]
    ['nth nth]

impls/clojure/src/mal/step7_quote.cljc

@@ -13,22 +13,25 @@
 
 ;; eval
 (declare EVAL)
-(defn is-pair [x]
-  (and (sequential? x) (> (count x) 0)))
 
+(declare quasiquote)
+(defn starts_with [ast sym]
+  (and (seq? ast)
+       (= (first ast) sym)))
+(defn qq-iter [seq]
+  (if (empty? seq)
+    ()
+    (let [elt (first seq)
+          acc (qq-iter (rest seq))]
+      (if (starts_with elt 'splice-unquote)
+        (list 'concat (second elt)     acc)
+        (list 'cons   (quasiquote elt) acc)))))
 (defn quasiquote [ast]
-  (cond
-    (not (is-pair ast))
-    (list 'quote ast)
-
-    (= 'unquote (first ast))
-    (second ast)
-
-    (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
-    (list 'concat (-> ast first second) (quasiquote (rest ast)))
-
-    :else
-    (list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
+  (cond (starts_with ast 'unquote)    (second ast)
+        (seq? ast)                    (qq-iter ast)
+        (vector? ast)                 (list 'vec (qq-iter ast))
+        (or (symbol? ast) (map? ast)) (list 'quote ast)
+        :else                         ast))
 
 (defn eval-ast [ast env]
   (cond
@@ -69,6 +72,9 @@
               'quote
               a1
 
+              'quasiquoteexpand
+              (quasiquote a1)
+
               'quasiquote
               (recur (quasiquote a1) env)
 

impls/clojure/src/mal/step8_macros.cljc

@@ -14,22 +14,25 @@
 
 ;; eval
 (declare EVAL)
-(defn is-pair [x]
-  (and (sequential? x) (> (count x) 0)))
 
+(declare quasiquote)
+(defn starts_with [ast sym]
+  (and (seq? ast)
+       (= (first ast) sym)))
+(defn qq-iter [seq]
+  (if (empty? seq)
+    ()
+    (let [elt (first seq)
+          acc (qq-iter (rest seq))]
+      (if (starts_with elt 'splice-unquote)
+        (list 'concat (second elt)     acc)
+        (list 'cons   (quasiquote elt) acc)))))
 (defn quasiquote [ast]
-  (cond
-    (not (is-pair ast))
-    (list 'quote ast)
-
-    (= 'unquote (first ast))
-    (second ast)
-
-    (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
-    (list 'concat (-> ast first second) (quasiquote (rest ast)))
-
-    :else
-    (list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
+  (cond (starts_with ast 'unquote) (second ast)
+        (seq? ast)                 (qq-iter ast)
+        (vector? ast)              (list 'vec (qq-iter ast))
+        (or (symbol? ast) (map? ast)) (list 'quote ast)
+        :else                         ast))
 
 (defn is-macro-call [ast env]
   (and (seq? ast)
@@ -88,6 +91,9 @@
               'quote
               a1
 
+              'quasiquoteexpand
+              (quasiquote a1)
+
               'quasiquote
               (recur (quasiquote a1) env)
 

impls/clojure/src/mal/step9_try.cljc

@@ -14,22 +14,25 @@
 
 ;; eval
 (declare EVAL)
-(defn is-pair [x]
-  (and (sequential? x) (> (count x) 0)))
 
+(declare quasiquote)
+(defn starts_with [ast sym]
+  (and (seq? ast)
+       (= (first ast) sym)))
+(defn qq-iter [seq]
+  (if (empty? seq)
+    ()
+    (let [elt (first seq)
+          acc (qq-iter (rest seq))]
+      (if (starts_with elt 'splice-unquote)
+        (list 'concat (second elt)     acc)
+        (list 'cons   (quasiquote elt) acc)))))
 (defn quasiquote [ast]
-  (cond
-    (not (is-pair ast))
-    (list 'quote ast)
-
-    (= 'unquote (first ast))
-    (second ast)
-
-    (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
-    (list 'concat (-> ast first second) (quasiquote (rest ast)))
-
-    :else
-    (list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
+  (cond (starts_with ast 'unquote) (second ast)
+        (seq? ast)                 (qq-iter ast)
+        (vector? ast)              (list 'vec (qq-iter ast))
+        (or (symbol? ast) (map? ast)) (list 'quote ast)
+        :else                         ast))
 
 (defn is-macro-call [ast env]
   (and (seq? ast)
@@ -88,6 +91,9 @@
               'quote
               a1
 
+              'quasiquoteexpand
+              (quasiquote a1)
+
               'quasiquote
               (recur (quasiquote a1) env)
 

impls/clojure/src/mal/stepA_mal.cljc

@@ -14,22 +14,25 @@
 
 ;; eval
 (declare EVAL)
-(defn is-pair [x]
-  (and (sequential? x) (> (count x) 0)))
 
+(declare quasiquote)
+(defn starts_with [ast sym]
+  (and (seq? ast)
+       (= (first ast) sym)))
+(defn qq-iter [seq]
+  (if (empty? seq)
+    ()
+    (let [elt (first seq)
+          acc (qq-iter (rest seq))]
+      (if (starts_with elt 'splice-unquote)
+        (list 'concat (second elt)     acc)
+        (list 'cons   (quasiquote elt) acc)))))
 (defn quasiquote [ast]
-  (cond
-    (not (is-pair ast))
-    (list 'quote ast)
-
-    (= 'unquote (first ast))
-    (second ast)
-
-    (and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
-    (list 'concat (-> ast first second) (quasiquote (rest ast)))
-
-    :else
-    (list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
+  (cond (starts_with ast 'unquote) (second ast)
+        (seq? ast)                 (qq-iter ast)
+        (vector? ast)              (list 'vec (qq-iter ast))
+        (or (symbol? ast) (map? ast)) (list 'quote ast)
+        :else                         ast))
 
 (defn is-macro-call [ast env]
   (and (seq? ast)
@@ -88,6 +91,9 @@
               'quote
               a1
 
+              'quasiquoteexpand
+              (quasiquote a1)
+
               'quasiquote
               (recur (quasiquote a1) env)
 

impls/coffee/core.coffee

@@ -84,6 +84,7 @@ exports.ns = {
   'sequential?': types._sequential_Q,
   'cons': (a,b) -> [a].concat(b),
   'concat': (a=[],b...) -> a.concat(b...),
+  'vec': (a) -> types._vector a...,
   'nth': (a,b) -> if a.length > b then a[b] else
     throw new Error "nth: index out of bounds",
   'first': (a) -> if a != null and a.length > 0 then a[0] else null,

impls/coffee/step7_quote.coffee

@@ -9,15 +9,19 @@ core = require("./core.coffee")
 READ = (str) -> reader.read_str str
 
 # eval
-is_pair = (x) -> types._sequential_Q(x) && x.length > 0
+starts_with = (ast, sym) ->
+  types._list_Q(ast) && 0<ast.length && ast[0]!=null && types._symbol_Q(ast[0]) && ast[0].name==sym
+
+qq_iter = (accumulator, elt) ->
+  if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator]
+  else [types._symbol('cons'), quasiquote(elt), accumulator]
 
 quasiquote = (ast) ->
-  if !is_pair(ast) then [types._symbol('quote'), ast]
-  else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
-  else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
-    [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
-  else
-    [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
+  if starts_with(ast, 'unquote') then ast[1]
+  else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
+  else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
+  else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
+  else ast
     
     
 
@@ -51,6 +55,8 @@ EVAL = (ast, env) ->
       env = let_env
     when "quote"
       return a1
+    when "quasiquoteexpand"
+      return quasiquote(a1)
     when "quasiquote"
       ast = quasiquote(a1)
     when "do"

impls/coffee/step8_macros.coffee

@@ -9,15 +9,19 @@ core = require("./core.coffee")
 READ = (str) -> reader.read_str str
 
 # eval
-is_pair = (x) -> types._sequential_Q(x) && x.length > 0
+starts_with = (ast, sym) ->
+  types._list_Q(ast) && 0<ast.length && ast[0]!=null && types._symbol_Q(ast[0]) && ast[0].name==sym
+
+qq_iter = (accumulator, elt) ->
+  if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator]
+  else [types._symbol('cons'), quasiquote(elt), accumulator]
 
 quasiquote = (ast) ->
-  if !is_pair(ast) then [types._symbol('quote'), ast]
-  else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
-  else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
-    [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
-  else
-    [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
+  if starts_with(ast, 'unquote') then ast[1]
+  else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
+  else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
+  else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
+  else ast
 
 is_macro_call = (ast, env) ->
   return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
@@ -63,6 +67,8 @@ EVAL = (ast, env) ->
       env = let_env
     when "quote"
       return a1
+    when "quasiquoteexpand"
+      return quasiquote(a1)
     when "quasiquote"
       ast = quasiquote(a1)
     when "defmacro!"

impls/coffee/step9_try.coffee

@@ -9,15 +9,19 @@ core = require("./core.coffee")
 READ = (str) -> reader.read_str str
 
 # eval
-is_pair = (x) -> types._sequential_Q(x) && x.length > 0
+starts_with = (ast, sym) ->
+  types._list_Q(ast) && 0<ast.length && ast[0]!=null && types._symbol_Q(ast[0]) && ast[0].name==sym
+
+qq_iter = (accumulator, elt) ->
+  if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator]
+  else [types._symbol('cons'), quasiquote(elt), accumulator]
 
 quasiquote = (ast) ->
-  if !is_pair(ast) then [types._symbol('quote'), ast]
-  else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
-  else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
-    [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
-  else
-    [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
+  if starts_with(ast, 'unquote') then ast[1]
+  else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
+  else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
+  else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
+  else ast
 
 is_macro_call = (ast, env) ->
   return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
@@ -63,6 +67,8 @@ EVAL = (ast, env) ->
       env = let_env
     when "quote"
       return a1
+    when "quasiquoteexpand"
+      return quasiquote(a1)
     when "quasiquote"
       ast = quasiquote(a1)
     when "defmacro!"

impls/coffee/stepA_mal.coffee

@@ -9,15 +9,19 @@ core = require("./core.coffee")
 READ = (str) -> reader.read_str str
 
 # eval
-is_pair = (x) -> types._sequential_Q(x) && x.length > 0
+starts_with = (ast, sym) ->
+  types._list_Q(ast) && 0<ast.length && ast[0]!=null && types._symbol_Q(ast[0]) && ast[0].name==sym
+
+qq_iter = (accumulator, elt) ->
+  if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator]
+  else [types._symbol('cons'), quasiquote(elt), accumulator]
 
 quasiquote = (ast) ->
-  if !is_pair(ast) then [types._symbol('quote'), ast]
-  else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
-  else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
-    [types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
-  else
-    [types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
+  if starts_with(ast, 'unquote') then ast[1]
+  else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
+  else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
+  else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
+  else ast
 
 is_macro_call = (ast, env) ->
   return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
@@ -63,6 +67,8 @@ EVAL = (ast, env) ->
       env = let_env
     when "quote"
       return a1
+    when "quasiquoteexpand"
+      return quasiquote(a1)
     when "quasiquote"
       ast = quasiquote(a1)
     when "defmacro!"

impls/common-lisp/src/core.lisp

@@ -133,6 +133,9 @@
         (apply (mal-data-value fn)
                (append (list (mal-data-value atom)) args))))
 
+(defmal vec (list)
+  (make-mal-vector (listify (mal-data-value list))))
+
 (defmal cons (element list)
   (make-mal-list (cons element (listify (mal-data-value list)))))
 

impls/common-lisp/src/step7_quote.lisp

@@ -31,8 +31,10 @@
 (defvar mal-fn* (make-mal-symbol "fn*"))
 (defvar mal-quote (make-mal-symbol "quote"))
 (defvar mal-quasiquote (make-mal-symbol "quasiquote"))
+(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
 (defvar mal-unquote (make-mal-symbol "unquote"))
 (defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
+(defvar mal-vec (make-mal-symbol "vec"))
 (defvar mal-cons (make-mal-symbol "cons"))
 (defvar mal-concat (make-mal-symbol "concat"))
 
@@ -58,29 +60,24 @@
     (types:hash-map (eval-hash-map ast env))
     (types:any ast)))
 
-(defun is-pair (value)
-  (and (or (mal-list-p value)
-           (mal-vector-p value))
-       (< 0 (length (mal-data-value value)))))
-
+(defun qq-reducer (elt acc)
+  (make-mal-list
+    (if (and (mal-list-p elt)
+             (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote))
+      (list mal-concat (second (mal-data-value elt)) acc)
+      (list mal-cons (quasiquote elt) acc))))
+(defun qq-iter (elts)
+  (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ())))
 (defun quasiquote (ast)
-  (if (not (is-pair ast))
-      (make-mal-list (list mal-quote ast))
-      (let ((forms (map 'list #'identity (mal-data-value ast))))
-        (cond
-          ((mal-data-value= mal-unquote (first forms))
-           (second forms))
+  (switch-mal-type ast
+    (types:list     (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
+                      (second (mal-data-value ast))
+                      (qq-iter (mal-data-value ast))))
+    (types:vector   (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
+    (types:hash-map (make-mal-list (list mal-quote ast)))
+    (types:symbol   (make-mal-list (list mal-quote ast)))
+    (types:any      ast)))
 
-          ((and (is-pair (first forms))
-                (mal-data-value= mal-splice-unquote
-                                 (first (mal-data-value (first forms)))))
-           (make-mal-list (list mal-concat
-                                (second (mal-data-value (first forms)))
-                                (quasiquote (make-mal-list (cdr forms))))))
-
-          (t (make-mal-list (list mal-cons
-                                  (quasiquote (first forms))
-                                  (quasiquote (make-mal-list (cdr forms))))))))))
 
 (defun mal-read (string)
   (reader:read-str string))
@@ -96,6 +93,9 @@
                  ((mal-data-value= mal-quote (first forms))
                   (return (second forms)))
 
+                 ((mal-data-value= mal-quasiquoteexpand (first forms))
+                  (return (quasiquote (second forms))))
+
                  ((mal-data-value= mal-quasiquote (first forms))
                   (setf ast (quasiquote (second forms))))
 

impls/common-lisp/src/step8_macros.lisp

@@ -43,8 +43,10 @@
 (defvar mal-fn* (make-mal-symbol "fn*"))
 (defvar mal-quote (make-mal-symbol "quote"))
 (defvar mal-quasiquote (make-mal-symbol "quasiquote"))
+(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
 (defvar mal-unquote (make-mal-symbol "unquote"))
 (defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
+(defvar mal-vec (make-mal-symbol "vec"))
 (defvar mal-cons (make-mal-symbol "cons"))
 (defvar mal-concat (make-mal-symbol "concat"))
 (defvar mal-defmacro! (make-mal-symbol "defmacro!"))
@@ -72,29 +74,23 @@
     (types:hash-map (eval-hash-map ast env))
     (types:any ast)))
 
-(defun is-pair (value)
-  (and (or (mal-list-p value)
-           (mal-vector-p value))
-       (< 0 (length (mal-data-value value)))))
-
+(defun qq-reducer (elt acc)
+  (make-mal-list
+    (if (and (mal-list-p elt)
+             (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote))
+      (list mal-concat (second (mal-data-value elt)) acc)
+      (list mal-cons (quasiquote elt) acc))))
+(defun qq-iter (elts)
+  (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ())))
 (defun quasiquote (ast)
-  (if (not (is-pair ast))
-      (make-mal-list (list mal-quote ast))
-      (let ((forms (map 'list #'identity (mal-data-value ast))))
-        (cond
-          ((mal-data-value= mal-unquote (first forms))
-           (second forms))
-
-          ((and (is-pair (first forms))
-                (mal-data-value= mal-splice-unquote
-                                 (first (mal-data-value (first forms)))))
-           (make-mal-list (list mal-concat
-                                (second (mal-data-value (first forms)))
-                                (quasiquote (make-mal-list (cdr forms))))))
-
-          (t (make-mal-list (list mal-cons
-                                  (quasiquote (first forms))
-                                  (quasiquote (make-mal-list (cdr forms))))))))))
+  (switch-mal-type ast
+    (types:list     (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
+                      (second (mal-data-value ast))
+                      (qq-iter (mal-data-value ast))))
+    (types:vector   (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
+    (types:hash-map (make-mal-list (list mal-quote ast)))
+    (types:symbol   (make-mal-list (list mal-quote ast)))
+    (types:any      ast)))
 
 (defun is-macro-call (ast env)
   (when (mal-list-p ast)
@@ -129,6 +125,9 @@
                  ((mal-data-value= mal-quote (first forms))
                   (return (second forms)))
 
+                 ((mal-data-value= mal-quasiquoteexpand (first forms))
+                  (return (quasiquote (second forms))))
+
                  ((mal-data-value= mal-quasiquote (first forms))
                   (setf ast (quasiquote (second forms))))
 

impls/common-lisp/src/step9_try.lisp

@@ -43,8 +43,10 @@
 (defvar mal-fn* (make-mal-symbol "fn*"))
 (defvar mal-quote (make-mal-symbol "quote"))
 (defvar mal-quasiquote (make-mal-symbol "quasiquote"))
+(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
 (defvar mal-unquote (make-mal-symbol "unquote"))
 (defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
+(defvar mal-vec (make-mal-symbol "vec"))
 (defvar mal-cons (make-mal-symbol "cons"))
 (defvar mal-concat (make-mal-symbol "concat"))
 (defvar mal-defmacro! (make-mal-symbol "defmacro!"))
@@ -75,29 +77,23 @@
     (types:hash-map (eval-hash-map ast env))
     (types:any ast)))
 
-(defun is-pair (value)
-  (and (or (mal-list-p value)
-           (mal-vector-p value))
-       (< 0 (length (mal-data-value value)))))
-
+(defun qq-reducer (elt acc)
+  (make-mal-list
+    (if (and (mal-list-p elt)
+             (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote))
+      (list mal-concat (second (mal-data-value elt)) acc)
+      (list mal-cons (quasiquote elt) acc))))
+(defun qq-iter (elts)
+  (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ())))
 (defun quasiquote (ast)
-  (if (not (is-pair ast))
-      (make-mal-list (list mal-quote ast))
-      (let ((forms (map 'list #'identity (mal-data-value ast))))
-        (cond
-          ((mal-data-value= mal-unquote (first forms))
-           (second forms))
-
-          ((and (is-pair (first forms))
-                (mal-data-value= mal-splice-unquote
-                                 (first (mal-data-value (first forms)))))
-           (make-mal-list (list mal-concat
-                                (second (mal-data-value (first forms)))
-                                (quasiquote (make-mal-list (cdr forms))))))
-
-          (t (make-mal-list (list mal-cons
-                                  (quasiquote (first forms))
-                                  (quasiquote (make-mal-list (cdr forms))))))))))
+  (switch-mal-type ast
+    (types:list     (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
+                      (second (mal-data-value ast))
+                      (qq-iter (mal-data-value ast))))
+    (types:vector   (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
+    (types:hash-map (make-mal-list (list mal-quote ast)))
+    (types:symbol   (make-mal-list (list mal-quote ast)))
+    (types:any      ast)))
 
 (defun is-macro-call (ast env)
   (when (mal-list-p ast)
@@ -132,6 +128,9 @@
                  ((mal-data-value= mal-quote (first forms))
                   (return (second forms)))
 
+                 ((mal-data-value= mal-quasiquoteexpand (first forms))
+                  (return (quasiquote (second forms))))
+
                  ((mal-data-value= mal-quasiquote (first forms))
                   (setf ast (quasiquote (second forms))))
 

impls/common-lisp/src/stepA_mal.lisp

@@ -42,8 +42,10 @@
 (defvar mal-fn* (make-mal-symbol "fn*"))
 (defvar mal-quote (make-mal-symbol "quote"))
 (defvar mal-quasiquote (make-mal-symbol "quasiquote"))
+(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
 (defvar mal-unquote (make-mal-symbol "unquote"))
 (defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
+(defvar mal-vec (make-mal-symbol "vec"))
 (defvar mal-cons (make-mal-symbol "cons"))
 (defvar mal-concat (make-mal-symbol "concat"))
 (defvar mal-defmacro! (make-mal-symbol "defmacro!"))
@@ -74,29 +76,23 @@
     (types:hash-map (eval-hash-map ast env))
     (types:any ast)))
 
-(defun is-pair (value)
-  (and (or (mal-list-p value)
-           (mal-vector-p value))
-       (< 0 (length (mal-data-value value)))))
-
+(defun qq-reducer (elt acc)
+  (make-mal-list
+    (if (and (mal-list-p elt)
+             (mal-data-value= (first (mal-data-value elt)) mal-splice-unquote))
+      (list mal-concat (second (mal-data-value elt)) acc)
+      (list mal-cons (quasiquote elt) acc))))
+(defun qq-iter (elts)
+  (reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ())))
 (defun quasiquote (ast)
-  (if (not (is-pair ast))
-      (make-mal-list (list mal-quote ast))
-      (let ((forms (map 'list #'identity (mal-data-value ast))))
-        (cond
-          ((mal-data-value= mal-unquote (first forms))
-           (second forms))
-
-          ((and (is-pair (first forms))
-                (mal-data-value= mal-splice-unquote
-                                 (first (mal-data-value (first forms)))))
-           (make-mal-list (list mal-concat
-                                (second (mal-data-value (first forms)))
-                                (quasiquote (make-mal-list (cdr forms))))))
-
-          (t (make-mal-list (list mal-cons
-                                  (quasiquote (first forms))
-                                  (quasiquote (make-mal-list (cdr forms))))))))))
+  (switch-mal-type ast
+    (types:list     (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
+                      (second (mal-data-value ast))
+                      (qq-iter (mal-data-value ast))))
+    (types:vector   (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
+    (types:hash-map (make-mal-list (list mal-quote ast)))
+    (types:symbol   (make-mal-list (list mal-quote ast)))
+    (types:any      ast)))
 
 (defun is-macro-call (ast env)
   (when (mal-list-p ast)
@@ -131,6 +127,9 @@
                  ((mal-data-value= mal-quote (first forms))
                   (return (second forms)))
 
+                 ((mal-data-value= mal-quasiquoteexpand (first forms))
+                  (return (quasiquote (second forms))))
+
                  ((mal-data-value= mal-quasiquote (first forms))
                   (setf ast (quasiquote (second forms))))
 

impls/cpp/Core.cpp

@@ -509,6 +509,13 @@ BUILTIN("vals")
     return hash->values();
 }
 
+BUILTIN("vec")
+{
+    CHECK_ARGS_IS(1);
+    ARG(malSequence, s);
+    return mal::vector(s->begin(), s->end());
+}
+
 BUILTIN("vector")
 {
     return mal::vector(argsBegin, argsEnd);

impls/cpp/step7_quote.cpp

@@ -146,6 +146,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
                 continue; // TCO
             }
 
+            if (special == "quasiquoteexpand") {
+                checkArgsIs("quasiquote", 1, argCount);
+                return quasiquote(list->item(1));
+            }
+
             if (special == "quasiquote") {
                 checkArgsIs("quasiquote", 1, argCount);
                 ast = quasiquote(list->item(1));
@@ -192,44 +197,41 @@ static bool isSymbol(malValuePtr obj, const String& text)
     return sym && (sym->value() == text);
 }
 
-static const malSequence* isPair(malValuePtr obj)
+//  Return arg when ast matches ('sym, arg), else NULL.
+static malValuePtr starts_with(const malValuePtr ast, const char* sym)
 {
-    const malSequence* list = DYNAMIC_CAST(malSequence, obj);
-    return list && !list->isEmpty() ? list : NULL;
+    const malList* list = DYNAMIC_CAST(malList, ast);
+    if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
+        return NULL;
+    checkArgsIs(sym, 1, list->count() - 1);
+    return list->item(1);
 }
 
 static malValuePtr quasiquote(malValuePtr obj)
 {
-    const malSequence* seq = isPair(obj);
-    if (!seq) {
+    if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
         return mal::list(mal::symbol("quote"), obj);
-    }
 
-    if (isSymbol(seq->item(0), "unquote")) {
-        // (qq (uq form)) -> form
-        checkArgsIs("unquote", 1, seq->count() - 1);
-        return seq->item(1);
-    }
+    const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
+    if (!seq)
+        return obj;
 
-    const malSequence* innerSeq = isPair(seq->item(0));
-    if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
-        checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
-        // (qq (sq '(a b c))) -> a b c
-        return mal::list(
-            mal::symbol("concat"),
-            innerSeq->item(1),
-            quasiquote(seq->rest())
-        );
-    }
-    else {
-        // (qq (a b c)) -> (list (qq a) (qq b) (qq c))
-        // (qq xs     ) -> (cons (qq (car xs)) (qq (cdr xs)))
-        return mal::list(
-            mal::symbol("cons"),
-            quasiquote(seq->first()),
-            quasiquote(seq->rest())
-        );
+    const malValuePtr unquoted = starts_with(obj, "unquote");
+    if (unquoted)
+        return unquoted;
+
+    malValuePtr res = mal::list(new malValueVec(0));
+    for (int i=seq->count()-1; 0<=i; i--) {
+        const malValuePtr elt     = seq->item(i);
+        const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
+        if (spl_unq)
+            res = mal::list(mal::symbol("concat"), spl_unq, res);
+         else
+            res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
     }
+    if (DYNAMIC_CAST(malVector, obj))
+        res = mal::list(mal::symbol("vec"), res);
+    return res;
 }
 
 static const char* malFunctionTable[] = {

impls/cpp/step8_macros.cpp

@@ -168,6 +168,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
                 return macroExpand(list->item(1), env);
             }
 
+            if (special == "quasiquoteexpand") {
+                checkArgsIs("quasiquote", 1, argCount);
+                return quasiquote(list->item(1));
+            }
+
             if (special == "quasiquote") {
                 checkArgsIs("quasiquote", 1, argCount);
                 ast = quasiquote(list->item(1));
@@ -214,50 +219,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
     return sym && (sym->value() == text);
 }
 
-static const malSequence* isPair(malValuePtr obj)
+//  Return arg when ast matches ('sym, arg), else NULL.
+static malValuePtr starts_with(const malValuePtr ast, const char* sym)
 {
-    const malSequence* list = DYNAMIC_CAST(malSequence, obj);
-    return list && !list->isEmpty() ? list : NULL;
+    const malList* list = DYNAMIC_CAST(malList, ast);
+    if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
+        return NULL;
+    checkArgsIs(sym, 1, list->count() - 1);
+    return list->item(1);
 }
 
 static malValuePtr quasiquote(malValuePtr obj)
 {
-    const malSequence* seq = isPair(obj);
-    if (!seq) {
+    if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
         return mal::list(mal::symbol("quote"), obj);
-    }
 
-    if (isSymbol(seq->item(0), "unquote")) {
-        // (qq (uq form)) -> form
-        checkArgsIs("unquote", 1, seq->count() - 1);
-        return seq->item(1);
-    }
+    const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
+    if (!seq)
+        return obj;
 
-    const malSequence* innerSeq = isPair(seq->item(0));
-    if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
-        checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
-        // (qq (sq '(a b c))) -> a b c
-        return mal::list(
-            mal::symbol("concat"),
-            innerSeq->item(1),
-            quasiquote(seq->rest())
-        );
-    }
-    else {
-        // (qq (a b c)) -> (list (qq a) (qq b) (qq c))
-        // (qq xs     ) -> (cons (qq (car xs)) (qq (cdr xs)))
-        return mal::list(
-            mal::symbol("cons"),
-            quasiquote(seq->first()),
-            quasiquote(seq->rest())
-        );
+    const malValuePtr unquoted = starts_with(obj, "unquote");
+    if (unquoted)
+        return unquoted;
+
+    malValuePtr res = mal::list(new malValueVec(0));
+    for (int i=seq->count()-1; 0<=i; i--) {
+        const malValuePtr elt     = seq->item(i);
+        const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
+        if (spl_unq)
+            res = mal::list(mal::symbol("concat"), spl_unq, res);
+         else
+            res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
     }
+    if (DYNAMIC_CAST(malVector, obj))
+        res = mal::list(mal::symbol("vec"), res);
+    return res;
 }
 
 static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
 {
-    if (const malSequence* seq = isPair(obj)) {
-        if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
+    const malList* seq = DYNAMIC_CAST(malList, obj);
+    if (seq && !seq->isEmpty()) {
+        if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
             if (malEnvPtr symEnv = env->find(sym->value())) {
                 malValuePtr value = sym->eval(symEnv);
                 if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {

impls/cpp/step9_try.cpp

@@ -171,6 +171,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
                 return macroExpand(list->item(1), env);
             }
 
+            if (special == "quasiquoteexpand") {
+                checkArgsIs("quasiquote", 1, argCount);
+                return quasiquote(list->item(1));
+            }
+
             if (special == "quasiquote") {
                 checkArgsIs("quasiquote", 1, argCount);
                 ast = quasiquote(list->item(1));
@@ -263,50 +268,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
     return sym && (sym->value() == text);
 }
 
-static const malSequence* isPair(malValuePtr obj)
+//  Return arg when ast matches ('sym, arg), else NULL.
+static malValuePtr starts_with(const malValuePtr ast, const char* sym)
 {
-    const malSequence* list = DYNAMIC_CAST(malSequence, obj);
-    return list && !list->isEmpty() ? list : NULL;
+    const malList* list = DYNAMIC_CAST(malList, ast);
+    if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
+        return NULL;
+    checkArgsIs(sym, 1, list->count() - 1);
+    return list->item(1);
 }
 
 static malValuePtr quasiquote(malValuePtr obj)
 {
-    const malSequence* seq = isPair(obj);
-    if (!seq) {
+    if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
         return mal::list(mal::symbol("quote"), obj);
-    }
 
-    if (isSymbol(seq->item(0), "unquote")) {
-        // (qq (uq form)) -> form
-        checkArgsIs("unquote", 1, seq->count() - 1);
-        return seq->item(1);
-    }
+    const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
+    if (!seq)
+        return obj;
 
-    const malSequence* innerSeq = isPair(seq->item(0));
-    if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
-        checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
-        // (qq (sq '(a b c))) -> a b c
-        return mal::list(
-            mal::symbol("concat"),
-            innerSeq->item(1),
-            quasiquote(seq->rest())
-        );
-    }
-    else {
-        // (qq (a b c)) -> (list (qq a) (qq b) (qq c))
-        // (qq xs     ) -> (cons (qq (car xs)) (qq (cdr xs)))
-        return mal::list(
-            mal::symbol("cons"),
-            quasiquote(seq->first()),
-            quasiquote(seq->rest())
-        );
+    const malValuePtr unquoted = starts_with(obj, "unquote");
+    if (unquoted)
+        return unquoted;
+
+    malValuePtr res = mal::list(new malValueVec(0));
+    for (int i=seq->count()-1; 0<=i; i--) {
+        const malValuePtr elt     = seq->item(i);
+        const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
+        if (spl_unq)
+            res = mal::list(mal::symbol("concat"), spl_unq, res);
+         else
+            res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
     }
+    if (DYNAMIC_CAST(malVector, obj))
+        res = mal::list(mal::symbol("vec"), res);
+    return res;
 }
 
 static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
 {
-    if (const malSequence* seq = isPair(obj)) {
-        if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
+    const malList* seq = DYNAMIC_CAST(malList, obj);
+    if (seq && !seq->isEmpty()) {
+        if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
             if (malEnvPtr symEnv = env->find(sym->value())) {
                 malValuePtr value = sym->eval(symEnv);
                 if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {

impls/cpp/stepA_mal.cpp

@@ -172,6 +172,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
                 return macroExpand(list->item(1), env);
             }
 
+            if (special == "quasiquoteexpand") {
+                checkArgsIs("quasiquote", 1, argCount);
+                return quasiquote(list->item(1));
+            }
+
             if (special == "quasiquote") {
                 checkArgsIs("quasiquote", 1, argCount);
                 ast = quasiquote(list->item(1));
@@ -264,50 +269,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
     return sym && (sym->value() == text);
 }
 
-static const malSequence* isPair(malValuePtr obj)
+//  Return arg when ast matches ('sym, arg), else NULL.
+static malValuePtr starts_with(const malValuePtr ast, const char* sym)
 {
-    const malSequence* list = DYNAMIC_CAST(malSequence, obj);
-    return list && !list->isEmpty() ? list : NULL;
+    const malList* list = DYNAMIC_CAST(malList, ast);
+    if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
+        return NULL;
+    checkArgsIs(sym, 1, list->count() - 1);
+    return list->item(1);
 }
 
 static malValuePtr quasiquote(malValuePtr obj)
 {
-    const malSequence* seq = isPair(obj);
-    if (!seq) {
+    if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
         return mal::list(mal::symbol("quote"), obj);
-    }
 
-    if (isSymbol(seq->item(0), "unquote")) {
-        // (qq (uq form)) -> form
-        checkArgsIs("unquote", 1, seq->count() - 1);
-        return seq->item(1);
-    }
+    const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
+    if (!seq)
+        return obj;
 
-    const malSequence* innerSeq = isPair(seq->item(0));
-    if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
-        checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
-        // (qq (sq '(a b c))) -> a b c
-        return mal::list(
-            mal::symbol("concat"),
-            innerSeq->item(1),
-            quasiquote(seq->rest())
-        );
-    }
-    else {
-        // (qq (a b c)) -> (list (qq a) (qq b) (qq c))
-        // (qq xs     ) -> (cons (qq (car xs)) (qq (cdr xs)))
-        return mal::list(
-            mal::symbol("cons"),
-            quasiquote(seq->first()),
-            quasiquote(seq->rest())
-        );
+    const malValuePtr unquoted = starts_with(obj, "unquote");
+    if (unquoted)
+        return unquoted;
+
+    malValuePtr res = mal::list(new malValueVec(0));
+    for (int i=seq->count()-1; 0<=i; i--) {
+        const malValuePtr elt     = seq->item(i);
+        const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
+        if (spl_unq)
+            res = mal::list(mal::symbol("concat"), spl_unq, res);
+         else
+            res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
     }
+    if (DYNAMIC_CAST(malVector, obj))
+        res = mal::list(mal::symbol("vec"), res);
+    return res;
 }
 
 static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
 {
-    if (const malSequence* seq = isPair(obj)) {
-        if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
+    const malList* seq = DYNAMIC_CAST(malList, obj);
+    if (seq && !seq->isEmpty()) {
+        if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
             if (malEnvPtr symEnv = env->find(sym->value())) {
                 malValuePtr value = sym->eval(symEnv);
                 if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {

impls/crystal/core.cr

@@ -88,6 +88,12 @@ module Mal
     end
   end
 
+  def self.vec(args)
+    arg = args.first.unwrap
+    arg.is_a? Array || eval_error "argument of vec must be a sequence"
+    arg.to_mal(Mal::Vector)
+  end
+
   def self.nth(args)
     a0, a1 = args[0].unwrap, args[1].unwrap
     eval_error "1st argument of nth must be list or vector" unless a0.is_a? Array
@@ -410,6 +416,7 @@ module Mal
     "slurp"       => func(:slurp),
     "cons"        => func(:cons),
     "concat"      => func(:concat),
+    "vec"         => func(:vec),
     "nth"         => func(:nth),
     "first"       => func(:first),
     "rest"        => func(:rest),

impls/crystal/step7_quote.cr

@@ -51,36 +51,49 @@ module Mal
     read_str str
   end
 
-  macro is_pair(list)
-    {{list}}.is_a?(Array) && !{{list}}.empty?
+  def starts_with(list, symbol)
+    if list.size == 2
+      head = list.first.unwrap
+      head.is_a? Mal::Symbol && head.str == symbol
+    end
+  end
+
+  def quasiquote_elts(list)
+    acc = Mal::Type.new(Mal::List.new)
+    list.reverse.each do |elt|
+      elt_val = elt.unwrap
+      if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote")
+        acc = Mal::Type.new(
+          Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc
+        )
+      else
+        acc = Mal::Type.new(
+          Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc
+        )
+      end
+    end
+    acc
   end
 
   def quasiquote(ast)
-    list = ast.unwrap
-
-    unless is_pair(list)
-      return Mal::Type.new(
+    ast_val = ast.unwrap
+    case ast_val
+    when Mal::List
+      if starts_with(ast_val,"unquote")
+        ast_val[1]
+      else
+        quasiquote_elts(ast_val)
+      end
+    when Mal::Vector
+      Mal::Type.new(
+        Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val)
+      )
+    when Mal::HashMap, Mal::Symbol
+      Mal::Type.new (
         Mal::List.new << gen_type(Mal::Symbol, "quote") << ast
       )
-    end
-
-    head = list.first.unwrap
-
-    case
-    # ("unquote" ...)
-    when head.is_a?(Mal::Symbol) && head.str == "unquote"
-      list[1]
-      # (("splice-unquote" ...) ...)
-    when is_pair(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote"
-      tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
-      Mal::Type.new(
-        Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail)
-      )
     else
-      tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
-      Mal::Type.new(
-        Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
-      )
+      ast
     end
   end
 
@@ -161,6 +174,8 @@ module Mal
         Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
       when "quote"
         list[1]
+      when "quasiquoteexpand"
+        quasiquote list[1]
       when "quasiquote"
         ast = quasiquote list[1]
         next # TCO

impls/crystal/step8_macros.cr

@@ -51,36 +51,49 @@ module Mal
     read_str str
   end
 
-  macro pair?(list)
-    {{list}}.is_a?(Array) && !{{list}}.empty?
+  def starts_with(list, symbol)
+    if list.size == 2
+      head = list.first.unwrap
+      head.is_a? Mal::Symbol && head.str == symbol
+    end
+  end
+
+  def quasiquote_elts(list)
+    acc = Mal::Type.new(Mal::List.new)
+    list.reverse.each do |elt|
+      elt_val = elt.unwrap
+      if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote")
+        acc = Mal::Type.new(
+          Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc
+        )
+      else
+        acc = Mal::Type.new(
+          Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc
+        )
+      end
+    end
+    acc
   end
 
   def quasiquote(ast)
-    list = ast.unwrap
-
-    unless pair?(list)
-      return Mal::Type.new(
+    ast_val = ast.unwrap
+    case ast_val
+    when Mal::List
+      if starts_with(ast_val,"unquote")
+        ast_val[1]
+      else
+        quasiquote_elts(ast_val)
+      end
+    when Mal::Vector
+      Mal::Type.new(
+        Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val)
+      )
+    when Mal::HashMap, Mal::Symbol
+      Mal::Type.new (
         Mal::List.new << gen_type(Mal::Symbol, "quote") << ast
       )
-    end
-
-    head = list.first.unwrap
-
-    case
-    # ("unquote" ...)
-    when head.is_a?(Mal::Symbol) && head.str == "unquote"
-      list[1]
-      # (("splice-unquote" ...) ...)
-    when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote"
-      tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
-      Mal::Type.new(
-        Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail)
-      )
     else
-      tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
-      Mal::Type.new(
-        Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
-      )
+      ast
     end
   end
 
@@ -200,6 +213,8 @@ module Mal
         Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
       when "quote"
         list[1]
+      when "quasiquoteexpand"
+        quasiquote list[1]
       when "quasiquote"
         ast = quasiquote list[1]
         next # TCO

impls/crystal/step9_try.cr

@@ -51,36 +51,49 @@ module Mal
     read_str str
   end
 
-  macro pair?(list)
-    {{list}}.is_a?(Array) && !{{list}}.empty?
+  def starts_with(list, symbol)
+    if list.size == 2
+      head = list.first.unwrap
+      head.is_a? Mal::Symbol && head.str == symbol
+    end
+  end
+
+  def quasiquote_elts(list)
+    acc = Mal::Type.new(Mal::List.new)
+    list.reverse.each do |elt|
+      elt_val = elt.unwrap
+      if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote")
+        acc = Mal::Type.new(
+          Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc
+        )
+      else
+        acc = Mal::Type.new(
+          Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc
+        )
+      end
+    end
+    acc
   end
 
   def quasiquote(ast)
-    list = ast.unwrap
-
-    unless pair?(list)
-      return Mal::Type.new(
+    ast_val = ast.unwrap
+    case ast_val
+    when Mal::List
+      if starts_with(ast_val,"unquote")
+        ast_val[1]
+      else
+        quasiquote_elts(ast_val)
+      end
+    when Mal::Vector
+      Mal::Type.new(
+        Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val)
+      )
+    when Mal::HashMap, Mal::Symbol
+      Mal::Type.new (
         Mal::List.new << gen_type(Mal::Symbol, "quote") << ast
       )
-    end
-
-    head = list.first.unwrap
-
-    case
-    # ("unquote" ...)
-    when head.is_a?(Mal::Symbol) && head.str == "unquote"
-      list[1]
-      # (("splice-unquote" ...) ...)
-    when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote"
-      tail = Mal::Type.new list[1..-1].to_mal
-      Mal::Type.new(
-        Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail)
-      )
     else
-      tail = Mal::Type.new list[1..-1].to_mal
-      Mal::Type.new(
-        Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
-      )
+      ast
     end
   end
 
@@ -200,6 +213,8 @@ module Mal
         Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
       when "quote"
         list[1]
+      when "quasiquoteexpand"
+        quasiquote list[1]
       when "quasiquote"
         ast = quasiquote list[1]
         next # TCO

impls/crystal/stepA_mal.cr

@@ -52,36 +52,49 @@ module Mal
     read_str str
   end
 
-  macro pair?(list)
-    {{list}}.is_a?(Array) && !{{list}}.empty?
+  def starts_with(list, symbol)
+    if list.size == 2
+      head = list.first.unwrap
+      head.is_a? Mal::Symbol && head.str == symbol
+    end
+  end
+
+  def quasiquote_elts(list)
+    acc = Mal::Type.new(Mal::List.new)
+    list.reverse.each do |elt|
+      elt_val = elt.unwrap
+      if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote")
+        acc = Mal::Type.new(
+          Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc
+        )
+      else
+        acc = Mal::Type.new(
+          Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc
+        )
+      end
+    end
+    acc
   end
 
   def quasiquote(ast)
-    list = ast.unwrap
-
-    unless pair?(list)
-      return Mal::Type.new(
+    ast_val = ast.unwrap
+    case ast_val
+    when Mal::List
+      if starts_with(ast_val,"unquote")
+        ast_val[1]
+      else
+        quasiquote_elts(ast_val)
+      end
+    when Mal::Vector
+      Mal::Type.new(
+        Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val)
+      )
+    when Mal::HashMap, Mal::Symbol
+      Mal::Type.new (
         Mal::List.new << gen_type(Mal::Symbol, "quote") << ast
       )
-    end
-
-    head = list.first.unwrap
-
-    case
-    # ("unquote" ...)
-    when head.is_a?(Mal::Symbol) && head.str == "unquote"
-      list[1]
-      # (("splice-unquote" ...) ...)
-    when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote"
-      tail = Mal::Type.new list[1..-1].to_mal
-      Mal::Type.new(
-        Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail)
-      )
     else
-      tail = Mal::Type.new list[1..-1].to_mal
-      Mal::Type.new(
-        Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
-      )
+      ast
     end
   end
 
@@ -206,6 +219,8 @@ module Mal
         Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
       when "quote"
         list[1]
+      when "quasiquoteexpand"
+        quasiquote list[1]
       when "quasiquote"
         ast = quasiquote list[1]
         next # TCO

impls/cs/core.cs

@@ -371,6 +371,7 @@ namespace Mal {
             {"sequential?", sequential_Q},
             {"cons", cons},
             {"concat", concat},
+            {"vec",  new MalFunc(a => new MalVector(((MalList)a[0]).getValue()))},
             {"nth", nth},
             {"first", first},
             {"rest",  rest},

impls/cs/step7_quote.cs

@@ -21,30 +21,41 @@ namespace Mal {
         }
 
         // eval
-        public static bool is_pair(MalVal x) {
-            return x is MalList && ((MalList)x).size() > 0;
+        public static bool starts_with(MalVal ast, string sym) {
+            if (ast is MalList && !(ast is MalVector)) {
+                MalList list = (MalList)ast;
+                if (list.size() == 2 && list[0] is MalSymbol) {
+                    MalSymbol a0 = (MalSymbol)list[0];
+                    return a0.getName() == sym;
+                }
+            }
+            return false;
         }
 
+        public static MalVal qq_loop(MalList ast) {
+            MalVal acc = new MalList();
+            for(int i=ast.size()-1; 0<=i; i-=1) {
+                MalVal elt = ast[i];
+                if (starts_with(elt, "splice-unquote")) {
+                    acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc);
+                } else {
+                    acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc);
+                }
+            }
+            return acc;
+        }
         public static MalVal quasiquote(MalVal ast) {
-            if (!is_pair(ast)) {
+            //  Check Vector subclass before List.
+            if (ast is MalVector) {
+                return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast)));
+            } else if (starts_with(ast, "unquote")) {
+                return ((MalList)ast)[1];
+            } else if (ast is MalList) {
+                return qq_loop((MalList)ast);
+            } else if (ast is MalSymbol || ast is MalHashMap) {
                 return new MalList(new MalSymbol("quote"), ast);
             } else {
-                MalVal a0 = ((MalList)ast)[0];
-                if ((a0 is MalSymbol) &&
-                    (((MalSymbol)a0).getName() == "unquote")) {
-                    return ((MalList)ast)[1];
-                } else if (is_pair(a0)) {
-                    MalVal a00 = ((MalList)a0)[0];
-                    if ((a00 is MalSymbol) &&
-                        (((MalSymbol)a00).getName() == "splice-unquote")) {
-                        return new MalList(new MalSymbol("concat"),
-                                           ((MalList)a0)[1],
-                                           quasiquote(((MalList)ast).rest()));
-                    }
-                }
-                return new MalList(new MalSymbol("cons"),
-                                   quasiquote(a0),
-                                   quasiquote(((MalList)ast).rest()));
+                return ast;
             }
         }
 
@@ -113,6 +124,8 @@ namespace Mal {
                 break;
             case "quote":
                 return ast[1];
+            case "quasiquoteexpand":
+                return quasiquote(ast[1]);
             case "quasiquote":
                 orig_ast = quasiquote(ast[1]);
                 break;

impls/cs/step8_macros.cs

@@ -21,30 +21,41 @@ namespace Mal {
         }
 
         // eval
-        public static bool is_pair(MalVal x) {
-            return x is MalList && ((MalList)x).size() > 0;
+        public static bool starts_with(MalVal ast, string sym) {
+            if (ast is MalList && !(ast is MalVector)) {
+                MalList list = (MalList)ast;
+                if (list.size() == 2 && list[0] is MalSymbol) {
+                    MalSymbol a0 = (MalSymbol)list[0];
+                    return a0.getName() == sym;
+                }
+            }
+            return false;
         }
 
+        public static MalVal qq_loop(MalList ast) {
+            MalVal acc = new MalList();
+            for(int i=ast.size()-1; 0<=i; i-=1) {
+                MalVal elt = ast[i];
+                if (starts_with(elt, "splice-unquote")) {
+                    acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc);
+                } else {
+                    acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc);
+                }
+            }
+            return acc;
+        }
         public static MalVal quasiquote(MalVal ast) {
-            if (!is_pair(ast)) {
+            //  Check Vector subclass before List.
+            if (ast is MalVector) {
+                return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast)));
+            } else if (starts_with(ast, "unquote")) {
+                return ((MalList)ast)[1];
+            } else if (ast is MalList) {
+                return qq_loop((MalList)ast);
+            } else if (ast is MalSymbol || ast is MalHashMap) {
                 return new MalList(new MalSymbol("quote"), ast);
             } else {
-                MalVal a0 = ((MalList)ast)[0];
-                if ((a0 is MalSymbol) &&
-                    (((MalSymbol)a0).getName() == "unquote")) {
-                    return ((MalList)ast)[1];
-                } else if (is_pair(a0)) {
-                    MalVal a00 = ((MalList)a0)[0];
-                    if ((a00 is MalSymbol) &&
-                        (((MalSymbol)a00).getName() == "splice-unquote")) {
-                        return new MalList(new MalSymbol("concat"),
-                                           ((MalList)a0)[1],
-                                           quasiquote(((MalList)ast).rest()));
-                    }
-                }
-                return new MalList(new MalSymbol("cons"),
-                                   quasiquote(a0),
-                                   quasiquote(((MalList)ast).rest()));
+                return ast;
             }
         }
 
@@ -142,6 +153,8 @@ namespace Mal {
                 break;
             case "quote":
                 return ast[1];
+            case "quasiquoteexpand":
+                return quasiquote(ast[1]);
             case "quasiquote":
                 orig_ast = quasiquote(ast[1]);
                 break;

impls/cs/step9_try.cs

@@ -21,30 +21,41 @@ namespace Mal {
         }
 
         // eval
-        public static bool is_pair(MalVal x) {
-            return x is MalList && ((MalList)x).size() > 0;
+        public static bool starts_with(MalVal ast, string sym) {
+            if (ast is MalList && !(ast is MalVector)) {
+                MalList list = (MalList)ast;
+                if (list.size() == 2 && list[0] is MalSymbol) {
+                    MalSymbol a0 = (MalSymbol)list[0];
+                    return a0.getName() == sym;
+                }
+            }
+            return false;
         }
 
+        public static MalVal qq_loop(MalList ast) {
+            MalVal acc = new MalList();
+            for(int i=ast.size()-1; 0<=i; i-=1) {
+                MalVal elt = ast[i];
+                if (starts_with(elt, "splice-unquote")) {
+                    acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc);
+                } else {
+                    acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc);
+                }
+            }
+            return acc;
+        }
         public static MalVal quasiquote(MalVal ast) {
-            if (!is_pair(ast)) {
+            //  Check Vector subclass before List.
+            if (ast is MalVector) {
+                return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast)));
+            } else if (starts_with(ast, "unquote")) {
+                return ((MalList)ast)[1];
+            } else if (ast is MalList) {
+                return qq_loop((MalList)ast);
+            } else if (ast is MalSymbol || ast is MalHashMap) {
                 return new MalList(new MalSymbol("quote"), ast);
             } else {
-                MalVal a0 = ((MalList)ast)[0];
-                if ((a0 is MalSymbol) &&
-                    (((MalSymbol)a0).getName() == "unquote")) {
-                    return ((MalList)ast)[1];
-                } else if (is_pair(a0)) {
-                    MalVal a00 = ((MalList)a0)[0];
-                    if ((a00 is MalSymbol) &&
-                        (((MalSymbol)a00).getName() == "splice-unquote")) {
-                        return new MalList(new MalSymbol("concat"),
-                                           ((MalList)a0)[1],
-                                           quasiquote(((MalList)ast).rest()));
-                    }
-                }
-                return new MalList(new MalSymbol("cons"),
-                                   quasiquote(a0),
-                                   quasiquote(((MalList)ast).rest()));
+                return ast;
             }
         }
 
@@ -142,6 +153,8 @@ namespace Mal {
                 break;
             case "quote":
                 return ast[1];
+            case "quasiquoteexpand":
+                return quasiquote(ast[1]);
             case "quasiquote":
                 orig_ast = quasiquote(ast[1]);
                 break;

impls/cs/stepA_mal.cs

@@ -21,30 +21,41 @@ namespace Mal {
         }
 
         // eval
-        public static bool is_pair(MalVal x) {
-            return x is MalList && ((MalList)x).size() > 0;
+        public static bool starts_with(MalVal ast, string sym) {
+            if (ast is MalList && !(ast is MalVector)) {
+                MalList list = (MalList)ast;
+                if (list.size() == 2 && list[0] is MalSymbol) {
+                    MalSymbol a0 = (MalSymbol)list[0];
+                    return a0.getName() == sym;
+                }
+            }
+            return false;
         }
 
+        public static MalVal qq_loop(MalList ast) {
+            MalVal acc = new MalList();
+            for(int i=ast.size()-1; 0<=i; i-=1) {
+                MalVal elt = ast[i];
+                if (starts_with(elt, "splice-unquote")) {
+                    acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc);
+                } else {
+                    acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc);
+                }
+            }
+            return acc;
+        }
         public static MalVal quasiquote(MalVal ast) {
-            if (!is_pair(ast)) {
+            //  Check Vector subclass before List.
+            if (ast is MalVector) {
+                return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast)));
+            } else if (starts_with(ast, "unquote")) {
+                return ((MalList)ast)[1];
+            } else if (ast is MalList) {
+                return qq_loop((MalList)ast);
+            } else if (ast is MalSymbol || ast is MalHashMap) {
                 return new MalList(new MalSymbol("quote"), ast);
             } else {
-                MalVal a0 = ((MalList)ast)[0];
-                if ((a0 is MalSymbol) &&
-                    (((MalSymbol)a0).getName() == "unquote")) {
-                    return ((MalList)ast)[1];
-                } else if (is_pair(a0)) {
-                    MalVal a00 = ((MalList)a0)[0];
-                    if ((a00 is MalSymbol) &&
-                        (((MalSymbol)a00).getName() == "splice-unquote")) {
-                        return new MalList(new MalSymbol("concat"),
-                                           ((MalList)a0)[1],
-                                           quasiquote(((MalList)ast).rest()));
-                    }
-                }
-                return new MalList(new MalSymbol("cons"),
-                                   quasiquote(a0),
-                                   quasiquote(((MalList)ast).rest()));
+                return ast;
             }
         }
 
@@ -142,6 +153,8 @@ namespace Mal {
                 break;
             case "quote":
                 return ast[1];
+            case "quasiquoteexpand":
+                return quasiquote(ast[1]);
             case "quasiquote":
                 orig_ast = quasiquote(ast[1]);
                 break;

impls/d/mal_core.d

@@ -213,6 +213,12 @@ static MalType mal_concat(MalType[] a ...)
     return new MalList(res);
 }
 
+static MalType mal_vec(MalType[] a ...)
+{
+    verify_args_count(a, 1);
+    return new MalVector(verify_cast!MalSequential(a[0]).elements);
+}
+
 static MalType mal_nth(MalType[] a ...)
 {
     verify_args_count(a, 2);
@@ -397,6 +403,7 @@ static this()
         "sequential?": (a ...) => mal_type_q!MalSequential(a),
         "cons":     &mal_cons,
         "concat":   &mal_concat,
+        "vec":      &mal_vec,
         "nth":      &mal_nth,
         "first":    &mal_first,
         "rest":     &mal_rest,

impls/d/step7_quote.d

@@ -13,36 +13,36 @@ import reader;
 import printer;
 import types;
 
-bool is_pair(MalType ast)
+bool starts_with(MalType ast, MalSymbol sym)
 {
-    auto lst = cast(MalSequential) ast;
+    auto lst = cast(MalList) ast;
     if (lst is null) return false;
-    return lst.elements.length > 0;
+    auto lste = lst.elements;
+    return lste.length > 0 && lste[0] == sym;
 }
 
 MalType quasiquote(MalType ast)
 {
-    if (!is_pair(ast))
-    {
+    if (cast(MalSymbol)ast || cast(MalHashmap)ast)
         return new MalList([sym_quote, ast]);
-    }
-    auto ast_seq = verify_cast!MalSequential(ast);
+
+    auto ast_seq = cast(MalSequential) ast;
+    if (ast_seq is null)
+        return ast;
+
     auto aste = ast_seq.elements;
-    if (aste[0] == sym_unquote)
-    {
+    if (starts_with(ast, sym_unquote))
         return aste[1];
-    }
 
-    if (is_pair(aste[0]))
-    {
-        auto ast0_seq = verify_cast!MalSequential(aste[0]);
-        if (ast0_seq.elements[0] == sym_splice_unquote)
-        {
-            return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
-        }
-    }
-
-    return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
+    MalType res = new MalList([]);;
+    foreach_reverse (elt; ast_seq.elements)
+        if (starts_with(elt, sym_splice_unquote))
+            res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
+        else
+            res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
+    if (cast(MalVector) ast)
+        res = new MalList([new MalSymbol("vec"), res]);
+    return res;
 }
 
 MalType READ(string str)
@@ -120,6 +120,9 @@ MalType EVAL(MalType ast, Env env)
             case "quote":
                 return aste[1];
 
+            case "quasiquoteexpand":
+                return quasiquote(aste[1]);
+
             case "quasiquote":
                 ast = quasiquote(aste[1]);
                 continue; // TCO

impls/d/step8_macros.d

@@ -13,36 +13,36 @@ import reader;
 import printer;
 import types;
 
-bool is_pair(MalType ast)
+bool starts_with(MalType ast, MalSymbol sym)
 {
-    auto lst = cast(MalSequential) ast;
+    auto lst = cast(MalList) ast;
     if (lst is null) return false;
-    return lst.elements.length > 0;
+    auto lste = lst.elements;
+    return lste.length > 0 && lste[0] == sym;
 }
 
 MalType quasiquote(MalType ast)
 {
-    if (!is_pair(ast))
-    {
+    if (cast(MalSymbol)ast || cast(MalHashmap)ast)
         return new MalList([sym_quote, ast]);
-    }
-    auto ast_seq = verify_cast!MalSequential(ast);
+
+    auto ast_seq = cast(MalSequential) ast;
+    if (ast_seq is null)
+        return ast;
+
     auto aste = ast_seq.elements;
-    if (aste[0] == sym_unquote)
-    {
+    if (starts_with(ast, sym_unquote))
         return aste[1];
-    }
 
-    if (is_pair(aste[0]))
-    {
-        auto ast0_seq = verify_cast!MalSequential(aste[0]);
-        if (ast0_seq.elements[0] == sym_splice_unquote)
-        {
-            return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
-        }
-    }
-
-    return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
+    MalType res = new MalList([]);;
+    foreach_reverse (elt; ast_seq.elements)
+        if (starts_with(elt, sym_splice_unquote))
+            res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
+        else
+            res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
+    if (cast(MalVector) ast)
+        res = new MalList([new MalSymbol("vec"), res]);
+    return res;
 }
 
 bool is_macro_call(MalType ast, Env env)
@@ -155,6 +155,9 @@ MalType EVAL(MalType ast, Env env)
             case "quote":
                 return aste[1];
 
+            case "quasiquoteexpand":
+                return quasiquote(aste[1]);
+
             case "quasiquote":
                 ast = quasiquote(aste[1]);
                 continue; // TCO

impls/d/step9_try.d

@@ -13,36 +13,36 @@ import reader;
 import printer;
 import types;
 
-bool is_pair(MalType ast)
+bool starts_with(MalType ast, MalSymbol sym)
 {
-    auto lst = cast(MalSequential) ast;
+    auto lst = cast(MalList) ast;
     if (lst is null) return false;
-    return lst.elements.length > 0;
+    auto lste = lst.elements;
+    return lste.length > 0 && lste[0] == sym;
 }
 
 MalType quasiquote(MalType ast)
 {
-    if (!is_pair(ast))
-    {
+    if (cast(MalSymbol)ast || cast(MalHashmap)ast)
         return new MalList([sym_quote, ast]);
-    }
-    auto ast_seq = verify_cast!MalSequential(ast);
+
+    auto ast_seq = cast(MalSequential) ast;
+    if (ast_seq is null)
+        return ast;
+
     auto aste = ast_seq.elements;
-    if (aste[0] == sym_unquote)
-    {
+    if (starts_with(ast, sym_unquote))
         return aste[1];
-    }
 
-    if (is_pair(aste[0]))
-    {
-        auto ast0_seq = verify_cast!MalSequential(aste[0]);
-        if (ast0_seq.elements[0] == sym_splice_unquote)
-        {
-            return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
-        }
-    }
-
-    return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
+    MalType res = new MalList([]);;
+    foreach_reverse (elt; ast_seq.elements)
+        if (starts_with(elt, sym_splice_unquote))
+            res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
+        else
+            res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
+    if (cast(MalVector) ast)
+        res = new MalList([new MalSymbol("vec"), res]);
+    return res;
 }
 
 bool is_macro_call(MalType ast, Env env)
@@ -155,6 +155,9 @@ MalType EVAL(MalType ast, Env env)
             case "quote":
                 return aste[1];
 
+            case "quasiquoteexpand":
+                return quasiquote(aste[1]);
+
             case "quasiquote":
                 ast = quasiquote(aste[1]);
                 continue; // TCO

impls/d/stepA_mal.d

@@ -14,36 +14,36 @@ import reader;
 import printer;
 import types;
 
-bool is_pair(MalType ast)
+bool starts_with(MalType ast, MalSymbol sym)
 {
-    auto lst = cast(MalSequential) ast;
+    auto lst = cast(MalList) ast;
     if (lst is null) return false;
-    return lst.elements.length > 0;
+    auto lste = lst.elements;
+    return lste.length > 0 && lste[0] == sym;
 }
 
 MalType quasiquote(MalType ast)
 {
-    if (!is_pair(ast))
-    {
+    if (cast(MalSymbol)ast || cast(MalHashmap)ast)
         return new MalList([sym_quote, ast]);
-    }
-    auto ast_seq = verify_cast!MalSequential(ast);
+
+    auto ast_seq = cast(MalSequential) ast;
+    if (ast_seq is null)
+        return ast;
+
     auto aste = ast_seq.elements;
-    if (aste[0] == sym_unquote)
-    {
+    if (starts_with(ast, sym_unquote))
         return aste[1];
-    }
 
-    if (is_pair(aste[0]))
-    {
-        auto ast0_seq = verify_cast!MalSequential(aste[0]);
-        if (ast0_seq.elements[0] == sym_splice_unquote)
-        {
-            return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
-        }
-    }
-
-    return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
+    MalType res = new MalList([]);;
+    foreach_reverse (elt; ast_seq.elements)
+        if (starts_with(elt, sym_splice_unquote))
+            res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
+        else
+            res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
+    if (cast(MalVector) ast)
+        res = new MalList([new MalSymbol("vec"), res]);
+    return res;
 }
 
 bool is_macro_call(MalType ast, Env env)
@@ -156,6 +156,9 @@ MalType EVAL(MalType ast, Env env)
             case "quote":
                 return aste[1];
 
+            case "quasiquoteexpand":
+                return quasiquote(aste[1]);
+
             case "quasiquote":
                 ast = quasiquote(aste[1]);
                 continue; // TCO

impls/dart/core.dart

@@ -125,6 +125,13 @@ Map<MalSymbol, MalBuiltin> ns = <MalSymbol, MalBuiltin>{
     }
     return new MalList(results);
   }),
+  new MalSymbol('vec'): new MalBuiltin((List<MalType> args) {
+    if (args.length == 1) {
+      if (args[0] is MalVector) return args[0];
+      if (args[0] is MalList)   return new MalVector(args[0].elements);
+    }
+    throw new MalException(new MalString("vec: wrong arguments"));
+  }),
   new MalSymbol('nth'): new MalBuiltin((List<MalType> args) {
     var indexable = args[0] as MalIterable;
     var index = args[1] as MalInt;

impls/dart/step7_quote.dart

@@ -23,31 +23,33 @@ void setupEnv(List<String> argv) {
       "(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))");
 }
 
-MalType quasiquote(MalType ast) {
-  bool isPair(MalType ast) {
-    return ast is MalIterable && ast.isNotEmpty;
-  }
+bool starts_with(MalType ast, String sym) {
+  return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
+}
 
-  if (!isPair(ast)) {
+MalType qq_loop(List<MalType> xs) {
+  var acc = new MalList([]);
+  for (var i=xs.length-1; 0<=i; i-=1) {
+    if (starts_with(xs[i], "splice-unquote")) {
+      acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]);
+    } else {
+      acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]);
+    }
+  }
+  return acc;
+}
+
+MalType quasiquote(MalType ast) {
+  if (starts_with(ast, "unquote")) {
+    return (ast as MalList).elements[1];
+  } else if (ast is MalList) {
+    return qq_loop(ast.elements);
+  } else if (ast is MalVector) {
+    return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]);
+  } else if (ast is MalSymbol || ast is MalHashMap) {
     return new MalList([new MalSymbol("quote"), ast]);
   } else {
-    var list = ast as MalIterable;
-    if (list.first == new MalSymbol("unquote")) {
-      return list[1];
-    } else if (isPair(list.first) &&
-        (list.first as MalIterable).first == new MalSymbol("splice-unquote")) {
-      return new MalList([
-        new MalSymbol("concat"),
-        (list.first as MalIterable)[1],
-        quasiquote(new MalList(list.sublist(1)))
-      ]);
-    } else {
-      return new MalList([
-        new MalSymbol("cons"),
-        quasiquote(list[0]),
-        quasiquote(new MalList(list.sublist(1)))
-      ]);
-    }
+    return ast;
   }
 }
 
@@ -142,6 +144,8 @@ MalType EVAL(MalType ast, Env env) {
                     EVAL(args[1], new Env(env, params, funcArgs)));
           } else if (symbol.value == "quote") {
             return args.single;
+          } else if (symbol.value == "quasiquoteexpand") {
+            return quasiquote(args.first);
           } else if (symbol.value == "quasiquote") {
             ast = quasiquote(args.first);
             continue;

impls/dart/step8_macros.dart

@@ -58,31 +58,33 @@ MalType macroexpand(MalType ast, Env env) {
   return ast;
 }
 
-MalType quasiquote(MalType ast) {
-  bool isPair(MalType ast) {
-    return ast is MalIterable && ast.isNotEmpty;
-  }
+bool starts_with(MalType ast, String sym) {
+  return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
+}
 
-  if (!isPair(ast)) {
+MalType qq_loop(List<MalType> xs) {
+  var acc = new MalList([]);
+  for (var i=xs.length-1; 0<=i; i-=1) {
+    if (starts_with(xs[i], "splice-unquote")) {
+      acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]);
+    } else {
+      acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]);
+    }
+  }
+  return acc;
+}
+
+MalType quasiquote(MalType ast) {
+  if (starts_with(ast, "unquote")) {
+    return (ast as MalList).elements[1];
+  } else if (ast is MalList) {
+    return qq_loop(ast.elements);
+  } else if (ast is MalVector) {
+    return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]);
+  } else if (ast is MalSymbol || ast is MalHashMap) {
     return new MalList([new MalSymbol("quote"), ast]);
   } else {
-    var list = ast as MalIterable;
-    if (list.first == new MalSymbol("unquote")) {
-      return list[1];
-    } else if (isPair(list.first) &&
-        (list.first as MalIterable).first == new MalSymbol("splice-unquote")) {
-      return new MalList([
-        new MalSymbol("concat"),
-        (list.first as MalIterable)[1],
-        quasiquote(new MalList(list.sublist(1)))
-      ]);
-    } else {
-      return new MalList([
-        new MalSymbol("cons"),
-        quasiquote(list[0]),
-        quasiquote(new MalList(list.sublist(1)))
-      ]);
-    }
+    return ast;
   }
 }
 
@@ -184,6 +186,8 @@ MalType EVAL(MalType ast, Env env) {
                     EVAL(args[1], new Env(env, params, funcArgs)));
           } else if (symbol.value == "quote") {
             return args.single;
+          } else if (symbol.value == "quasiquoteexpand") {
+            return quasiquote(args.first);
           } else if (symbol.value == "quasiquote") {
             ast = quasiquote(args.first);
             continue;

impls/dart/step9_try.dart

@@ -58,31 +58,33 @@ MalType macroexpand(MalType ast, Env env) {
   return ast;
 }
 
-MalType quasiquote(MalType ast) {
-  bool isPair(MalType ast) {
-    return ast is MalIterable && ast.isNotEmpty;
-  }
+bool starts_with(MalType ast, String sym) {
+  return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
+}
 
-  if (!isPair(ast)) {
+MalType qq_loop(List<MalType> xs) {
+  var acc = new MalList([]);
+  for (var i=xs.length-1; 0<=i; i-=1) {
+    if (starts_with(xs[i], "splice-unquote")) {
+      acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]);
+    } else {
+      acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]);
+    }
+  }
+  return acc;
+}
+
+MalType quasiquote(MalType ast) {
+  if (starts_with(ast, "unquote")) {
+    return (ast as MalList).elements[1];
+  } else if (ast is MalList) {
+    return qq_loop(ast.elements);
+  } else if (ast is MalVector) {
+    return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]);
+  } else if (ast is MalSymbol || ast is MalHashMap) {
     return new MalList([new MalSymbol("quote"), ast]);
   } else {
-    var list = ast as MalIterable;
-    if (list.first == new MalSymbol("unquote")) {
-      return list[1];
-    } else if (isPair(list.first) &&
-        (list.first as MalIterable).first == new MalSymbol("splice-unquote")) {
-      return new MalList([
-        new MalSymbol("concat"),
-        (list.first as MalIterable)[1],
-        quasiquote(new MalList(list.sublist(1)))
-      ]);
-    } else {
-      return new MalList([
-        new MalSymbol("cons"),
-        quasiquote(list[0]),
-        quasiquote(new MalList(list.sublist(1)))
-      ]);
-    }
+    return ast;
   }
 }
 
@@ -184,6 +186,8 @@ MalType EVAL(MalType ast, Env env) {
                     EVAL(args[1], new Env(env, params, funcArgs)));
           } else if (symbol.value == "quote") {
             return args.single;
+          } else if (symbol.value == "quasiquoteexpand") {
+            return quasiquote(args.first);
           } else if (symbol.value == "quasiquote") {
             ast = quasiquote(args.first);
             continue;

impls/dart/stepA_mal.dart

@@ -60,31 +60,33 @@ MalType macroexpand(MalType ast, Env env) {
   return ast;
 }
 
-MalType quasiquote(MalType ast) {
-  bool isPair(MalType ast) {
-    return ast is MalIterable && ast.isNotEmpty;
-  }
+bool starts_with(MalType ast, String sym) {
+  return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
+}
 
-  if (!isPair(ast)) {
+MalType qq_loop(List<MalType> xs) {
+  var acc = new MalList([]);
+  for (var i=xs.length-1; 0<=i; i-=1) {
+    if (starts_with(xs[i], "splice-unquote")) {
+      acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]);
+    } else {
+      acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]);
+    }
+  }
+  return acc;
+}
+
+MalType quasiquote(MalType ast) {
+  if (starts_with(ast, "unquote")) {
+    return (ast as MalList).elements[1];
+  } else if (ast is MalList) {
+    return qq_loop(ast.elements);
+  } else if (ast is MalVector) {
+    return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]);
+  } else if (ast is MalSymbol || ast is MalHashMap) {
     return new MalList([new MalSymbol("quote"), ast]);
   } else {
-    var list = ast as MalIterable;
-    if (list.first == new MalSymbol("unquote")) {
-      return list[1];
-    } else if (isPair(list.first) &&
-        (list.first as MalIterable).first == new MalSymbol("splice-unquote")) {
-      return new MalList([
-        new MalSymbol("concat"),
-        (list.first as MalIterable)[1],
-        quasiquote(new MalList(list.sublist(1)))
-      ]);
-    } else {
-      return new MalList([
-        new MalSymbol("cons"),
-        quasiquote(list[0]),
-        quasiquote(new MalList(list.sublist(1)))
-      ]);
-    }
+    return ast;
   }
 }
 
@@ -186,6 +188,8 @@ MalType EVAL(MalType ast, Env env) {
                     EVAL(args[1], new Env(env, params, funcArgs)));
           } else if (symbol.value == "quote") {
             return args.single;
+          } else if (symbol.value == "quasiquoteexpand") {
+            return quasiquote(args.first);
           } else if (symbol.value == "quasiquote") {
             ast = quasiquote(args.first);
             continue;

impls/elisp/mal/core.el

@@ -1,79 +1,52 @@
+(require 'cl-lib)
+
 (defun mal-seq-p (mal-object)
-  (let ((type (mal-type mal-object)))
-    (if (or (eq type 'list) (eq type 'vector))
-        mal-true
-      mal-false)))
+  (memq (mal-type mal-object) '(list vector)))
 
 (defun mal-listify (mal-object)
-  (let ((type (mal-type mal-object)))
-    (if (eq type 'vector)
-        (append (mal-value mal-object) nil)
-      (mal-value mal-object))))
+  (cl-ecase (mal-type mal-object)
+    (list   (mal-value mal-object))
+    (vector (append (mal-value mal-object) nil))))
 
 (defun mal-= (a b)
-  (let ((a-type (mal-type a))
-        (b-type (mal-type b)))
-    (cond
-     ((and (and (not (eq a-type 'map))
-                (not (eq a-type 'list))
-                (not (eq a-type 'vector)))
-           (and (not (eq b-type 'map))
-                (not (eq b-type 'list))
-                (not (eq b-type 'vector))))
-      (mal-atom-= a b))
-     ((and (or (eq a-type 'list) (eq a-type 'vector))
-           (or (eq b-type 'list) (eq b-type 'vector)))
-      (mal-seq-= a b))
-     ((and (eq a-type 'map) (eq b-type 'map))
-      (mal-map-= a b))
-     (t
-      ;; incompatible types
-      nil))))
-
-(defun mal-atom-= (a b)
-  (equal (mal-value a) (mal-value b)))
+  (cl-case (mal-type a)
+    ((list vector) (and (mal-seq-p b)
+                        (mal-seq-= (mal-listify a) (mal-listify b))))
+    (map           (and (mal-map-p b)
+                        (mal-map-= (mal-value a) (mal-value b))))
+    (t             (equal (mal-value a) (mal-value b)))))
 
 (defun mal-seq-= (a b)
-  (when (= (length (mal-value a))
-           (length (mal-value b)))
-    (when (everyp 'mal-= (mal-listify a) (mal-listify b))
-      t)))
-
-(defun everyp (predicate list-a list-b)
-  (let ((everyp t))
-    (while (and everyp list-a list-b)
-      (let ((item-a (pop list-a))
-            (item-b (pop list-b)))
-        (when (not (funcall predicate item-a item-b))
-          (setq everyp nil))))
-    everyp))
+  (if a
+      (and b
+           (mal-= (car a) (car b))
+           (mal-seq-= (cdr a) (cdr b)))
+    (null b)))
 
 (defun mal-map-= (a b)
-  (catch 'return
-    (let ((a* (mal-value a))
-          (b* (mal-value b)))
-      (when (= (hash-table-count a*)
-               (hash-table-count b*))
-        (maphash (lambda (key a-value)
-                   (let ((b-value (gethash key b*)))
-                     (if b-value
-                         (when (not (mal-= a-value b-value))
-                           (throw 'return nil))
-                       (throw 'return nil))))
-                 a*)
-        ;; if we made it this far, the maps are equal
-        t))))
+  (when (= (hash-table-count a)
+           (hash-table-count b))
+    (catch 'return
+      (maphash (lambda (key a-value)
+                 (let ((b-value (gethash key b)))
+                   (unless (and b-value
+                                (mal-= a-value b-value))
+                     (throw 'return nil))))
+               a)
+      ;; if we made it this far, the maps are equal
+      t)))
 
 (define-hash-table-test 'mal-= 'mal-= 'sxhash)
 
 (defun mal-conj (seq &rest args)
-  (let ((type (mal-type seq))
-        (value (mal-value seq)))
-    (if (eq type 'vector)
-        (mal-vector (vconcat (append (append value nil) args)))
+  (let ((value (mal-value seq)))
+    (cl-ecase (mal-type seq)
+     (vector
+        (mal-vector (vconcat (append (append value nil) args))))
+     (list
       (while args
         (push (pop args) value))
-      (mal-list value))))
+      (mal-list value)))))
 
 (defun elisp-to-mal (arg)
   (cond
@@ -143,6 +116,7 @@
                                (value (apply (mal-value fn*) args*)))
                           (setf (aref atom 1) value)))))
 
+    (vec . ,(mal-fn (lambda (seq) (if (mal-vector-p seq) seq (mal-vector (mal-value seq))))))
     (cons . ,(mal-fn (lambda (arg list) (mal-list (cons arg (mal-listify list))))))
     (concat . ,(mal-fn (lambda (&rest lists)
                          (let ((lists* (mapcar (lambda (item) (mal-listify item)) lists)))
@@ -156,10 +130,8 @@
     (first . ,(mal-fn (lambda (seq)
                         (if (mal-nil-p seq)
                             mal-nil
-                          (let* ((list (mal-listify seq))
-                                 (value (car list)))
-                            (or value mal-nil))))))
-    (rest . ,(mal-fn (lambda (seq) (mal-list (cdr (mal-listify seq))))))
+                          (or (car (mal-listify seq)) mal-nil)))))
+    (rest . ,(mal-fn (lambda (seq) (mal-list (unless (mal-nil-p seq) (cdr (mal-listify seq)))))))
 
     (throw . ,(mal-fn (lambda (mal-object) (signal 'mal-custom (list mal-object)))))
 
@@ -185,7 +157,7 @@
     (map? . ,(mal-fn (lambda (arg) (if (mal-map-p arg) mal-true mal-false))))
 
     (symbol . ,(mal-fn (lambda (string) (mal-symbol (intern (mal-value string))))))
-    (keyword . ,(mal-fn (lambda (string) (mal-keyword (intern (concat ":" (mal-value string)))))))
+    (keyword . ,(mal-fn (lambda (x) (if (mal-keyword-p x) x (mal-keyword (intern (concat ":" (mal-value x))))))))
     (vector . ,(mal-fn (lambda (&rest args) (mal-vector (vconcat args)))))
     (hash-map . ,(mal-fn (lambda (&rest args)
                            (let ((map (make-hash-table :test 'mal-=)))
@@ -193,7 +165,7 @@
                                (puthash (pop args) (pop args) map))
                              (mal-map map)))))
 
-    (sequential? . ,(mal-fn 'mal-seq-p))
+    (sequential? . ,(mal-fn (lambda (mal-object) (if (mal-seq-p mal-object) mal-true mal-false))))
     (fn? . ,(mal-fn (lambda (arg) (if (or (mal-fn-p arg)
                                           (and (mal-func-p arg)
                                                (not (mal-func-macro-p arg))))

impls/elisp/mal/printer.el

@@ -1,34 +1,35 @@
+(require 'cl-lib)
+
 (defun pr-str (form &optional print-readably)
-  (let ((type (mal-type form))
-        (value (mal-value form)))
-    (cond
-     ((eq type 'nil)
+  (let ((value (mal-value form)))
+    (cl-ecase (mal-type form)
+     ('nil
       "nil")
-     ((eq type 'true)
+     (true
       "true")
-     ((eq type 'false)
+     (false
       "false")
-     ((eq type 'number)
-      (number-to-string (mal-value form)))
-     ((eq type 'string)
+     (number
+      (number-to-string value))
+     (string
       (if print-readably
           (let ((print-escape-newlines t))
             (prin1-to-string value))
         value))
-     ((or (eq type 'symbol) (eq type 'keyword))
+     ((symbol keyword)
       (symbol-name value))
-     ((eq type 'list)
+     (list
       (pr-list value print-readably))
-     ((eq type 'vector)
+     (vector
       (pr-vector value print-readably))
-     ((eq type 'map)
+     (map
       (pr-map value print-readably))
-     ((eq type 'fn)
+     (fn
       "#<fn>")
-     ((eq type 'func)
+     (func
       "#<func>")
-     ((eq type 'atom)
-      (format "(atom %s)" (mal-value value))))))
+     (atom
+      (format "(atom %s)" (pr-str value print-readably))))))
 
 (defun pr-list (form print-readably)
   (let ((items (mapconcat

impls/elisp/mal/reader.el

@@ -1,3 +1,5 @@
+(require 'cl-lib)
+
 ;; HACK: `text-quoting-style' prettifies quotes in error messages on
 ;; Emacs 25, but no longer does from 26 upwards...
 (when (= emacs-major-version 25)
@@ -33,29 +35,28 @@
       (nreverse output))))
 
 (defun read-form ()
-  (let ((token (peek)))
-    (cond
-     ((string= token "'")
+  (pcase (peek)
+    ("'"
       (read-quote))
-     ((string= token "`")
+    ("`"
       (read-quasiquote))
-     ((string= token "~")
+    ("~"
       (read-unquote))
-     ((string= token "~@")
+    ("~@"
       (read-splice-unquote))
-     ((string= token "@")
+    ("@"
       (read-deref))
-     ((string= token "^")
+    ("^"
       (read-with-meta))
-     ((string= token "(")
+    ("("
       (read-list))
-     ((string= token "[")
+    ("["
       (read-vector))
-     ((string= token "{")
+    ("{"
       (read-map))
-     (t
+    (_
       ;; assume anything else is an atom
-      (read-atom)))))
+      (read-atom))))
 
 (defun read-simple-reader-macro (symbol)
   (next) ; pop reader macro token

impls/elisp/step1_read_print.el

@@ -35,14 +35,12 @@
                ;; empty input, carry on
                )
               (unterminated-sequence
-               (let* ((type (cadr err))
-                      (end
-                       (cond
-                        ((eq type 'string) ?\")
-                        ((eq type 'list) ?\))
-                        ((eq type 'vector) ?\])
-                        ((eq type 'map) ?}))))
-                 (princ (format "Expected '%c', got EOF\n" end))))
+               (princ (format "Expected '%c', got EOF\n"
+                              (cl-case (cadr err)
+                                (string ?\")
+                                (list   ?\))
+                                (vector ?\])
+                                (map    ?})))))
               (error ; catch-all
                (println (error-message-string err))
                (backtrace)))

impls/elisp/step2_eval.el

@@ -20,20 +20,19 @@
     (eval-ast ast env)))
 
 (defun eval-ast (ast env)
-  (let ((type (mal-type ast))
-        (value (mal-value ast)))
-    (cond
-     ((eq type 'symbol)
+  (let ((value (mal-value ast)))
+    (cl-case (mal-type ast)
+     (symbol
       (let ((definition (gethash value env)))
         (or definition (error "Definition not found"))))
-     ((eq type 'list)
+     (list
       (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
-     ((eq type 'vector)
+     (vector
       (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
-     ((eq type 'map)
+     (map
       (let ((map (copy-hash-table value)))
-        (maphash (lambda (key value)
-                   (puthash key (EVAL value env) map))
+        (maphash (lambda (key val)
+                   (puthash key (EVAL val env) map))
                  map)
         (mal-map map)))
      (t
@@ -67,14 +66,12 @@
                ;; empty input, carry on
                )
               (unterminated-sequence
-               (let* ((type (cadr err))
-                      (end
-                       (cond
-                        ((eq type 'string) ?\")
-                        ((eq type 'list) ?\))
-                        ((eq type 'vector) ?\])
-                        ((eq type 'map) ?}))))
-                 (princ (format "Expected '%c', got EOF\n" end))))
+               (princ (format "Expected '%c', got EOF\n"
+                              (cl-case (cadr err)
+                                (string ?\")
+                                (list   ?\))
+                                (vector ?\])
+                                (map    ?})))))
               (error ; catch-all
                (println (error-message-string err))
                (backtrace)))

impls/elisp/step3_env.el

@@ -15,17 +15,15 @@
 (defun EVAL (ast env)
   (if (and (mal-list-p ast) (mal-value ast))
       (let* ((a (mal-value ast))
-             (a0 (car a))
-             (a0* (mal-value a0))
              (a1 (cadr a))
              (a1* (mal-value a1))
              (a2 (nth 2 a)))
-        (cond
-         ((eq a0* 'def!)
+        (cl-case (mal-value (car a))
+         (def!
           (let ((identifier a1*)
                 (value (EVAL a2 env)))
             (mal-env-set env identifier value)))
-         ((eq a0* 'let*)
+         (let*
           (let ((env* (mal-env env))
                 (bindings (if (vectorp a1*) (append a1* nil) a1*))
                 (form a2))
@@ -43,20 +41,19 @@
     (eval-ast ast env)))
 
 (defun eval-ast (ast env)
-  (let ((type (mal-type ast))
-        (value (mal-value ast)))
-    (cond
-     ((eq type 'symbol)
+  (let ((value (mal-value ast)))
+    (cl-case (mal-type ast)
+     (symbol
       (let ((definition (mal-env-get env value)))
         (or definition (error "Definition not found"))))
-     ((eq type 'list)
+     (list
       (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
-     ((eq type 'vector)
+     (vector
       (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
-     ((eq type 'map)
+     (map
       (let ((map (copy-hash-table value)))
-        (maphash (lambda (key value)
-                   (puthash key (EVAL value env) map))
+        (maphash (lambda (key val)
+                   (puthash key (EVAL val env) map))
                  map)
         (mal-map map)))
      (t
@@ -90,14 +87,12 @@
                ;; empty input, carry on
                )
               (unterminated-sequence
-               (let* ((type (cadr err))
-                      (end
-                       (cond
-                        ((eq type 'string) ?\")
-                        ((eq type 'list) ?\))
-                        ((eq type 'vector) ?\])
-                        ((eq type 'map) ?}))))
-                 (princ (format "Expected '%c', got EOF\n" end))))
+               (princ (format "Expected '%c', got EOF\n"
+                              (cl-case (cadr err)
+                                (string ?\")
+                                (list   ?\))
+                                (vector ?\])
+                                (map    ?})))))
               (error ; catch-all
                (println (error-message-string err))))
           (setq eof t)

impls/elisp/step4_if_fn_do.el

@@ -19,29 +19,26 @@
 (defun EVAL (ast env)
   (if (and (mal-list-p ast) (mal-value ast))
       (let* ((a (mal-value ast))
-             (a0 (car a))
-             (a0* (mal-value a0))
              (a1 (cadr a))
              (a2 (nth 2 a))
              (a3 (nth 3 a)))
-        (cond
-         ((eq a0* 'def!)
+        (cl-case (mal-value (car a))
+         (def!
           (let ((identifier (mal-value a1))
                 (value (EVAL a2 env)))
             (mal-env-set env identifier value)))
-         ((eq a0* 'let*)
-          (let* ((env* (mal-env env))
-                 (a1* (mal-value a1))
-                 (bindings (if (vectorp a1*) (append a1* nil) a1*))
-                 (form a2))
+         (let*
+          (let ((env* (mal-env env))
+                (bindings (mal-listify a1))
+                (form a2))
             (while bindings
               (let ((key (mal-value (pop bindings)))
                     (value (EVAL (pop bindings) env*)))
                 (mal-env-set env* key value)))
             (EVAL form env*)))
-         ((eq a0* 'do)
+         (do
           (car (last (mal-value (eval-ast (mal-list (cdr a)) env)))))
-         ((eq a0* 'if)
+         (if
           (let* ((condition (EVAL a1 env))
                  (condition-type (mal-type condition))
                  (then a2)
@@ -52,7 +49,7 @@
               (if else
                   (EVAL else env)
                 mal-nil))))
-         ((eq a0* 'fn*)
+         (fn*
           (let ((binds (mapcar 'mal-value (mal-value a1)))
                 (body a2))
             (mal-fn
@@ -62,31 +59,25 @@
          (t
           ;; not a special form
           (let* ((ast* (mal-value (eval-ast ast env)))
-                 (fn (car ast*))
-                 (fn* (cond
-                       ((functionp fn)
-                        fn)
-                       ((mal-fn-p fn)
-                        (mal-value fn))))
+                 (fn* (mal-value (car ast*)))
                  (args (cdr ast*)))
             (apply fn* args)))))
     (eval-ast ast env)))
 
 (defun eval-ast (ast env)
-  (let ((type (mal-type ast))
-        (value (mal-value ast)))
-    (cond
-     ((eq type 'symbol)
+  (let ((value (mal-value ast)))
+    (cl-case (mal-type ast)
+     (symbol
       (let ((definition (mal-env-get env value)))
         (or definition (error "Definition not found"))))
-     ((eq type 'list)
+     (list
       (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
-     ((eq type 'vector)
+     (vector
       (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
-     ((eq type 'map)
+     (map
       (let ((map (copy-hash-table value)))
-        (maphash (lambda (key value)
-                   (puthash key (EVAL value env) map))
+        (maphash (lambda (key val)
+                   (puthash key (EVAL val env) map))
                  map)
         (mal-map map)))
      (t
@@ -122,14 +113,12 @@
                ;; empty input, carry on
                )
               (unterminated-sequence
-               (let* ((type (cadr err))
-                      (end
-                       (cond
-                        ((eq type 'string) ?\")
-                        ((eq type 'list) ?\))
-                        ((eq type 'vector) ?\])
-                        ((eq type 'map) ?}))))
-                 (princ (format "Expected '%c', got EOF\n" end))))
+               (princ (format "Expected '%c', got EOF\n"
+                              (cl-case (cadr err)
+                                (string ?\")
+                                (list   ?\))
+                                (vector ?\])
+                                (map    ?})))))
               (error ; catch-all
                (println (error-message-string err))))
           (setq eof t)

impls/elisp/step5_tco.el

@@ -23,36 +23,32 @@
     (while t
       (if (and (mal-list-p ast) (mal-value ast))
           (let* ((a (mal-value ast))
-                 (a0 (car a))
-                 (a0* (mal-value a0))
                  (a1 (cadr a))
                  (a2 (nth 2 a))
                  (a3 (nth 3 a)))
-            (cond
-             ((eq a0* 'def!)
+            (cl-case (mal-value (car a))
+             (def!
               (let ((identifier (mal-value a1))
                     (value (EVAL a2 env)))
                 (throw 'return (mal-env-set env identifier value))))
-             ((eq a0* 'let*)
-              (let* ((env* (mal-env env))
-                     (bindings (mal-value a1))
-                     (form a2))
-                (when (vectorp bindings)
-                  (setq bindings (append bindings nil)))
+             (let*
+              (let ((env* (mal-env env))
+                    (bindings (mal-listify a1))
+                    (form a2))
                 (while bindings
                   (let ((key (mal-value (pop bindings)))
                         (value (EVAL (pop bindings) env*)))
                     (mal-env-set env* key value)))
                 (setq env env*
                       ast form))) ; TCO
-             ((eq a0* 'do)
+             (do
               (let* ((a0... (cdr a))
                      (butlast (butlast a0...))
                      (last (car (last a0...))))
                 (when butlast
                   (eval-ast (mal-list butlast) env))
                 (setq ast last))) ; TCO
-             ((eq a0* 'if)
+             (if
               (let* ((condition (EVAL a1 env))
                      (condition-type (mal-type condition))
                      (then a2)
@@ -63,7 +59,7 @@
                   (if else
                       (setq ast else) ; TCO
                     (throw 'return mal-nil)))))
-             ((eq a0* 'fn*)
+             (fn*
               (let* ((binds (mapcar 'mal-value (mal-value a1)))
                      (body a2)
                      (fn (mal-fn
@@ -82,29 +78,24 @@
                                          args)))
                       (setq env env*
                             ast (mal-func-ast fn))) ; TCO
-                  (let ((fn* (if (mal-fn-p fn)
-                                 ;; unbox user-defined function
-                                 (mal-value fn)
-                               ;; use built-in function
-                               fn)))
+                  (let ((fn* (mal-value fn)))
                     (throw 'return (apply fn* args))))))))
         (throw 'return (eval-ast ast env))))))
 
 (defun eval-ast (ast env)
-  (let ((type (mal-type ast))
-        (value (mal-value ast)))
-    (cond
-     ((eq type 'symbol)
+  (let ((value (mal-value ast)))
+    (cl-case (mal-type ast)
+     (symbol
       (let ((definition (mal-env-get env value)))
         (or definition (error "Definition not found"))))
-     ((eq type 'list)
+     (list
       (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
-     ((eq type 'vector)
+     (vector
       (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
-     ((eq type 'map)
+     (map
       (let ((map (copy-hash-table value)))
-        (maphash (lambda (key value)
-                   (puthash key (EVAL value env) map))
+        (maphash (lambda (key val)
+                   (puthash key (EVAL val env) map))
                  map)
         (mal-map map)))
      (t
@@ -140,14 +131,12 @@
                ;; empty input, carry on
                )
               (unterminated-sequence
-               (let* ((type (cadr err))
-                      (end
-                       (cond
-                        ((eq type 'string) ?\")
-                        ((eq type 'list) ?\))
-                        ((eq type 'vector) ?\])
-                        ((eq type 'map) ?}))))
-                 (princ (format "Expected '%c', got EOF\n" end))))
+               (princ (format "Expected '%c', got EOF\n"
+                              (cl-case (cadr err)
+                                (string ?\")
+                                (list   ?\))
+                                (vector ?\])
+                                (map    ?})))))
               (error ; catch-all
                (println (error-message-string err))))
           (setq eof t)

impls/elisp/step6_file.el

@@ -22,36 +22,32 @@
     (while t
       (if (and (mal-list-p ast) (mal-value ast))
           (let* ((a (mal-value ast))
-                 (a0 (car a))
-                 (a0* (mal-value a0))
                  (a1 (cadr a))
                  (a2 (nth 2 a))
                  (a3 (nth 3 a)))
-            (cond
-             ((eq a0* 'def!)
+            (cl-case (mal-value (car a))
+             (def!
               (let ((identifier (mal-value a1))
                     (value (EVAL a2 env)))
                 (throw 'return (mal-env-set env identifier value))))
-             ((eq a0* 'let*)
-              (let* ((env* (mal-env env))
-                     (bindings (mal-value a1))
-                     (form a2))
-                (when (vectorp bindings)
-                  (setq bindings (append bindings nil)))
+             (let*
+              (let ((env* (mal-env env))
+                    (bindings (mal-listify a1))
+                    (form a2))
                 (while bindings
                   (let ((key (mal-value (pop bindings)))
                         (value (EVAL (pop bindings) env*)))
                     (mal-env-set env* key value)))
                 (setq env env*
                       ast form))) ; TCO
-             ((eq a0* 'do)
+             (do
               (let* ((a0... (cdr a))
                      (butlast (butlast a0...))
                      (last (car (last a0...))))
                 (when butlast
                   (eval-ast (mal-list butlast) env))
                 (setq ast last))) ; TCO
-             ((eq a0* 'if)
+             (if
               (let* ((condition (EVAL a1 env))
                      (condition-type (mal-type condition))
                      (then a2)
@@ -62,7 +58,7 @@
                   (if else
                       (setq ast else) ; TCO
                     (throw 'return mal-nil)))))
-             ((eq a0* 'fn*)
+             (fn*
               (let* ((binds (mapcar 'mal-value (mal-value a1)))
                      (body a2)
                      (fn (mal-fn
@@ -87,20 +83,19 @@
         (throw 'return (eval-ast ast env))))))
 
 (defun eval-ast (ast env)
-  (let ((type (mal-type ast))
-        (value (mal-value ast)))
-    (cond
-     ((eq type 'symbol)
+  (let ((value (mal-value ast)))
+    (cl-case (mal-type ast)
+     (symbol
       (let ((definition (mal-env-get env value)))
         (or definition (error "Definition not found"))))
-     ((eq type 'list)
+     (list
       (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
-     ((eq type 'vector)
+     (vector
       (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
-     ((eq type 'map)
+     (map
       (let ((map (copy-hash-table value)))
-        (maphash (lambda (key value)
-                   (puthash key (EVAL value env) map))
+        (maphash (lambda (key val)
+                   (puthash key (EVAL val env) map))
                  map)
         (mal-map map)))
      (t
@@ -136,14 +131,12 @@
       ;; empty input, carry on
       )
      (unterminated-sequence
-      (let* ((type (cadr err))
-             (end
-              (cond
-               ((eq type 'string) ?\")
-               ((eq type 'list) ?\))
-               ((eq type 'vector) ?\])
-               ((eq type 'map) ?}))))
-        (princ (format "Expected '%c', got EOF\n" end))))
+      (princ (format "Expected '%c', got EOF\n"
+                     (cl-case (cadr err)
+                       (string ?\")
+                       (list   ?\))
+                       (vector ?\])
+                       (map    ?})))))
      (error ; catch-all
       (println (error-message-string err)))))
 

impls/elisp/step7_quote.el

@@ -1,5 +1,6 @@
 ;; -*- lexical-binding: t; -*-
 
+(require 'cl-lib)
 (require 'mal/types)
 (require 'mal/func)
 (require 'mal/env)
@@ -14,34 +15,30 @@
         (fn (cdr binding)))
     (mal-env-set repl-env symbol fn)))
 
-(defun mal-pair-p (mal-object)
-  (let ((type (mal-type mal-object))
-        (value (mal-value mal-object)))
-    (if (and (or (eq type 'list) (eq type 'vector))
-             (not (zerop (length value))))
-        t
-      nil)))
+(defun starts-with-p (ast sym)
+  (let ((l (mal-value ast)))
+    (and l
+         (let ((s (car l)))
+           (and (mal-symbol-p s)
+                (eq (mal-value s) sym))))))
+
+(defun qq-reducer (elt acc)
+  (mal-list (if (and (mal-list-p elt)
+                     (starts-with-p elt 'splice-unquote))
+                (list (mal-symbol 'concat) (cadr (mal-value elt)) acc)
+              (list (mal-symbol 'cons) (quasiquote elt) acc))))
+
+(defun qq-iter (elts)
+  (cl-reduce 'qq-reducer elts :from-end t :initial-value (mal-list nil)))
 
 (defun quasiquote (ast)
-  (if (not (mal-pair-p ast))
-      (mal-list (list (mal-symbol 'quote) ast))
-    (let* ((a (mal-listify ast))
-           (a0 (car a))
-           (a0... (cdr a))
-           (a1 (cadr a)))
-      (cond
-       ((eq (mal-value a0) 'unquote)
-        a1)
-       ((and (mal-pair-p a0)
-             (eq (mal-value (car (mal-value a0)))
-                 'splice-unquote))
-        (mal-list (list (mal-symbol 'concat)
-                        (cadr (mal-value a0))
-                        (quasiquote (mal-list a0...)))))
-       (t
-        (mal-list (list (mal-symbol 'cons)
-                        (quasiquote a0)
-                        (quasiquote (mal-list a0...)))))))))
+  (cl-case (mal-type ast)
+    (list         (if (starts-with-p ast 'unquote)
+                      (cadr (mal-value ast))
+                    (qq-iter (mal-value ast))))
+    (vector       (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast)))))
+    ((map symbol) (mal-list (list (mal-symbol 'quote) ast)))
+    (t            ast)))
 
 (defun READ (input)
   (read-str input))
@@ -51,40 +48,38 @@
     (while t
       (if (and (mal-list-p ast) (mal-value ast))
           (let* ((a (mal-value ast))
-                 (a0 (car a))
-                 (a0* (mal-value a0))
                  (a1 (cadr a))
                  (a2 (nth 2 a))
                  (a3 (nth 3 a)))
-            (cond
-             ((eq a0* 'def!)
+            (cl-case (mal-value (car a))
+             (def!
               (let ((identifier (mal-value a1))
                     (value (EVAL a2 env)))
                 (throw 'return (mal-env-set env identifier value))))
-             ((eq a0* 'let*)
-              (let* ((env* (mal-env env))
-                     (bindings (mal-value a1))
-                     (form a2))
-                (when (vectorp bindings)
-                  (setq bindings (append bindings nil)))
+             (let*
+              (let ((env* (mal-env env))
+                    (bindings (mal-listify a1))
+                    (form a2))
                 (while bindings
                   (let ((key (mal-value (pop bindings)))
                         (value (EVAL (pop bindings) env*)))
                     (mal-env-set env* key value)))
                 (setq env env*
                       ast form))) ; TCO
-             ((eq a0* 'quote)
+             (quote
               (throw 'return a1))
-             ((eq a0* 'quasiquote)
+             (quasiquoteexpand
+              (throw 'return (quasiquote a1)))
+             (quasiquote
               (setq ast (quasiquote a1))) ; TCO
-             ((eq a0* 'do)
+             (do
               (let* ((a0... (cdr a))
                      (butlast (butlast a0...))
                      (last (car (last a0...))))
                 (when butlast
                   (eval-ast (mal-list butlast) env))
                 (setq ast last))) ; TCO
-             ((eq a0* 'if)
+             (if
               (let* ((condition (EVAL a1 env))
                      (condition-type (mal-type condition))
                      (then a2)
@@ -95,7 +90,7 @@
                   (if else
                       (setq ast else) ; TCO
                     (throw 'return mal-nil)))))
-             ((eq a0* 'fn*)
+             (fn*
               (let* ((binds (mapcar 'mal-value (mal-value a1)))
                      (body a2)
                      (fn (mal-fn
@@ -120,20 +115,19 @@
         (throw 'return (eval-ast ast env))))))
 
 (defun eval-ast (ast env)
-  (let ((type (mal-type ast))
-        (value (mal-value ast)))
-    (cond
-     ((eq type 'symbol)
+  (let ((value (mal-value ast)))
+    (cl-case (mal-type ast)
+     (symbol
       (let ((definition (mal-env-get env value)))
         (or definition (error "Definition not found"))))
-     ((eq type 'list)
+     (list
       (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
-     ((eq type 'vector)
+     (vector
       (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
-     ((eq type 'map)
+     (map
       (let ((map (copy-hash-table value)))
-        (maphash (lambda (key value)
-                   (puthash key (EVAL value env) map))
+        (maphash (lambda (key val)
+                   (puthash key (EVAL val env) map))
                  map)
         (mal-map map)))
      (t
@@ -169,14 +163,12 @@
       ;; empty input, carry on
       )
      (unterminated-sequence
-      (let* ((type (cadr err))
-             (end
-              (cond
-               ((eq type 'string) ?\")
-               ((eq type 'list) ?\))
-               ((eq type 'vector) ?\])
-               ((eq type 'map) ?}))))
-        (princ (format "Expected '%c', got EOF\n" end))))
+      (princ (format "Expected '%c', got EOF\n"
+                     (cl-case (cadr err)
+                       (string ?\")
+                       (list   ?\))
+                       (vector ?\])
+                       (map    ?})))))
      (error ; catch-all
       (println (error-message-string err)))))