mirror of
https://github.com/kanaka/mal.git
synced 2024-08-17 01:30:26 +03:00
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
This commit is contained in:
parent
ece70f9703
commit
fbfe6784d2
@ -37,7 +37,7 @@ make REGRESS=1 TEST_OPTS='--hard --pre-eval=\(load-file\ \"../answer.mal\"\)' te
|
|||||||
|
|
||||||
- Implement `>`, `<=` and `>=` with `<`.
|
- 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.
|
functions.
|
||||||
|
|
||||||
- Implement `count`, `nth`, `map`, `concat` and `conj` with the empty
|
- Implement `count`, `nth`, `map`, `concat` and `conj` with the empty
|
||||||
|
@ -23,6 +23,7 @@
|
|||||||
(def! >= (fn* [a b] (not (< a b))))
|
(def! >= (fn* [a b] (not (< a b))))
|
||||||
|
|
||||||
(def! list (fn* [& xs] xs))
|
(def! list (fn* [& xs] xs))
|
||||||
|
(def! vec (fn* [xs] (apply vector xs)))
|
||||||
(def! prn (fn* [& xs] (println (apply pr-str xs))))
|
(def! prn (fn* [& xs] (println (apply pr-str xs))))
|
||||||
(def! hash-map (fn* [& xs] (apply assoc {} xs)))
|
(def! hash-map (fn* [& xs] (apply assoc {} xs)))
|
||||||
(def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs))))
|
(def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs))))
|
||||||
@ -48,7 +49,7 @@
|
|||||||
(def! conj
|
(def! conj
|
||||||
(fn* [xs & ys]
|
(fn* [xs & ys]
|
||||||
(if (vector? xs)
|
(if (vector? xs)
|
||||||
(apply vector (concat xs ys))
|
(vec (concat xs ys))
|
||||||
(reduce (fn* [acc x] (cons x acc)) xs ys))))
|
(reduce (fn* [acc x] (cons x acc)) xs ys))))
|
||||||
|
|
||||||
(def! do2 (fn* [& xs] (nth xs (- (count xs) 1))))
|
(def! do2 (fn* [& xs] (nth xs (- (count xs) 1))))
|
||||||
@ -69,8 +70,7 @@
|
|||||||
(first (rest ast))
|
(first (rest ast))
|
||||||
(foldr _quasiquote_iter () ast))
|
(foldr _quasiquote_iter () ast))
|
||||||
(if (vector? ast)
|
(if (vector? ast)
|
||||||
;; TODO: once tests are fixed, replace 'list with 'vector.
|
(list 'vec (foldr _quasiquote_iter () ast))
|
||||||
(list 'apply 'list (foldr _quasiquote_iter () ast))
|
|
||||||
(list 'quote ast)))))
|
(list 'quote ast)))))
|
||||||
|
|
||||||
;; Interpret kvs as [k1 v1 k2 v2 ... kn vn] and returns
|
;; Interpret kvs as [k1 v1 k2 v2 ... kn vn] and returns
|
||||||
|
@ -256,6 +256,7 @@ package body Core is
|
|||||||
P ("throw", Err.Throw'Access);
|
P ("throw", Err.Throw'Access);
|
||||||
P ("time-ms", Time_Ms'Access);
|
P ("time-ms", Time_Ms'Access);
|
||||||
P ("vals", Types.Maps.Vals'Access);
|
P ("vals", Types.Maps.Vals'Access);
|
||||||
|
P ("vec", Types.Sequences.Vec'Access);
|
||||||
P ("vector", Types.Sequences.Vector'Access);
|
P ("vector", Types.Sequences.Vector'Access);
|
||||||
P ("with-meta", With_Meta'Access);
|
P ("with-meta", With_Meta'Access);
|
||||||
end NS_Add_To_Repl;
|
end NS_Add_To_Repl;
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
with Ada.Command_Line;
|
with Ada.Command_Line;
|
||||||
with Ada.Containers.Vectors;
|
|
||||||
with Ada.Environment_Variables;
|
with Ada.Environment_Variables;
|
||||||
with Ada.Text_IO.Unbounded_IO;
|
with Ada.Text_IO.Unbounded_IO;
|
||||||
|
|
||||||
@ -23,7 +22,6 @@ procedure Step7_Quote is
|
|||||||
use all type Types.Kind_Type;
|
use all type Types.Kind_Type;
|
||||||
use type Types.Strings.Instance;
|
use type Types.Strings.Instance;
|
||||||
package ACL renames Ada.Command_Line;
|
package ACL renames Ada.Command_Line;
|
||||||
package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
|
|
||||||
|
|
||||||
function Read return Types.T_Array with Inline;
|
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;
|
function Eval_Builtin (Args : in Types.T_Array) return Types.T;
|
||||||
-- The built-in variant needs to see the Repl variable.
|
-- The built-in variant needs to see the Repl variable.
|
||||||
|
|
||||||
function Quasiquote (Ast : in Types.T;
|
function Quasiquote (Ast : in Types.T) return 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.
|
|
||||||
|
|
||||||
procedure Print (Ast : in Types.T) with Inline;
|
procedure Print (Ast : in Types.T) with Inline;
|
||||||
|
|
||||||
@ -174,9 +167,13 @@ procedure Step7_Quote is
|
|||||||
Ast => Ast.Sequence.all.Data (3),
|
Ast => Ast.Sequence.all.Data (3),
|
||||||
Env => Env));
|
Env => Env));
|
||||||
end;
|
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
|
elsif First.Str.all = "quasiquote" then
|
||||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
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
|
else
|
||||||
-- Equivalent to First := Eval (First, Env)
|
-- Equivalent to First := Eval (First, Env)
|
||||||
-- except that we already know enough to spare a recursive call.
|
-- 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));
|
Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
|
||||||
end Print;
|
end Print;
|
||||||
|
|
||||||
function Quasiquote (Ast : in Types.T;
|
function Quasiquote (Ast : in Types.T) return Types.T is
|
||||||
Env : in Envs.Ptr) return Types.T
|
|
||||||
is
|
|
||||||
|
|
||||||
function Quasiquote_List (List : in Types.T_Array) return Types.T;
|
function Qq_Seq return Types.T;
|
||||||
-- Handle vectors and lists not starting with unquote.
|
function Starts_With (Sequence : Types.T_Array;
|
||||||
|
Symbol : String) return Boolean;
|
||||||
|
|
||||||
function Quasiquote_List (List : in Types.T_Array) return Types.T is
|
function Qq_Seq return Types.T is
|
||||||
Vector : Vectors.Vector; -- buffer for concatenation
|
Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
|
||||||
Tmp : Types.T;
|
|
||||||
begin
|
begin
|
||||||
for Elt of List loop
|
for Elt of reverse Ast.Sequence.all.Data loop
|
||||||
if Elt.Kind in Kind_List
|
if Elt.Kind = Kind_List
|
||||||
and then 0 < Elt.Sequence.all.Length
|
and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
|
||||||
and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
|
|
||||||
and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
|
|
||||||
then
|
then
|
||||||
Err.Check (Elt.Sequence.all.Length = 2,
|
Err.Check (Elt.Sequence.all.Length = 2,
|
||||||
"splice-unquote expects 1 parameter");
|
"splice-unquote expects 1 parameter");
|
||||||
Tmp := Eval (Elt.Sequence.all.Data (2), Env);
|
Result := Types.Sequences.List
|
||||||
Err.Check (Tmp.Kind = Kind_List,
|
(((Kind_Symbol, Types.Strings.Alloc ("concat")),
|
||||||
"splice_unquote expects a list");
|
Elt.Sequence.all.Data (2), Result));
|
||||||
for Sub_Elt of Tmp.Sequence.all.Data loop
|
|
||||||
Vector.Append (Sub_Elt);
|
|
||||||
end loop;
|
|
||||||
else
|
else
|
||||||
Vector.Append (Quasiquote (Elt, Env));
|
Result := Types.Sequences.List
|
||||||
|
(((Kind_Symbol, Types.Strings.Alloc ("cons")),
|
||||||
|
Quasiquote (Elt), Result));
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
-- Now that we know the number of elements, convert to a list.
|
return Result;
|
||||||
declare
|
end Qq_Seq;
|
||||||
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;
|
|
||||||
|
|
||||||
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
|
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 =>
|
when Kind_List =>
|
||||||
if 0 < Ast.Sequence.all.Length
|
if Starts_With (Ast.Sequence.all.Data, "unquote") then
|
||||||
and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
|
|
||||||
and then Ast.Sequence.all.Data (1).Str.all = "unquote"
|
|
||||||
then
|
|
||||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
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
|
else
|
||||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
return Qq_Seq;
|
||||||
end if;
|
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 =>
|
when others =>
|
||||||
return Ast;
|
return Ast;
|
||||||
end case;
|
end case;
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
with Ada.Command_Line;
|
with Ada.Command_Line;
|
||||||
with Ada.Containers.Vectors;
|
|
||||||
with Ada.Environment_Variables;
|
with Ada.Environment_Variables;
|
||||||
with Ada.Text_IO.Unbounded_IO;
|
with Ada.Text_IO.Unbounded_IO;
|
||||||
|
|
||||||
@ -23,7 +22,6 @@ procedure Step8_Macros is
|
|||||||
use all type Types.Kind_Type;
|
use all type Types.Kind_Type;
|
||||||
use type Types.Strings.Instance;
|
use type Types.Strings.Instance;
|
||||||
package ACL renames Ada.Command_Line;
|
package ACL renames Ada.Command_Line;
|
||||||
package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
|
|
||||||
|
|
||||||
function Read return Types.T_Array with Inline;
|
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;
|
function Eval_Builtin (Args : in Types.T_Array) return Types.T;
|
||||||
-- The built-in variant needs to see the Repl variable.
|
-- The built-in variant needs to see the Repl variable.
|
||||||
|
|
||||||
function Quasiquote (Ast : in Types.T;
|
function Quasiquote (Ast : in Types.T) return 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.
|
|
||||||
|
|
||||||
procedure Print (Ast : in Types.T) with Inline;
|
procedure Print (Ast : in Types.T) with Inline;
|
||||||
|
|
||||||
@ -195,9 +188,13 @@ procedure Step8_Macros is
|
|||||||
Macroexpanding := True;
|
Macroexpanding := True;
|
||||||
Ast := Ast.Sequence.all.Data (2);
|
Ast := Ast.Sequence.all.Data (2);
|
||||||
goto Restart;
|
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
|
elsif First.Str.all = "quasiquote" then
|
||||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
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
|
else
|
||||||
-- Equivalent to First := Eval (First, Env)
|
-- Equivalent to First := Eval (First, Env)
|
||||||
-- except that we already know enough to spare a recursive call.
|
-- 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));
|
Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
|
||||||
end Print;
|
end Print;
|
||||||
|
|
||||||
function Quasiquote (Ast : in Types.T;
|
function Quasiquote (Ast : in Types.T) return Types.T is
|
||||||
Env : in Envs.Ptr) return Types.T
|
|
||||||
is
|
|
||||||
|
|
||||||
function Quasiquote_List (List : in Types.T_Array) return Types.T;
|
function Qq_Seq return Types.T;
|
||||||
-- Handle vectors and lists not starting with unquote.
|
function Starts_With (Sequence : Types.T_Array;
|
||||||
|
Symbol : String) return Boolean;
|
||||||
|
|
||||||
function Quasiquote_List (List : in Types.T_Array) return Types.T is
|
function Qq_Seq return Types.T is
|
||||||
Vector : Vectors.Vector; -- buffer for concatenation
|
Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
|
||||||
Tmp : Types.T;
|
|
||||||
begin
|
begin
|
||||||
for Elt of List loop
|
for Elt of reverse Ast.Sequence.all.Data loop
|
||||||
if Elt.Kind in Kind_List
|
if Elt.Kind = Kind_List
|
||||||
and then 0 < Elt.Sequence.all.Length
|
and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
|
||||||
and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
|
|
||||||
and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
|
|
||||||
then
|
then
|
||||||
Err.Check (Elt.Sequence.all.Length = 2,
|
Err.Check (Elt.Sequence.all.Length = 2,
|
||||||
"splice-unquote expects 1 parameter");
|
"splice-unquote expects 1 parameter");
|
||||||
Tmp := Eval (Elt.Sequence.all.Data (2), Env);
|
Result := Types.Sequences.List
|
||||||
Err.Check (Tmp.Kind = Kind_List,
|
(((Kind_Symbol, Types.Strings.Alloc ("concat")),
|
||||||
"splice_unquote expects a list");
|
Elt.Sequence.all.Data (2), Result));
|
||||||
for Sub_Elt of Tmp.Sequence.all.Data loop
|
|
||||||
Vector.Append (Sub_Elt);
|
|
||||||
end loop;
|
|
||||||
else
|
else
|
||||||
Vector.Append (Quasiquote (Elt, Env));
|
Result := Types.Sequences.List
|
||||||
|
(((Kind_Symbol, Types.Strings.Alloc ("cons")),
|
||||||
|
Quasiquote (Elt), Result));
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
-- Now that we know the number of elements, convert to a list.
|
return Result;
|
||||||
declare
|
end Qq_Seq;
|
||||||
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;
|
|
||||||
|
|
||||||
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
|
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 =>
|
when Kind_List =>
|
||||||
if 0 < Ast.Sequence.all.Length
|
if Starts_With (Ast.Sequence.all.Data, "unquote") then
|
||||||
and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
|
|
||||||
and then Ast.Sequence.all.Data (1).Str.all = "unquote"
|
|
||||||
then
|
|
||||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
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
|
else
|
||||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
return Qq_Seq;
|
||||||
end if;
|
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 =>
|
when others =>
|
||||||
return Ast;
|
return Ast;
|
||||||
end case;
|
end case;
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
with Ada.Command_Line;
|
with Ada.Command_Line;
|
||||||
with Ada.Containers.Vectors;
|
|
||||||
with Ada.Environment_Variables;
|
with Ada.Environment_Variables;
|
||||||
with Ada.Text_IO.Unbounded_IO;
|
with Ada.Text_IO.Unbounded_IO;
|
||||||
|
|
||||||
@ -23,7 +22,6 @@ procedure Step9_Try is
|
|||||||
use all type Types.Kind_Type;
|
use all type Types.Kind_Type;
|
||||||
use type Types.Strings.Instance;
|
use type Types.Strings.Instance;
|
||||||
package ACL renames Ada.Command_Line;
|
package ACL renames Ada.Command_Line;
|
||||||
package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
|
|
||||||
|
|
||||||
function Read return Types.T_Array with Inline;
|
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;
|
function Eval_Builtin (Args : in Types.T_Array) return Types.T;
|
||||||
-- The built-in variant needs to see the Repl variable.
|
-- The built-in variant needs to see the Repl variable.
|
||||||
|
|
||||||
function Quasiquote (Ast : in Types.T;
|
function Quasiquote (Ast : in Types.T) return 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.
|
|
||||||
|
|
||||||
procedure Print (Ast : in Types.T) with Inline;
|
procedure Print (Ast : in Types.T) with Inline;
|
||||||
|
|
||||||
@ -195,9 +188,13 @@ procedure Step9_Try is
|
|||||||
Macroexpanding := True;
|
Macroexpanding := True;
|
||||||
Ast := Ast.Sequence.all.Data (2);
|
Ast := Ast.Sequence.all.Data (2);
|
||||||
goto Restart;
|
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
|
elsif First.Str.all = "quasiquote" then
|
||||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
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
|
elsif First.Str.all = "try*" then
|
||||||
if Ast.Sequence.all.Length = 2 then
|
if Ast.Sequence.all.Length = 2 then
|
||||||
Ast := Ast.Sequence.all.Data (2);
|
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));
|
Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
|
||||||
end Print;
|
end Print;
|
||||||
|
|
||||||
function Quasiquote (Ast : in Types.T;
|
function Quasiquote (Ast : in Types.T) return Types.T is
|
||||||
Env : in Envs.Ptr) return Types.T
|
|
||||||
is
|
|
||||||
|
|
||||||
function Quasiquote_List (List : in Types.T_Array) return Types.T;
|
function Qq_Seq return Types.T;
|
||||||
-- Handle vectors and lists not starting with unquote.
|
function Starts_With (Sequence : Types.T_Array;
|
||||||
|
Symbol : String) return Boolean;
|
||||||
|
|
||||||
function Quasiquote_List (List : in Types.T_Array) return Types.T is
|
function Qq_Seq return Types.T is
|
||||||
Vector : Vectors.Vector; -- buffer for concatenation
|
Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
|
||||||
Tmp : Types.T;
|
|
||||||
begin
|
begin
|
||||||
for Elt of List loop
|
for Elt of reverse Ast.Sequence.all.Data loop
|
||||||
if Elt.Kind in Kind_List
|
if Elt.Kind = Kind_List
|
||||||
and then 0 < Elt.Sequence.all.Length
|
and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
|
||||||
and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
|
|
||||||
and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
|
|
||||||
then
|
then
|
||||||
Err.Check (Elt.Sequence.all.Length = 2,
|
Err.Check (Elt.Sequence.all.Length = 2,
|
||||||
"splice-unquote expects 1 parameter");
|
"splice-unquote expects 1 parameter");
|
||||||
Tmp := Eval (Elt.Sequence.all.Data (2), Env);
|
Result := Types.Sequences.List
|
||||||
Err.Check (Tmp.Kind = Kind_List,
|
(((Kind_Symbol, Types.Strings.Alloc ("concat")),
|
||||||
"splice_unquote expects a list");
|
Elt.Sequence.all.Data (2), Result));
|
||||||
for Sub_Elt of Tmp.Sequence.all.Data loop
|
|
||||||
Vector.Append (Sub_Elt);
|
|
||||||
end loop;
|
|
||||||
else
|
else
|
||||||
Vector.Append (Quasiquote (Elt, Env));
|
Result := Types.Sequences.List
|
||||||
|
(((Kind_Symbol, Types.Strings.Alloc ("cons")),
|
||||||
|
Quasiquote (Elt), Result));
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
-- Now that we know the number of elements, convert to a list.
|
return Result;
|
||||||
declare
|
end Qq_Seq;
|
||||||
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;
|
|
||||||
|
|
||||||
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
|
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 =>
|
when Kind_List =>
|
||||||
if 0 < Ast.Sequence.all.Length
|
if Starts_With (Ast.Sequence.all.Data, "unquote") then
|
||||||
and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
|
|
||||||
and then Ast.Sequence.all.Data (1).Str.all = "unquote"
|
|
||||||
then
|
|
||||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
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
|
else
|
||||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
return Qq_Seq;
|
||||||
end if;
|
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 =>
|
when others =>
|
||||||
return Ast;
|
return Ast;
|
||||||
end case;
|
end case;
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
with Ada.Command_Line;
|
with Ada.Command_Line;
|
||||||
with Ada.Containers.Vectors;
|
|
||||||
with Ada.Environment_Variables;
|
with Ada.Environment_Variables;
|
||||||
with Ada.Text_IO.Unbounded_IO;
|
with Ada.Text_IO.Unbounded_IO;
|
||||||
|
|
||||||
@ -24,7 +23,6 @@ procedure StepA_Mal is
|
|||||||
use all type Types.Kind_Type;
|
use all type Types.Kind_Type;
|
||||||
use type Types.Strings.Instance;
|
use type Types.Strings.Instance;
|
||||||
package ACL renames Ada.Command_Line;
|
package ACL renames Ada.Command_Line;
|
||||||
package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
|
|
||||||
|
|
||||||
function Read return Types.T_Array with Inline;
|
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;
|
function Eval_Builtin (Args : in Types.T_Array) return Types.T;
|
||||||
-- The built-in variant needs to see the Repl variable.
|
-- The built-in variant needs to see the Repl variable.
|
||||||
|
|
||||||
function Quasiquote (Ast : in Types.T;
|
function Quasiquote (Ast : in Types.T) return 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.
|
|
||||||
|
|
||||||
procedure Print (Ast : in Types.T) with Inline;
|
procedure Print (Ast : in Types.T) with Inline;
|
||||||
|
|
||||||
@ -196,9 +189,13 @@ procedure StepA_Mal is
|
|||||||
Macroexpanding := True;
|
Macroexpanding := True;
|
||||||
Ast := Ast.Sequence.all.Data (2);
|
Ast := Ast.Sequence.all.Data (2);
|
||||||
goto Restart;
|
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
|
elsif First.Str.all = "quasiquote" then
|
||||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
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
|
elsif First.Str.all = "try*" then
|
||||||
if Ast.Sequence.all.Length = 2 then
|
if Ast.Sequence.all.Length = 2 then
|
||||||
Ast := Ast.Sequence.all.Data (2);
|
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));
|
Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
|
||||||
end Print;
|
end Print;
|
||||||
|
|
||||||
function Quasiquote (Ast : in Types.T;
|
function Quasiquote (Ast : in Types.T) return Types.T is
|
||||||
Env : in Envs.Ptr) return Types.T
|
|
||||||
is
|
|
||||||
|
|
||||||
function Quasiquote_List (List : in Types.T_Array) return Types.T;
|
function Qq_Seq return Types.T;
|
||||||
-- Handle vectors and lists not starting with unquote.
|
function Starts_With (Sequence : Types.T_Array;
|
||||||
|
Symbol : String) return Boolean;
|
||||||
|
|
||||||
function Quasiquote_List (List : in Types.T_Array) return Types.T is
|
function Qq_Seq return Types.T is
|
||||||
Vector : Vectors.Vector; -- buffer for concatenation
|
Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
|
||||||
Tmp : Types.T;
|
|
||||||
begin
|
begin
|
||||||
for Elt of List loop
|
for Elt of reverse Ast.Sequence.all.Data loop
|
||||||
if Elt.Kind in Kind_List
|
if Elt.Kind = Kind_List
|
||||||
and then 0 < Elt.Sequence.all.Length
|
and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
|
||||||
and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
|
|
||||||
and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
|
|
||||||
then
|
then
|
||||||
Err.Check (Elt.Sequence.all.Length = 2,
|
Err.Check (Elt.Sequence.all.Length = 2,
|
||||||
"splice-unquote expects 1 parameter");
|
"splice-unquote expects 1 parameter");
|
||||||
Tmp := Eval (Elt.Sequence.all.Data (2), Env);
|
Result := Types.Sequences.List
|
||||||
Err.Check (Tmp.Kind = Kind_List,
|
(((Kind_Symbol, Types.Strings.Alloc ("concat")),
|
||||||
"splice_unquote expects a list");
|
Elt.Sequence.all.Data (2), Result));
|
||||||
for Sub_Elt of Tmp.Sequence.all.Data loop
|
|
||||||
Vector.Append (Sub_Elt);
|
|
||||||
end loop;
|
|
||||||
else
|
else
|
||||||
Vector.Append (Quasiquote (Elt, Env));
|
Result := Types.Sequences.List
|
||||||
|
(((Kind_Symbol, Types.Strings.Alloc ("cons")),
|
||||||
|
Quasiquote (Elt), Result));
|
||||||
end if;
|
end if;
|
||||||
end loop;
|
end loop;
|
||||||
-- Now that we know the number of elements, convert to a list.
|
return Result;
|
||||||
declare
|
end Qq_Seq;
|
||||||
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;
|
|
||||||
|
|
||||||
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
|
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 =>
|
when Kind_List =>
|
||||||
if 0 < Ast.Sequence.all.Length
|
if Starts_With (Ast.Sequence.all.Data, "unquote") then
|
||||||
and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
|
|
||||||
and then Ast.Sequence.all.Data (1).Str.all = "unquote"
|
|
||||||
then
|
|
||||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
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
|
else
|
||||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
return Qq_Seq;
|
||||||
end if;
|
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 =>
|
when others =>
|
||||||
return Ast;
|
return Ast;
|
||||||
end case;
|
end case;
|
||||||
|
@ -208,6 +208,14 @@ package body Types.Sequences is
|
|||||||
end case;
|
end case;
|
||||||
end Rest;
|
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
|
function Vector (Args : in T_Array) return T
|
||||||
is
|
is
|
||||||
Ref : constant Sequence_Ptr := Constructor (Args'Length);
|
Ref : constant Sequence_Ptr := Constructor (Args'Length);
|
||||||
|
@ -24,6 +24,7 @@ package Types.Sequences is
|
|||||||
function Map (Args : in T_Array) return T;
|
function Map (Args : in T_Array) return T;
|
||||||
function Nth (Args : in T_Array) return T;
|
function Nth (Args : in T_Array) return T;
|
||||||
function Rest (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;
|
function Vector (Args : in T_Array) return T;
|
||||||
|
|
||||||
-- New instances must be created via this constructor.
|
-- New instances must be created via this constructor.
|
||||||
|
@ -645,6 +645,25 @@ package body Core is
|
|||||||
end New_Vector;
|
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)
|
function New_Map (Rest_Handle : Mal_Handle)
|
||||||
return Types.Mal_Handle is
|
return Types.Mal_Handle is
|
||||||
Rest_List : List_Mal_Type;
|
Rest_List : List_Mal_Type;
|
||||||
@ -1059,6 +1078,10 @@ package body Core is
|
|||||||
"list?",
|
"list?",
|
||||||
New_Func_Mal_Type ("list?", Is_List'access));
|
New_Func_Mal_Type ("list?", Is_List'access));
|
||||||
|
|
||||||
|
Envs.Set (Repl_Env,
|
||||||
|
"vec",
|
||||||
|
New_Func_Mal_Type ("vec", Vec'access));
|
||||||
|
|
||||||
Envs.Set (Repl_Env,
|
Envs.Set (Repl_Env,
|
||||||
"vector",
|
"vector",
|
||||||
New_Func_Mal_Type ("vector", New_Vector'access));
|
New_Func_Mal_Type ("vector", New_Vector'access));
|
||||||
|
@ -100,85 +100,78 @@ procedure Step7_Quote is
|
|||||||
|
|
||||||
end Eval_Ast;
|
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
|
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;
|
L : List_Ptr;
|
||||||
D_Ptr, Ast_P : List_Class_Ptr;
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
if Debug then
|
if Debug then
|
||||||
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Create a New List for the result...
|
if Deref (Param).Sym_Type not in Sym | List then
|
||||||
Res := New_List_Mal_Type (List_List);
|
-- No need to quote, Eval would not affect these anyway.
|
||||||
L := Deref_List (Res);
|
return Param;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- This is the equivalent of Is_Pair
|
|
||||||
if Deref (Param).Sym_Type /= List or else
|
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.
|
-- 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 (New_Symbol_Mal_Type ("quote"));
|
||||||
L.Append (Param);
|
L.Append (Param);
|
||||||
return Res;
|
return Res;
|
||||||
|
|
||||||
end if;
|
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 the first element of ast is a symbol named "unquote":
|
||||||
if Deref (First_Elem).Sym_Type = Sym and then
|
if Starts_With (Param, "unquote") then
|
||||||
Deref_Sym (First_Elem).Get_Sym = "unquote" then
|
|
||||||
|
|
||||||
-- return the second element of ast.`
|
-- return the second element of ast.`
|
||||||
D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
|
return Deref_List_Class (Param).Nth (1);
|
||||||
return Car (D_Ptr.all);
|
|
||||||
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- if the first element of first element of `ast` (`ast[0][0]`)
|
Res := New_List_Mal_Type (List_List);
|
||||||
-- 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
|
|
||||||
|
|
||||||
D_Ptr := Deref_List_Class (First_Elem);
|
for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
|
||||||
FE_0 := Car (D_Ptr.all);
|
Elt := Deref_List_Class (Param).Nth (I);
|
||||||
|
New_Res := New_List_Mal_Type (List_List);
|
||||||
if Deref (FE_0).Sym_Type = Sym and then
|
L := Deref_List (New_Res);
|
||||||
Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
|
if Starts_With (Elt, "splice-unquote") then
|
||||||
|
|
||||||
-- return a new list containing: a symbol named "concat",
|
|
||||||
L.Append (New_Symbol_Mal_Type ("concat"));
|
L.Append (New_Symbol_Mal_Type ("concat"));
|
||||||
|
L.Append (Deref_List (Elt).Nth (1));
|
||||||
-- the second element of first element of ast (ast[0][1]),
|
else
|
||||||
D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
|
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||||
L.Append (Car (D_Ptr.all));
|
L.Append (Quasi_Quote_Processing (Elt));
|
||||||
|
|
||||||
-- 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;
|
|
||||||
|
|
||||||
end if;
|
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;
|
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;
|
return Res;
|
||||||
|
|
||||||
end Quasi_Quote_Processing;
|
end Quasi_Quote_Processing;
|
||||||
@ -312,6 +305,11 @@ procedure Step7_Quote is
|
|||||||
|
|
||||||
return Car (Rest_List);
|
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
|
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||||
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
||||||
|
|
||||||
|
@ -164,85 +164,78 @@ procedure Step8_Macros is
|
|||||||
|
|
||||||
end Eval_Ast;
|
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
|
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;
|
L : List_Ptr;
|
||||||
D_Ptr, Ast_P : List_Class_Ptr;
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
if Debug then
|
if Debug then
|
||||||
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Create a New List for the result...
|
if Deref (Param).Sym_Type not in Sym | List then
|
||||||
Res := New_List_Mal_Type (List_List);
|
-- No need to quote, Eval would not affect these anyway.
|
||||||
L := Deref_List (Res);
|
return Param;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- This is the equivalent of Is_Pair
|
|
||||||
if Deref (Param).Sym_Type /= List or else
|
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.
|
-- 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 (New_Symbol_Mal_Type ("quote"));
|
||||||
L.Append (Param);
|
L.Append (Param);
|
||||||
return Res;
|
return Res;
|
||||||
|
|
||||||
end if;
|
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 the first element of ast is a symbol named "unquote":
|
||||||
if Deref (First_Elem).Sym_Type = Sym and then
|
if Starts_With (Param, "unquote") then
|
||||||
Deref_Sym (First_Elem).Get_Sym = "unquote" then
|
|
||||||
|
|
||||||
-- return the second element of ast.`
|
-- return the second element of ast.`
|
||||||
D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
|
return Deref_List_Class (Param).Nth (1);
|
||||||
return Car (D_Ptr.all);
|
|
||||||
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- if the first element of first element of `ast` (`ast[0][0]`)
|
Res := New_List_Mal_Type (List_List);
|
||||||
-- 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
|
|
||||||
|
|
||||||
D_Ptr := Deref_List_Class (First_Elem);
|
for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
|
||||||
FE_0 := Car (D_Ptr.all);
|
Elt := Deref_List_Class (Param).Nth (I);
|
||||||
|
New_Res := New_List_Mal_Type (List_List);
|
||||||
if Deref (FE_0).Sym_Type = Sym and then
|
L := Deref_List (New_Res);
|
||||||
Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
|
if Starts_With (Elt, "splice-unquote") then
|
||||||
|
|
||||||
-- return a new list containing: a symbol named "concat",
|
|
||||||
L.Append (New_Symbol_Mal_Type ("concat"));
|
L.Append (New_Symbol_Mal_Type ("concat"));
|
||||||
|
L.Append (Deref_List (Elt).Nth (1));
|
||||||
-- the second element of first element of ast (ast[0][1]),
|
else
|
||||||
D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
|
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||||
L.Append (Car (D_Ptr.all));
|
L.Append (Quasi_Quote_Processing (Elt));
|
||||||
|
|
||||||
-- 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;
|
|
||||||
|
|
||||||
end if;
|
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;
|
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;
|
return Res;
|
||||||
|
|
||||||
end Quasi_Quote_Processing;
|
end Quasi_Quote_Processing;
|
||||||
@ -388,6 +381,11 @@ procedure Step8_Macros is
|
|||||||
|
|
||||||
return Car (Rest_List);
|
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
|
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||||
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
||||||
|
|
||||||
|
@ -164,85 +164,78 @@ procedure Step9_Try is
|
|||||||
|
|
||||||
end Eval_Ast;
|
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
|
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;
|
L : List_Ptr;
|
||||||
D_Ptr, Ast_P : List_Class_Ptr;
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
if Debug then
|
if Debug then
|
||||||
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Create a New List for the result...
|
if Deref (Param).Sym_Type not in Sym | List then
|
||||||
Res := New_List_Mal_Type (List_List);
|
-- No need to quote, Eval would not affect these anyway.
|
||||||
L := Deref_List (Res);
|
return Param;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- This is the equivalent of Is_Pair
|
|
||||||
if Deref (Param).Sym_Type /= List or else
|
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.
|
-- 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 (New_Symbol_Mal_Type ("quote"));
|
||||||
L.Append (Param);
|
L.Append (Param);
|
||||||
return Res;
|
return Res;
|
||||||
|
|
||||||
end if;
|
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 the first element of ast is a symbol named "unquote":
|
||||||
if Deref (First_Elem).Sym_Type = Sym and then
|
if Starts_With (Param, "unquote") then
|
||||||
Deref_Sym (First_Elem).Get_Sym = "unquote" then
|
|
||||||
|
|
||||||
-- return the second element of ast.`
|
-- return the second element of ast.`
|
||||||
D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
|
return Deref_List_Class (Param).Nth (1);
|
||||||
return Car (D_Ptr.all);
|
|
||||||
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- if the first element of first element of `ast` (`ast[0][0]`)
|
Res := New_List_Mal_Type (List_List);
|
||||||
-- 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
|
|
||||||
|
|
||||||
D_Ptr := Deref_List_Class (First_Elem);
|
for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
|
||||||
FE_0 := Car (D_Ptr.all);
|
Elt := Deref_List_Class (Param).Nth (I);
|
||||||
|
New_Res := New_List_Mal_Type (List_List);
|
||||||
if Deref (FE_0).Sym_Type = Sym and then
|
L := Deref_List (New_Res);
|
||||||
Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
|
if Starts_With (Elt, "splice-unquote") then
|
||||||
|
|
||||||
-- return a new list containing: a symbol named "concat",
|
|
||||||
L.Append (New_Symbol_Mal_Type ("concat"));
|
L.Append (New_Symbol_Mal_Type ("concat"));
|
||||||
|
L.Append (Deref_List (Elt).Nth (1));
|
||||||
-- the second element of first element of ast (ast[0][1]),
|
else
|
||||||
D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
|
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||||
L.Append (Car (D_Ptr.all));
|
L.Append (Quasi_Quote_Processing (Elt));
|
||||||
|
|
||||||
-- 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;
|
|
||||||
|
|
||||||
end if;
|
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;
|
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;
|
return Res;
|
||||||
|
|
||||||
end Quasi_Quote_Processing;
|
end Quasi_Quote_Processing;
|
||||||
@ -414,6 +407,11 @@ procedure Step9_Try is
|
|||||||
|
|
||||||
return Car (Rest_List);
|
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
|
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||||
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
||||||
|
|
||||||
|
@ -164,85 +164,78 @@ procedure StepA_Mal is
|
|||||||
|
|
||||||
end Eval_Ast;
|
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
|
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;
|
L : List_Ptr;
|
||||||
D_Ptr, Ast_P : List_Class_Ptr;
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
if Debug then
|
if Debug then
|
||||||
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Create a New List for the result...
|
if Deref (Param).Sym_Type not in Sym | List then
|
||||||
Res := New_List_Mal_Type (List_List);
|
-- No need to quote, Eval would not affect these anyway.
|
||||||
L := Deref_List (Res);
|
return Param;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- This is the equivalent of Is_Pair
|
|
||||||
if Deref (Param).Sym_Type /= List or else
|
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.
|
-- 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 (New_Symbol_Mal_Type ("quote"));
|
||||||
L.Append (Param);
|
L.Append (Param);
|
||||||
return Res;
|
return Res;
|
||||||
|
|
||||||
end if;
|
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 the first element of ast is a symbol named "unquote":
|
||||||
if Deref (First_Elem).Sym_Type = Sym and then
|
if Starts_With (Param, "unquote") then
|
||||||
Deref_Sym (First_Elem).Get_Sym = "unquote" then
|
|
||||||
|
|
||||||
-- return the second element of ast.`
|
-- return the second element of ast.`
|
||||||
D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
|
return Deref_List_Class (Param).Nth (1);
|
||||||
return Car (D_Ptr.all);
|
|
||||||
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- if the first element of first element of `ast` (`ast[0][0]`)
|
Res := New_List_Mal_Type (List_List);
|
||||||
-- 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
|
|
||||||
|
|
||||||
D_Ptr := Deref_List_Class (First_Elem);
|
for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
|
||||||
FE_0 := Car (D_Ptr.all);
|
Elt := Deref_List_Class (Param).Nth (I);
|
||||||
|
New_Res := New_List_Mal_Type (List_List);
|
||||||
if Deref (FE_0).Sym_Type = Sym and then
|
L := Deref_List (New_Res);
|
||||||
Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
|
if Starts_With (Elt, "splice-unquote") then
|
||||||
|
|
||||||
-- return a new list containing: a symbol named "concat",
|
|
||||||
L.Append (New_Symbol_Mal_Type ("concat"));
|
L.Append (New_Symbol_Mal_Type ("concat"));
|
||||||
|
L.Append (Deref_List (Elt).Nth (1));
|
||||||
-- the second element of first element of ast (ast[0][1]),
|
else
|
||||||
D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
|
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||||
L.Append (Car (D_Ptr.all));
|
L.Append (Quasi_Quote_Processing (Elt));
|
||||||
|
|
||||||
-- 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;
|
|
||||||
|
|
||||||
end if;
|
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;
|
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;
|
return Res;
|
||||||
|
|
||||||
end Quasi_Quote_Processing;
|
end Quasi_Quote_Processing;
|
||||||
@ -414,6 +407,11 @@ procedure StepA_Mal is
|
|||||||
|
|
||||||
return Car (Rest_List);
|
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
|
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||||
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
||||||
|
|
||||||
|
@ -628,6 +628,24 @@ function core_concat(idx, new_idx, new_len, len, i, lst, lst_idx, lst_len, j)
|
|||||||
return "(" new_idx
|
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)
|
function core_nth(idx, lst, num, n, lst_idx)
|
||||||
{
|
{
|
||||||
if (types_heap[idx]["len"] != 3) {
|
if (types_heap[idx]["len"] != 3) {
|
||||||
@ -1078,6 +1096,7 @@ function core_init()
|
|||||||
|
|
||||||
core_ns["'list"] = "&core_list"
|
core_ns["'list"] = "&core_list"
|
||||||
core_ns["'list?"] = "&core_listp"
|
core_ns["'list?"] = "&core_listp"
|
||||||
|
core_ns["'vec"] = "&core_vec"
|
||||||
core_ns["'vector"] = "&core_vector"
|
core_ns["'vector"] = "&core_vector"
|
||||||
core_ns["'vector?"] = "&core_vectorp"
|
core_ns["'vector?"] = "&core_vectorp"
|
||||||
core_ns["'hash-map"] = "&core_hash_map"
|
core_ns["'hash-map"] = "&core_hash_map"
|
||||||
|
@ -9,69 +9,82 @@ function READ(str)
|
|||||||
return reader_read_str(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()
|
new_idx = types_allocate()
|
||||||
types_heap[new_idx][0] = "'quote"
|
types_heap[new_idx][0] = "'quote"
|
||||||
types_heap[new_idx][1] = ast
|
types_heap[new_idx][1] = ast
|
||||||
types_heap[new_idx]["len"] = 2
|
types_heap[new_idx]["len"] = 2
|
||||||
return "(" new_idx
|
return "(" new_idx
|
||||||
}
|
}
|
||||||
idx = substr(ast, 2)
|
ret = starts_with(ast, "'unquote")
|
||||||
first = types_heap[idx][0]
|
if (ret ~ /^!/) {
|
||||||
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])
|
|
||||||
types_release(ast)
|
types_release(ast)
|
||||||
return ret
|
return ret
|
||||||
}
|
}
|
||||||
|
if (ret) {
|
||||||
first_idx = substr(first, 2)
|
types_addref(ret)
|
||||||
if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
|
types_release(ast)
|
||||||
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)
|
|
||||||
return ret
|
return ret
|
||||||
}
|
}
|
||||||
|
|
||||||
new_idx = types_allocate()
|
new_idx = types_allocate()
|
||||||
types_heap[new_idx][0] = verb
|
types_heap[new_idx]["len"] = 0
|
||||||
types_heap[new_idx][1] = first
|
ast_idx = substr(ast, 2)
|
||||||
types_heap[new_idx][2] = ret
|
for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
|
||||||
types_heap[new_idx]["len"] = 3
|
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
|
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)
|
types_release(ast)
|
||||||
env_release(env)
|
env_release(env)
|
||||||
return body
|
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":
|
case "'quasiquote":
|
||||||
if (len != 2) {
|
if (len != 2) {
|
||||||
types_release(ast)
|
types_release(ast)
|
||||||
|
@ -9,81 +9,93 @@ function READ(str)
|
|||||||
return reader_read_str(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()
|
new_idx = types_allocate()
|
||||||
types_heap[new_idx][0] = "'quote"
|
types_heap[new_idx][0] = "'quote"
|
||||||
types_heap[new_idx][1] = ast
|
types_heap[new_idx][1] = ast
|
||||||
types_heap[new_idx]["len"] = 2
|
types_heap[new_idx]["len"] = 2
|
||||||
return "(" new_idx
|
return "(" new_idx
|
||||||
}
|
}
|
||||||
idx = substr(ast, 2)
|
ret = starts_with(ast, "'unquote")
|
||||||
first = types_heap[idx][0]
|
if (ret ~ /^!/) {
|
||||||
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])
|
|
||||||
types_release(ast)
|
types_release(ast)
|
||||||
return ret
|
return ret
|
||||||
}
|
}
|
||||||
|
if (ret) {
|
||||||
first_idx = substr(first, 2)
|
types_addref(ret)
|
||||||
if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
|
types_release(ast)
|
||||||
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)
|
|
||||||
return ret
|
return ret
|
||||||
}
|
}
|
||||||
|
|
||||||
new_idx = types_allocate()
|
new_idx = types_allocate()
|
||||||
types_heap[new_idx][0] = verb
|
types_heap[new_idx]["len"] = 0
|
||||||
types_heap[new_idx][1] = first
|
ast_idx = substr(ast, 2)
|
||||||
types_heap[new_idx][2] = ret
|
for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
|
||||||
types_heap[new_idx]["len"] = 3
|
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
|
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)) {
|
if (ast !~ /^\(/) return 0
|
||||||
return 0
|
idx = substr(ast, 2)
|
||||||
}
|
len = types_heap[idx]["len"]
|
||||||
sym = types_heap[substr(ast, 2)][0]
|
if (len == 0) return 0
|
||||||
if (sym !~ /^'/) {
|
sym = types_heap[idx][0]
|
||||||
return 0
|
if (sym !~ /^'/) return 0
|
||||||
}
|
|
||||||
f = env_get(env, sym)
|
f = env_get(env, sym)
|
||||||
return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
|
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)
|
types_release(ast)
|
||||||
env_release(env)
|
env_release(env)
|
||||||
return body
|
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":
|
case "'quasiquote":
|
||||||
if (len != 2) {
|
if (len != 2) {
|
||||||
types_release(ast)
|
types_release(ast)
|
||||||
|
@ -9,81 +9,93 @@ function READ(str)
|
|||||||
return reader_read_str(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()
|
new_idx = types_allocate()
|
||||||
types_heap[new_idx][0] = "'quote"
|
types_heap[new_idx][0] = "'quote"
|
||||||
types_heap[new_idx][1] = ast
|
types_heap[new_idx][1] = ast
|
||||||
types_heap[new_idx]["len"] = 2
|
types_heap[new_idx]["len"] = 2
|
||||||
return "(" new_idx
|
return "(" new_idx
|
||||||
}
|
}
|
||||||
idx = substr(ast, 2)
|
ret = starts_with(ast, "'unquote")
|
||||||
first = types_heap[idx][0]
|
if (ret ~ /^!/) {
|
||||||
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])
|
|
||||||
types_release(ast)
|
types_release(ast)
|
||||||
return ret
|
return ret
|
||||||
}
|
}
|
||||||
|
if (ret) {
|
||||||
first_idx = substr(first, 2)
|
types_addref(ret)
|
||||||
if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
|
types_release(ast)
|
||||||
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)
|
|
||||||
return ret
|
return ret
|
||||||
}
|
}
|
||||||
|
|
||||||
new_idx = types_allocate()
|
new_idx = types_allocate()
|
||||||
types_heap[new_idx][0] = verb
|
types_heap[new_idx]["len"] = 0
|
||||||
types_heap[new_idx][1] = first
|
ast_idx = substr(ast, 2)
|
||||||
types_heap[new_idx][2] = ret
|
for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
|
||||||
types_heap[new_idx]["len"] = 3
|
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
|
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)) {
|
if (ast !~ /^\(/) return 0
|
||||||
return 0
|
idx = substr(ast, 2)
|
||||||
}
|
len = types_heap[idx]["len"]
|
||||||
sym = types_heap[substr(ast, 2)][0]
|
if (len == 0) return 0
|
||||||
if (sym !~ /^'/) {
|
sym = types_heap[idx][0]
|
||||||
return 0
|
if (sym !~ /^'/) return 0
|
||||||
}
|
|
||||||
f = env_get(env, sym)
|
f = env_get(env, sym)
|
||||||
return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
|
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)
|
types_release(ast)
|
||||||
env_release(env)
|
env_release(env)
|
||||||
return body
|
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":
|
case "'quasiquote":
|
||||||
if (len != 2) {
|
if (len != 2) {
|
||||||
types_release(ast)
|
types_release(ast)
|
||||||
|
@ -9,81 +9,93 @@ function READ(str)
|
|||||||
return reader_read_str(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()
|
new_idx = types_allocate()
|
||||||
types_heap[new_idx][0] = "'quote"
|
types_heap[new_idx][0] = "'quote"
|
||||||
types_heap[new_idx][1] = ast
|
types_heap[new_idx][1] = ast
|
||||||
types_heap[new_idx]["len"] = 2
|
types_heap[new_idx]["len"] = 2
|
||||||
return "(" new_idx
|
return "(" new_idx
|
||||||
}
|
}
|
||||||
idx = substr(ast, 2)
|
ret = starts_with(ast, "'unquote")
|
||||||
first = types_heap[idx][0]
|
if (ret ~ /^!/) {
|
||||||
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])
|
|
||||||
types_release(ast)
|
types_release(ast)
|
||||||
return ret
|
return ret
|
||||||
}
|
}
|
||||||
|
if (ret) {
|
||||||
first_idx = substr(first, 2)
|
types_addref(ret)
|
||||||
if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
|
types_release(ast)
|
||||||
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)
|
|
||||||
return ret
|
return ret
|
||||||
}
|
}
|
||||||
|
|
||||||
new_idx = types_allocate()
|
new_idx = types_allocate()
|
||||||
types_heap[new_idx][0] = verb
|
types_heap[new_idx]["len"] = 0
|
||||||
types_heap[new_idx][1] = first
|
ast_idx = substr(ast, 2)
|
||||||
types_heap[new_idx][2] = ret
|
for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
|
||||||
types_heap[new_idx]["len"] = 3
|
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
|
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)) {
|
if (ast !~ /^\(/) return 0
|
||||||
return 0
|
idx = substr(ast, 2)
|
||||||
}
|
len = types_heap[idx]["len"]
|
||||||
sym = types_heap[substr(ast, 2)][0]
|
if (len == 0) return 0
|
||||||
if (sym !~ /^'/) {
|
sym = types_heap[idx][0]
|
||||||
return 0
|
if (sym !~ /^'/) return 0
|
||||||
}
|
|
||||||
f = env_get(env, sym)
|
f = env_get(env, sym)
|
||||||
return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
|
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)
|
types_release(ast)
|
||||||
env_release(env)
|
env_release(env)
|
||||||
return body
|
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":
|
case "'quasiquote":
|
||||||
if (len != 2) {
|
if (len != 2) {
|
||||||
types_release(ast)
|
types_release(ast)
|
||||||
|
@ -402,6 +402,7 @@ declare -A core_ns=(
|
|||||||
[sequential?]=sequential?
|
[sequential?]=sequential?
|
||||||
[cons]=cons
|
[cons]=cons
|
||||||
[concat]=concat
|
[concat]=concat
|
||||||
|
[vec]=vec
|
||||||
[nth]=nth
|
[nth]=nth
|
||||||
[first]=_first
|
[first]=_first
|
||||||
[rest]=_rest
|
[rest]=_rest
|
||||||
|
@ -12,42 +12,47 @@ READ () {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# eval
|
# eval
|
||||||
IS_PAIR () {
|
starts_with () {
|
||||||
if _sequential? "${1}"; then
|
_list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
|
||||||
_count "${1}"
|
|
||||||
[[ "${r}" > 0 ]] && return 0
|
|
||||||
fi
|
|
||||||
return 1
|
|
||||||
}
|
}
|
||||||
|
|
||||||
QUASIQUOTE () {
|
QUASIQUOTE () {
|
||||||
if ! IS_PAIR "${1}"; then
|
_obj_type "$1"
|
||||||
_symbol quote
|
case "$r" in
|
||||||
_list "${r}" "${1}"
|
list)
|
||||||
return
|
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
|
else
|
||||||
_nth "${1}" 0; local a0="${r}"
|
_nth "${1}" 0; local a0="$r"
|
||||||
if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
|
if starts_with "$a0" splice-unquote; then
|
||||||
_nth "${1}" 1
|
_symbol concat; local a="$r"
|
||||||
return
|
_nth "$a0" 1; local b="$r"
|
||||||
elif IS_PAIR "${a0}"; then
|
else
|
||||||
_nth "${a0}" 0; local a00="${r}"
|
_symbol cons; local a="$r"
|
||||||
if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
|
QUASIQUOTE "$a0"; local b="$r"
|
||||||
_symbol concat; local a="${r}"
|
|
||||||
_nth "${a0}" 1; local b="${r}"
|
|
||||||
_rest "${1}"
|
|
||||||
QUASIQUOTE "${r}"; local c="${r}"
|
|
||||||
_list "${a}" "${b}" "${c}"
|
|
||||||
return
|
|
||||||
fi
|
|
||||||
fi
|
fi
|
||||||
|
_rest "$1"
|
||||||
|
qqIter "$r"
|
||||||
|
_list "$a" "$b" "$r"
|
||||||
fi
|
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 () {
|
EVAL_AST () {
|
||||||
@ -115,6 +120,9 @@ EVAL () {
|
|||||||
quote)
|
quote)
|
||||||
r="${a1}"
|
r="${a1}"
|
||||||
return ;;
|
return ;;
|
||||||
|
quasiquoteexpand)
|
||||||
|
QUASIQUOTE "${a1}"
|
||||||
|
return ;;
|
||||||
quasiquote)
|
quasiquote)
|
||||||
QUASIQUOTE "${a1}"
|
QUASIQUOTE "${a1}"
|
||||||
ast="${r}"
|
ast="${r}"
|
||||||
|
@ -12,42 +12,47 @@ READ () {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# eval
|
# eval
|
||||||
IS_PAIR () {
|
starts_with () {
|
||||||
if _sequential? "${1}"; then
|
_list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
|
||||||
_count "${1}"
|
|
||||||
[[ "${r}" > 0 ]] && return 0
|
|
||||||
fi
|
|
||||||
return 1
|
|
||||||
}
|
}
|
||||||
|
|
||||||
QUASIQUOTE () {
|
QUASIQUOTE () {
|
||||||
if ! IS_PAIR "${1}"; then
|
_obj_type "$1"
|
||||||
_symbol quote
|
case "$r" in
|
||||||
_list "${r}" "${1}"
|
list)
|
||||||
return
|
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
|
else
|
||||||
_nth "${1}" 0; local a0="${r}"
|
_nth "${1}" 0; local a0="$r"
|
||||||
if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
|
if starts_with "$a0" splice-unquote; then
|
||||||
_nth "${1}" 1
|
_symbol concat; local a="$r"
|
||||||
return
|
_nth "$a0" 1; local b="$r"
|
||||||
elif IS_PAIR "${a0}"; then
|
else
|
||||||
_nth "${a0}" 0; local a00="${r}"
|
_symbol cons; local a="$r"
|
||||||
if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
|
QUASIQUOTE "$a0"; local b="$r"
|
||||||
_symbol concat; local a="${r}"
|
|
||||||
_nth "${a0}" 1; local b="${r}"
|
|
||||||
_rest "${1}"
|
|
||||||
QUASIQUOTE "${r}"; local c="${r}"
|
|
||||||
_list "${a}" "${b}" "${c}"
|
|
||||||
return
|
|
||||||
fi
|
|
||||||
fi
|
fi
|
||||||
|
_rest "$1"
|
||||||
|
qqIter "$r"
|
||||||
|
_list "$a" "$b" "$r"
|
||||||
fi
|
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 () {
|
IS_MACRO_CALL () {
|
||||||
@ -148,6 +153,9 @@ EVAL () {
|
|||||||
quote)
|
quote)
|
||||||
r="${a1}"
|
r="${a1}"
|
||||||
return ;;
|
return ;;
|
||||||
|
quasiquoteexpand)
|
||||||
|
QUASIQUOTE "${a1}"
|
||||||
|
return ;;
|
||||||
quasiquote)
|
quasiquote)
|
||||||
QUASIQUOTE "${a1}"
|
QUASIQUOTE "${a1}"
|
||||||
ast="${r}"
|
ast="${r}"
|
||||||
|
@ -12,42 +12,47 @@ READ () {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# eval
|
# eval
|
||||||
IS_PAIR () {
|
starts_with () {
|
||||||
if _sequential? "${1}"; then
|
_list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
|
||||||
_count "${1}"
|
|
||||||
[[ "${r}" > 0 ]] && return 0
|
|
||||||
fi
|
|
||||||
return 1
|
|
||||||
}
|
}
|
||||||
|
|
||||||
QUASIQUOTE () {
|
QUASIQUOTE () {
|
||||||
if ! IS_PAIR "${1}"; then
|
_obj_type "$1"
|
||||||
_symbol quote
|
case "$r" in
|
||||||
_list "${r}" "${1}"
|
list)
|
||||||
return
|
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
|
else
|
||||||
_nth "${1}" 0; local a0="${r}"
|
_nth "${1}" 0; local a0="$r"
|
||||||
if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
|
if starts_with "$a0" splice-unquote; then
|
||||||
_nth "${1}" 1
|
_symbol concat; local a="$r"
|
||||||
return
|
_nth "$a0" 1; local b="$r"
|
||||||
elif IS_PAIR "${a0}"; then
|
else
|
||||||
_nth "${a0}" 0; local a00="${r}"
|
_symbol cons; local a="$r"
|
||||||
if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
|
QUASIQUOTE "$a0"; local b="$r"
|
||||||
_symbol concat; local a="${r}"
|
|
||||||
_nth "${a0}" 1; local b="${r}"
|
|
||||||
_rest "${1}"
|
|
||||||
QUASIQUOTE "${r}"; local c="${r}"
|
|
||||||
_list "${a}" "${b}" "${c}"
|
|
||||||
return
|
|
||||||
fi
|
|
||||||
fi
|
fi
|
||||||
|
_rest "$1"
|
||||||
|
qqIter "$r"
|
||||||
|
_list "$a" "$b" "$r"
|
||||||
fi
|
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 () {
|
IS_MACRO_CALL () {
|
||||||
@ -148,6 +153,9 @@ EVAL () {
|
|||||||
quote)
|
quote)
|
||||||
r="${a1}"
|
r="${a1}"
|
||||||
return ;;
|
return ;;
|
||||||
|
quasiquoteexpand)
|
||||||
|
QUASIQUOTE "${a1}"
|
||||||
|
return ;;
|
||||||
quasiquote)
|
quasiquote)
|
||||||
QUASIQUOTE "${a1}"
|
QUASIQUOTE "${a1}"
|
||||||
ast="${r}"
|
ast="${r}"
|
||||||
|
@ -12,42 +12,47 @@ READ () {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# eval
|
# eval
|
||||||
IS_PAIR () {
|
starts_with () {
|
||||||
if _sequential? "${1}"; then
|
_list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
|
||||||
_count "${1}"
|
|
||||||
[[ "${r}" > 0 ]] && return 0
|
|
||||||
fi
|
|
||||||
return 1
|
|
||||||
}
|
}
|
||||||
|
|
||||||
QUASIQUOTE () {
|
QUASIQUOTE () {
|
||||||
if ! IS_PAIR "${1}"; then
|
_obj_type "$1"
|
||||||
_symbol quote
|
case "$r" in
|
||||||
_list "${r}" "${1}"
|
list)
|
||||||
return
|
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
|
else
|
||||||
_nth "${1}" 0; local a0="${r}"
|
_nth "${1}" 0; local a0="$r"
|
||||||
if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
|
if starts_with "$a0" splice-unquote; then
|
||||||
_nth "${1}" 1
|
_symbol concat; local a="$r"
|
||||||
return
|
_nth "$a0" 1; local b="$r"
|
||||||
elif IS_PAIR "${a0}"; then
|
else
|
||||||
_nth "${a0}" 0; local a00="${r}"
|
_symbol cons; local a="$r"
|
||||||
if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
|
QUASIQUOTE "$a0"; local b="$r"
|
||||||
_symbol concat; local a="${r}"
|
|
||||||
_nth "${a0}" 1; local b="${r}"
|
|
||||||
_rest "${1}"
|
|
||||||
QUASIQUOTE "${r}"; local c="${r}"
|
|
||||||
_list "${a}" "${b}" "${c}"
|
|
||||||
return
|
|
||||||
fi
|
|
||||||
fi
|
fi
|
||||||
|
_rest "$1"
|
||||||
|
qqIter "$r"
|
||||||
|
_list "$a" "$b" "$r"
|
||||||
fi
|
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 () {
|
IS_MACRO_CALL () {
|
||||||
@ -148,6 +153,9 @@ EVAL () {
|
|||||||
quote)
|
quote)
|
||||||
r="${a1}"
|
r="${a1}"
|
||||||
return ;;
|
return ;;
|
||||||
|
quasiquoteexpand)
|
||||||
|
QUASIQUOTE "${a1}"
|
||||||
|
return ;;
|
||||||
quasiquote)
|
quasiquote)
|
||||||
QUASIQUOTE "${a1}"
|
QUASIQUOTE "${a1}"
|
||||||
ast="${r}"
|
ast="${r}"
|
||||||
|
@ -209,6 +209,12 @@ _vector () {
|
|||||||
}
|
}
|
||||||
_vector? () { [[ ${1} =~ ^vector_ ]]; }
|
_vector? () { [[ ${1} =~ ^vector_ ]]; }
|
||||||
|
|
||||||
|
vec () {
|
||||||
|
__new_obj_hash_code
|
||||||
|
r="vector_$r"
|
||||||
|
ANON["$r"]=${ANON["$1"]}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
# hash maps (associative arrays)
|
# hash maps (associative arrays)
|
||||||
|
|
||||||
|
@ -173,7 +173,7 @@ DO_FUNCTION:
|
|||||||
|
|
||||||
REM Switch on the function number
|
REM Switch on the function number
|
||||||
REM MEMORY DEBUGGING:
|
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
|
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:
|
DO_1_9:
|
||||||
@ -189,7 +189,7 @@ DO_FUNCTION:
|
|||||||
DO_50_59:
|
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
|
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:
|
DO_60_69:
|
||||||
ON G-59 GOTO DO_PR_MEMORY_SUMMARY
|
ON G-59 GOTO DO_VEC,DO_PR_MEMORY_SUMMARY
|
||||||
|
|
||||||
DO_EQUAL_Q:
|
DO_EQUAL_Q:
|
||||||
GOSUB EQUAL_Q
|
GOSUB EQUAL_Q
|
||||||
@ -333,8 +333,7 @@ DO_FUNCTION:
|
|||||||
GOSUB LIST_Q
|
GOSUB LIST_Q
|
||||||
GOTO RETURN_TRUE_FALSE
|
GOTO RETURN_TRUE_FALSE
|
||||||
DO_VECTOR:
|
DO_VECTOR:
|
||||||
A=AR:T=7:GOSUB FORCE_SEQ_TYPE
|
A=AR:T=7:GOTO FORCE_SEQ_TYPE
|
||||||
RETURN
|
|
||||||
DO_VECTOR_Q:
|
DO_VECTOR_Q:
|
||||||
GOSUB TYPE_A
|
GOSUB TYPE_A
|
||||||
R=T=7
|
R=T=7
|
||||||
@ -457,6 +456,8 @@ DO_FUNCTION:
|
|||||||
GOSUB POP_R: REM pop return value
|
GOSUB POP_R: REM pop return value
|
||||||
GOSUB POP_Q: REM pop current
|
GOSUB POP_Q: REM pop current
|
||||||
RETURN
|
RETURN
|
||||||
|
DO_VEC:
|
||||||
|
T=7:GOTO FORCE_SEQ_TYPE
|
||||||
|
|
||||||
DO_NTH:
|
DO_NTH:
|
||||||
B=B1
|
B=B1
|
||||||
@ -625,7 +626,8 @@ INIT_CORE_NS:
|
|||||||
|
|
||||||
B$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=58
|
B$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=58
|
||||||
B$="read-file":GOSUB INIT_CORE_SET_FUNCTION: REM A=59
|
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
|
REM these are in DO_TCO_FUNCTION
|
||||||
A=65
|
A=65
|
||||||
|
@ -234,9 +234,9 @@ SUB EVAL
|
|||||||
|
|
||||||
EVAL_DO_FUNCTION:
|
EVAL_DO_FUNCTION:
|
||||||
REM regular 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
|
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:
|
EVAL_DO_FUNCTION_SKIP:
|
||||||
|
|
||||||
REM pop and release f/args
|
REM pop and release f/args
|
||||||
|
@ -258,9 +258,9 @@ SUB EVAL
|
|||||||
|
|
||||||
EVAL_DO_FUNCTION:
|
EVAL_DO_FUNCTION:
|
||||||
REM regular 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
|
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:
|
EVAL_DO_FUNCTION_SKIP:
|
||||||
|
|
||||||
REM pop and release f/args
|
REM pop and release f/args
|
||||||
|
@ -258,9 +258,9 @@ SUB EVAL
|
|||||||
|
|
||||||
EVAL_DO_FUNCTION:
|
EVAL_DO_FUNCTION:
|
||||||
REM regular 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
|
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:
|
EVAL_DO_FUNCTION_SKIP:
|
||||||
|
|
||||||
REM pop and release f/args
|
REM pop and release f/args
|
||||||
|
@ -17,74 +17,114 @@ MAL_READ:
|
|||||||
|
|
||||||
REM QUASIQUOTE(A) -> R
|
REM QUASIQUOTE(A) -> R
|
||||||
SUB QUASIQUOTE
|
SUB QUASIQUOTE
|
||||||
REM pair?
|
|
||||||
GOSUB TYPE_A
|
GOSUB TYPE_A
|
||||||
IF T<6 OR T>7 THEN GOTO QQ_QUOTE
|
IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
|
||||||
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
|
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
|
GOTO QQ_UNQUOTE
|
||||||
|
|
||||||
|
QQ_UNCHANGED:
|
||||||
|
R=A
|
||||||
|
GOSUB INC_REF_R
|
||||||
|
|
||||||
|
GOTO QQ_DONE
|
||||||
|
|
||||||
QQ_QUOTE:
|
QQ_QUOTE:
|
||||||
REM ['quote, ast]
|
REM ['quote, ast]
|
||||||
B$="quote":T=5:GOSUB STRING
|
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
|
AY=B:GOSUB RELEASE
|
||||||
|
|
||||||
GOTO QQ_DONE
|
GOTO QQ_DONE
|
||||||
|
|
||||||
QQ_UNQUOTE:
|
QQ_UNQUOTE:
|
||||||
R=Z%(A+2)
|
REM [ast[1]]
|
||||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
R=Z%(Z%(A+1)+2)
|
||||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
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
|
GOSUB PUSH_A
|
||||||
REM rest of cases call quasiquote on ast[1..]
|
A=Z%(A+1):CALL QQ_FOLDR
|
||||||
A=Z%(A+1):CALL QUASIQUOTE
|
|
||||||
W=R
|
|
||||||
GOSUB POP_A
|
GOSUB POP_A
|
||||||
|
|
||||||
REM set A to ast[0] for last two cases
|
REM Set A to elt = (first A)
|
||||||
A=Z%(A+2)
|
A=Z%(A+2)
|
||||||
|
|
||||||
REM pair?
|
REM Quasiquote transition function:
|
||||||
GOSUB TYPE_A
|
REM A: current element, R: accumulator -> R: new accumulator
|
||||||
IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
|
|
||||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
|
||||||
|
|
||||||
|
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)
|
B=Z%(A+2)
|
||||||
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
||||||
IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
|
IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
|
||||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
|
REM ('concat, A[1], R)
|
||||||
B=Z%(Z%(A+1)+2)
|
B=Z%(Z%(A+1)+2)
|
||||||
|
A=R
|
||||||
B$="concat":T=5:GOSUB STRING:C=R
|
B$="concat":T=5:GOSUB STRING:C=R
|
||||||
A=W:GOSUB LIST3
|
GOSUB LIST3
|
||||||
REM release inner quasiquoted since outer list takes ownership
|
REM release inner quasiquoted since outer list takes ownership
|
||||||
AY=A:GOSUB RELEASE
|
AY=A:GOSUB RELEASE
|
||||||
AY=C:GOSUB RELEASE
|
AY=C:GOSUB RELEASE
|
||||||
GOTO QQ_DONE
|
|
||||||
|
|
||||||
QQ_DEFAULT:
|
GOTO QQ_FOLDR_DONE
|
||||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
Q=W:GOSUB PUSH_Q
|
QQ_DEFAULT:
|
||||||
REM A set above to ast[0]
|
REM ('cons, quasiquote(A), R)
|
||||||
CALL QUASIQUOTE
|
GOSUB PUSH_R
|
||||||
B=R
|
CALL QUASIQUOTE
|
||||||
GOSUB POP_Q:W=Q
|
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
|
QQ_FOLDR_DONE:
|
||||||
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:
|
|
||||||
END SUB
|
END SUB
|
||||||
|
|
||||||
|
|
||||||
@ -198,6 +238,7 @@ SUB EVAL
|
|||||||
IF A$="def!" THEN GOTO EVAL_DEF
|
IF A$="def!" THEN GOTO EVAL_DEF
|
||||||
IF A$="let*" THEN GOTO EVAL_LET
|
IF A$="let*" THEN GOTO EVAL_LET
|
||||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||||
|
IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
|
||||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||||
IF A$="do" THEN GOTO EVAL_DO
|
IF A$="do" THEN GOTO EVAL_DO
|
||||||
IF A$="if" THEN GOTO EVAL_IF
|
IF A$="if" THEN GOTO EVAL_IF
|
||||||
@ -290,6 +331,11 @@ SUB EVAL
|
|||||||
GOSUB INC_REF_R
|
GOSUB INC_REF_R
|
||||||
GOTO EVAL_RETURN
|
GOTO EVAL_RETURN
|
||||||
|
|
||||||
|
EVAL_QUASIQUOTEEXPAND:
|
||||||
|
R=Z%(Z%(A+1)+2)
|
||||||
|
A=R:CALL QUASIQUOTE
|
||||||
|
GOTO EVAL_RETURN
|
||||||
|
|
||||||
EVAL_QUASIQUOTE:
|
EVAL_QUASIQUOTE:
|
||||||
R=Z%(Z%(A+1)+2)
|
R=Z%(Z%(A+1)+2)
|
||||||
A=R:CALL QUASIQUOTE
|
A=R:CALL QUASIQUOTE
|
||||||
@ -348,9 +394,9 @@ SUB EVAL
|
|||||||
|
|
||||||
EVAL_DO_FUNCTION:
|
EVAL_DO_FUNCTION:
|
||||||
REM regular 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
|
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:
|
EVAL_DO_FUNCTION_SKIP:
|
||||||
|
|
||||||
REM pop and release f/args
|
REM pop and release f/args
|
||||||
|
@ -17,74 +17,114 @@ MAL_READ:
|
|||||||
|
|
||||||
REM QUASIQUOTE(A) -> R
|
REM QUASIQUOTE(A) -> R
|
||||||
SUB QUASIQUOTE
|
SUB QUASIQUOTE
|
||||||
REM pair?
|
|
||||||
GOSUB TYPE_A
|
GOSUB TYPE_A
|
||||||
IF T<6 OR T>7 THEN GOTO QQ_QUOTE
|
IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
|
||||||
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
|
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
|
GOTO QQ_UNQUOTE
|
||||||
|
|
||||||
|
QQ_UNCHANGED:
|
||||||
|
R=A
|
||||||
|
GOSUB INC_REF_R
|
||||||
|
|
||||||
|
GOTO QQ_DONE
|
||||||
|
|
||||||
QQ_QUOTE:
|
QQ_QUOTE:
|
||||||
REM ['quote, ast]
|
REM ['quote, ast]
|
||||||
B$="quote":T=5:GOSUB STRING
|
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
|
AY=B:GOSUB RELEASE
|
||||||
|
|
||||||
GOTO QQ_DONE
|
GOTO QQ_DONE
|
||||||
|
|
||||||
QQ_UNQUOTE:
|
QQ_UNQUOTE:
|
||||||
R=Z%(A+2)
|
REM [ast[1]]
|
||||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
R=Z%(Z%(A+1)+2)
|
||||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
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
|
GOSUB PUSH_A
|
||||||
REM rest of cases call quasiquote on ast[1..]
|
A=Z%(A+1):CALL QQ_FOLDR
|
||||||
A=Z%(A+1):CALL QUASIQUOTE
|
|
||||||
W=R
|
|
||||||
GOSUB POP_A
|
GOSUB POP_A
|
||||||
|
|
||||||
REM set A to ast[0] for last two cases
|
REM Set A to elt = (first A)
|
||||||
A=Z%(A+2)
|
A=Z%(A+2)
|
||||||
|
|
||||||
REM pair?
|
REM Quasiquote transition function:
|
||||||
GOSUB TYPE_A
|
REM A: current element, R: accumulator -> R: new accumulator
|
||||||
IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
|
|
||||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
|
||||||
|
|
||||||
|
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)
|
B=Z%(A+2)
|
||||||
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
||||||
IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
|
IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
|
||||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
|
REM ('concat, A[1], R)
|
||||||
B=Z%(Z%(A+1)+2)
|
B=Z%(Z%(A+1)+2)
|
||||||
|
A=R
|
||||||
B$="concat":T=5:GOSUB STRING:C=R
|
B$="concat":T=5:GOSUB STRING:C=R
|
||||||
A=W:GOSUB LIST3
|
GOSUB LIST3
|
||||||
REM release inner quasiquoted since outer list takes ownership
|
REM release inner quasiquoted since outer list takes ownership
|
||||||
AY=A:GOSUB RELEASE
|
AY=A:GOSUB RELEASE
|
||||||
AY=C:GOSUB RELEASE
|
AY=C:GOSUB RELEASE
|
||||||
GOTO QQ_DONE
|
|
||||||
|
|
||||||
QQ_DEFAULT:
|
GOTO QQ_FOLDR_DONE
|
||||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
Q=W:GOSUB PUSH_Q
|
QQ_DEFAULT:
|
||||||
REM A set above to ast[0]
|
REM ('cons, quasiquote(A), R)
|
||||||
CALL QUASIQUOTE
|
GOSUB PUSH_R
|
||||||
B=R
|
CALL QUASIQUOTE
|
||||||
GOSUB POP_Q:W=Q
|
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
|
QQ_FOLDR_DONE:
|
||||||
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:
|
|
||||||
END SUB
|
END SUB
|
||||||
|
|
||||||
REM MACROEXPAND(A, E) -> A:
|
REM MACROEXPAND(A, E) -> A:
|
||||||
@ -238,6 +278,7 @@ SUB EVAL
|
|||||||
IF A$="def!" THEN GOTO EVAL_DEF
|
IF A$="def!" THEN GOTO EVAL_DEF
|
||||||
IF A$="let*" THEN GOTO EVAL_LET
|
IF A$="let*" THEN GOTO EVAL_LET
|
||||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||||
|
IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
|
||||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||||
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
||||||
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
||||||
@ -332,6 +373,11 @@ SUB EVAL
|
|||||||
GOSUB INC_REF_R
|
GOSUB INC_REF_R
|
||||||
GOTO EVAL_RETURN
|
GOTO EVAL_RETURN
|
||||||
|
|
||||||
|
EVAL_QUASIQUOTEEXPAND:
|
||||||
|
R=Z%(Z%(A+1)+2)
|
||||||
|
A=R:CALL QUASIQUOTE
|
||||||
|
GOTO EVAL_RETURN
|
||||||
|
|
||||||
EVAL_QUASIQUOTE:
|
EVAL_QUASIQUOTE:
|
||||||
R=Z%(Z%(A+1)+2)
|
R=Z%(Z%(A+1)+2)
|
||||||
A=R:CALL QUASIQUOTE
|
A=R:CALL QUASIQUOTE
|
||||||
@ -415,9 +461,9 @@ SUB EVAL
|
|||||||
|
|
||||||
EVAL_DO_FUNCTION:
|
EVAL_DO_FUNCTION:
|
||||||
REM regular 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
|
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:
|
EVAL_DO_FUNCTION_SKIP:
|
||||||
|
|
||||||
REM pop and release f/args
|
REM pop and release f/args
|
||||||
|
@ -17,74 +17,114 @@ MAL_READ:
|
|||||||
|
|
||||||
REM QUASIQUOTE(A) -> R
|
REM QUASIQUOTE(A) -> R
|
||||||
SUB QUASIQUOTE
|
SUB QUASIQUOTE
|
||||||
REM pair?
|
|
||||||
GOSUB TYPE_A
|
GOSUB TYPE_A
|
||||||
IF T<6 OR T>7 THEN GOTO QQ_QUOTE
|
IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
|
||||||
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
|
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
|
GOTO QQ_UNQUOTE
|
||||||
|
|
||||||
|
QQ_UNCHANGED:
|
||||||
|
R=A
|
||||||
|
GOSUB INC_REF_R
|
||||||
|
|
||||||
|
GOTO QQ_DONE
|
||||||
|
|
||||||
QQ_QUOTE:
|
QQ_QUOTE:
|
||||||
REM ['quote, ast]
|
REM ['quote, ast]
|
||||||
B$="quote":T=5:GOSUB STRING
|
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
|
AY=B:GOSUB RELEASE
|
||||||
|
|
||||||
GOTO QQ_DONE
|
GOTO QQ_DONE
|
||||||
|
|
||||||
QQ_UNQUOTE:
|
QQ_UNQUOTE:
|
||||||
R=Z%(A+2)
|
REM [ast[1]]
|
||||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
R=Z%(Z%(A+1)+2)
|
||||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
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
|
GOSUB PUSH_A
|
||||||
REM rest of cases call quasiquote on ast[1..]
|
A=Z%(A+1):CALL QQ_FOLDR
|
||||||
A=Z%(A+1):CALL QUASIQUOTE
|
|
||||||
W=R
|
|
||||||
GOSUB POP_A
|
GOSUB POP_A
|
||||||
|
|
||||||
REM set A to ast[0] for last two cases
|
REM Set A to elt = (first A)
|
||||||
A=Z%(A+2)
|
A=Z%(A+2)
|
||||||
|
|
||||||
REM pair?
|
REM Quasiquote transition function:
|
||||||
GOSUB TYPE_A
|
REM A: current element, R: accumulator -> R: new accumulator
|
||||||
IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
|
|
||||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
|
||||||
|
|
||||||
|
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)
|
B=Z%(A+2)
|
||||||
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
||||||
IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
|
IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
|
||||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
|
REM ('concat, A[1], R)
|
||||||
B=Z%(Z%(A+1)+2)
|
B=Z%(Z%(A+1)+2)
|
||||||
|
A=R
|
||||||
B$="concat":T=5:GOSUB STRING:C=R
|
B$="concat":T=5:GOSUB STRING:C=R
|
||||||
A=W:GOSUB LIST3
|
GOSUB LIST3
|
||||||
REM release inner quasiquoted since outer list takes ownership
|
REM release inner quasiquoted since outer list takes ownership
|
||||||
AY=A:GOSUB RELEASE
|
AY=A:GOSUB RELEASE
|
||||||
AY=C:GOSUB RELEASE
|
AY=C:GOSUB RELEASE
|
||||||
GOTO QQ_DONE
|
|
||||||
|
|
||||||
QQ_DEFAULT:
|
GOTO QQ_FOLDR_DONE
|
||||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
Q=W:GOSUB PUSH_Q
|
QQ_DEFAULT:
|
||||||
REM A set above to ast[0]
|
REM ('cons, quasiquote(A), R)
|
||||||
CALL QUASIQUOTE
|
GOSUB PUSH_R
|
||||||
B=R
|
CALL QUASIQUOTE
|
||||||
GOSUB POP_Q:W=Q
|
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
|
QQ_FOLDR_DONE:
|
||||||
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:
|
|
||||||
END SUB
|
END SUB
|
||||||
|
|
||||||
REM MACROEXPAND(A, E) -> A:
|
REM MACROEXPAND(A, E) -> A:
|
||||||
@ -238,6 +278,7 @@ SUB EVAL
|
|||||||
IF A$="def!" THEN GOTO EVAL_DEF
|
IF A$="def!" THEN GOTO EVAL_DEF
|
||||||
IF A$="let*" THEN GOTO EVAL_LET
|
IF A$="let*" THEN GOTO EVAL_LET
|
||||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||||
|
IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
|
||||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||||
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
||||||
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
||||||
@ -333,6 +374,11 @@ SUB EVAL
|
|||||||
GOSUB INC_REF_R
|
GOSUB INC_REF_R
|
||||||
GOTO EVAL_RETURN
|
GOTO EVAL_RETURN
|
||||||
|
|
||||||
|
EVAL_QUASIQUOTEEXPAND:
|
||||||
|
R=Z%(Z%(A+1)+2)
|
||||||
|
A=R:CALL QUASIQUOTE
|
||||||
|
GOTO EVAL_RETURN
|
||||||
|
|
||||||
EVAL_QUASIQUOTE:
|
EVAL_QUASIQUOTE:
|
||||||
R=Z%(Z%(A+1)+2)
|
R=Z%(Z%(A+1)+2)
|
||||||
A=R:CALL QUASIQUOTE
|
A=R:CALL QUASIQUOTE
|
||||||
@ -448,9 +494,9 @@ SUB EVAL
|
|||||||
|
|
||||||
EVAL_DO_FUNCTION:
|
EVAL_DO_FUNCTION:
|
||||||
REM regular 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
|
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:
|
EVAL_DO_FUNCTION_SKIP:
|
||||||
|
|
||||||
REM pop and release f/args
|
REM pop and release f/args
|
||||||
|
@ -14,74 +14,114 @@ REM READ is inlined in RE
|
|||||||
|
|
||||||
REM QUASIQUOTE(A) -> R
|
REM QUASIQUOTE(A) -> R
|
||||||
SUB QUASIQUOTE
|
SUB QUASIQUOTE
|
||||||
REM pair?
|
|
||||||
GOSUB TYPE_A
|
GOSUB TYPE_A
|
||||||
IF T<6 OR T>7 THEN GOTO QQ_QUOTE
|
IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
|
||||||
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
|
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
|
GOTO QQ_UNQUOTE
|
||||||
|
|
||||||
|
QQ_UNCHANGED:
|
||||||
|
R=A
|
||||||
|
GOSUB INC_REF_R
|
||||||
|
|
||||||
|
GOTO QQ_DONE
|
||||||
|
|
||||||
QQ_QUOTE:
|
QQ_QUOTE:
|
||||||
REM ['quote, ast]
|
REM ['quote, ast]
|
||||||
B$="quote":T=5:GOSUB STRING
|
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
|
AY=B:GOSUB RELEASE
|
||||||
|
|
||||||
GOTO QQ_DONE
|
GOTO QQ_DONE
|
||||||
|
|
||||||
QQ_UNQUOTE:
|
QQ_UNQUOTE:
|
||||||
R=Z%(A+2)
|
REM [ast[1]]
|
||||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
R=Z%(Z%(A+1)+2)
|
||||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
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
|
GOSUB PUSH_A
|
||||||
REM rest of cases call quasiquote on ast[1..]
|
A=Z%(A+1):CALL QQ_FOLDR
|
||||||
A=Z%(A+1):CALL QUASIQUOTE
|
|
||||||
W=R
|
|
||||||
GOSUB POP_A
|
GOSUB POP_A
|
||||||
|
|
||||||
REM set A to ast[0] for last two cases
|
REM Set A to elt = (first A)
|
||||||
A=Z%(A+2)
|
A=Z%(A+2)
|
||||||
|
|
||||||
REM pair?
|
REM Quasiquote transition function:
|
||||||
GOSUB TYPE_A
|
REM A: current element, R: accumulator -> R: new accumulator
|
||||||
IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
|
|
||||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
|
||||||
|
|
||||||
|
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)
|
B=Z%(A+2)
|
||||||
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
||||||
IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
|
IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
|
||||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
|
REM ('concat, A[1], R)
|
||||||
B=Z%(Z%(A+1)+2)
|
B=Z%(Z%(A+1)+2)
|
||||||
|
A=R
|
||||||
B$="concat":T=5:GOSUB STRING:C=R
|
B$="concat":T=5:GOSUB STRING:C=R
|
||||||
A=W:GOSUB LIST3
|
GOSUB LIST3
|
||||||
REM release inner quasiquoted since outer list takes ownership
|
REM release inner quasiquoted since outer list takes ownership
|
||||||
AY=A:GOSUB RELEASE
|
AY=A:GOSUB RELEASE
|
||||||
AY=C:GOSUB RELEASE
|
AY=C:GOSUB RELEASE
|
||||||
GOTO QQ_DONE
|
|
||||||
|
|
||||||
QQ_DEFAULT:
|
GOTO QQ_FOLDR_DONE
|
||||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
Q=W:GOSUB PUSH_Q
|
QQ_DEFAULT:
|
||||||
REM A set above to ast[0]
|
REM ('cons, quasiquote(A), R)
|
||||||
CALL QUASIQUOTE
|
GOSUB PUSH_R
|
||||||
B=R
|
CALL QUASIQUOTE
|
||||||
GOSUB POP_Q:W=Q
|
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
|
QQ_FOLDR_DONE:
|
||||||
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:
|
|
||||||
END SUB
|
END SUB
|
||||||
|
|
||||||
REM MACROEXPAND(A, E) -> A:
|
REM MACROEXPAND(A, E) -> A:
|
||||||
@ -235,6 +275,7 @@ SUB EVAL
|
|||||||
IF A$="def!" THEN GOTO EVAL_DEF
|
IF A$="def!" THEN GOTO EVAL_DEF
|
||||||
IF A$="let*" THEN GOTO EVAL_LET
|
IF A$="let*" THEN GOTO EVAL_LET
|
||||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||||
|
IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
|
||||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||||
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
||||||
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
||||||
@ -330,6 +371,11 @@ SUB EVAL
|
|||||||
GOSUB INC_REF_R
|
GOSUB INC_REF_R
|
||||||
GOTO EVAL_RETURN
|
GOTO EVAL_RETURN
|
||||||
|
|
||||||
|
EVAL_QUASIQUOTEEXPAND:
|
||||||
|
R=Z%(Z%(A+1)+2)
|
||||||
|
A=R:CALL QUASIQUOTE
|
||||||
|
GOTO EVAL_RETURN
|
||||||
|
|
||||||
EVAL_QUASIQUOTE:
|
EVAL_QUASIQUOTE:
|
||||||
R=Z%(Z%(A+1)+2)
|
R=Z%(Z%(A+1)+2)
|
||||||
A=R:CALL QUASIQUOTE
|
A=R:CALL QUASIQUOTE
|
||||||
@ -445,9 +491,9 @@ SUB EVAL
|
|||||||
|
|
||||||
EVAL_DO_FUNCTION:
|
EVAL_DO_FUNCTION:
|
||||||
REM regular 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
|
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:
|
EVAL_DO_FUNCTION_SKIP:
|
||||||
|
|
||||||
REM pop and release f/args
|
REM pop and release f/args
|
||||||
|
@ -286,6 +286,10 @@ DEF FNcore_call(fn%, args%)
|
|||||||
WHEN 60
|
WHEN 60
|
||||||
PROCcore_prepare_args("?", "seq")
|
PROCcore_prepare_args("?", "seq")
|
||||||
=FNcore_seq(args%(0))
|
=FNcore_seq(args%(0))
|
||||||
|
DATA vec, 61
|
||||||
|
WHEN 61
|
||||||
|
PROCcore_prepare_args("l", "vec")
|
||||||
|
=FNas_vector(args%(0))
|
||||||
DATA "", -1
|
DATA "", -1
|
||||||
ENDCASE
|
ENDCASE
|
||||||
ERROR &40E809F1, "Call to non-existent core function"
|
ERROR &40E809F1, "Call to non-existent core function"
|
||||||
|
@ -53,25 +53,33 @@ END
|
|||||||
DEF FNREAD(a$)
|
DEF FNREAD(a$)
|
||||||
=FNread_str(FNalloc_string(a$))
|
=FNread_str(FNalloc_string(a$))
|
||||||
|
|
||||||
DEF FNis_pair(val%)
|
DEF FNstarts_with(ast%, sym$)
|
||||||
=FNis_seq(val%) AND NOT FNis_empty(val%)
|
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%)
|
DEF FNquasiquote(ast%)
|
||||||
LOCAL car%, caar%
|
IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
|
||||||
IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
IF FNis_list(ast%) THEN =FNqq_elts(ast%)
|
||||||
car% = FNfirst(ast%)
|
IF FNis_vector(ast%) THEN
|
||||||
IF FNis_symbol(car%) THEN
|
=FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
|
||||||
IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
|
|
||||||
ENDIF
|
ENDIF
|
||||||
IF FNis_pair(car%) THEN
|
IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
|
||||||
caar% = FNfirst(car%)
|
=FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||||
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
|
|
||||||
ENDIF
|
ENDIF
|
||||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
|
=ast%
|
||||||
|
|
||||||
DEF FNEVAL(ast%, env%)
|
DEF FNEVAL(ast%, env%)
|
||||||
PROCgc_enter
|
PROCgc_enter
|
||||||
@ -124,6 +132,8 @@ DEF FNEVAL_(ast%, env%)
|
|||||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||||
WHEN "quote"
|
WHEN "quote"
|
||||||
=FNnth(ast%, 1)
|
=FNnth(ast%, 1)
|
||||||
|
WHEN "quasiquoteexpand"
|
||||||
|
= FNquasiquote(FNnth(ast%, 1))
|
||||||
WHEN "quasiquote"
|
WHEN "quasiquote"
|
||||||
ast% = FNquasiquote(FNnth(ast%, 1))
|
ast% = FNquasiquote(FNnth(ast%, 1))
|
||||||
REM Loop round for tail-call optimisation
|
REM Loop round for tail-call optimisation
|
||||||
|
@ -54,25 +54,33 @@ END
|
|||||||
DEF FNREAD(a$)
|
DEF FNREAD(a$)
|
||||||
=FNread_str(FNalloc_string(a$))
|
=FNread_str(FNalloc_string(a$))
|
||||||
|
|
||||||
DEF FNis_pair(val%)
|
DEF FNstarts_with(ast%, sym$)
|
||||||
=FNis_seq(val%) AND NOT FNis_empty(val%)
|
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%)
|
DEF FNquasiquote(ast%)
|
||||||
LOCAL car%, caar%
|
IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
|
||||||
IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
IF FNis_list(ast%) THEN =FNqq_elts(ast%)
|
||||||
car% = FNfirst(ast%)
|
IF FNis_vector(ast%) THEN
|
||||||
IF FNis_symbol(car%) THEN
|
=FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
|
||||||
IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
|
|
||||||
ENDIF
|
ENDIF
|
||||||
IF FNis_pair(car%) THEN
|
IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
|
||||||
caar% = FNfirst(car%)
|
=FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||||
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
|
|
||||||
ENDIF
|
ENDIF
|
||||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
|
=ast%
|
||||||
|
|
||||||
DEF FNis_macro_call(ast%, env%)
|
DEF FNis_macro_call(ast%, env%)
|
||||||
LOCAL car%, val%
|
LOCAL car%, val%
|
||||||
@ -153,6 +161,8 @@ DEF FNEVAL_(ast%, env%)
|
|||||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||||
WHEN "quote"
|
WHEN "quote"
|
||||||
=FNnth(ast%, 1)
|
=FNnth(ast%, 1)
|
||||||
|
WHEN "quasiquoteexpand"
|
||||||
|
= FNquasiquote(FNnth(ast%, 1))
|
||||||
WHEN "quasiquote"
|
WHEN "quasiquote"
|
||||||
ast% = FNquasiquote(FNnth(ast%, 1))
|
ast% = FNquasiquote(FNnth(ast%, 1))
|
||||||
REM Loop round for tail-call optimisation
|
REM Loop round for tail-call optimisation
|
||||||
|
@ -54,25 +54,33 @@ END
|
|||||||
DEF FNREAD(a$)
|
DEF FNREAD(a$)
|
||||||
=FNread_str(FNalloc_string(a$))
|
=FNread_str(FNalloc_string(a$))
|
||||||
|
|
||||||
DEF FNis_pair(val%)
|
DEF FNstarts_with(ast%, sym$)
|
||||||
=FNis_seq(val%) AND NOT FNis_empty(val%)
|
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%)
|
DEF FNquasiquote(ast%)
|
||||||
LOCAL car%, caar%
|
IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
|
||||||
IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
IF FNis_list(ast%) THEN =FNqq_elts(ast%)
|
||||||
car% = FNfirst(ast%)
|
IF FNis_vector(ast%) THEN
|
||||||
IF FNis_symbol(car%) THEN
|
=FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
|
||||||
IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
|
|
||||||
ENDIF
|
ENDIF
|
||||||
IF FNis_pair(car%) THEN
|
IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
|
||||||
caar% = FNfirst(car%)
|
=FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||||
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
|
|
||||||
ENDIF
|
ENDIF
|
||||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
|
=ast%
|
||||||
|
|
||||||
DEF FNis_macro_call(ast%, env%)
|
DEF FNis_macro_call(ast%, env%)
|
||||||
LOCAL car%, val%
|
LOCAL car%, val%
|
||||||
@ -195,6 +203,8 @@ DEF FNEVAL_(ast%, env%)
|
|||||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||||
WHEN "quote"
|
WHEN "quote"
|
||||||
=FNnth(ast%, 1)
|
=FNnth(ast%, 1)
|
||||||
|
WHEN "quasiquoteexpand"
|
||||||
|
= FNquasiquote(FNnth(ast%, 1))
|
||||||
WHEN "quasiquote"
|
WHEN "quasiquote"
|
||||||
ast% = FNquasiquote(FNnth(ast%, 1))
|
ast% = FNquasiquote(FNnth(ast%, 1))
|
||||||
REM Loop round for tail-call optimisation
|
REM Loop round for tail-call optimisation
|
||||||
|
@ -56,25 +56,33 @@ END
|
|||||||
DEF FNREAD(a$)
|
DEF FNREAD(a$)
|
||||||
=FNread_str(FNalloc_string(a$))
|
=FNread_str(FNalloc_string(a$))
|
||||||
|
|
||||||
DEF FNis_pair(val%)
|
DEF FNstarts_with(ast%, sym$)
|
||||||
=FNis_seq(val%) AND NOT FNis_empty(val%)
|
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%)
|
DEF FNquasiquote(ast%)
|
||||||
LOCAL car%, caar%
|
IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
|
||||||
IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
IF FNis_list(ast%) THEN =FNqq_elts(ast%)
|
||||||
car% = FNfirst(ast%)
|
IF FNis_vector(ast%) THEN
|
||||||
IF FNis_symbol(car%) THEN
|
=FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
|
||||||
IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
|
|
||||||
ENDIF
|
ENDIF
|
||||||
IF FNis_pair(car%) THEN
|
IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
|
||||||
caar% = FNfirst(car%)
|
=FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||||
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
|
|
||||||
ENDIF
|
ENDIF
|
||||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
|
=ast%
|
||||||
|
|
||||||
DEF FNis_macro_call(ast%, env%)
|
DEF FNis_macro_call(ast%, env%)
|
||||||
LOCAL car%, val%
|
LOCAL car%, val%
|
||||||
@ -197,6 +205,8 @@ DEF FNEVAL_(ast%, env%)
|
|||||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||||
WHEN "quote"
|
WHEN "quote"
|
||||||
=FNnth(ast%, 1)
|
=FNnth(ast%, 1)
|
||||||
|
WHEN "quasiquoteexpand"
|
||||||
|
= FNquasiquote(FNnth(ast%, 1))
|
||||||
WHEN "quasiquote"
|
WHEN "quasiquote"
|
||||||
ast% = FNquasiquote(FNnth(ast%, 1))
|
ast% = FNquasiquote(FNnth(ast%, 1))
|
||||||
REM Loop round for tail-call optimisation
|
REM Loop round for tail-call optimisation
|
||||||
|
@ -330,6 +330,24 @@ MalVal *concat(MalVal *args) {
|
|||||||
return lst;
|
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) {
|
MalVal *nth(MalVal *seq, MalVal *idx) {
|
||||||
return _nth(seq, idx->val.intnum);
|
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},
|
{"=", (void*(*)(void*))equal_Q, 2},
|
||||||
{"throw", (void*(*)(void*))throw, 1},
|
{"throw", (void*(*)(void*))throw, 1},
|
||||||
{"nil?", (void*(*)(void*))nil_Q, 1},
|
{"nil?", (void*(*)(void*))nil_Q, 1},
|
||||||
@ -553,6 +571,7 @@ core_ns_entry core_ns[61] = {
|
|||||||
{"sequential?", (void*(*)(void*))sequential_Q, 1},
|
{"sequential?", (void*(*)(void*))sequential_Q, 1},
|
||||||
{"cons", (void*(*)(void*))cons, 2},
|
{"cons", (void*(*)(void*))cons, 2},
|
||||||
{"concat", (void*(*)(void*))concat, -1},
|
{"concat", (void*(*)(void*))concat, -1},
|
||||||
|
{"vec", (void*(*)(void*))vec, 1},
|
||||||
{"nth", (void*(*)(void*))nth, 2},
|
{"nth", (void*(*)(void*))nth, 2},
|
||||||
{"first", (void*(*)(void*))_first, 1},
|
{"first", (void*(*)(void*))_first, 1},
|
||||||
{"rest", (void*(*)(void*))_rest, 1},
|
{"rest", (void*(*)(void*))_rest, 1},
|
||||||
|
@ -10,6 +10,6 @@ typedef struct {
|
|||||||
int arg_cnt;
|
int arg_cnt;
|
||||||
} core_ns_entry;
|
} core_ns_entry;
|
||||||
|
|
||||||
extern core_ns_entry core_ns[61];
|
extern core_ns_entry core_ns[62];
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
@ -10,6 +10,7 @@
|
|||||||
|
|
||||||
// Declarations
|
// Declarations
|
||||||
MalVal *EVAL(MalVal *ast, Env *env);
|
MalVal *EVAL(MalVal *ast, Env *env);
|
||||||
|
MalVal *quasiquote(MalVal *ast);
|
||||||
|
|
||||||
// read
|
// read
|
||||||
MalVal *READ(char prompt[], char *str) {
|
MalVal *READ(char prompt[], char *str) {
|
||||||
@ -30,30 +31,40 @@ MalVal *READ(char prompt[], char *str) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// eval
|
// eval
|
||||||
int is_pair(MalVal *x) {
|
int starts_with(MalVal *ast, const char *sym) {
|
||||||
return _sequential_Q(x) && (_count(x) > 0);
|
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) {
|
MalVal *quasiquote(MalVal *ast) {
|
||||||
if (!is_pair(ast)) {
|
switch (ast->type) {
|
||||||
return _listX(2, malval_new_symbol("quote"), ast);
|
case MAL_LIST:
|
||||||
} else {
|
if (starts_with(ast, "unquote"))
|
||||||
MalVal *a0 = _nth(ast, 0);
|
|
||||||
if ((a0->type & MAL_SYMBOL) &&
|
|
||||||
strcmp("unquote", a0->val.string) == 0) {
|
|
||||||
return _nth(ast, 1);
|
return _nth(ast, 1);
|
||||||
} else if (is_pair(a0)) {
|
else
|
||||||
MalVal *a00 = _nth(a0, 0);
|
return qq_iter(ast->val.array);
|
||||||
if ((a00->type & MAL_SYMBOL) &&
|
case MAL_VECTOR:
|
||||||
strcmp("splice-unquote", a00->val.string) == 0) {
|
return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
|
||||||
return _listX(3, malval_new_symbol("concat"),
|
case MAL_HASH_MAP:
|
||||||
_nth(a0, 1),
|
case MAL_SYMBOL:
|
||||||
quasiquote(_rest(ast)));
|
return _listX(2, malval_new_symbol("quote"), ast);
|
||||||
}
|
default:
|
||||||
}
|
return ast;
|
||||||
return _listX(3, malval_new_symbol("cons"),
|
|
||||||
quasiquote(a0),
|
|
||||||
quasiquote(_rest(ast)));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -137,6 +148,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
|
|||||||
strcmp("quote", a0->val.string) == 0) {
|
strcmp("quote", a0->val.string) == 0) {
|
||||||
//g_print("eval apply quote\n");
|
//g_print("eval apply quote\n");
|
||||||
return _nth(ast, 1);
|
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) &&
|
} else if ((a0->type & MAL_SYMBOL) &&
|
||||||
strcmp("quasiquote", a0->val.string) == 0) {
|
strcmp("quasiquote", a0->val.string) == 0) {
|
||||||
//g_print("eval apply quasiquote\n");
|
//g_print("eval apply quasiquote\n");
|
||||||
|
@ -10,6 +10,7 @@
|
|||||||
|
|
||||||
// Declarations
|
// Declarations
|
||||||
MalVal *EVAL(MalVal *ast, Env *env);
|
MalVal *EVAL(MalVal *ast, Env *env);
|
||||||
|
MalVal *quasiquote(MalVal *ast);
|
||||||
MalVal *macroexpand(MalVal *ast, Env *env);
|
MalVal *macroexpand(MalVal *ast, Env *env);
|
||||||
|
|
||||||
// read
|
// read
|
||||||
@ -31,30 +32,40 @@ MalVal *READ(char prompt[], char *str) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// eval
|
// eval
|
||||||
int is_pair(MalVal *x) {
|
int starts_with(MalVal *ast, const char *sym) {
|
||||||
return _sequential_Q(x) && (_count(x) > 0);
|
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) {
|
MalVal *quasiquote(MalVal *ast) {
|
||||||
if (!is_pair(ast)) {
|
switch (ast->type) {
|
||||||
return _listX(2, malval_new_symbol("quote"), ast);
|
case MAL_LIST:
|
||||||
} else {
|
if (starts_with(ast, "unquote"))
|
||||||
MalVal *a0 = _nth(ast, 0);
|
|
||||||
if ((a0->type & MAL_SYMBOL) &&
|
|
||||||
strcmp("unquote", a0->val.string) == 0) {
|
|
||||||
return _nth(ast, 1);
|
return _nth(ast, 1);
|
||||||
} else if (is_pair(a0)) {
|
else
|
||||||
MalVal *a00 = _nth(a0, 0);
|
return qq_iter(ast->val.array);
|
||||||
if ((a00->type & MAL_SYMBOL) &&
|
case MAL_VECTOR:
|
||||||
strcmp("splice-unquote", a00->val.string) == 0) {
|
return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
|
||||||
return _listX(3, malval_new_symbol("concat"),
|
case MAL_HASH_MAP:
|
||||||
_nth(a0, 1),
|
case MAL_SYMBOL:
|
||||||
quasiquote(_rest(ast)));
|
return _listX(2, malval_new_symbol("quote"), ast);
|
||||||
}
|
default:
|
||||||
}
|
return ast;
|
||||||
return _listX(3, malval_new_symbol("cons"),
|
|
||||||
quasiquote(a0),
|
|
||||||
quasiquote(_rest(ast)));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -163,6 +174,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
|
|||||||
strcmp("quote", a0->val.string) == 0) {
|
strcmp("quote", a0->val.string) == 0) {
|
||||||
//g_print("eval apply quote\n");
|
//g_print("eval apply quote\n");
|
||||||
return _nth(ast, 1);
|
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) &&
|
} else if ((a0->type & MAL_SYMBOL) &&
|
||||||
strcmp("quasiquote", a0->val.string) == 0) {
|
strcmp("quasiquote", a0->val.string) == 0) {
|
||||||
//g_print("eval apply quasiquote\n");
|
//g_print("eval apply quasiquote\n");
|
||||||
|
@ -11,6 +11,7 @@
|
|||||||
|
|
||||||
// Declarations
|
// Declarations
|
||||||
MalVal *EVAL(MalVal *ast, Env *env);
|
MalVal *EVAL(MalVal *ast, Env *env);
|
||||||
|
MalVal *quasiquote(MalVal *ast);
|
||||||
MalVal *macroexpand(MalVal *ast, Env *env);
|
MalVal *macroexpand(MalVal *ast, Env *env);
|
||||||
|
|
||||||
// read
|
// read
|
||||||
@ -32,30 +33,40 @@ MalVal *READ(char prompt[], char *str) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// eval
|
// eval
|
||||||
int is_pair(MalVal *x) {
|
int starts_with(MalVal *ast, const char *sym) {
|
||||||
return _sequential_Q(x) && (_count(x) > 0);
|
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) {
|
MalVal *quasiquote(MalVal *ast) {
|
||||||
if (!is_pair(ast)) {
|
switch (ast->type) {
|
||||||
return _listX(2, malval_new_symbol("quote"), ast);
|
case MAL_LIST:
|
||||||
} else {
|
if (starts_with(ast, "unquote"))
|
||||||
MalVal *a0 = _nth(ast, 0);
|
|
||||||
if ((a0->type & MAL_SYMBOL) &&
|
|
||||||
strcmp("unquote", a0->val.string) == 0) {
|
|
||||||
return _nth(ast, 1);
|
return _nth(ast, 1);
|
||||||
} else if (is_pair(a0)) {
|
else
|
||||||
MalVal *a00 = _nth(a0, 0);
|
return qq_iter(ast->val.array);
|
||||||
if ((a00->type & MAL_SYMBOL) &&
|
case MAL_VECTOR:
|
||||||
strcmp("splice-unquote", a00->val.string) == 0) {
|
return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
|
||||||
return _listX(3, malval_new_symbol("concat"),
|
case MAL_HASH_MAP:
|
||||||
_nth(a0, 1),
|
case MAL_SYMBOL:
|
||||||
quasiquote(_rest(ast)));
|
return _listX(2, malval_new_symbol("quote"), ast);
|
||||||
}
|
default:
|
||||||
}
|
return ast;
|
||||||
return _listX(3, malval_new_symbol("cons"),
|
|
||||||
quasiquote(a0),
|
|
||||||
quasiquote(_rest(ast)));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -164,6 +175,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
|
|||||||
strcmp("quote", a0->val.string) == 0) {
|
strcmp("quote", a0->val.string) == 0) {
|
||||||
//g_print("eval apply quote\n");
|
//g_print("eval apply quote\n");
|
||||||
return _nth(ast, 1);
|
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) &&
|
} else if ((a0->type & MAL_SYMBOL) &&
|
||||||
strcmp("quasiquote", a0->val.string) == 0) {
|
strcmp("quasiquote", a0->val.string) == 0) {
|
||||||
//g_print("eval apply quasiquote\n");
|
//g_print("eval apply quasiquote\n");
|
||||||
|
@ -11,6 +11,7 @@
|
|||||||
|
|
||||||
// Declarations
|
// Declarations
|
||||||
MalVal *EVAL(MalVal *ast, Env *env);
|
MalVal *EVAL(MalVal *ast, Env *env);
|
||||||
|
MalVal *quasiquote(MalVal *ast);
|
||||||
MalVal *macroexpand(MalVal *ast, Env *env);
|
MalVal *macroexpand(MalVal *ast, Env *env);
|
||||||
|
|
||||||
// read
|
// read
|
||||||
@ -32,30 +33,40 @@ MalVal *READ(char prompt[], char *str) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// eval
|
// eval
|
||||||
int is_pair(MalVal *x) {
|
int starts_with(MalVal *ast, const char *sym) {
|
||||||
return _sequential_Q(x) && (_count(x) > 0);
|
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) {
|
MalVal *quasiquote(MalVal *ast) {
|
||||||
if (!is_pair(ast)) {
|
switch (ast->type) {
|
||||||
return _listX(2, malval_new_symbol("quote"), ast);
|
case MAL_LIST:
|
||||||
} else {
|
if (starts_with(ast, "unquote"))
|
||||||
MalVal *a0 = _nth(ast, 0);
|
|
||||||
if ((a0->type & MAL_SYMBOL) &&
|
|
||||||
strcmp("unquote", a0->val.string) == 0) {
|
|
||||||
return _nth(ast, 1);
|
return _nth(ast, 1);
|
||||||
} else if (is_pair(a0)) {
|
else
|
||||||
MalVal *a00 = _nth(a0, 0);
|
return qq_iter(ast->val.array);
|
||||||
if ((a00->type & MAL_SYMBOL) &&
|
case MAL_VECTOR:
|
||||||
strcmp("splice-unquote", a00->val.string) == 0) {
|
return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
|
||||||
return _listX(3, malval_new_symbol("concat"),
|
case MAL_HASH_MAP:
|
||||||
_nth(a0, 1),
|
case MAL_SYMBOL:
|
||||||
quasiquote(_rest(ast)));
|
return _listX(2, malval_new_symbol("quote"), ast);
|
||||||
}
|
default:
|
||||||
}
|
return ast;
|
||||||
return _listX(3, malval_new_symbol("cons"),
|
|
||||||
quasiquote(a0),
|
|
||||||
quasiquote(_rest(ast)));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -164,6 +175,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
|
|||||||
strcmp("quote", a0->val.string) == 0) {
|
strcmp("quote", a0->val.string) == 0) {
|
||||||
//g_print("eval apply quote\n");
|
//g_print("eval apply quote\n");
|
||||||
return _nth(ast, 1);
|
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) &&
|
} else if ((a0->type & MAL_SYMBOL) &&
|
||||||
strcmp("quasiquote", a0->val.string) == 0) {
|
strcmp("quasiquote", a0->val.string) == 0) {
|
||||||
//g_print("eval apply quasiquote\n");
|
//g_print("eval apply quasiquote\n");
|
||||||
|
@ -10,7 +10,7 @@ public class Core
|
|||||||
"pr-str", "str", "prn", "println",
|
"pr-str", "str", "prn", "println",
|
||||||
"read-string", "slurp",
|
"read-string", "slurp",
|
||||||
"atom", "atom?", "deref", "reset!", "swap!",
|
"atom", "atom?", "deref", "reset!", "swap!",
|
||||||
"cons", "concat",
|
"vec", "cons", "concat",
|
||||||
"nth", "first", "rest",
|
"nth", "first", "rest",
|
||||||
"throw",
|
"throw",
|
||||||
"apply", "map",
|
"apply", "map",
|
||||||
@ -52,6 +52,7 @@ new MalDeref @=> Core.ns["deref"];
|
|||||||
new MalDoReset @=> Core.ns["reset!"];
|
new MalDoReset @=> Core.ns["reset!"];
|
||||||
new MalDoSwap @=> Core.ns["swap!"];
|
new MalDoSwap @=> Core.ns["swap!"];
|
||||||
|
|
||||||
|
new MalVec @=> Core.ns["vec"];
|
||||||
new MalCons @=> Core.ns["cons"];
|
new MalCons @=> Core.ns["cons"];
|
||||||
new MalConcat @=> Core.ns["concat"];
|
new MalConcat @=> Core.ns["concat"];
|
||||||
|
|
||||||
|
@ -27,50 +27,52 @@ fun MalObject READ(string input)
|
|||||||
return Reader.read_str(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") &&
|
if (a.size() != 2)
|
||||||
Util.sequenceToMalObjectArray(m).size() > 0 )
|
|
||||||
{
|
|
||||||
return true;
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
{
|
||||||
return false;
|
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)
|
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]);
|
return MalList.create([MalSymbol.create("quote"), ast]);
|
||||||
}
|
}
|
||||||
|
return 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)))]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
fun MalObject EVAL(MalObject m, Env env)
|
fun MalObject EVAL(MalObject m, Env env)
|
||||||
@ -132,6 +134,10 @@ fun MalObject EVAL(MalObject m, Env env)
|
|||||||
{
|
{
|
||||||
return ast[1];
|
return ast[1];
|
||||||
}
|
}
|
||||||
|
else if( a0 == "quasiquoteexpand" )
|
||||||
|
{
|
||||||
|
return quasiquote(ast[1]);
|
||||||
|
}
|
||||||
else if( a0 == "quasiquote" )
|
else if( a0 == "quasiquote" )
|
||||||
{
|
{
|
||||||
quasiquote(ast[1]) @=> m;
|
quasiquote(ast[1]) @=> m;
|
||||||
|
@ -27,50 +27,52 @@ fun MalObject READ(string input)
|
|||||||
return Reader.read_str(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") &&
|
if (a.size() != 2)
|
||||||
Util.sequenceToMalObjectArray(m).size() > 0 )
|
|
||||||
{
|
|
||||||
return true;
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
{
|
||||||
return false;
|
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)
|
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]);
|
return MalList.create([MalSymbol.create("quote"), ast]);
|
||||||
}
|
}
|
||||||
|
return 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)))]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
fun int isMacroCall(MalObject ast, Env env)
|
fun int isMacroCall(MalObject ast, Env env)
|
||||||
@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
|
|||||||
{
|
{
|
||||||
return ast[1];
|
return ast[1];
|
||||||
}
|
}
|
||||||
|
else if( a0 == "quasiquoteexpand" )
|
||||||
|
{
|
||||||
|
return quasiquote(ast[1]);
|
||||||
|
}
|
||||||
else if( a0 == "quasiquote" )
|
else if( a0 == "quasiquote" )
|
||||||
{
|
{
|
||||||
quasiquote(ast[1]) @=> m;
|
quasiquote(ast[1]) @=> m;
|
||||||
|
@ -27,50 +27,52 @@ fun MalObject READ(string input)
|
|||||||
return Reader.read_str(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") &&
|
if (a.size() != 2)
|
||||||
Util.sequenceToMalObjectArray(m).size() > 0 )
|
|
||||||
{
|
|
||||||
return true;
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
{
|
||||||
return false;
|
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)
|
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]);
|
return MalList.create([MalSymbol.create("quote"), ast]);
|
||||||
}
|
}
|
||||||
|
return 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)))]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
fun int isMacroCall(MalObject ast, Env env)
|
fun int isMacroCall(MalObject ast, Env env)
|
||||||
@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
|
|||||||
{
|
{
|
||||||
return ast[1];
|
return ast[1];
|
||||||
}
|
}
|
||||||
|
else if( a0 == "quasiquoteexpand" )
|
||||||
|
{
|
||||||
|
return quasiquote(ast[1]);
|
||||||
|
}
|
||||||
else if( a0 == "quasiquote" )
|
else if( a0 == "quasiquote" )
|
||||||
{
|
{
|
||||||
quasiquote(ast[1]) @=> m;
|
quasiquote(ast[1]) @=> m;
|
||||||
|
@ -27,50 +27,52 @@ fun MalObject READ(string input)
|
|||||||
return Reader.read_str(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") &&
|
if (a.size() != 2)
|
||||||
Util.sequenceToMalObjectArray(m).size() > 0 )
|
|
||||||
{
|
|
||||||
return true;
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
{
|
||||||
return false;
|
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)
|
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]);
|
return MalList.create([MalSymbol.create("quote"), ast]);
|
||||||
}
|
}
|
||||||
|
return 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)))]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
fun int isMacroCall(MalObject ast, Env env)
|
fun int isMacroCall(MalObject ast, Env env)
|
||||||
@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
|
|||||||
{
|
{
|
||||||
return ast[1];
|
return ast[1];
|
||||||
}
|
}
|
||||||
|
else if( a0 == "quasiquoteexpand" )
|
||||||
|
{
|
||||||
|
return quasiquote(ast[1]);
|
||||||
|
}
|
||||||
else if( a0 == "quasiquote" )
|
else if( a0 == "quasiquote" )
|
||||||
{
|
{
|
||||||
quasiquote(ast[1]) @=> m;
|
quasiquote(ast[1]) @=> m;
|
||||||
|
15
impls/chuck/types/subr/MalVec.ck
Normal file
15
impls/chuck/types/subr/MalVec.ck
Normal file
@ -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"));
|
||||||
|
}
|
||||||
|
}
|
@ -72,6 +72,7 @@
|
|||||||
['vals (fn [hm] (let [vs (vals hm)] (if (nil? vs) '() vs)))]
|
['vals (fn [hm] (let [vs (vals hm)] (if (nil? vs) '() vs)))]
|
||||||
|
|
||||||
['sequential? sequential?]
|
['sequential? sequential?]
|
||||||
|
['vec vec]
|
||||||
['cons cons]
|
['cons cons]
|
||||||
['concat #(apply list (apply concat %&))]
|
['concat #(apply list (apply concat %&))]
|
||||||
['nth nth]
|
['nth nth]
|
||||||
|
@ -13,22 +13,25 @@
|
|||||||
|
|
||||||
;; eval
|
;; eval
|
||||||
(declare 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]
|
(defn quasiquote [ast]
|
||||||
(cond
|
(cond (starts_with ast 'unquote) (second ast)
|
||||||
(not (is-pair ast))
|
(seq? ast) (qq-iter ast)
|
||||||
(list 'quote ast)
|
(vector? ast) (list 'vec (qq-iter ast))
|
||||||
|
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||||
(= 'unquote (first ast))
|
:else 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)))))
|
|
||||||
|
|
||||||
(defn eval-ast [ast env]
|
(defn eval-ast [ast env]
|
||||||
(cond
|
(cond
|
||||||
@ -69,6 +72,9 @@
|
|||||||
'quote
|
'quote
|
||||||
a1
|
a1
|
||||||
|
|
||||||
|
'quasiquoteexpand
|
||||||
|
(quasiquote a1)
|
||||||
|
|
||||||
'quasiquote
|
'quasiquote
|
||||||
(recur (quasiquote a1) env)
|
(recur (quasiquote a1) env)
|
||||||
|
|
||||||
|
@ -14,22 +14,25 @@
|
|||||||
|
|
||||||
;; eval
|
;; eval
|
||||||
(declare 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]
|
(defn quasiquote [ast]
|
||||||
(cond
|
(cond (starts_with ast 'unquote) (second ast)
|
||||||
(not (is-pair ast))
|
(seq? ast) (qq-iter ast)
|
||||||
(list 'quote ast)
|
(vector? ast) (list 'vec (qq-iter ast))
|
||||||
|
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||||
(= 'unquote (first ast))
|
:else 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)))))
|
|
||||||
|
|
||||||
(defn is-macro-call [ast env]
|
(defn is-macro-call [ast env]
|
||||||
(and (seq? ast)
|
(and (seq? ast)
|
||||||
@ -88,6 +91,9 @@
|
|||||||
'quote
|
'quote
|
||||||
a1
|
a1
|
||||||
|
|
||||||
|
'quasiquoteexpand
|
||||||
|
(quasiquote a1)
|
||||||
|
|
||||||
'quasiquote
|
'quasiquote
|
||||||
(recur (quasiquote a1) env)
|
(recur (quasiquote a1) env)
|
||||||
|
|
||||||
|
@ -14,22 +14,25 @@
|
|||||||
|
|
||||||
;; eval
|
;; eval
|
||||||
(declare 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]
|
(defn quasiquote [ast]
|
||||||
(cond
|
(cond (starts_with ast 'unquote) (second ast)
|
||||||
(not (is-pair ast))
|
(seq? ast) (qq-iter ast)
|
||||||
(list 'quote ast)
|
(vector? ast) (list 'vec (qq-iter ast))
|
||||||
|
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||||
(= 'unquote (first ast))
|
:else 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)))))
|
|
||||||
|
|
||||||
(defn is-macro-call [ast env]
|
(defn is-macro-call [ast env]
|
||||||
(and (seq? ast)
|
(and (seq? ast)
|
||||||
@ -88,6 +91,9 @@
|
|||||||
'quote
|
'quote
|
||||||
a1
|
a1
|
||||||
|
|
||||||
|
'quasiquoteexpand
|
||||||
|
(quasiquote a1)
|
||||||
|
|
||||||
'quasiquote
|
'quasiquote
|
||||||
(recur (quasiquote a1) env)
|
(recur (quasiquote a1) env)
|
||||||
|
|
||||||
|
@ -14,22 +14,25 @@
|
|||||||
|
|
||||||
;; eval
|
;; eval
|
||||||
(declare 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]
|
(defn quasiquote [ast]
|
||||||
(cond
|
(cond (starts_with ast 'unquote) (second ast)
|
||||||
(not (is-pair ast))
|
(seq? ast) (qq-iter ast)
|
||||||
(list 'quote ast)
|
(vector? ast) (list 'vec (qq-iter ast))
|
||||||
|
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||||
(= 'unquote (first ast))
|
:else 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)))))
|
|
||||||
|
|
||||||
(defn is-macro-call [ast env]
|
(defn is-macro-call [ast env]
|
||||||
(and (seq? ast)
|
(and (seq? ast)
|
||||||
@ -88,6 +91,9 @@
|
|||||||
'quote
|
'quote
|
||||||
a1
|
a1
|
||||||
|
|
||||||
|
'quasiquoteexpand
|
||||||
|
(quasiquote a1)
|
||||||
|
|
||||||
'quasiquote
|
'quasiquote
|
||||||
(recur (quasiquote a1) env)
|
(recur (quasiquote a1) env)
|
||||||
|
|
||||||
|
@ -84,6 +84,7 @@ exports.ns = {
|
|||||||
'sequential?': types._sequential_Q,
|
'sequential?': types._sequential_Q,
|
||||||
'cons': (a,b) -> [a].concat(b),
|
'cons': (a,b) -> [a].concat(b),
|
||||||
'concat': (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
|
'nth': (a,b) -> if a.length > b then a[b] else
|
||||||
throw new Error "nth: index out of bounds",
|
throw new Error "nth: index out of bounds",
|
||||||
'first': (a) -> if a != null and a.length > 0 then a[0] else null,
|
'first': (a) -> if a != null and a.length > 0 then a[0] else null,
|
||||||
|
@ -9,15 +9,19 @@ core = require("./core.coffee")
|
|||||||
READ = (str) -> reader.read_str str
|
READ = (str) -> reader.read_str str
|
||||||
|
|
||||||
# eval
|
# 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) ->
|
quasiquote = (ast) ->
|
||||||
if !is_pair(ast) then [types._symbol('quote'), ast]
|
if starts_with(ast, 'unquote') then ast[1]
|
||||||
else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
|
else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
|
||||||
else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
|
else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
|
||||||
[types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
|
else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
|
||||||
else
|
else ast
|
||||||
[types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -51,6 +55,8 @@ EVAL = (ast, env) ->
|
|||||||
env = let_env
|
env = let_env
|
||||||
when "quote"
|
when "quote"
|
||||||
return a1
|
return a1
|
||||||
|
when "quasiquoteexpand"
|
||||||
|
return quasiquote(a1)
|
||||||
when "quasiquote"
|
when "quasiquote"
|
||||||
ast = quasiquote(a1)
|
ast = quasiquote(a1)
|
||||||
when "do"
|
when "do"
|
||||||
|
@ -9,15 +9,19 @@ core = require("./core.coffee")
|
|||||||
READ = (str) -> reader.read_str str
|
READ = (str) -> reader.read_str str
|
||||||
|
|
||||||
# eval
|
# 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) ->
|
quasiquote = (ast) ->
|
||||||
if !is_pair(ast) then [types._symbol('quote'), ast]
|
if starts_with(ast, 'unquote') then ast[1]
|
||||||
else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
|
else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
|
||||||
else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
|
else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
|
||||||
[types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
|
else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
|
||||||
else
|
else ast
|
||||||
[types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
is_macro_call = (ast, env) ->
|
is_macro_call = (ast, env) ->
|
||||||
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
||||||
@ -63,6 +67,8 @@ EVAL = (ast, env) ->
|
|||||||
env = let_env
|
env = let_env
|
||||||
when "quote"
|
when "quote"
|
||||||
return a1
|
return a1
|
||||||
|
when "quasiquoteexpand"
|
||||||
|
return quasiquote(a1)
|
||||||
when "quasiquote"
|
when "quasiquote"
|
||||||
ast = quasiquote(a1)
|
ast = quasiquote(a1)
|
||||||
when "defmacro!"
|
when "defmacro!"
|
||||||
|
@ -9,15 +9,19 @@ core = require("./core.coffee")
|
|||||||
READ = (str) -> reader.read_str str
|
READ = (str) -> reader.read_str str
|
||||||
|
|
||||||
# eval
|
# 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) ->
|
quasiquote = (ast) ->
|
||||||
if !is_pair(ast) then [types._symbol('quote'), ast]
|
if starts_with(ast, 'unquote') then ast[1]
|
||||||
else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
|
else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
|
||||||
else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
|
else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
|
||||||
[types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
|
else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
|
||||||
else
|
else ast
|
||||||
[types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
is_macro_call = (ast, env) ->
|
is_macro_call = (ast, env) ->
|
||||||
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
||||||
@ -63,6 +67,8 @@ EVAL = (ast, env) ->
|
|||||||
env = let_env
|
env = let_env
|
||||||
when "quote"
|
when "quote"
|
||||||
return a1
|
return a1
|
||||||
|
when "quasiquoteexpand"
|
||||||
|
return quasiquote(a1)
|
||||||
when "quasiquote"
|
when "quasiquote"
|
||||||
ast = quasiquote(a1)
|
ast = quasiquote(a1)
|
||||||
when "defmacro!"
|
when "defmacro!"
|
||||||
|
@ -9,15 +9,19 @@ core = require("./core.coffee")
|
|||||||
READ = (str) -> reader.read_str str
|
READ = (str) -> reader.read_str str
|
||||||
|
|
||||||
# eval
|
# 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) ->
|
quasiquote = (ast) ->
|
||||||
if !is_pair(ast) then [types._symbol('quote'), ast]
|
if starts_with(ast, 'unquote') then ast[1]
|
||||||
else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
|
else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
|
||||||
else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
|
else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
|
||||||
[types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
|
else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
|
||||||
else
|
else ast
|
||||||
[types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
|
|
||||||
|
|
||||||
is_macro_call = (ast, env) ->
|
is_macro_call = (ast, env) ->
|
||||||
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
||||||
@ -63,6 +67,8 @@ EVAL = (ast, env) ->
|
|||||||
env = let_env
|
env = let_env
|
||||||
when "quote"
|
when "quote"
|
||||||
return a1
|
return a1
|
||||||
|
when "quasiquoteexpand"
|
||||||
|
return quasiquote(a1)
|
||||||
when "quasiquote"
|
when "quasiquote"
|
||||||
ast = quasiquote(a1)
|
ast = quasiquote(a1)
|
||||||
when "defmacro!"
|
when "defmacro!"
|
||||||
|
@ -133,6 +133,9 @@
|
|||||||
(apply (mal-data-value fn)
|
(apply (mal-data-value fn)
|
||||||
(append (list (mal-data-value atom)) args))))
|
(append (list (mal-data-value atom)) args))))
|
||||||
|
|
||||||
|
(defmal vec (list)
|
||||||
|
(make-mal-vector (listify (mal-data-value list))))
|
||||||
|
|
||||||
(defmal cons (element list)
|
(defmal cons (element list)
|
||||||
(make-mal-list (cons element (listify (mal-data-value list)))))
|
(make-mal-list (cons element (listify (mal-data-value list)))))
|
||||||
|
|
||||||
|
@ -31,8 +31,10 @@
|
|||||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||||
(defvar mal-quote (make-mal-symbol "quote"))
|
(defvar mal-quote (make-mal-symbol "quote"))
|
||||||
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
||||||
|
(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
|
||||||
(defvar mal-unquote (make-mal-symbol "unquote"))
|
(defvar mal-unquote (make-mal-symbol "unquote"))
|
||||||
(defvar mal-splice-unquote (make-mal-symbol "splice-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-cons (make-mal-symbol "cons"))
|
||||||
(defvar mal-concat (make-mal-symbol "concat"))
|
(defvar mal-concat (make-mal-symbol "concat"))
|
||||||
|
|
||||||
@ -58,29 +60,24 @@
|
|||||||
(types:hash-map (eval-hash-map ast env))
|
(types:hash-map (eval-hash-map ast env))
|
||||||
(types:any ast)))
|
(types:any ast)))
|
||||||
|
|
||||||
(defun is-pair (value)
|
(defun qq-reducer (elt acc)
|
||||||
(and (or (mal-list-p value)
|
(make-mal-list
|
||||||
(mal-vector-p value))
|
(if (and (mal-list-p elt)
|
||||||
(< 0 (length (mal-data-value value)))))
|
(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)
|
(defun quasiquote (ast)
|
||||||
(if (not (is-pair ast))
|
(switch-mal-type ast
|
||||||
(make-mal-list (list mal-quote ast))
|
(types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
|
||||||
(let ((forms (map 'list #'identity (mal-data-value ast))))
|
(second (mal-data-value ast))
|
||||||
(cond
|
(qq-iter (mal-data-value ast))))
|
||||||
((mal-data-value= mal-unquote (first forms))
|
(types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
|
||||||
(second forms))
|
(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)
|
(defun mal-read (string)
|
||||||
(reader:read-str string))
|
(reader:read-str string))
|
||||||
@ -96,6 +93,9 @@
|
|||||||
((mal-data-value= mal-quote (first forms))
|
((mal-data-value= mal-quote (first forms))
|
||||||
(return (second forms)))
|
(return (second forms)))
|
||||||
|
|
||||||
|
((mal-data-value= mal-quasiquoteexpand (first forms))
|
||||||
|
(return (quasiquote (second forms))))
|
||||||
|
|
||||||
((mal-data-value= mal-quasiquote (first forms))
|
((mal-data-value= mal-quasiquote (first forms))
|
||||||
(setf ast (quasiquote (second forms))))
|
(setf ast (quasiquote (second forms))))
|
||||||
|
|
||||||
|
@ -43,8 +43,10 @@
|
|||||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||||
(defvar mal-quote (make-mal-symbol "quote"))
|
(defvar mal-quote (make-mal-symbol "quote"))
|
||||||
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
||||||
|
(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
|
||||||
(defvar mal-unquote (make-mal-symbol "unquote"))
|
(defvar mal-unquote (make-mal-symbol "unquote"))
|
||||||
(defvar mal-splice-unquote (make-mal-symbol "splice-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-cons (make-mal-symbol "cons"))
|
||||||
(defvar mal-concat (make-mal-symbol "concat"))
|
(defvar mal-concat (make-mal-symbol "concat"))
|
||||||
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
||||||
@ -72,29 +74,23 @@
|
|||||||
(types:hash-map (eval-hash-map ast env))
|
(types:hash-map (eval-hash-map ast env))
|
||||||
(types:any ast)))
|
(types:any ast)))
|
||||||
|
|
||||||
(defun is-pair (value)
|
(defun qq-reducer (elt acc)
|
||||||
(and (or (mal-list-p value)
|
(make-mal-list
|
||||||
(mal-vector-p value))
|
(if (and (mal-list-p elt)
|
||||||
(< 0 (length (mal-data-value value)))))
|
(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)
|
(defun quasiquote (ast)
|
||||||
(if (not (is-pair ast))
|
(switch-mal-type ast
|
||||||
(make-mal-list (list mal-quote ast))
|
(types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
|
||||||
(let ((forms (map 'list #'identity (mal-data-value ast))))
|
(second (mal-data-value ast))
|
||||||
(cond
|
(qq-iter (mal-data-value ast))))
|
||||||
((mal-data-value= mal-unquote (first forms))
|
(types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
|
||||||
(second forms))
|
(types:hash-map (make-mal-list (list mal-quote ast)))
|
||||||
|
(types:symbol (make-mal-list (list mal-quote ast)))
|
||||||
((and (is-pair (first forms))
|
(types:any ast)))
|
||||||
(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 is-macro-call (ast env)
|
(defun is-macro-call (ast env)
|
||||||
(when (mal-list-p ast)
|
(when (mal-list-p ast)
|
||||||
@ -129,6 +125,9 @@
|
|||||||
((mal-data-value= mal-quote (first forms))
|
((mal-data-value= mal-quote (first forms))
|
||||||
(return (second forms)))
|
(return (second forms)))
|
||||||
|
|
||||||
|
((mal-data-value= mal-quasiquoteexpand (first forms))
|
||||||
|
(return (quasiquote (second forms))))
|
||||||
|
|
||||||
((mal-data-value= mal-quasiquote (first forms))
|
((mal-data-value= mal-quasiquote (first forms))
|
||||||
(setf ast (quasiquote (second forms))))
|
(setf ast (quasiquote (second forms))))
|
||||||
|
|
||||||
|
@ -43,8 +43,10 @@
|
|||||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||||
(defvar mal-quote (make-mal-symbol "quote"))
|
(defvar mal-quote (make-mal-symbol "quote"))
|
||||||
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
||||||
|
(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
|
||||||
(defvar mal-unquote (make-mal-symbol "unquote"))
|
(defvar mal-unquote (make-mal-symbol "unquote"))
|
||||||
(defvar mal-splice-unquote (make-mal-symbol "splice-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-cons (make-mal-symbol "cons"))
|
||||||
(defvar mal-concat (make-mal-symbol "concat"))
|
(defvar mal-concat (make-mal-symbol "concat"))
|
||||||
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
||||||
@ -75,29 +77,23 @@
|
|||||||
(types:hash-map (eval-hash-map ast env))
|
(types:hash-map (eval-hash-map ast env))
|
||||||
(types:any ast)))
|
(types:any ast)))
|
||||||
|
|
||||||
(defun is-pair (value)
|
(defun qq-reducer (elt acc)
|
||||||
(and (or (mal-list-p value)
|
(make-mal-list
|
||||||
(mal-vector-p value))
|
(if (and (mal-list-p elt)
|
||||||
(< 0 (length (mal-data-value value)))))
|
(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)
|
(defun quasiquote (ast)
|
||||||
(if (not (is-pair ast))
|
(switch-mal-type ast
|
||||||
(make-mal-list (list mal-quote ast))
|
(types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
|
||||||
(let ((forms (map 'list #'identity (mal-data-value ast))))
|
(second (mal-data-value ast))
|
||||||
(cond
|
(qq-iter (mal-data-value ast))))
|
||||||
((mal-data-value= mal-unquote (first forms))
|
(types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
|
||||||
(second forms))
|
(types:hash-map (make-mal-list (list mal-quote ast)))
|
||||||
|
(types:symbol (make-mal-list (list mal-quote ast)))
|
||||||
((and (is-pair (first forms))
|
(types:any ast)))
|
||||||
(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 is-macro-call (ast env)
|
(defun is-macro-call (ast env)
|
||||||
(when (mal-list-p ast)
|
(when (mal-list-p ast)
|
||||||
@ -132,6 +128,9 @@
|
|||||||
((mal-data-value= mal-quote (first forms))
|
((mal-data-value= mal-quote (first forms))
|
||||||
(return (second forms)))
|
(return (second forms)))
|
||||||
|
|
||||||
|
((mal-data-value= mal-quasiquoteexpand (first forms))
|
||||||
|
(return (quasiquote (second forms))))
|
||||||
|
|
||||||
((mal-data-value= mal-quasiquote (first forms))
|
((mal-data-value= mal-quasiquote (first forms))
|
||||||
(setf ast (quasiquote (second forms))))
|
(setf ast (quasiquote (second forms))))
|
||||||
|
|
||||||
|
@ -42,8 +42,10 @@
|
|||||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||||
(defvar mal-quote (make-mal-symbol "quote"))
|
(defvar mal-quote (make-mal-symbol "quote"))
|
||||||
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
||||||
|
(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
|
||||||
(defvar mal-unquote (make-mal-symbol "unquote"))
|
(defvar mal-unquote (make-mal-symbol "unquote"))
|
||||||
(defvar mal-splice-unquote (make-mal-symbol "splice-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-cons (make-mal-symbol "cons"))
|
||||||
(defvar mal-concat (make-mal-symbol "concat"))
|
(defvar mal-concat (make-mal-symbol "concat"))
|
||||||
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
||||||
@ -74,29 +76,23 @@
|
|||||||
(types:hash-map (eval-hash-map ast env))
|
(types:hash-map (eval-hash-map ast env))
|
||||||
(types:any ast)))
|
(types:any ast)))
|
||||||
|
|
||||||
(defun is-pair (value)
|
(defun qq-reducer (elt acc)
|
||||||
(and (or (mal-list-p value)
|
(make-mal-list
|
||||||
(mal-vector-p value))
|
(if (and (mal-list-p elt)
|
||||||
(< 0 (length (mal-data-value value)))))
|
(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)
|
(defun quasiquote (ast)
|
||||||
(if (not (is-pair ast))
|
(switch-mal-type ast
|
||||||
(make-mal-list (list mal-quote ast))
|
(types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
|
||||||
(let ((forms (map 'list #'identity (mal-data-value ast))))
|
(second (mal-data-value ast))
|
||||||
(cond
|
(qq-iter (mal-data-value ast))))
|
||||||
((mal-data-value= mal-unquote (first forms))
|
(types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
|
||||||
(second forms))
|
(types:hash-map (make-mal-list (list mal-quote ast)))
|
||||||
|
(types:symbol (make-mal-list (list mal-quote ast)))
|
||||||
((and (is-pair (first forms))
|
(types:any ast)))
|
||||||
(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 is-macro-call (ast env)
|
(defun is-macro-call (ast env)
|
||||||
(when (mal-list-p ast)
|
(when (mal-list-p ast)
|
||||||
@ -131,6 +127,9 @@
|
|||||||
((mal-data-value= mal-quote (first forms))
|
((mal-data-value= mal-quote (first forms))
|
||||||
(return (second forms)))
|
(return (second forms)))
|
||||||
|
|
||||||
|
((mal-data-value= mal-quasiquoteexpand (first forms))
|
||||||
|
(return (quasiquote (second forms))))
|
||||||
|
|
||||||
((mal-data-value= mal-quasiquote (first forms))
|
((mal-data-value= mal-quasiquote (first forms))
|
||||||
(setf ast (quasiquote (second forms))))
|
(setf ast (quasiquote (second forms))))
|
||||||
|
|
||||||
|
@ -509,6 +509,13 @@ BUILTIN("vals")
|
|||||||
return hash->values();
|
return hash->values();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
BUILTIN("vec")
|
||||||
|
{
|
||||||
|
CHECK_ARGS_IS(1);
|
||||||
|
ARG(malSequence, s);
|
||||||
|
return mal::vector(s->begin(), s->end());
|
||||||
|
}
|
||||||
|
|
||||||
BUILTIN("vector")
|
BUILTIN("vector")
|
||||||
{
|
{
|
||||||
return mal::vector(argsBegin, argsEnd);
|
return mal::vector(argsBegin, argsEnd);
|
||||||
|
@ -146,6 +146,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
|
|||||||
continue; // TCO
|
continue; // TCO
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (special == "quasiquoteexpand") {
|
||||||
|
checkArgsIs("quasiquote", 1, argCount);
|
||||||
|
return quasiquote(list->item(1));
|
||||||
|
}
|
||||||
|
|
||||||
if (special == "quasiquote") {
|
if (special == "quasiquote") {
|
||||||
checkArgsIs("quasiquote", 1, argCount);
|
checkArgsIs("quasiquote", 1, argCount);
|
||||||
ast = quasiquote(list->item(1));
|
ast = quasiquote(list->item(1));
|
||||||
@ -192,44 +197,41 @@ static bool isSymbol(malValuePtr obj, const String& text)
|
|||||||
return sym && (sym->value() == 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);
|
const malList* list = DYNAMIC_CAST(malList, ast);
|
||||||
return list && !list->isEmpty() ? list : NULL;
|
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)
|
static malValuePtr quasiquote(malValuePtr obj)
|
||||||
{
|
{
|
||||||
const malSequence* seq = isPair(obj);
|
if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
|
||||||
if (!seq) {
|
|
||||||
return mal::list(mal::symbol("quote"), obj);
|
return mal::list(mal::symbol("quote"), obj);
|
||||||
}
|
|
||||||
|
|
||||||
if (isSymbol(seq->item(0), "unquote")) {
|
const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
|
||||||
// (qq (uq form)) -> form
|
if (!seq)
|
||||||
checkArgsIs("unquote", 1, seq->count() - 1);
|
return obj;
|
||||||
return seq->item(1);
|
|
||||||
}
|
|
||||||
|
|
||||||
const malSequence* innerSeq = isPair(seq->item(0));
|
const malValuePtr unquoted = starts_with(obj, "unquote");
|
||||||
if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
|
if (unquoted)
|
||||||
checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
|
return unquoted;
|
||||||
// (qq (sq '(a b c))) -> a b c
|
|
||||||
return mal::list(
|
malValuePtr res = mal::list(new malValueVec(0));
|
||||||
mal::symbol("concat"),
|
for (int i=seq->count()-1; 0<=i; i--) {
|
||||||
innerSeq->item(1),
|
const malValuePtr elt = seq->item(i);
|
||||||
quasiquote(seq->rest())
|
const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
|
||||||
);
|
if (spl_unq)
|
||||||
}
|
res = mal::list(mal::symbol("concat"), spl_unq, res);
|
||||||
else {
|
else
|
||||||
// (qq (a b c)) -> (list (qq a) (qq b) (qq c))
|
res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
|
||||||
// (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
|
|
||||||
return mal::list(
|
|
||||||
mal::symbol("cons"),
|
|
||||||
quasiquote(seq->first()),
|
|
||||||
quasiquote(seq->rest())
|
|
||||||
);
|
|
||||||
}
|
}
|
||||||
|
if (DYNAMIC_CAST(malVector, obj))
|
||||||
|
res = mal::list(mal::symbol("vec"), res);
|
||||||
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
static const char* malFunctionTable[] = {
|
static const char* malFunctionTable[] = {
|
||||||
|
@ -168,6 +168,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
|
|||||||
return macroExpand(list->item(1), env);
|
return macroExpand(list->item(1), env);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (special == "quasiquoteexpand") {
|
||||||
|
checkArgsIs("quasiquote", 1, argCount);
|
||||||
|
return quasiquote(list->item(1));
|
||||||
|
}
|
||||||
|
|
||||||
if (special == "quasiquote") {
|
if (special == "quasiquote") {
|
||||||
checkArgsIs("quasiquote", 1, argCount);
|
checkArgsIs("quasiquote", 1, argCount);
|
||||||
ast = quasiquote(list->item(1));
|
ast = quasiquote(list->item(1));
|
||||||
@ -214,50 +219,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
|
|||||||
return sym && (sym->value() == 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);
|
const malList* list = DYNAMIC_CAST(malList, ast);
|
||||||
return list && !list->isEmpty() ? list : NULL;
|
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)
|
static malValuePtr quasiquote(malValuePtr obj)
|
||||||
{
|
{
|
||||||
const malSequence* seq = isPair(obj);
|
if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
|
||||||
if (!seq) {
|
|
||||||
return mal::list(mal::symbol("quote"), obj);
|
return mal::list(mal::symbol("quote"), obj);
|
||||||
}
|
|
||||||
|
|
||||||
if (isSymbol(seq->item(0), "unquote")) {
|
const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
|
||||||
// (qq (uq form)) -> form
|
if (!seq)
|
||||||
checkArgsIs("unquote", 1, seq->count() - 1);
|
return obj;
|
||||||
return seq->item(1);
|
|
||||||
}
|
|
||||||
|
|
||||||
const malSequence* innerSeq = isPair(seq->item(0));
|
const malValuePtr unquoted = starts_with(obj, "unquote");
|
||||||
if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
|
if (unquoted)
|
||||||
checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
|
return unquoted;
|
||||||
// (qq (sq '(a b c))) -> a b c
|
|
||||||
return mal::list(
|
malValuePtr res = mal::list(new malValueVec(0));
|
||||||
mal::symbol("concat"),
|
for (int i=seq->count()-1; 0<=i; i--) {
|
||||||
innerSeq->item(1),
|
const malValuePtr elt = seq->item(i);
|
||||||
quasiquote(seq->rest())
|
const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
|
||||||
);
|
if (spl_unq)
|
||||||
}
|
res = mal::list(mal::symbol("concat"), spl_unq, res);
|
||||||
else {
|
else
|
||||||
// (qq (a b c)) -> (list (qq a) (qq b) (qq c))
|
res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
|
||||||
// (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
|
|
||||||
return mal::list(
|
|
||||||
mal::symbol("cons"),
|
|
||||||
quasiquote(seq->first()),
|
|
||||||
quasiquote(seq->rest())
|
|
||||||
);
|
|
||||||
}
|
}
|
||||||
|
if (DYNAMIC_CAST(malVector, obj))
|
||||||
|
res = mal::list(mal::symbol("vec"), res);
|
||||||
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
||||||
{
|
{
|
||||||
if (const malSequence* seq = isPair(obj)) {
|
const malList* seq = DYNAMIC_CAST(malList, obj);
|
||||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
|
if (seq && !seq->isEmpty()) {
|
||||||
|
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
|
||||||
if (malEnvPtr symEnv = env->find(sym->value())) {
|
if (malEnvPtr symEnv = env->find(sym->value())) {
|
||||||
malValuePtr value = sym->eval(symEnv);
|
malValuePtr value = sym->eval(symEnv);
|
||||||
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
||||||
|
@ -171,6 +171,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
|
|||||||
return macroExpand(list->item(1), env);
|
return macroExpand(list->item(1), env);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (special == "quasiquoteexpand") {
|
||||||
|
checkArgsIs("quasiquote", 1, argCount);
|
||||||
|
return quasiquote(list->item(1));
|
||||||
|
}
|
||||||
|
|
||||||
if (special == "quasiquote") {
|
if (special == "quasiquote") {
|
||||||
checkArgsIs("quasiquote", 1, argCount);
|
checkArgsIs("quasiquote", 1, argCount);
|
||||||
ast = quasiquote(list->item(1));
|
ast = quasiquote(list->item(1));
|
||||||
@ -263,50 +268,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
|
|||||||
return sym && (sym->value() == 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);
|
const malList* list = DYNAMIC_CAST(malList, ast);
|
||||||
return list && !list->isEmpty() ? list : NULL;
|
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)
|
static malValuePtr quasiquote(malValuePtr obj)
|
||||||
{
|
{
|
||||||
const malSequence* seq = isPair(obj);
|
if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
|
||||||
if (!seq) {
|
|
||||||
return mal::list(mal::symbol("quote"), obj);
|
return mal::list(mal::symbol("quote"), obj);
|
||||||
}
|
|
||||||
|
|
||||||
if (isSymbol(seq->item(0), "unquote")) {
|
const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
|
||||||
// (qq (uq form)) -> form
|
if (!seq)
|
||||||
checkArgsIs("unquote", 1, seq->count() - 1);
|
return obj;
|
||||||
return seq->item(1);
|
|
||||||
}
|
|
||||||
|
|
||||||
const malSequence* innerSeq = isPair(seq->item(0));
|
const malValuePtr unquoted = starts_with(obj, "unquote");
|
||||||
if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
|
if (unquoted)
|
||||||
checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
|
return unquoted;
|
||||||
// (qq (sq '(a b c))) -> a b c
|
|
||||||
return mal::list(
|
malValuePtr res = mal::list(new malValueVec(0));
|
||||||
mal::symbol("concat"),
|
for (int i=seq->count()-1; 0<=i; i--) {
|
||||||
innerSeq->item(1),
|
const malValuePtr elt = seq->item(i);
|
||||||
quasiquote(seq->rest())
|
const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
|
||||||
);
|
if (spl_unq)
|
||||||
}
|
res = mal::list(mal::symbol("concat"), spl_unq, res);
|
||||||
else {
|
else
|
||||||
// (qq (a b c)) -> (list (qq a) (qq b) (qq c))
|
res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
|
||||||
// (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
|
|
||||||
return mal::list(
|
|
||||||
mal::symbol("cons"),
|
|
||||||
quasiquote(seq->first()),
|
|
||||||
quasiquote(seq->rest())
|
|
||||||
);
|
|
||||||
}
|
}
|
||||||
|
if (DYNAMIC_CAST(malVector, obj))
|
||||||
|
res = mal::list(mal::symbol("vec"), res);
|
||||||
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
||||||
{
|
{
|
||||||
if (const malSequence* seq = isPair(obj)) {
|
const malList* seq = DYNAMIC_CAST(malList, obj);
|
||||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
|
if (seq && !seq->isEmpty()) {
|
||||||
|
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
|
||||||
if (malEnvPtr symEnv = env->find(sym->value())) {
|
if (malEnvPtr symEnv = env->find(sym->value())) {
|
||||||
malValuePtr value = sym->eval(symEnv);
|
malValuePtr value = sym->eval(symEnv);
|
||||||
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
||||||
|
@ -172,6 +172,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
|
|||||||
return macroExpand(list->item(1), env);
|
return macroExpand(list->item(1), env);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (special == "quasiquoteexpand") {
|
||||||
|
checkArgsIs("quasiquote", 1, argCount);
|
||||||
|
return quasiquote(list->item(1));
|
||||||
|
}
|
||||||
|
|
||||||
if (special == "quasiquote") {
|
if (special == "quasiquote") {
|
||||||
checkArgsIs("quasiquote", 1, argCount);
|
checkArgsIs("quasiquote", 1, argCount);
|
||||||
ast = quasiquote(list->item(1));
|
ast = quasiquote(list->item(1));
|
||||||
@ -264,50 +269,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
|
|||||||
return sym && (sym->value() == 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);
|
const malList* list = DYNAMIC_CAST(malList, ast);
|
||||||
return list && !list->isEmpty() ? list : NULL;
|
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)
|
static malValuePtr quasiquote(malValuePtr obj)
|
||||||
{
|
{
|
||||||
const malSequence* seq = isPair(obj);
|
if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
|
||||||
if (!seq) {
|
|
||||||
return mal::list(mal::symbol("quote"), obj);
|
return mal::list(mal::symbol("quote"), obj);
|
||||||
}
|
|
||||||
|
|
||||||
if (isSymbol(seq->item(0), "unquote")) {
|
const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
|
||||||
// (qq (uq form)) -> form
|
if (!seq)
|
||||||
checkArgsIs("unquote", 1, seq->count() - 1);
|
return obj;
|
||||||
return seq->item(1);
|
|
||||||
}
|
|
||||||
|
|
||||||
const malSequence* innerSeq = isPair(seq->item(0));
|
const malValuePtr unquoted = starts_with(obj, "unquote");
|
||||||
if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
|
if (unquoted)
|
||||||
checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
|
return unquoted;
|
||||||
// (qq (sq '(a b c))) -> a b c
|
|
||||||
return mal::list(
|
malValuePtr res = mal::list(new malValueVec(0));
|
||||||
mal::symbol("concat"),
|
for (int i=seq->count()-1; 0<=i; i--) {
|
||||||
innerSeq->item(1),
|
const malValuePtr elt = seq->item(i);
|
||||||
quasiquote(seq->rest())
|
const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
|
||||||
);
|
if (spl_unq)
|
||||||
}
|
res = mal::list(mal::symbol("concat"), spl_unq, res);
|
||||||
else {
|
else
|
||||||
// (qq (a b c)) -> (list (qq a) (qq b) (qq c))
|
res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
|
||||||
// (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
|
|
||||||
return mal::list(
|
|
||||||
mal::symbol("cons"),
|
|
||||||
quasiquote(seq->first()),
|
|
||||||
quasiquote(seq->rest())
|
|
||||||
);
|
|
||||||
}
|
}
|
||||||
|
if (DYNAMIC_CAST(malVector, obj))
|
||||||
|
res = mal::list(mal::symbol("vec"), res);
|
||||||
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
||||||
{
|
{
|
||||||
if (const malSequence* seq = isPair(obj)) {
|
const malList* seq = DYNAMIC_CAST(malList, obj);
|
||||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
|
if (seq && !seq->isEmpty()) {
|
||||||
|
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
|
||||||
if (malEnvPtr symEnv = env->find(sym->value())) {
|
if (malEnvPtr symEnv = env->find(sym->value())) {
|
||||||
malValuePtr value = sym->eval(symEnv);
|
malValuePtr value = sym->eval(symEnv);
|
||||||
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
||||||
|
@ -88,6 +88,12 @@ module Mal
|
|||||||
end
|
end
|
||||||
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)
|
def self.nth(args)
|
||||||
a0, a1 = args[0].unwrap, args[1].unwrap
|
a0, a1 = args[0].unwrap, args[1].unwrap
|
||||||
eval_error "1st argument of nth must be list or vector" unless a0.is_a? Array
|
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),
|
"slurp" => func(:slurp),
|
||||||
"cons" => func(:cons),
|
"cons" => func(:cons),
|
||||||
"concat" => func(:concat),
|
"concat" => func(:concat),
|
||||||
|
"vec" => func(:vec),
|
||||||
"nth" => func(:nth),
|
"nth" => func(:nth),
|
||||||
"first" => func(:first),
|
"first" => func(:first),
|
||||||
"rest" => func(:rest),
|
"rest" => func(:rest),
|
||||||
|
@ -51,36 +51,49 @@ module Mal
|
|||||||
read_str str
|
read_str str
|
||||||
end
|
end
|
||||||
|
|
||||||
macro is_pair(list)
|
def starts_with(list, symbol)
|
||||||
{{list}}.is_a?(Array) && !{{list}}.empty?
|
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
|
end
|
||||||
|
|
||||||
def quasiquote(ast)
|
def quasiquote(ast)
|
||||||
list = ast.unwrap
|
ast_val = ast.unwrap
|
||||||
|
case ast_val
|
||||||
unless is_pair(list)
|
when Mal::List
|
||||||
return Mal::Type.new(
|
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
|
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
|
else
|
||||||
tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
|
ast
|
||||||
Mal::Type.new(
|
|
||||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
|
|
||||||
)
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -161,6 +174,8 @@ module Mal
|
|||||||
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
||||||
when "quote"
|
when "quote"
|
||||||
list[1]
|
list[1]
|
||||||
|
when "quasiquoteexpand"
|
||||||
|
quasiquote list[1]
|
||||||
when "quasiquote"
|
when "quasiquote"
|
||||||
ast = quasiquote list[1]
|
ast = quasiquote list[1]
|
||||||
next # TCO
|
next # TCO
|
||||||
|
@ -51,36 +51,49 @@ module Mal
|
|||||||
read_str str
|
read_str str
|
||||||
end
|
end
|
||||||
|
|
||||||
macro pair?(list)
|
def starts_with(list, symbol)
|
||||||
{{list}}.is_a?(Array) && !{{list}}.empty?
|
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
|
end
|
||||||
|
|
||||||
def quasiquote(ast)
|
def quasiquote(ast)
|
||||||
list = ast.unwrap
|
ast_val = ast.unwrap
|
||||||
|
case ast_val
|
||||||
unless pair?(list)
|
when Mal::List
|
||||||
return Mal::Type.new(
|
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
|
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
|
else
|
||||||
tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
|
ast
|
||||||
Mal::Type.new(
|
|
||||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
|
|
||||||
)
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -200,6 +213,8 @@ module Mal
|
|||||||
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
||||||
when "quote"
|
when "quote"
|
||||||
list[1]
|
list[1]
|
||||||
|
when "quasiquoteexpand"
|
||||||
|
quasiquote list[1]
|
||||||
when "quasiquote"
|
when "quasiquote"
|
||||||
ast = quasiquote list[1]
|
ast = quasiquote list[1]
|
||||||
next # TCO
|
next # TCO
|
||||||
|
@ -51,36 +51,49 @@ module Mal
|
|||||||
read_str str
|
read_str str
|
||||||
end
|
end
|
||||||
|
|
||||||
macro pair?(list)
|
def starts_with(list, symbol)
|
||||||
{{list}}.is_a?(Array) && !{{list}}.empty?
|
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
|
end
|
||||||
|
|
||||||
def quasiquote(ast)
|
def quasiquote(ast)
|
||||||
list = ast.unwrap
|
ast_val = ast.unwrap
|
||||||
|
case ast_val
|
||||||
unless pair?(list)
|
when Mal::List
|
||||||
return Mal::Type.new(
|
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
|
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
|
else
|
||||||
tail = Mal::Type.new list[1..-1].to_mal
|
ast
|
||||||
Mal::Type.new(
|
|
||||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
|
|
||||||
)
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -200,6 +213,8 @@ module Mal
|
|||||||
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
||||||
when "quote"
|
when "quote"
|
||||||
list[1]
|
list[1]
|
||||||
|
when "quasiquoteexpand"
|
||||||
|
quasiquote list[1]
|
||||||
when "quasiquote"
|
when "quasiquote"
|
||||||
ast = quasiquote list[1]
|
ast = quasiquote list[1]
|
||||||
next # TCO
|
next # TCO
|
||||||
|
@ -52,36 +52,49 @@ module Mal
|
|||||||
read_str str
|
read_str str
|
||||||
end
|
end
|
||||||
|
|
||||||
macro pair?(list)
|
def starts_with(list, symbol)
|
||||||
{{list}}.is_a?(Array) && !{{list}}.empty?
|
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
|
end
|
||||||
|
|
||||||
def quasiquote(ast)
|
def quasiquote(ast)
|
||||||
list = ast.unwrap
|
ast_val = ast.unwrap
|
||||||
|
case ast_val
|
||||||
unless pair?(list)
|
when Mal::List
|
||||||
return Mal::Type.new(
|
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
|
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
|
else
|
||||||
tail = Mal::Type.new list[1..-1].to_mal
|
ast
|
||||||
Mal::Type.new(
|
|
||||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
|
|
||||||
)
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -206,6 +219,8 @@ module Mal
|
|||||||
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
||||||
when "quote"
|
when "quote"
|
||||||
list[1]
|
list[1]
|
||||||
|
when "quasiquoteexpand"
|
||||||
|
quasiquote list[1]
|
||||||
when "quasiquote"
|
when "quasiquote"
|
||||||
ast = quasiquote list[1]
|
ast = quasiquote list[1]
|
||||||
next # TCO
|
next # TCO
|
||||||
|
@ -371,6 +371,7 @@ namespace Mal {
|
|||||||
{"sequential?", sequential_Q},
|
{"sequential?", sequential_Q},
|
||||||
{"cons", cons},
|
{"cons", cons},
|
||||||
{"concat", concat},
|
{"concat", concat},
|
||||||
|
{"vec", new MalFunc(a => new MalVector(((MalList)a[0]).getValue()))},
|
||||||
{"nth", nth},
|
{"nth", nth},
|
||||||
{"first", first},
|
{"first", first},
|
||||||
{"rest", rest},
|
{"rest", rest},
|
||||||
|
@ -21,30 +21,41 @@ namespace Mal {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// eval
|
// eval
|
||||||
public static bool is_pair(MalVal x) {
|
public static bool starts_with(MalVal ast, string sym) {
|
||||||
return x is MalList && ((MalList)x).size() > 0;
|
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) {
|
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);
|
return new MalList(new MalSymbol("quote"), ast);
|
||||||
} else {
|
} else {
|
||||||
MalVal a0 = ((MalList)ast)[0];
|
return ast;
|
||||||
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()));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -113,6 +124,8 @@ namespace Mal {
|
|||||||
break;
|
break;
|
||||||
case "quote":
|
case "quote":
|
||||||
return ast[1];
|
return ast[1];
|
||||||
|
case "quasiquoteexpand":
|
||||||
|
return quasiquote(ast[1]);
|
||||||
case "quasiquote":
|
case "quasiquote":
|
||||||
orig_ast = quasiquote(ast[1]);
|
orig_ast = quasiquote(ast[1]);
|
||||||
break;
|
break;
|
||||||
|
@ -21,30 +21,41 @@ namespace Mal {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// eval
|
// eval
|
||||||
public static bool is_pair(MalVal x) {
|
public static bool starts_with(MalVal ast, string sym) {
|
||||||
return x is MalList && ((MalList)x).size() > 0;
|
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) {
|
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);
|
return new MalList(new MalSymbol("quote"), ast);
|
||||||
} else {
|
} else {
|
||||||
MalVal a0 = ((MalList)ast)[0];
|
return ast;
|
||||||
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()));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -142,6 +153,8 @@ namespace Mal {
|
|||||||
break;
|
break;
|
||||||
case "quote":
|
case "quote":
|
||||||
return ast[1];
|
return ast[1];
|
||||||
|
case "quasiquoteexpand":
|
||||||
|
return quasiquote(ast[1]);
|
||||||
case "quasiquote":
|
case "quasiquote":
|
||||||
orig_ast = quasiquote(ast[1]);
|
orig_ast = quasiquote(ast[1]);
|
||||||
break;
|
break;
|
||||||
|
@ -21,30 +21,41 @@ namespace Mal {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// eval
|
// eval
|
||||||
public static bool is_pair(MalVal x) {
|
public static bool starts_with(MalVal ast, string sym) {
|
||||||
return x is MalList && ((MalList)x).size() > 0;
|
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) {
|
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);
|
return new MalList(new MalSymbol("quote"), ast);
|
||||||
} else {
|
} else {
|
||||||
MalVal a0 = ((MalList)ast)[0];
|
return ast;
|
||||||
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()));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -142,6 +153,8 @@ namespace Mal {
|
|||||||
break;
|
break;
|
||||||
case "quote":
|
case "quote":
|
||||||
return ast[1];
|
return ast[1];
|
||||||
|
case "quasiquoteexpand":
|
||||||
|
return quasiquote(ast[1]);
|
||||||
case "quasiquote":
|
case "quasiquote":
|
||||||
orig_ast = quasiquote(ast[1]);
|
orig_ast = quasiquote(ast[1]);
|
||||||
break;
|
break;
|
||||||
|
@ -21,30 +21,41 @@ namespace Mal {
|
|||||||
}
|
}
|
||||||
|
|
||||||
// eval
|
// eval
|
||||||
public static bool is_pair(MalVal x) {
|
public static bool starts_with(MalVal ast, string sym) {
|
||||||
return x is MalList && ((MalList)x).size() > 0;
|
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) {
|
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);
|
return new MalList(new MalSymbol("quote"), ast);
|
||||||
} else {
|
} else {
|
||||||
MalVal a0 = ((MalList)ast)[0];
|
return ast;
|
||||||
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()));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -142,6 +153,8 @@ namespace Mal {
|
|||||||
break;
|
break;
|
||||||
case "quote":
|
case "quote":
|
||||||
return ast[1];
|
return ast[1];
|
||||||
|
case "quasiquoteexpand":
|
||||||
|
return quasiquote(ast[1]);
|
||||||
case "quasiquote":
|
case "quasiquote":
|
||||||
orig_ast = quasiquote(ast[1]);
|
orig_ast = quasiquote(ast[1]);
|
||||||
break;
|
break;
|
||||||
|
@ -213,6 +213,12 @@ static MalType mal_concat(MalType[] a ...)
|
|||||||
return new MalList(res);
|
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 ...)
|
static MalType mal_nth(MalType[] a ...)
|
||||||
{
|
{
|
||||||
verify_args_count(a, 2);
|
verify_args_count(a, 2);
|
||||||
@ -397,6 +403,7 @@ static this()
|
|||||||
"sequential?": (a ...) => mal_type_q!MalSequential(a),
|
"sequential?": (a ...) => mal_type_q!MalSequential(a),
|
||||||
"cons": &mal_cons,
|
"cons": &mal_cons,
|
||||||
"concat": &mal_concat,
|
"concat": &mal_concat,
|
||||||
|
"vec": &mal_vec,
|
||||||
"nth": &mal_nth,
|
"nth": &mal_nth,
|
||||||
"first": &mal_first,
|
"first": &mal_first,
|
||||||
"rest": &mal_rest,
|
"rest": &mal_rest,
|
||||||
|
@ -13,36 +13,36 @@ import reader;
|
|||||||
import printer;
|
import printer;
|
||||||
import types;
|
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;
|
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)
|
MalType quasiquote(MalType ast)
|
||||||
{
|
{
|
||||||
if (!is_pair(ast))
|
if (cast(MalSymbol)ast || cast(MalHashmap)ast)
|
||||||
{
|
|
||||||
return new MalList([sym_quote, 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;
|
auto aste = ast_seq.elements;
|
||||||
if (aste[0] == sym_unquote)
|
if (starts_with(ast, sym_unquote))
|
||||||
{
|
|
||||||
return aste[1];
|
return aste[1];
|
||||||
}
|
|
||||||
|
|
||||||
if (is_pair(aste[0]))
|
MalType res = new MalList([]);;
|
||||||
{
|
foreach_reverse (elt; ast_seq.elements)
|
||||||
auto ast0_seq = verify_cast!MalSequential(aste[0]);
|
if (starts_with(elt, sym_splice_unquote))
|
||||||
if (ast0_seq.elements[0] == sym_splice_unquote)
|
res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
|
||||||
{
|
else
|
||||||
return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
|
res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
|
||||||
}
|
if (cast(MalVector) ast)
|
||||||
}
|
res = new MalList([new MalSymbol("vec"), res]);
|
||||||
|
return res;
|
||||||
return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
MalType READ(string str)
|
MalType READ(string str)
|
||||||
@ -120,6 +120,9 @@ MalType EVAL(MalType ast, Env env)
|
|||||||
case "quote":
|
case "quote":
|
||||||
return aste[1];
|
return aste[1];
|
||||||
|
|
||||||
|
case "quasiquoteexpand":
|
||||||
|
return quasiquote(aste[1]);
|
||||||
|
|
||||||
case "quasiquote":
|
case "quasiquote":
|
||||||
ast = quasiquote(aste[1]);
|
ast = quasiquote(aste[1]);
|
||||||
continue; // TCO
|
continue; // TCO
|
||||||
|
@ -13,36 +13,36 @@ import reader;
|
|||||||
import printer;
|
import printer;
|
||||||
import types;
|
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;
|
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)
|
MalType quasiquote(MalType ast)
|
||||||
{
|
{
|
||||||
if (!is_pair(ast))
|
if (cast(MalSymbol)ast || cast(MalHashmap)ast)
|
||||||
{
|
|
||||||
return new MalList([sym_quote, 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;
|
auto aste = ast_seq.elements;
|
||||||
if (aste[0] == sym_unquote)
|
if (starts_with(ast, sym_unquote))
|
||||||
{
|
|
||||||
return aste[1];
|
return aste[1];
|
||||||
}
|
|
||||||
|
|
||||||
if (is_pair(aste[0]))
|
MalType res = new MalList([]);;
|
||||||
{
|
foreach_reverse (elt; ast_seq.elements)
|
||||||
auto ast0_seq = verify_cast!MalSequential(aste[0]);
|
if (starts_with(elt, sym_splice_unquote))
|
||||||
if (ast0_seq.elements[0] == sym_splice_unquote)
|
res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
|
||||||
{
|
else
|
||||||
return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
|
res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
|
||||||
}
|
if (cast(MalVector) ast)
|
||||||
}
|
res = new MalList([new MalSymbol("vec"), res]);
|
||||||
|
return res;
|
||||||
return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
bool is_macro_call(MalType ast, Env env)
|
bool is_macro_call(MalType ast, Env env)
|
||||||
@ -155,6 +155,9 @@ MalType EVAL(MalType ast, Env env)
|
|||||||
case "quote":
|
case "quote":
|
||||||
return aste[1];
|
return aste[1];
|
||||||
|
|
||||||
|
case "quasiquoteexpand":
|
||||||
|
return quasiquote(aste[1]);
|
||||||
|
|
||||||
case "quasiquote":
|
case "quasiquote":
|
||||||
ast = quasiquote(aste[1]);
|
ast = quasiquote(aste[1]);
|
||||||
continue; // TCO
|
continue; // TCO
|
||||||
|
@ -13,36 +13,36 @@ import reader;
|
|||||||
import printer;
|
import printer;
|
||||||
import types;
|
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;
|
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)
|
MalType quasiquote(MalType ast)
|
||||||
{
|
{
|
||||||
if (!is_pair(ast))
|
if (cast(MalSymbol)ast || cast(MalHashmap)ast)
|
||||||
{
|
|
||||||
return new MalList([sym_quote, 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;
|
auto aste = ast_seq.elements;
|
||||||
if (aste[0] == sym_unquote)
|
if (starts_with(ast, sym_unquote))
|
||||||
{
|
|
||||||
return aste[1];
|
return aste[1];
|
||||||
}
|
|
||||||
|
|
||||||
if (is_pair(aste[0]))
|
MalType res = new MalList([]);;
|
||||||
{
|
foreach_reverse (elt; ast_seq.elements)
|
||||||
auto ast0_seq = verify_cast!MalSequential(aste[0]);
|
if (starts_with(elt, sym_splice_unquote))
|
||||||
if (ast0_seq.elements[0] == sym_splice_unquote)
|
res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
|
||||||
{
|
else
|
||||||
return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
|
res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
|
||||||
}
|
if (cast(MalVector) ast)
|
||||||
}
|
res = new MalList([new MalSymbol("vec"), res]);
|
||||||
|
return res;
|
||||||
return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
bool is_macro_call(MalType ast, Env env)
|
bool is_macro_call(MalType ast, Env env)
|
||||||
@ -155,6 +155,9 @@ MalType EVAL(MalType ast, Env env)
|
|||||||
case "quote":
|
case "quote":
|
||||||
return aste[1];
|
return aste[1];
|
||||||
|
|
||||||
|
case "quasiquoteexpand":
|
||||||
|
return quasiquote(aste[1]);
|
||||||
|
|
||||||
case "quasiquote":
|
case "quasiquote":
|
||||||
ast = quasiquote(aste[1]);
|
ast = quasiquote(aste[1]);
|
||||||
continue; // TCO
|
continue; // TCO
|
||||||
|
@ -14,36 +14,36 @@ import reader;
|
|||||||
import printer;
|
import printer;
|
||||||
import types;
|
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;
|
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)
|
MalType quasiquote(MalType ast)
|
||||||
{
|
{
|
||||||
if (!is_pair(ast))
|
if (cast(MalSymbol)ast || cast(MalHashmap)ast)
|
||||||
{
|
|
||||||
return new MalList([sym_quote, 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;
|
auto aste = ast_seq.elements;
|
||||||
if (aste[0] == sym_unquote)
|
if (starts_with(ast, sym_unquote))
|
||||||
{
|
|
||||||
return aste[1];
|
return aste[1];
|
||||||
}
|
|
||||||
|
|
||||||
if (is_pair(aste[0]))
|
MalType res = new MalList([]);;
|
||||||
{
|
foreach_reverse (elt; ast_seq.elements)
|
||||||
auto ast0_seq = verify_cast!MalSequential(aste[0]);
|
if (starts_with(elt, sym_splice_unquote))
|
||||||
if (ast0_seq.elements[0] == sym_splice_unquote)
|
res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
|
||||||
{
|
else
|
||||||
return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
|
res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
|
||||||
}
|
if (cast(MalVector) ast)
|
||||||
}
|
res = new MalList([new MalSymbol("vec"), res]);
|
||||||
|
return res;
|
||||||
return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
bool is_macro_call(MalType ast, Env env)
|
bool is_macro_call(MalType ast, Env env)
|
||||||
@ -156,6 +156,9 @@ MalType EVAL(MalType ast, Env env)
|
|||||||
case "quote":
|
case "quote":
|
||||||
return aste[1];
|
return aste[1];
|
||||||
|
|
||||||
|
case "quasiquoteexpand":
|
||||||
|
return quasiquote(aste[1]);
|
||||||
|
|
||||||
case "quasiquote":
|
case "quasiquote":
|
||||||
ast = quasiquote(aste[1]);
|
ast = quasiquote(aste[1]);
|
||||||
continue; // TCO
|
continue; // TCO
|
||||||
|
@ -125,6 +125,13 @@ Map<MalSymbol, MalBuiltin> ns = <MalSymbol, MalBuiltin>{
|
|||||||
}
|
}
|
||||||
return new MalList(results);
|
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) {
|
new MalSymbol('nth'): new MalBuiltin((List<MalType> args) {
|
||||||
var indexable = args[0] as MalIterable;
|
var indexable = args[0] as MalIterable;
|
||||||
var index = args[1] as MalInt;
|
var index = args[1] as MalInt;
|
||||||
|
@ -23,31 +23,33 @@ void setupEnv(List<String> argv) {
|
|||||||
"(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))");
|
"(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))");
|
||||||
}
|
}
|
||||||
|
|
||||||
MalType quasiquote(MalType ast) {
|
bool starts_with(MalType ast, String sym) {
|
||||||
bool isPair(MalType ast) {
|
return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
|
||||||
return ast is MalIterable && ast.isNotEmpty;
|
}
|
||||||
}
|
|
||||||
|
|
||||||
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]);
|
return new MalList([new MalSymbol("quote"), ast]);
|
||||||
} else {
|
} else {
|
||||||
var list = ast as MalIterable;
|
return ast;
|
||||||
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)))
|
|
||||||
]);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -142,6 +144,8 @@ MalType EVAL(MalType ast, Env env) {
|
|||||||
EVAL(args[1], new Env(env, params, funcArgs)));
|
EVAL(args[1], new Env(env, params, funcArgs)));
|
||||||
} else if (symbol.value == "quote") {
|
} else if (symbol.value == "quote") {
|
||||||
return args.single;
|
return args.single;
|
||||||
|
} else if (symbol.value == "quasiquoteexpand") {
|
||||||
|
return quasiquote(args.first);
|
||||||
} else if (symbol.value == "quasiquote") {
|
} else if (symbol.value == "quasiquote") {
|
||||||
ast = quasiquote(args.first);
|
ast = quasiquote(args.first);
|
||||||
continue;
|
continue;
|
||||||
|
@ -58,31 +58,33 @@ MalType macroexpand(MalType ast, Env env) {
|
|||||||
return ast;
|
return ast;
|
||||||
}
|
}
|
||||||
|
|
||||||
MalType quasiquote(MalType ast) {
|
bool starts_with(MalType ast, String sym) {
|
||||||
bool isPair(MalType ast) {
|
return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
|
||||||
return ast is MalIterable && ast.isNotEmpty;
|
}
|
||||||
}
|
|
||||||
|
|
||||||
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]);
|
return new MalList([new MalSymbol("quote"), ast]);
|
||||||
} else {
|
} else {
|
||||||
var list = ast as MalIterable;
|
return ast;
|
||||||
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)))
|
|
||||||
]);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -184,6 +186,8 @@ MalType EVAL(MalType ast, Env env) {
|
|||||||
EVAL(args[1], new Env(env, params, funcArgs)));
|
EVAL(args[1], new Env(env, params, funcArgs)));
|
||||||
} else if (symbol.value == "quote") {
|
} else if (symbol.value == "quote") {
|
||||||
return args.single;
|
return args.single;
|
||||||
|
} else if (symbol.value == "quasiquoteexpand") {
|
||||||
|
return quasiquote(args.first);
|
||||||
} else if (symbol.value == "quasiquote") {
|
} else if (symbol.value == "quasiquote") {
|
||||||
ast = quasiquote(args.first);
|
ast = quasiquote(args.first);
|
||||||
continue;
|
continue;
|
||||||
|
@ -58,31 +58,33 @@ MalType macroexpand(MalType ast, Env env) {
|
|||||||
return ast;
|
return ast;
|
||||||
}
|
}
|
||||||
|
|
||||||
MalType quasiquote(MalType ast) {
|
bool starts_with(MalType ast, String sym) {
|
||||||
bool isPair(MalType ast) {
|
return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
|
||||||
return ast is MalIterable && ast.isNotEmpty;
|
}
|
||||||
}
|
|
||||||
|
|
||||||
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]);
|
return new MalList([new MalSymbol("quote"), ast]);
|
||||||
} else {
|
} else {
|
||||||
var list = ast as MalIterable;
|
return ast;
|
||||||
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)))
|
|
||||||
]);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -184,6 +186,8 @@ MalType EVAL(MalType ast, Env env) {
|
|||||||
EVAL(args[1], new Env(env, params, funcArgs)));
|
EVAL(args[1], new Env(env, params, funcArgs)));
|
||||||
} else if (symbol.value == "quote") {
|
} else if (symbol.value == "quote") {
|
||||||
return args.single;
|
return args.single;
|
||||||
|
} else if (symbol.value == "quasiquoteexpand") {
|
||||||
|
return quasiquote(args.first);
|
||||||
} else if (symbol.value == "quasiquote") {
|
} else if (symbol.value == "quasiquote") {
|
||||||
ast = quasiquote(args.first);
|
ast = quasiquote(args.first);
|
||||||
continue;
|
continue;
|
||||||
|
@ -60,31 +60,33 @@ MalType macroexpand(MalType ast, Env env) {
|
|||||||
return ast;
|
return ast;
|
||||||
}
|
}
|
||||||
|
|
||||||
MalType quasiquote(MalType ast) {
|
bool starts_with(MalType ast, String sym) {
|
||||||
bool isPair(MalType ast) {
|
return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
|
||||||
return ast is MalIterable && ast.isNotEmpty;
|
}
|
||||||
}
|
|
||||||
|
|
||||||
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]);
|
return new MalList([new MalSymbol("quote"), ast]);
|
||||||
} else {
|
} else {
|
||||||
var list = ast as MalIterable;
|
return ast;
|
||||||
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)))
|
|
||||||
]);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -186,6 +188,8 @@ MalType EVAL(MalType ast, Env env) {
|
|||||||
EVAL(args[1], new Env(env, params, funcArgs)));
|
EVAL(args[1], new Env(env, params, funcArgs)));
|
||||||
} else if (symbol.value == "quote") {
|
} else if (symbol.value == "quote") {
|
||||||
return args.single;
|
return args.single;
|
||||||
|
} else if (symbol.value == "quasiquoteexpand") {
|
||||||
|
return quasiquote(args.first);
|
||||||
} else if (symbol.value == "quasiquote") {
|
} else if (symbol.value == "quasiquote") {
|
||||||
ast = quasiquote(args.first);
|
ast = quasiquote(args.first);
|
||||||
continue;
|
continue;
|
||||||
|
@ -1,79 +1,52 @@
|
|||||||
|
(require 'cl-lib)
|
||||||
|
|
||||||
(defun mal-seq-p (mal-object)
|
(defun mal-seq-p (mal-object)
|
||||||
(let ((type (mal-type mal-object)))
|
(memq (mal-type mal-object) '(list vector)))
|
||||||
(if (or (eq type 'list) (eq type 'vector))
|
|
||||||
mal-true
|
|
||||||
mal-false)))
|
|
||||||
|
|
||||||
(defun mal-listify (mal-object)
|
(defun mal-listify (mal-object)
|
||||||
(let ((type (mal-type mal-object)))
|
(cl-ecase (mal-type mal-object)
|
||||||
(if (eq type 'vector)
|
(list (mal-value mal-object))
|
||||||
(append (mal-value mal-object) nil)
|
(vector (append (mal-value mal-object) nil))))
|
||||||
(mal-value mal-object))))
|
|
||||||
|
|
||||||
(defun mal-= (a b)
|
(defun mal-= (a b)
|
||||||
(let ((a-type (mal-type a))
|
(cl-case (mal-type a)
|
||||||
(b-type (mal-type b)))
|
((list vector) (and (mal-seq-p b)
|
||||||
(cond
|
(mal-seq-= (mal-listify a) (mal-listify b))))
|
||||||
((and (and (not (eq a-type 'map))
|
(map (and (mal-map-p b)
|
||||||
(not (eq a-type 'list))
|
(mal-map-= (mal-value a) (mal-value b))))
|
||||||
(not (eq a-type 'vector)))
|
(t (equal (mal-value a) (mal-value b)))))
|
||||||
(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)))
|
|
||||||
|
|
||||||
(defun mal-seq-= (a b)
|
(defun mal-seq-= (a b)
|
||||||
(when (= (length (mal-value a))
|
(if a
|
||||||
(length (mal-value b)))
|
(and b
|
||||||
(when (everyp 'mal-= (mal-listify a) (mal-listify b))
|
(mal-= (car a) (car b))
|
||||||
t)))
|
(mal-seq-= (cdr a) (cdr b)))
|
||||||
|
(null b)))
|
||||||
(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))
|
|
||||||
|
|
||||||
(defun mal-map-= (a b)
|
(defun mal-map-= (a b)
|
||||||
(catch 'return
|
(when (= (hash-table-count a)
|
||||||
(let ((a* (mal-value a))
|
(hash-table-count b))
|
||||||
(b* (mal-value b)))
|
(catch 'return
|
||||||
(when (= (hash-table-count a*)
|
(maphash (lambda (key a-value)
|
||||||
(hash-table-count b*))
|
(let ((b-value (gethash key b)))
|
||||||
(maphash (lambda (key a-value)
|
(unless (and b-value
|
||||||
(let ((b-value (gethash key b*)))
|
(mal-= a-value b-value))
|
||||||
(if b-value
|
(throw 'return nil))))
|
||||||
(when (not (mal-= a-value b-value))
|
a)
|
||||||
(throw 'return nil))
|
;; if we made it this far, the maps are equal
|
||||||
(throw 'return nil))))
|
t)))
|
||||||
a*)
|
|
||||||
;; if we made it this far, the maps are equal
|
|
||||||
t))))
|
|
||||||
|
|
||||||
(define-hash-table-test 'mal-= 'mal-= 'sxhash)
|
(define-hash-table-test 'mal-= 'mal-= 'sxhash)
|
||||||
|
|
||||||
(defun mal-conj (seq &rest args)
|
(defun mal-conj (seq &rest args)
|
||||||
(let ((type (mal-type seq))
|
(let ((value (mal-value seq)))
|
||||||
(value (mal-value seq)))
|
(cl-ecase (mal-type seq)
|
||||||
(if (eq type 'vector)
|
(vector
|
||||||
(mal-vector (vconcat (append (append value nil) args)))
|
(mal-vector (vconcat (append (append value nil) args))))
|
||||||
|
(list
|
||||||
(while args
|
(while args
|
||||||
(push (pop args) value))
|
(push (pop args) value))
|
||||||
(mal-list value))))
|
(mal-list value)))))
|
||||||
|
|
||||||
(defun elisp-to-mal (arg)
|
(defun elisp-to-mal (arg)
|
||||||
(cond
|
(cond
|
||||||
@ -143,6 +116,7 @@
|
|||||||
(value (apply (mal-value fn*) args*)))
|
(value (apply (mal-value fn*) args*)))
|
||||||
(setf (aref atom 1) value)))))
|
(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))))))
|
(cons . ,(mal-fn (lambda (arg list) (mal-list (cons arg (mal-listify list))))))
|
||||||
(concat . ,(mal-fn (lambda (&rest lists)
|
(concat . ,(mal-fn (lambda (&rest lists)
|
||||||
(let ((lists* (mapcar (lambda (item) (mal-listify item)) lists)))
|
(let ((lists* (mapcar (lambda (item) (mal-listify item)) lists)))
|
||||||
@ -156,10 +130,8 @@
|
|||||||
(first . ,(mal-fn (lambda (seq)
|
(first . ,(mal-fn (lambda (seq)
|
||||||
(if (mal-nil-p seq)
|
(if (mal-nil-p seq)
|
||||||
mal-nil
|
mal-nil
|
||||||
(let* ((list (mal-listify seq))
|
(or (car (mal-listify seq)) mal-nil)))))
|
||||||
(value (car list)))
|
(rest . ,(mal-fn (lambda (seq) (mal-list (unless (mal-nil-p seq) (cdr (mal-listify seq)))))))
|
||||||
(or value mal-nil))))))
|
|
||||||
(rest . ,(mal-fn (lambda (seq) (mal-list (cdr (mal-listify seq))))))
|
|
||||||
|
|
||||||
(throw . ,(mal-fn (lambda (mal-object) (signal 'mal-custom (list mal-object)))))
|
(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))))
|
(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))))))
|
(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)))))
|
(vector . ,(mal-fn (lambda (&rest args) (mal-vector (vconcat args)))))
|
||||||
(hash-map . ,(mal-fn (lambda (&rest args)
|
(hash-map . ,(mal-fn (lambda (&rest args)
|
||||||
(let ((map (make-hash-table :test 'mal-=)))
|
(let ((map (make-hash-table :test 'mal-=)))
|
||||||
@ -193,7 +165,7 @@
|
|||||||
(puthash (pop args) (pop args) map))
|
(puthash (pop args) (pop args) map))
|
||||||
(mal-map 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)
|
(fn? . ,(mal-fn (lambda (arg) (if (or (mal-fn-p arg)
|
||||||
(and (mal-func-p arg)
|
(and (mal-func-p arg)
|
||||||
(not (mal-func-macro-p arg))))
|
(not (mal-func-macro-p arg))))
|
||||||
|
@ -1,34 +1,35 @@
|
|||||||
|
(require 'cl-lib)
|
||||||
|
|
||||||
(defun pr-str (form &optional print-readably)
|
(defun pr-str (form &optional print-readably)
|
||||||
(let ((type (mal-type form))
|
(let ((value (mal-value form)))
|
||||||
(value (mal-value form)))
|
(cl-ecase (mal-type form)
|
||||||
(cond
|
('nil
|
||||||
((eq type 'nil)
|
|
||||||
"nil")
|
"nil")
|
||||||
((eq type 'true)
|
(true
|
||||||
"true")
|
"true")
|
||||||
((eq type 'false)
|
(false
|
||||||
"false")
|
"false")
|
||||||
((eq type 'number)
|
(number
|
||||||
(number-to-string (mal-value form)))
|
(number-to-string value))
|
||||||
((eq type 'string)
|
(string
|
||||||
(if print-readably
|
(if print-readably
|
||||||
(let ((print-escape-newlines t))
|
(let ((print-escape-newlines t))
|
||||||
(prin1-to-string value))
|
(prin1-to-string value))
|
||||||
value))
|
value))
|
||||||
((or (eq type 'symbol) (eq type 'keyword))
|
((symbol keyword)
|
||||||
(symbol-name value))
|
(symbol-name value))
|
||||||
((eq type 'list)
|
(list
|
||||||
(pr-list value print-readably))
|
(pr-list value print-readably))
|
||||||
((eq type 'vector)
|
(vector
|
||||||
(pr-vector value print-readably))
|
(pr-vector value print-readably))
|
||||||
((eq type 'map)
|
(map
|
||||||
(pr-map value print-readably))
|
(pr-map value print-readably))
|
||||||
((eq type 'fn)
|
(fn
|
||||||
"#<fn>")
|
"#<fn>")
|
||||||
((eq type 'func)
|
(func
|
||||||
"#<func>")
|
"#<func>")
|
||||||
((eq type 'atom)
|
(atom
|
||||||
(format "(atom %s)" (mal-value value))))))
|
(format "(atom %s)" (pr-str value print-readably))))))
|
||||||
|
|
||||||
(defun pr-list (form print-readably)
|
(defun pr-list (form print-readably)
|
||||||
(let ((items (mapconcat
|
(let ((items (mapconcat
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
(require 'cl-lib)
|
||||||
|
|
||||||
;; HACK: `text-quoting-style' prettifies quotes in error messages on
|
;; HACK: `text-quoting-style' prettifies quotes in error messages on
|
||||||
;; Emacs 25, but no longer does from 26 upwards...
|
;; Emacs 25, but no longer does from 26 upwards...
|
||||||
(when (= emacs-major-version 25)
|
(when (= emacs-major-version 25)
|
||||||
@ -33,29 +35,28 @@
|
|||||||
(nreverse output))))
|
(nreverse output))))
|
||||||
|
|
||||||
(defun read-form ()
|
(defun read-form ()
|
||||||
(let ((token (peek)))
|
(pcase (peek)
|
||||||
(cond
|
("'"
|
||||||
((string= token "'")
|
|
||||||
(read-quote))
|
(read-quote))
|
||||||
((string= token "`")
|
("`"
|
||||||
(read-quasiquote))
|
(read-quasiquote))
|
||||||
((string= token "~")
|
("~"
|
||||||
(read-unquote))
|
(read-unquote))
|
||||||
((string= token "~@")
|
("~@"
|
||||||
(read-splice-unquote))
|
(read-splice-unquote))
|
||||||
((string= token "@")
|
("@"
|
||||||
(read-deref))
|
(read-deref))
|
||||||
((string= token "^")
|
("^"
|
||||||
(read-with-meta))
|
(read-with-meta))
|
||||||
((string= token "(")
|
("("
|
||||||
(read-list))
|
(read-list))
|
||||||
((string= token "[")
|
("["
|
||||||
(read-vector))
|
(read-vector))
|
||||||
((string= token "{")
|
("{"
|
||||||
(read-map))
|
(read-map))
|
||||||
(t
|
(_
|
||||||
;; assume anything else is an atom
|
;; assume anything else is an atom
|
||||||
(read-atom)))))
|
(read-atom))))
|
||||||
|
|
||||||
(defun read-simple-reader-macro (symbol)
|
(defun read-simple-reader-macro (symbol)
|
||||||
(next) ; pop reader macro token
|
(next) ; pop reader macro token
|
||||||
|
@ -35,14 +35,12 @@
|
|||||||
;; empty input, carry on
|
;; empty input, carry on
|
||||||
)
|
)
|
||||||
(unterminated-sequence
|
(unterminated-sequence
|
||||||
(let* ((type (cadr err))
|
(princ (format "Expected '%c', got EOF\n"
|
||||||
(end
|
(cl-case (cadr err)
|
||||||
(cond
|
(string ?\")
|
||||||
((eq type 'string) ?\")
|
(list ?\))
|
||||||
((eq type 'list) ?\))
|
(vector ?\])
|
||||||
((eq type 'vector) ?\])
|
(map ?})))))
|
||||||
((eq type 'map) ?}))))
|
|
||||||
(princ (format "Expected '%c', got EOF\n" end))))
|
|
||||||
(error ; catch-all
|
(error ; catch-all
|
||||||
(println (error-message-string err))
|
(println (error-message-string err))
|
||||||
(backtrace)))
|
(backtrace)))
|
||||||
|
@ -20,20 +20,19 @@
|
|||||||
(eval-ast ast env)))
|
(eval-ast ast env)))
|
||||||
|
|
||||||
(defun eval-ast (ast env)
|
(defun eval-ast (ast env)
|
||||||
(let ((type (mal-type ast))
|
(let ((value (mal-value ast)))
|
||||||
(value (mal-value ast)))
|
(cl-case (mal-type ast)
|
||||||
(cond
|
(symbol
|
||||||
((eq type 'symbol)
|
|
||||||
(let ((definition (gethash value env)))
|
(let ((definition (gethash value env)))
|
||||||
(or definition (error "Definition not found"))))
|
(or definition (error "Definition not found"))))
|
||||||
((eq type 'list)
|
(list
|
||||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||||
((eq type 'vector)
|
(vector
|
||||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||||
((eq type 'map)
|
(map
|
||||||
(let ((map (copy-hash-table value)))
|
(let ((map (copy-hash-table value)))
|
||||||
(maphash (lambda (key value)
|
(maphash (lambda (key val)
|
||||||
(puthash key (EVAL value env) map))
|
(puthash key (EVAL val env) map))
|
||||||
map)
|
map)
|
||||||
(mal-map map)))
|
(mal-map map)))
|
||||||
(t
|
(t
|
||||||
@ -67,14 +66,12 @@
|
|||||||
;; empty input, carry on
|
;; empty input, carry on
|
||||||
)
|
)
|
||||||
(unterminated-sequence
|
(unterminated-sequence
|
||||||
(let* ((type (cadr err))
|
(princ (format "Expected '%c', got EOF\n"
|
||||||
(end
|
(cl-case (cadr err)
|
||||||
(cond
|
(string ?\")
|
||||||
((eq type 'string) ?\")
|
(list ?\))
|
||||||
((eq type 'list) ?\))
|
(vector ?\])
|
||||||
((eq type 'vector) ?\])
|
(map ?})))))
|
||||||
((eq type 'map) ?}))))
|
|
||||||
(princ (format "Expected '%c', got EOF\n" end))))
|
|
||||||
(error ; catch-all
|
(error ; catch-all
|
||||||
(println (error-message-string err))
|
(println (error-message-string err))
|
||||||
(backtrace)))
|
(backtrace)))
|
||||||
|
@ -15,17 +15,15 @@
|
|||||||
(defun EVAL (ast env)
|
(defun EVAL (ast env)
|
||||||
(if (and (mal-list-p ast) (mal-value ast))
|
(if (and (mal-list-p ast) (mal-value ast))
|
||||||
(let* ((a (mal-value ast))
|
(let* ((a (mal-value ast))
|
||||||
(a0 (car a))
|
|
||||||
(a0* (mal-value a0))
|
|
||||||
(a1 (cadr a))
|
(a1 (cadr a))
|
||||||
(a1* (mal-value a1))
|
(a1* (mal-value a1))
|
||||||
(a2 (nth 2 a)))
|
(a2 (nth 2 a)))
|
||||||
(cond
|
(cl-case (mal-value (car a))
|
||||||
((eq a0* 'def!)
|
(def!
|
||||||
(let ((identifier a1*)
|
(let ((identifier a1*)
|
||||||
(value (EVAL a2 env)))
|
(value (EVAL a2 env)))
|
||||||
(mal-env-set env identifier value)))
|
(mal-env-set env identifier value)))
|
||||||
((eq a0* 'let*)
|
(let*
|
||||||
(let ((env* (mal-env env))
|
(let ((env* (mal-env env))
|
||||||
(bindings (if (vectorp a1*) (append a1* nil) a1*))
|
(bindings (if (vectorp a1*) (append a1* nil) a1*))
|
||||||
(form a2))
|
(form a2))
|
||||||
@ -43,20 +41,19 @@
|
|||||||
(eval-ast ast env)))
|
(eval-ast ast env)))
|
||||||
|
|
||||||
(defun eval-ast (ast env)
|
(defun eval-ast (ast env)
|
||||||
(let ((type (mal-type ast))
|
(let ((value (mal-value ast)))
|
||||||
(value (mal-value ast)))
|
(cl-case (mal-type ast)
|
||||||
(cond
|
(symbol
|
||||||
((eq type 'symbol)
|
|
||||||
(let ((definition (mal-env-get env value)))
|
(let ((definition (mal-env-get env value)))
|
||||||
(or definition (error "Definition not found"))))
|
(or definition (error "Definition not found"))))
|
||||||
((eq type 'list)
|
(list
|
||||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||||
((eq type 'vector)
|
(vector
|
||||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||||
((eq type 'map)
|
(map
|
||||||
(let ((map (copy-hash-table value)))
|
(let ((map (copy-hash-table value)))
|
||||||
(maphash (lambda (key value)
|
(maphash (lambda (key val)
|
||||||
(puthash key (EVAL value env) map))
|
(puthash key (EVAL val env) map))
|
||||||
map)
|
map)
|
||||||
(mal-map map)))
|
(mal-map map)))
|
||||||
(t
|
(t
|
||||||
@ -90,14 +87,12 @@
|
|||||||
;; empty input, carry on
|
;; empty input, carry on
|
||||||
)
|
)
|
||||||
(unterminated-sequence
|
(unterminated-sequence
|
||||||
(let* ((type (cadr err))
|
(princ (format "Expected '%c', got EOF\n"
|
||||||
(end
|
(cl-case (cadr err)
|
||||||
(cond
|
(string ?\")
|
||||||
((eq type 'string) ?\")
|
(list ?\))
|
||||||
((eq type 'list) ?\))
|
(vector ?\])
|
||||||
((eq type 'vector) ?\])
|
(map ?})))))
|
||||||
((eq type 'map) ?}))))
|
|
||||||
(princ (format "Expected '%c', got EOF\n" end))))
|
|
||||||
(error ; catch-all
|
(error ; catch-all
|
||||||
(println (error-message-string err))))
|
(println (error-message-string err))))
|
||||||
(setq eof t)
|
(setq eof t)
|
||||||
|
@ -19,29 +19,26 @@
|
|||||||
(defun EVAL (ast env)
|
(defun EVAL (ast env)
|
||||||
(if (and (mal-list-p ast) (mal-value ast))
|
(if (and (mal-list-p ast) (mal-value ast))
|
||||||
(let* ((a (mal-value ast))
|
(let* ((a (mal-value ast))
|
||||||
(a0 (car a))
|
|
||||||
(a0* (mal-value a0))
|
|
||||||
(a1 (cadr a))
|
(a1 (cadr a))
|
||||||
(a2 (nth 2 a))
|
(a2 (nth 2 a))
|
||||||
(a3 (nth 3 a)))
|
(a3 (nth 3 a)))
|
||||||
(cond
|
(cl-case (mal-value (car a))
|
||||||
((eq a0* 'def!)
|
(def!
|
||||||
(let ((identifier (mal-value a1))
|
(let ((identifier (mal-value a1))
|
||||||
(value (EVAL a2 env)))
|
(value (EVAL a2 env)))
|
||||||
(mal-env-set env identifier value)))
|
(mal-env-set env identifier value)))
|
||||||
((eq a0* 'let*)
|
(let*
|
||||||
(let* ((env* (mal-env env))
|
(let ((env* (mal-env env))
|
||||||
(a1* (mal-value a1))
|
(bindings (mal-listify a1))
|
||||||
(bindings (if (vectorp a1*) (append a1* nil) a1*))
|
(form a2))
|
||||||
(form a2))
|
|
||||||
(while bindings
|
(while bindings
|
||||||
(let ((key (mal-value (pop bindings)))
|
(let ((key (mal-value (pop bindings)))
|
||||||
(value (EVAL (pop bindings) env*)))
|
(value (EVAL (pop bindings) env*)))
|
||||||
(mal-env-set env* key value)))
|
(mal-env-set env* key value)))
|
||||||
(EVAL form env*)))
|
(EVAL form env*)))
|
||||||
((eq a0* 'do)
|
(do
|
||||||
(car (last (mal-value (eval-ast (mal-list (cdr a)) env)))))
|
(car (last (mal-value (eval-ast (mal-list (cdr a)) env)))))
|
||||||
((eq a0* 'if)
|
(if
|
||||||
(let* ((condition (EVAL a1 env))
|
(let* ((condition (EVAL a1 env))
|
||||||
(condition-type (mal-type condition))
|
(condition-type (mal-type condition))
|
||||||
(then a2)
|
(then a2)
|
||||||
@ -52,7 +49,7 @@
|
|||||||
(if else
|
(if else
|
||||||
(EVAL else env)
|
(EVAL else env)
|
||||||
mal-nil))))
|
mal-nil))))
|
||||||
((eq a0* 'fn*)
|
(fn*
|
||||||
(let ((binds (mapcar 'mal-value (mal-value a1)))
|
(let ((binds (mapcar 'mal-value (mal-value a1)))
|
||||||
(body a2))
|
(body a2))
|
||||||
(mal-fn
|
(mal-fn
|
||||||
@ -62,31 +59,25 @@
|
|||||||
(t
|
(t
|
||||||
;; not a special form
|
;; not a special form
|
||||||
(let* ((ast* (mal-value (eval-ast ast env)))
|
(let* ((ast* (mal-value (eval-ast ast env)))
|
||||||
(fn (car ast*))
|
(fn* (mal-value (car ast*)))
|
||||||
(fn* (cond
|
|
||||||
((functionp fn)
|
|
||||||
fn)
|
|
||||||
((mal-fn-p fn)
|
|
||||||
(mal-value fn))))
|
|
||||||
(args (cdr ast*)))
|
(args (cdr ast*)))
|
||||||
(apply fn* args)))))
|
(apply fn* args)))))
|
||||||
(eval-ast ast env)))
|
(eval-ast ast env)))
|
||||||
|
|
||||||
(defun eval-ast (ast env)
|
(defun eval-ast (ast env)
|
||||||
(let ((type (mal-type ast))
|
(let ((value (mal-value ast)))
|
||||||
(value (mal-value ast)))
|
(cl-case (mal-type ast)
|
||||||
(cond
|
(symbol
|
||||||
((eq type 'symbol)
|
|
||||||
(let ((definition (mal-env-get env value)))
|
(let ((definition (mal-env-get env value)))
|
||||||
(or definition (error "Definition not found"))))
|
(or definition (error "Definition not found"))))
|
||||||
((eq type 'list)
|
(list
|
||||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||||
((eq type 'vector)
|
(vector
|
||||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||||
((eq type 'map)
|
(map
|
||||||
(let ((map (copy-hash-table value)))
|
(let ((map (copy-hash-table value)))
|
||||||
(maphash (lambda (key value)
|
(maphash (lambda (key val)
|
||||||
(puthash key (EVAL value env) map))
|
(puthash key (EVAL val env) map))
|
||||||
map)
|
map)
|
||||||
(mal-map map)))
|
(mal-map map)))
|
||||||
(t
|
(t
|
||||||
@ -122,14 +113,12 @@
|
|||||||
;; empty input, carry on
|
;; empty input, carry on
|
||||||
)
|
)
|
||||||
(unterminated-sequence
|
(unterminated-sequence
|
||||||
(let* ((type (cadr err))
|
(princ (format "Expected '%c', got EOF\n"
|
||||||
(end
|
(cl-case (cadr err)
|
||||||
(cond
|
(string ?\")
|
||||||
((eq type 'string) ?\")
|
(list ?\))
|
||||||
((eq type 'list) ?\))
|
(vector ?\])
|
||||||
((eq type 'vector) ?\])
|
(map ?})))))
|
||||||
((eq type 'map) ?}))))
|
|
||||||
(princ (format "Expected '%c', got EOF\n" end))))
|
|
||||||
(error ; catch-all
|
(error ; catch-all
|
||||||
(println (error-message-string err))))
|
(println (error-message-string err))))
|
||||||
(setq eof t)
|
(setq eof t)
|
||||||
|
@ -23,36 +23,32 @@
|
|||||||
(while t
|
(while t
|
||||||
(if (and (mal-list-p ast) (mal-value ast))
|
(if (and (mal-list-p ast) (mal-value ast))
|
||||||
(let* ((a (mal-value ast))
|
(let* ((a (mal-value ast))
|
||||||
(a0 (car a))
|
|
||||||
(a0* (mal-value a0))
|
|
||||||
(a1 (cadr a))
|
(a1 (cadr a))
|
||||||
(a2 (nth 2 a))
|
(a2 (nth 2 a))
|
||||||
(a3 (nth 3 a)))
|
(a3 (nth 3 a)))
|
||||||
(cond
|
(cl-case (mal-value (car a))
|
||||||
((eq a0* 'def!)
|
(def!
|
||||||
(let ((identifier (mal-value a1))
|
(let ((identifier (mal-value a1))
|
||||||
(value (EVAL a2 env)))
|
(value (EVAL a2 env)))
|
||||||
(throw 'return (mal-env-set env identifier value))))
|
(throw 'return (mal-env-set env identifier value))))
|
||||||
((eq a0* 'let*)
|
(let*
|
||||||
(let* ((env* (mal-env env))
|
(let ((env* (mal-env env))
|
||||||
(bindings (mal-value a1))
|
(bindings (mal-listify a1))
|
||||||
(form a2))
|
(form a2))
|
||||||
(when (vectorp bindings)
|
|
||||||
(setq bindings (append bindings nil)))
|
|
||||||
(while bindings
|
(while bindings
|
||||||
(let ((key (mal-value (pop bindings)))
|
(let ((key (mal-value (pop bindings)))
|
||||||
(value (EVAL (pop bindings) env*)))
|
(value (EVAL (pop bindings) env*)))
|
||||||
(mal-env-set env* key value)))
|
(mal-env-set env* key value)))
|
||||||
(setq env env*
|
(setq env env*
|
||||||
ast form))) ; TCO
|
ast form))) ; TCO
|
||||||
((eq a0* 'do)
|
(do
|
||||||
(let* ((a0... (cdr a))
|
(let* ((a0... (cdr a))
|
||||||
(butlast (butlast a0...))
|
(butlast (butlast a0...))
|
||||||
(last (car (last a0...))))
|
(last (car (last a0...))))
|
||||||
(when butlast
|
(when butlast
|
||||||
(eval-ast (mal-list butlast) env))
|
(eval-ast (mal-list butlast) env))
|
||||||
(setq ast last))) ; TCO
|
(setq ast last))) ; TCO
|
||||||
((eq a0* 'if)
|
(if
|
||||||
(let* ((condition (EVAL a1 env))
|
(let* ((condition (EVAL a1 env))
|
||||||
(condition-type (mal-type condition))
|
(condition-type (mal-type condition))
|
||||||
(then a2)
|
(then a2)
|
||||||
@ -63,7 +59,7 @@
|
|||||||
(if else
|
(if else
|
||||||
(setq ast else) ; TCO
|
(setq ast else) ; TCO
|
||||||
(throw 'return mal-nil)))))
|
(throw 'return mal-nil)))))
|
||||||
((eq a0* 'fn*)
|
(fn*
|
||||||
(let* ((binds (mapcar 'mal-value (mal-value a1)))
|
(let* ((binds (mapcar 'mal-value (mal-value a1)))
|
||||||
(body a2)
|
(body a2)
|
||||||
(fn (mal-fn
|
(fn (mal-fn
|
||||||
@ -82,29 +78,24 @@
|
|||||||
args)))
|
args)))
|
||||||
(setq env env*
|
(setq env env*
|
||||||
ast (mal-func-ast fn))) ; TCO
|
ast (mal-func-ast fn))) ; TCO
|
||||||
(let ((fn* (if (mal-fn-p fn)
|
(let ((fn* (mal-value fn)))
|
||||||
;; unbox user-defined function
|
|
||||||
(mal-value fn)
|
|
||||||
;; use built-in function
|
|
||||||
fn)))
|
|
||||||
(throw 'return (apply fn* args))))))))
|
(throw 'return (apply fn* args))))))))
|
||||||
(throw 'return (eval-ast ast env))))))
|
(throw 'return (eval-ast ast env))))))
|
||||||
|
|
||||||
(defun eval-ast (ast env)
|
(defun eval-ast (ast env)
|
||||||
(let ((type (mal-type ast))
|
(let ((value (mal-value ast)))
|
||||||
(value (mal-value ast)))
|
(cl-case (mal-type ast)
|
||||||
(cond
|
(symbol
|
||||||
((eq type 'symbol)
|
|
||||||
(let ((definition (mal-env-get env value)))
|
(let ((definition (mal-env-get env value)))
|
||||||
(or definition (error "Definition not found"))))
|
(or definition (error "Definition not found"))))
|
||||||
((eq type 'list)
|
(list
|
||||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||||
((eq type 'vector)
|
(vector
|
||||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||||
((eq type 'map)
|
(map
|
||||||
(let ((map (copy-hash-table value)))
|
(let ((map (copy-hash-table value)))
|
||||||
(maphash (lambda (key value)
|
(maphash (lambda (key val)
|
||||||
(puthash key (EVAL value env) map))
|
(puthash key (EVAL val env) map))
|
||||||
map)
|
map)
|
||||||
(mal-map map)))
|
(mal-map map)))
|
||||||
(t
|
(t
|
||||||
@ -140,14 +131,12 @@
|
|||||||
;; empty input, carry on
|
;; empty input, carry on
|
||||||
)
|
)
|
||||||
(unterminated-sequence
|
(unterminated-sequence
|
||||||
(let* ((type (cadr err))
|
(princ (format "Expected '%c', got EOF\n"
|
||||||
(end
|
(cl-case (cadr err)
|
||||||
(cond
|
(string ?\")
|
||||||
((eq type 'string) ?\")
|
(list ?\))
|
||||||
((eq type 'list) ?\))
|
(vector ?\])
|
||||||
((eq type 'vector) ?\])
|
(map ?})))))
|
||||||
((eq type 'map) ?}))))
|
|
||||||
(princ (format "Expected '%c', got EOF\n" end))))
|
|
||||||
(error ; catch-all
|
(error ; catch-all
|
||||||
(println (error-message-string err))))
|
(println (error-message-string err))))
|
||||||
(setq eof t)
|
(setq eof t)
|
||||||
|
@ -22,36 +22,32 @@
|
|||||||
(while t
|
(while t
|
||||||
(if (and (mal-list-p ast) (mal-value ast))
|
(if (and (mal-list-p ast) (mal-value ast))
|
||||||
(let* ((a (mal-value ast))
|
(let* ((a (mal-value ast))
|
||||||
(a0 (car a))
|
|
||||||
(a0* (mal-value a0))
|
|
||||||
(a1 (cadr a))
|
(a1 (cadr a))
|
||||||
(a2 (nth 2 a))
|
(a2 (nth 2 a))
|
||||||
(a3 (nth 3 a)))
|
(a3 (nth 3 a)))
|
||||||
(cond
|
(cl-case (mal-value (car a))
|
||||||
((eq a0* 'def!)
|
(def!
|
||||||
(let ((identifier (mal-value a1))
|
(let ((identifier (mal-value a1))
|
||||||
(value (EVAL a2 env)))
|
(value (EVAL a2 env)))
|
||||||
(throw 'return (mal-env-set env identifier value))))
|
(throw 'return (mal-env-set env identifier value))))
|
||||||
((eq a0* 'let*)
|
(let*
|
||||||
(let* ((env* (mal-env env))
|
(let ((env* (mal-env env))
|
||||||
(bindings (mal-value a1))
|
(bindings (mal-listify a1))
|
||||||
(form a2))
|
(form a2))
|
||||||
(when (vectorp bindings)
|
|
||||||
(setq bindings (append bindings nil)))
|
|
||||||
(while bindings
|
(while bindings
|
||||||
(let ((key (mal-value (pop bindings)))
|
(let ((key (mal-value (pop bindings)))
|
||||||
(value (EVAL (pop bindings) env*)))
|
(value (EVAL (pop bindings) env*)))
|
||||||
(mal-env-set env* key value)))
|
(mal-env-set env* key value)))
|
||||||
(setq env env*
|
(setq env env*
|
||||||
ast form))) ; TCO
|
ast form))) ; TCO
|
||||||
((eq a0* 'do)
|
(do
|
||||||
(let* ((a0... (cdr a))
|
(let* ((a0... (cdr a))
|
||||||
(butlast (butlast a0...))
|
(butlast (butlast a0...))
|
||||||
(last (car (last a0...))))
|
(last (car (last a0...))))
|
||||||
(when butlast
|
(when butlast
|
||||||
(eval-ast (mal-list butlast) env))
|
(eval-ast (mal-list butlast) env))
|
||||||
(setq ast last))) ; TCO
|
(setq ast last))) ; TCO
|
||||||
((eq a0* 'if)
|
(if
|
||||||
(let* ((condition (EVAL a1 env))
|
(let* ((condition (EVAL a1 env))
|
||||||
(condition-type (mal-type condition))
|
(condition-type (mal-type condition))
|
||||||
(then a2)
|
(then a2)
|
||||||
@ -62,7 +58,7 @@
|
|||||||
(if else
|
(if else
|
||||||
(setq ast else) ; TCO
|
(setq ast else) ; TCO
|
||||||
(throw 'return mal-nil)))))
|
(throw 'return mal-nil)))))
|
||||||
((eq a0* 'fn*)
|
(fn*
|
||||||
(let* ((binds (mapcar 'mal-value (mal-value a1)))
|
(let* ((binds (mapcar 'mal-value (mal-value a1)))
|
||||||
(body a2)
|
(body a2)
|
||||||
(fn (mal-fn
|
(fn (mal-fn
|
||||||
@ -87,20 +83,19 @@
|
|||||||
(throw 'return (eval-ast ast env))))))
|
(throw 'return (eval-ast ast env))))))
|
||||||
|
|
||||||
(defun eval-ast (ast env)
|
(defun eval-ast (ast env)
|
||||||
(let ((type (mal-type ast))
|
(let ((value (mal-value ast)))
|
||||||
(value (mal-value ast)))
|
(cl-case (mal-type ast)
|
||||||
(cond
|
(symbol
|
||||||
((eq type 'symbol)
|
|
||||||
(let ((definition (mal-env-get env value)))
|
(let ((definition (mal-env-get env value)))
|
||||||
(or definition (error "Definition not found"))))
|
(or definition (error "Definition not found"))))
|
||||||
((eq type 'list)
|
(list
|
||||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||||
((eq type 'vector)
|
(vector
|
||||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||||
((eq type 'map)
|
(map
|
||||||
(let ((map (copy-hash-table value)))
|
(let ((map (copy-hash-table value)))
|
||||||
(maphash (lambda (key value)
|
(maphash (lambda (key val)
|
||||||
(puthash key (EVAL value env) map))
|
(puthash key (EVAL val env) map))
|
||||||
map)
|
map)
|
||||||
(mal-map map)))
|
(mal-map map)))
|
||||||
(t
|
(t
|
||||||
@ -136,14 +131,12 @@
|
|||||||
;; empty input, carry on
|
;; empty input, carry on
|
||||||
)
|
)
|
||||||
(unterminated-sequence
|
(unterminated-sequence
|
||||||
(let* ((type (cadr err))
|
(princ (format "Expected '%c', got EOF\n"
|
||||||
(end
|
(cl-case (cadr err)
|
||||||
(cond
|
(string ?\")
|
||||||
((eq type 'string) ?\")
|
(list ?\))
|
||||||
((eq type 'list) ?\))
|
(vector ?\])
|
||||||
((eq type 'vector) ?\])
|
(map ?})))))
|
||||||
((eq type 'map) ?}))))
|
|
||||||
(princ (format "Expected '%c', got EOF\n" end))))
|
|
||||||
(error ; catch-all
|
(error ; catch-all
|
||||||
(println (error-message-string err)))))
|
(println (error-message-string err)))))
|
||||||
|
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
;; -*- lexical-binding: t; -*-
|
;; -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
(require 'mal/types)
|
(require 'mal/types)
|
||||||
(require 'mal/func)
|
(require 'mal/func)
|
||||||
(require 'mal/env)
|
(require 'mal/env)
|
||||||
@ -14,34 +15,30 @@
|
|||||||
(fn (cdr binding)))
|
(fn (cdr binding)))
|
||||||
(mal-env-set repl-env symbol fn)))
|
(mal-env-set repl-env symbol fn)))
|
||||||
|
|
||||||
(defun mal-pair-p (mal-object)
|
(defun starts-with-p (ast sym)
|
||||||
(let ((type (mal-type mal-object))
|
(let ((l (mal-value ast)))
|
||||||
(value (mal-value mal-object)))
|
(and l
|
||||||
(if (and (or (eq type 'list) (eq type 'vector))
|
(let ((s (car l)))
|
||||||
(not (zerop (length value))))
|
(and (mal-symbol-p s)
|
||||||
t
|
(eq (mal-value s) sym))))))
|
||||||
nil)))
|
|
||||||
|
(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)
|
(defun quasiquote (ast)
|
||||||
(if (not (mal-pair-p ast))
|
(cl-case (mal-type ast)
|
||||||
(mal-list (list (mal-symbol 'quote) ast))
|
(list (if (starts-with-p ast 'unquote)
|
||||||
(let* ((a (mal-listify ast))
|
(cadr (mal-value ast))
|
||||||
(a0 (car a))
|
(qq-iter (mal-value ast))))
|
||||||
(a0... (cdr a))
|
(vector (mal-list (list (mal-symbol 'vec) (qq-iter (mal-value ast)))))
|
||||||
(a1 (cadr a)))
|
((map symbol) (mal-list (list (mal-symbol 'quote) ast)))
|
||||||
(cond
|
(t ast)))
|
||||||
((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...)))))))))
|
|
||||||
|
|
||||||
(defun READ (input)
|
(defun READ (input)
|
||||||
(read-str input))
|
(read-str input))
|
||||||
@ -51,40 +48,38 @@
|
|||||||
(while t
|
(while t
|
||||||
(if (and (mal-list-p ast) (mal-value ast))
|
(if (and (mal-list-p ast) (mal-value ast))
|
||||||
(let* ((a (mal-value ast))
|
(let* ((a (mal-value ast))
|
||||||
(a0 (car a))
|
|
||||||
(a0* (mal-value a0))
|
|
||||||
(a1 (cadr a))
|
(a1 (cadr a))
|
||||||
(a2 (nth 2 a))
|
(a2 (nth 2 a))
|
||||||
(a3 (nth 3 a)))
|
(a3 (nth 3 a)))
|
||||||
(cond
|
(cl-case (mal-value (car a))
|
||||||
((eq a0* 'def!)
|
(def!
|
||||||
(let ((identifier (mal-value a1))
|
(let ((identifier (mal-value a1))
|
||||||
(value (EVAL a2 env)))
|
(value (EVAL a2 env)))
|
||||||
(throw 'return (mal-env-set env identifier value))))
|
(throw 'return (mal-env-set env identifier value))))
|
||||||
((eq a0* 'let*)
|
(let*
|
||||||
(let* ((env* (mal-env env))
|
(let ((env* (mal-env env))
|
||||||
(bindings (mal-value a1))
|
(bindings (mal-listify a1))
|
||||||
(form a2))
|
(form a2))
|
||||||
(when (vectorp bindings)
|
|
||||||
(setq bindings (append bindings nil)))
|
|
||||||
(while bindings
|
(while bindings
|
||||||
(let ((key (mal-value (pop bindings)))
|
(let ((key (mal-value (pop bindings)))
|
||||||
(value (EVAL (pop bindings) env*)))
|
(value (EVAL (pop bindings) env*)))
|
||||||
(mal-env-set env* key value)))
|
(mal-env-set env* key value)))
|
||||||
(setq env env*
|
(setq env env*
|
||||||
ast form))) ; TCO
|
ast form))) ; TCO
|
||||||
((eq a0* 'quote)
|
(quote
|
||||||
(throw 'return a1))
|
(throw 'return a1))
|
||||||
((eq a0* 'quasiquote)
|
(quasiquoteexpand
|
||||||
|
(throw 'return (quasiquote a1)))
|
||||||
|
(quasiquote
|
||||||
(setq ast (quasiquote a1))) ; TCO
|
(setq ast (quasiquote a1))) ; TCO
|
||||||
((eq a0* 'do)
|
(do
|
||||||
(let* ((a0... (cdr a))
|
(let* ((a0... (cdr a))
|
||||||
(butlast (butlast a0...))
|
(butlast (butlast a0...))
|
||||||
(last (car (last a0...))))
|
(last (car (last a0...))))
|
||||||
(when butlast
|
(when butlast
|
||||||
(eval-ast (mal-list butlast) env))
|
(eval-ast (mal-list butlast) env))
|
||||||
(setq ast last))) ; TCO
|
(setq ast last))) ; TCO
|
||||||
((eq a0* 'if)
|
(if
|
||||||
(let* ((condition (EVAL a1 env))
|
(let* ((condition (EVAL a1 env))
|
||||||
(condition-type (mal-type condition))
|
(condition-type (mal-type condition))
|
||||||
(then a2)
|
(then a2)
|
||||||
@ -95,7 +90,7 @@
|
|||||||
(if else
|
(if else
|
||||||
(setq ast else) ; TCO
|
(setq ast else) ; TCO
|
||||||
(throw 'return mal-nil)))))
|
(throw 'return mal-nil)))))
|
||||||
((eq a0* 'fn*)
|
(fn*
|
||||||
(let* ((binds (mapcar 'mal-value (mal-value a1)))
|
(let* ((binds (mapcar 'mal-value (mal-value a1)))
|
||||||
(body a2)
|
(body a2)
|
||||||
(fn (mal-fn
|
(fn (mal-fn
|
||||||
@ -120,20 +115,19 @@
|
|||||||
(throw 'return (eval-ast ast env))))))
|
(throw 'return (eval-ast ast env))))))
|
||||||
|
|
||||||
(defun eval-ast (ast env)
|
(defun eval-ast (ast env)
|
||||||
(let ((type (mal-type ast))
|
(let ((value (mal-value ast)))
|
||||||
(value (mal-value ast)))
|
(cl-case (mal-type ast)
|
||||||
(cond
|
(symbol
|
||||||
((eq type 'symbol)
|
|
||||||
(let ((definition (mal-env-get env value)))
|
(let ((definition (mal-env-get env value)))
|
||||||
(or definition (error "Definition not found"))))
|
(or definition (error "Definition not found"))))
|
||||||
((eq type 'list)
|
(list
|
||||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||||
((eq type 'vector)
|
(vector
|
||||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||||
((eq type 'map)
|
(map
|
||||||
(let ((map (copy-hash-table value)))
|
(let ((map (copy-hash-table value)))
|
||||||
(maphash (lambda (key value)
|
(maphash (lambda (key val)
|
||||||
(puthash key (EVAL value env) map))
|
(puthash key (EVAL val env) map))
|
||||||
map)
|
map)
|
||||||
(mal-map map)))
|
(mal-map map)))
|
||||||
(t
|
(t
|
||||||
@ -169,14 +163,12 @@
|
|||||||
;; empty input, carry on
|
;; empty input, carry on
|
||||||
)
|
)
|
||||||
(unterminated-sequence
|
(unterminated-sequence
|
||||||
(let* ((type (cadr err))
|
(princ (format "Expected '%c', got EOF\n"
|
||||||
(end
|
(cl-case (cadr err)
|
||||||
(cond
|
(string ?\")
|
||||||
((eq type 'string) ?\")
|
(list ?\))
|
||||||
((eq type 'list) ?\))
|
(vector ?\])
|
||||||
((eq type 'vector) ?\])
|
(map ?})))))
|
||||||
((eq type 'map) ?}))))
|
|
||||||
(princ (format "Expected '%c', got EOF\n" end))))
|
|
||||||
(error ; catch-all
|
(error ; catch-all
|
||||||
(println (error-message-string err)))))
|
(println (error-message-string err)))))
|
||||||
|
|
||||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user