mirror of
https://github.com/kanaka/mal.git
synced 2024-09-11 13:55:55 +03:00
Merge pull request #401 from asarhaddon/quasiquote
New soft tests, quasiquote algorithm described at #103 on some impls.
This commit is contained in:
commit
21877e6018
@ -37,7 +37,7 @@ make REGRESS=1 TEST_OPTS='--hard --pre-eval=\(load-file\ \"../answer.mal\"\)' te
|
||||
|
||||
- Implement `>`, `<=` and `>=` with `<`.
|
||||
|
||||
- Implement `hash-map`, `list`, `prn` and `swap!` as non-recursive
|
||||
- Implement `list`, `vec`, `prn`, `hash-map` and `swap!` as non-recursive
|
||||
functions.
|
||||
|
||||
- Implement `count`, `nth`, `map`, `concat` and `conj` with the empty
|
||||
|
@ -1,8 +1,7 @@
|
||||
;; These are the answers to the questions in ../docs/exercise.md.
|
||||
|
||||
;; In order to avoid unexpected circular dependencies among solutions,
|
||||
;; this files attempts to be self-contained.
|
||||
(def! identity (fn* [x] x))
|
||||
;; this answer file attempts to be self-contained.
|
||||
(def! reduce (fn* (f init xs)
|
||||
(if (empty? xs) init (reduce f (f init (first xs)) (rest xs)))))
|
||||
(def! foldr (fn* [f init xs]
|
||||
@ -23,9 +22,10 @@
|
||||
(def! <= (fn* [a b] (not (< b a))))
|
||||
(def! >= (fn* [a b] (not (< a b))))
|
||||
|
||||
(def! hash-map (fn* [& xs] (apply assoc {} xs)))
|
||||
(def! list (fn* [& xs] xs))
|
||||
(def! vec (fn* [xs] (apply vector xs)))
|
||||
(def! prn (fn* [& xs] (println (apply pr-str xs))))
|
||||
(def! hash-map (fn* [& xs] (apply assoc {} xs)))
|
||||
(def! swap! (fn* [a f & xs] (reset! a (apply f (deref a) xs))))
|
||||
|
||||
(def! count
|
||||
@ -44,65 +44,65 @@
|
||||
(fn* [f xs]
|
||||
(foldr (fn* [x acc] (cons (f x) acc)) () xs)))
|
||||
(def! concat
|
||||
(fn* [& xs]
|
||||
(foldr (fn* [xs ys] (foldr cons ys xs)) () xs)))
|
||||
(fn* [& xs]
|
||||
(foldr (fn* [x acc] (foldr cons acc x)) () xs)))
|
||||
(def! conj
|
||||
(fn* [xs & ys]
|
||||
(if (vector? xs)
|
||||
(apply vector (concat xs ys))
|
||||
(reduce (fn* [xs x] (cons x xs)) xs ys))))
|
||||
(vec (concat xs ys))
|
||||
(reduce (fn* [acc x] (cons x acc)) xs ys))))
|
||||
|
||||
(def! do2 (fn* [& xs] (nth xs (- (count xs) 1))))
|
||||
(def! do3 (fn* [& xs] (reduce (fn* [acc x] x) nil xs)))
|
||||
(def! do3 (fn* [& xs] (reduce (fn* [_ x] x) nil xs)))
|
||||
;; do2 will probably be more efficient when lists are implemented as
|
||||
;; arrays with direct indexing, but when they are implemented as
|
||||
;; linked lists, do3 may win because it only does one traversal.
|
||||
|
||||
(defmacro! quote (fn* [ast] (list (fn* [] ast))))
|
||||
(defmacro! quote2 (fn* [ast]
|
||||
(list (fn* [] ast))))
|
||||
(def! _quasiquote_iter (fn* [x acc]
|
||||
(if (if (list? x) (= (first x) 'splice-unquote)) ; logical and
|
||||
(list 'concat (first (rest x)) acc)
|
||||
(list 'cons (list 'quasiquote x) acc))))
|
||||
(defmacro! quasiquote (fn* [ast]
|
||||
(list 'cons (list 'quasiquote2 x) acc))))
|
||||
(defmacro! quasiquote2 (fn* [ast]
|
||||
(if (list? ast)
|
||||
(if (= (first ast) 'unquote)
|
||||
(first (rest ast))
|
||||
(foldr _quasiquote_iter () ast))
|
||||
(if (vector? ast)
|
||||
;; TODO: once tests are fixed, replace 'list with 'vector.
|
||||
(list 'apply 'list (foldr _quasiquote_iter () ast))
|
||||
(list 'vec (foldr _quasiquote_iter () ast))
|
||||
(list 'quote ast)))))
|
||||
|
||||
(def! _letA_keys (fn* [binds]
|
||||
(if (empty? binds)
|
||||
()
|
||||
(cons (first binds) (_letA_keys (rest (rest binds)))))))
|
||||
(def! _letA_values (fn* [binds]
|
||||
(if (empty? binds)
|
||||
()
|
||||
(_letA_keys (rest binds)))))
|
||||
(def! _letA (fn* [binds form]
|
||||
(cons (list 'fn* (_letA_keys binds) form) (_letA_values binds))))
|
||||
;; Interpret kvs as [k1 v1 k2 v2 ... kn vn] and returns
|
||||
;; (f k1 v1 (f k2 v2 (f ... (f kn vn)))).
|
||||
(def! _foldr_pairs (fn* [f init kvs]
|
||||
(if (empty? kvs)
|
||||
init
|
||||
(let* [key (first kvs)
|
||||
rst (rest kvs)
|
||||
val (first rst)
|
||||
acc (_foldr_pairs f init (rest rst))]
|
||||
(f key val acc)))))
|
||||
(defmacro! let*A (fn* [binds form]
|
||||
(let* [formal (_foldr_pairs (fn* [key val acc] (cons key acc)) () binds)
|
||||
actual (_foldr_pairs (fn* [key val acc] (cons val acc)) () binds)]
|
||||
`((fn* ~formal ~form) ~@actual))))
|
||||
;; Fails for (let* [a 1 b (+ 1 a)] b)
|
||||
(def! _letB (fn* [binds form]
|
||||
(if (empty? binds)
|
||||
form
|
||||
(list (list 'fn* [(first binds)] (_letB (rest (rest binds)) form))
|
||||
(first (rest binds))))))
|
||||
(defmacro! let*B (fn* [binds form]
|
||||
(let* [f (fn* [key val acc]
|
||||
`((fn* [~key] ~acc) ~val))]
|
||||
(_foldr_pairs f form binds))))
|
||||
;; Fails for (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1))
|
||||
(def! _c_combinator (fn* [x] (x x)))
|
||||
(def! _d_combinator (fn* [f] (fn* [x] (f (fn* [v] ((x x) v))))))
|
||||
(def! _Y_combinator (fn* [x] (_c_combinator (_d_combinator x))))
|
||||
(def! _letC
|
||||
(fn* [binds form]
|
||||
(if (empty? binds)
|
||||
form
|
||||
(list (list 'fn* [(first binds)] (_letC (rest (rest binds)) form))
|
||||
(list '_Y_combinator (list 'fn* [(first binds)] (first (rest binds))))))))
|
||||
(defmacro! let*C (fn* [binds form]
|
||||
(let* [f (fn* [key val acc]
|
||||
`((fn* [~key] ~acc) (_Y_combinator (fn* [~key] ~val))))]
|
||||
(_foldr_pairs f form binds))))
|
||||
;; Fails for mutual recursion.
|
||||
;; See http://okmij.org/ftp/Computation/fixed-point-combinators.html
|
||||
;; if you are motivated to implement solution D.
|
||||
(defmacro! let* _letC)
|
||||
|
||||
(def! apply
|
||||
;; Replace (f a b [c d]) with ('f 'a 'b 'c 'd) then evaluate the
|
||||
@ -156,10 +156,8 @@
|
||||
(fn* [xs]
|
||||
(reduce update_max 0 xs))))
|
||||
|
||||
(def! compose
|
||||
(let* [compose2 (fn* [f acc] (fn* [x] (f (acc x))))]
|
||||
(fn* [& fs]
|
||||
(foldr compose2 identity fs))))
|
||||
;; ((compose f1 f2) x) is equivalent to (f1 (f2 x))
|
||||
;; This is the mathematical composition. For practical purposes, `->`
|
||||
;; and `->>` defined in `core.mal` are more efficient and general.
|
||||
;; (fn* [& fs] (foldr (fn* [f acc] (fn* [x] (f (acc x)))) identity fs))
|
||||
;; computes the composition of an arbitrary number of functions.
|
||||
;; The first anonymous function is the mathematical composition.
|
||||
;; For practical purposes, `->` and `->>` in `core.mal` are more
|
||||
;; efficient and general.
|
||||
|
@ -256,6 +256,7 @@ package body Core is
|
||||
P ("throw", Err.Throw'Access);
|
||||
P ("time-ms", Time_Ms'Access);
|
||||
P ("vals", Types.Maps.Vals'Access);
|
||||
P ("vec", Types.Sequences.Vec'Access);
|
||||
P ("vector", Types.Sequences.Vector'Access);
|
||||
P ("with-meta", With_Meta'Access);
|
||||
end NS_Add_To_Repl;
|
||||
|
@ -1,5 +1,4 @@
|
||||
with Ada.Command_Line;
|
||||
with Ada.Containers.Vectors;
|
||||
with Ada.Environment_Variables;
|
||||
with Ada.Text_IO.Unbounded_IO;
|
||||
|
||||
@ -23,7 +22,6 @@ procedure Step7_Quote is
|
||||
use all type Types.Kind_Type;
|
||||
use type Types.Strings.Instance;
|
||||
package ACL renames Ada.Command_Line;
|
||||
package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
|
||||
|
||||
function Read return Types.T_Array with Inline;
|
||||
|
||||
@ -32,12 +30,7 @@ procedure Step7_Quote is
|
||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T;
|
||||
-- The built-in variant needs to see the Repl variable.
|
||||
|
||||
function Quasiquote (Ast : in Types.T;
|
||||
Env : in Envs.Ptr) return Types.T;
|
||||
-- Mergeing quote and quasiquote into eval with a flag triggering
|
||||
-- a different behaviour as done for macros in step8 would improve
|
||||
-- the performances significantly, but Kanaka finds that it breaks
|
||||
-- too much the step structure shared by all implementations.
|
||||
function Quasiquote (Ast : in Types.T) return Types.T;
|
||||
|
||||
procedure Print (Ast : in Types.T) with Inline;
|
||||
|
||||
@ -174,9 +167,13 @@ procedure Step7_Quote is
|
||||
Ast => Ast.Sequence.all.Data (3),
|
||||
Env => Env));
|
||||
end;
|
||||
elsif First.Str.all = "quasiquoteexpand" then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Quasiquote (Ast.Sequence.all.Data (2));
|
||||
elsif First.Str.all = "quasiquote" then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Quasiquote (Ast.Sequence.all.Data (2), Env);
|
||||
Ast := Quasiquote (Ast.Sequence.all.Data (2));
|
||||
goto Restart;
|
||||
else
|
||||
-- Equivalent to First := Eval (First, Env)
|
||||
-- except that we already know enough to spare a recursive call.
|
||||
@ -266,62 +263,54 @@ procedure Step7_Quote is
|
||||
Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
|
||||
end Print;
|
||||
|
||||
function Quasiquote (Ast : in Types.T;
|
||||
Env : in Envs.Ptr) return Types.T
|
||||
is
|
||||
function Quasiquote (Ast : in Types.T) return Types.T is
|
||||
|
||||
function Quasiquote_List (List : in Types.T_Array) return Types.T;
|
||||
-- Handle vectors and lists not starting with unquote.
|
||||
function Qq_Seq return Types.T;
|
||||
function Starts_With (Sequence : Types.T_Array;
|
||||
Symbol : String) return Boolean;
|
||||
|
||||
function Quasiquote_List (List : in Types.T_Array) return Types.T is
|
||||
Vector : Vectors.Vector; -- buffer for concatenation
|
||||
Tmp : Types.T;
|
||||
function Qq_Seq return Types.T is
|
||||
Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
|
||||
begin
|
||||
for Elt of List loop
|
||||
if Elt.Kind in Kind_List
|
||||
and then 0 < Elt.Sequence.all.Length
|
||||
and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
|
||||
and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
|
||||
for Elt of reverse Ast.Sequence.all.Data loop
|
||||
if Elt.Kind = Kind_List
|
||||
and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
|
||||
then
|
||||
Err.Check (Elt.Sequence.all.Length = 2,
|
||||
"splice-unquote expects 1 parameter");
|
||||
Tmp := Eval (Elt.Sequence.all.Data (2), Env);
|
||||
Err.Check (Tmp.Kind = Kind_List,
|
||||
"splice_unquote expects a list");
|
||||
for Sub_Elt of Tmp.Sequence.all.Data loop
|
||||
Vector.Append (Sub_Elt);
|
||||
end loop;
|
||||
Result := Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("concat")),
|
||||
Elt.Sequence.all.Data (2), Result));
|
||||
else
|
||||
Vector.Append (Quasiquote (Elt, Env));
|
||||
Result := Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("cons")),
|
||||
Quasiquote (Elt), Result));
|
||||
end if;
|
||||
end loop;
|
||||
-- Now that we know the number of elements, convert to a list.
|
||||
declare
|
||||
Sequence : constant Types.Sequence_Ptr
|
||||
:= Types.Sequences.Constructor (Natural (Vector.Length));
|
||||
begin
|
||||
for I in 1 .. Natural (Vector.Length) loop
|
||||
Sequence.all.Data (I) := Vector (I);
|
||||
end loop;
|
||||
return (Kind_List, Sequence);
|
||||
end;
|
||||
end Quasiquote_List;
|
||||
return Result;
|
||||
end Qq_Seq;
|
||||
|
||||
begin -- Quasiquote
|
||||
function Starts_With (Sequence : Types.T_Array;
|
||||
Symbol : String) return Boolean is
|
||||
(0 < Sequence'Length
|
||||
and then Sequence (Sequence'First).Kind = Kind_Symbol
|
||||
and then Sequence (Sequence'First).Str.all = Symbol);
|
||||
|
||||
begin
|
||||
case Ast.Kind is
|
||||
when Kind_Vector =>
|
||||
-- When the test is updated, replace Kind_List with Kind_Vector.
|
||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
||||
when Kind_List =>
|
||||
if 0 < Ast.Sequence.all.Length
|
||||
and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
|
||||
and then Ast.Sequence.all.Data (1).Str.all = "unquote"
|
||||
then
|
||||
if Starts_With (Ast.Sequence.all.Data, "unquote") then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Eval (Ast.Sequence.all.Data (2), Env);
|
||||
return Ast.Sequence.all.Data (2);
|
||||
else
|
||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
||||
return Qq_Seq;
|
||||
end if;
|
||||
when Kind_Vector =>
|
||||
return Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq));
|
||||
when Kind_Map | Kind_Symbol =>
|
||||
return Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast));
|
||||
when others =>
|
||||
return Ast;
|
||||
end case;
|
||||
|
@ -1,5 +1,4 @@
|
||||
with Ada.Command_Line;
|
||||
with Ada.Containers.Vectors;
|
||||
with Ada.Environment_Variables;
|
||||
with Ada.Text_IO.Unbounded_IO;
|
||||
|
||||
@ -23,7 +22,6 @@ procedure Step8_Macros is
|
||||
use all type Types.Kind_Type;
|
||||
use type Types.Strings.Instance;
|
||||
package ACL renames Ada.Command_Line;
|
||||
package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
|
||||
|
||||
function Read return Types.T_Array with Inline;
|
||||
|
||||
@ -32,12 +30,7 @@ procedure Step8_Macros is
|
||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T;
|
||||
-- The built-in variant needs to see the Repl variable.
|
||||
|
||||
function Quasiquote (Ast : in Types.T;
|
||||
Env : in Envs.Ptr) return Types.T;
|
||||
-- Mergeing quote and quasiquote into eval with a flag triggering
|
||||
-- a different behaviour as done for macros in step8 would improve
|
||||
-- the performances significantly, but Kanaka finds that it breaks
|
||||
-- too much the step structure shared by all implementations.
|
||||
function Quasiquote (Ast : in Types.T) return Types.T;
|
||||
|
||||
procedure Print (Ast : in Types.T) with Inline;
|
||||
|
||||
@ -195,9 +188,13 @@ procedure Step8_Macros is
|
||||
Macroexpanding := True;
|
||||
Ast := Ast.Sequence.all.Data (2);
|
||||
goto Restart;
|
||||
elsif First.Str.all = "quasiquoteexpand" then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Quasiquote (Ast.Sequence.all.Data (2));
|
||||
elsif First.Str.all = "quasiquote" then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Quasiquote (Ast.Sequence.all.Data (2), Env);
|
||||
Ast := Quasiquote (Ast.Sequence.all.Data (2));
|
||||
goto Restart;
|
||||
else
|
||||
-- Equivalent to First := Eval (First, Env)
|
||||
-- except that we already know enough to spare a recursive call.
|
||||
@ -315,62 +312,54 @@ procedure Step8_Macros is
|
||||
Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
|
||||
end Print;
|
||||
|
||||
function Quasiquote (Ast : in Types.T;
|
||||
Env : in Envs.Ptr) return Types.T
|
||||
is
|
||||
function Quasiquote (Ast : in Types.T) return Types.T is
|
||||
|
||||
function Quasiquote_List (List : in Types.T_Array) return Types.T;
|
||||
-- Handle vectors and lists not starting with unquote.
|
||||
function Qq_Seq return Types.T;
|
||||
function Starts_With (Sequence : Types.T_Array;
|
||||
Symbol : String) return Boolean;
|
||||
|
||||
function Quasiquote_List (List : in Types.T_Array) return Types.T is
|
||||
Vector : Vectors.Vector; -- buffer for concatenation
|
||||
Tmp : Types.T;
|
||||
function Qq_Seq return Types.T is
|
||||
Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
|
||||
begin
|
||||
for Elt of List loop
|
||||
if Elt.Kind in Kind_List
|
||||
and then 0 < Elt.Sequence.all.Length
|
||||
and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
|
||||
and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
|
||||
for Elt of reverse Ast.Sequence.all.Data loop
|
||||
if Elt.Kind = Kind_List
|
||||
and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
|
||||
then
|
||||
Err.Check (Elt.Sequence.all.Length = 2,
|
||||
"splice-unquote expects 1 parameter");
|
||||
Tmp := Eval (Elt.Sequence.all.Data (2), Env);
|
||||
Err.Check (Tmp.Kind = Kind_List,
|
||||
"splice_unquote expects a list");
|
||||
for Sub_Elt of Tmp.Sequence.all.Data loop
|
||||
Vector.Append (Sub_Elt);
|
||||
end loop;
|
||||
Result := Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("concat")),
|
||||
Elt.Sequence.all.Data (2), Result));
|
||||
else
|
||||
Vector.Append (Quasiquote (Elt, Env));
|
||||
Result := Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("cons")),
|
||||
Quasiquote (Elt), Result));
|
||||
end if;
|
||||
end loop;
|
||||
-- Now that we know the number of elements, convert to a list.
|
||||
declare
|
||||
Sequence : constant Types.Sequence_Ptr
|
||||
:= Types.Sequences.Constructor (Natural (Vector.Length));
|
||||
begin
|
||||
for I in 1 .. Natural (Vector.Length) loop
|
||||
Sequence.all.Data (I) := Vector (I);
|
||||
end loop;
|
||||
return (Kind_List, Sequence);
|
||||
end;
|
||||
end Quasiquote_List;
|
||||
return Result;
|
||||
end Qq_Seq;
|
||||
|
||||
begin -- Quasiquote
|
||||
function Starts_With (Sequence : Types.T_Array;
|
||||
Symbol : String) return Boolean is
|
||||
(0 < Sequence'Length
|
||||
and then Sequence (Sequence'First).Kind = Kind_Symbol
|
||||
and then Sequence (Sequence'First).Str.all = Symbol);
|
||||
|
||||
begin
|
||||
case Ast.Kind is
|
||||
when Kind_Vector =>
|
||||
-- When the test is updated, replace Kind_List with Kind_Vector.
|
||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
||||
when Kind_List =>
|
||||
if 0 < Ast.Sequence.all.Length
|
||||
and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
|
||||
and then Ast.Sequence.all.Data (1).Str.all = "unquote"
|
||||
then
|
||||
if Starts_With (Ast.Sequence.all.Data, "unquote") then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Eval (Ast.Sequence.all.Data (2), Env);
|
||||
return Ast.Sequence.all.Data (2);
|
||||
else
|
||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
||||
return Qq_Seq;
|
||||
end if;
|
||||
when Kind_Vector =>
|
||||
return Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq));
|
||||
when Kind_Map | Kind_Symbol =>
|
||||
return Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast));
|
||||
when others =>
|
||||
return Ast;
|
||||
end case;
|
||||
|
@ -1,5 +1,4 @@
|
||||
with Ada.Command_Line;
|
||||
with Ada.Containers.Vectors;
|
||||
with Ada.Environment_Variables;
|
||||
with Ada.Text_IO.Unbounded_IO;
|
||||
|
||||
@ -23,7 +22,6 @@ procedure Step9_Try is
|
||||
use all type Types.Kind_Type;
|
||||
use type Types.Strings.Instance;
|
||||
package ACL renames Ada.Command_Line;
|
||||
package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
|
||||
|
||||
function Read return Types.T_Array with Inline;
|
||||
|
||||
@ -32,12 +30,7 @@ procedure Step9_Try is
|
||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T;
|
||||
-- The built-in variant needs to see the Repl variable.
|
||||
|
||||
function Quasiquote (Ast : in Types.T;
|
||||
Env : in Envs.Ptr) return Types.T;
|
||||
-- Mergeing quote and quasiquote into eval with a flag triggering
|
||||
-- a different behaviour as done for macros in step8 would improve
|
||||
-- the performances significantly, but Kanaka finds that it breaks
|
||||
-- too much the step structure shared by all implementations.
|
||||
function Quasiquote (Ast : in Types.T) return Types.T;
|
||||
|
||||
procedure Print (Ast : in Types.T) with Inline;
|
||||
|
||||
@ -195,9 +188,13 @@ procedure Step9_Try is
|
||||
Macroexpanding := True;
|
||||
Ast := Ast.Sequence.all.Data (2);
|
||||
goto Restart;
|
||||
elsif First.Str.all = "quasiquoteexpand" then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Quasiquote (Ast.Sequence.all.Data (2));
|
||||
elsif First.Str.all = "quasiquote" then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Quasiquote (Ast.Sequence.all.Data (2), Env);
|
||||
Ast := Quasiquote (Ast.Sequence.all.Data (2));
|
||||
goto Restart;
|
||||
elsif First.Str.all = "try*" then
|
||||
if Ast.Sequence.all.Length = 2 then
|
||||
Ast := Ast.Sequence.all.Data (2);
|
||||
@ -345,62 +342,54 @@ procedure Step9_Try is
|
||||
Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
|
||||
end Print;
|
||||
|
||||
function Quasiquote (Ast : in Types.T;
|
||||
Env : in Envs.Ptr) return Types.T
|
||||
is
|
||||
function Quasiquote (Ast : in Types.T) return Types.T is
|
||||
|
||||
function Quasiquote_List (List : in Types.T_Array) return Types.T;
|
||||
-- Handle vectors and lists not starting with unquote.
|
||||
function Qq_Seq return Types.T;
|
||||
function Starts_With (Sequence : Types.T_Array;
|
||||
Symbol : String) return Boolean;
|
||||
|
||||
function Quasiquote_List (List : in Types.T_Array) return Types.T is
|
||||
Vector : Vectors.Vector; -- buffer for concatenation
|
||||
Tmp : Types.T;
|
||||
function Qq_Seq return Types.T is
|
||||
Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
|
||||
begin
|
||||
for Elt of List loop
|
||||
if Elt.Kind in Kind_List
|
||||
and then 0 < Elt.Sequence.all.Length
|
||||
and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
|
||||
and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
|
||||
for Elt of reverse Ast.Sequence.all.Data loop
|
||||
if Elt.Kind = Kind_List
|
||||
and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
|
||||
then
|
||||
Err.Check (Elt.Sequence.all.Length = 2,
|
||||
"splice-unquote expects 1 parameter");
|
||||
Tmp := Eval (Elt.Sequence.all.Data (2), Env);
|
||||
Err.Check (Tmp.Kind = Kind_List,
|
||||
"splice_unquote expects a list");
|
||||
for Sub_Elt of Tmp.Sequence.all.Data loop
|
||||
Vector.Append (Sub_Elt);
|
||||
end loop;
|
||||
Result := Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("concat")),
|
||||
Elt.Sequence.all.Data (2), Result));
|
||||
else
|
||||
Vector.Append (Quasiquote (Elt, Env));
|
||||
Result := Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("cons")),
|
||||
Quasiquote (Elt), Result));
|
||||
end if;
|
||||
end loop;
|
||||
-- Now that we know the number of elements, convert to a list.
|
||||
declare
|
||||
Sequence : constant Types.Sequence_Ptr
|
||||
:= Types.Sequences.Constructor (Natural (Vector.Length));
|
||||
begin
|
||||
for I in 1 .. Natural (Vector.Length) loop
|
||||
Sequence.all.Data (I) := Vector (I);
|
||||
end loop;
|
||||
return (Kind_List, Sequence);
|
||||
end;
|
||||
end Quasiquote_List;
|
||||
return Result;
|
||||
end Qq_Seq;
|
||||
|
||||
begin -- Quasiquote
|
||||
function Starts_With (Sequence : Types.T_Array;
|
||||
Symbol : String) return Boolean is
|
||||
(0 < Sequence'Length
|
||||
and then Sequence (Sequence'First).Kind = Kind_Symbol
|
||||
and then Sequence (Sequence'First).Str.all = Symbol);
|
||||
|
||||
begin
|
||||
case Ast.Kind is
|
||||
when Kind_Vector =>
|
||||
-- When the test is updated, replace Kind_List with Kind_Vector.
|
||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
||||
when Kind_List =>
|
||||
if 0 < Ast.Sequence.all.Length
|
||||
and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
|
||||
and then Ast.Sequence.all.Data (1).Str.all = "unquote"
|
||||
then
|
||||
if Starts_With (Ast.Sequence.all.Data, "unquote") then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Eval (Ast.Sequence.all.Data (2), Env);
|
||||
return Ast.Sequence.all.Data (2);
|
||||
else
|
||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
||||
return Qq_Seq;
|
||||
end if;
|
||||
when Kind_Vector =>
|
||||
return Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq));
|
||||
when Kind_Map | Kind_Symbol =>
|
||||
return Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast));
|
||||
when others =>
|
||||
return Ast;
|
||||
end case;
|
||||
|
@ -1,5 +1,4 @@
|
||||
with Ada.Command_Line;
|
||||
with Ada.Containers.Vectors;
|
||||
with Ada.Environment_Variables;
|
||||
with Ada.Text_IO.Unbounded_IO;
|
||||
|
||||
@ -24,7 +23,6 @@ procedure StepA_Mal is
|
||||
use all type Types.Kind_Type;
|
||||
use type Types.Strings.Instance;
|
||||
package ACL renames Ada.Command_Line;
|
||||
package Vectors is new Ada.Containers.Vectors (Positive, Types.T);
|
||||
|
||||
function Read return Types.T_Array with Inline;
|
||||
|
||||
@ -33,12 +31,7 @@ procedure StepA_Mal is
|
||||
function Eval_Builtin (Args : in Types.T_Array) return Types.T;
|
||||
-- The built-in variant needs to see the Repl variable.
|
||||
|
||||
function Quasiquote (Ast : in Types.T;
|
||||
Env : in Envs.Ptr) return Types.T;
|
||||
-- Mergeing quote and quasiquote into eval with a flag triggering
|
||||
-- a different behaviour as done for macros in step8 would improve
|
||||
-- the performances significantly, but Kanaka finds that it breaks
|
||||
-- too much the step structure shared by all implementations.
|
||||
function Quasiquote (Ast : in Types.T) return Types.T;
|
||||
|
||||
procedure Print (Ast : in Types.T) with Inline;
|
||||
|
||||
@ -196,9 +189,13 @@ procedure StepA_Mal is
|
||||
Macroexpanding := True;
|
||||
Ast := Ast.Sequence.all.Data (2);
|
||||
goto Restart;
|
||||
elsif First.Str.all = "quasiquoteexpand" then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Quasiquote (Ast.Sequence.all.Data (2));
|
||||
elsif First.Str.all = "quasiquote" then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Quasiquote (Ast.Sequence.all.Data (2), Env);
|
||||
Ast := Quasiquote (Ast.Sequence.all.Data (2));
|
||||
goto Restart;
|
||||
elsif First.Str.all = "try*" then
|
||||
if Ast.Sequence.all.Length = 2 then
|
||||
Ast := Ast.Sequence.all.Data (2);
|
||||
@ -351,62 +348,54 @@ procedure StepA_Mal is
|
||||
Ada.Text_IO.Unbounded_IO.Put_Line (Printer.Pr_Str (Ast));
|
||||
end Print;
|
||||
|
||||
function Quasiquote (Ast : in Types.T;
|
||||
Env : in Envs.Ptr) return Types.T
|
||||
is
|
||||
function Quasiquote (Ast : in Types.T) return Types.T is
|
||||
|
||||
function Quasiquote_List (List : in Types.T_Array) return Types.T;
|
||||
-- Handle vectors and lists not starting with unquote.
|
||||
function Qq_Seq return Types.T;
|
||||
function Starts_With (Sequence : Types.T_Array;
|
||||
Symbol : String) return Boolean;
|
||||
|
||||
function Quasiquote_List (List : in Types.T_Array) return Types.T is
|
||||
Vector : Vectors.Vector; -- buffer for concatenation
|
||||
Tmp : Types.T;
|
||||
function Qq_Seq return Types.T is
|
||||
Result : Types.T := Types.Sequences.List ((1 .. 0 => Types.Nil));
|
||||
begin
|
||||
for Elt of List loop
|
||||
if Elt.Kind in Kind_List
|
||||
and then 0 < Elt.Sequence.all.Length
|
||||
and then Elt.Sequence.all.Data (1).Kind = Kind_Symbol
|
||||
and then Elt.Sequence.all.Data (1).Str.all = "splice-unquote"
|
||||
for Elt of reverse Ast.Sequence.all.Data loop
|
||||
if Elt.Kind = Kind_List
|
||||
and then Starts_With (Elt.Sequence.all.Data, "splice-unquote")
|
||||
then
|
||||
Err.Check (Elt.Sequence.all.Length = 2,
|
||||
"splice-unquote expects 1 parameter");
|
||||
Tmp := Eval (Elt.Sequence.all.Data (2), Env);
|
||||
Err.Check (Tmp.Kind = Kind_List,
|
||||
"splice_unquote expects a list");
|
||||
for Sub_Elt of Tmp.Sequence.all.Data loop
|
||||
Vector.Append (Sub_Elt);
|
||||
end loop;
|
||||
Result := Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("concat")),
|
||||
Elt.Sequence.all.Data (2), Result));
|
||||
else
|
||||
Vector.Append (Quasiquote (Elt, Env));
|
||||
Result := Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("cons")),
|
||||
Quasiquote (Elt), Result));
|
||||
end if;
|
||||
end loop;
|
||||
-- Now that we know the number of elements, convert to a list.
|
||||
declare
|
||||
Sequence : constant Types.Sequence_Ptr
|
||||
:= Types.Sequences.Constructor (Natural (Vector.Length));
|
||||
begin
|
||||
for I in 1 .. Natural (Vector.Length) loop
|
||||
Sequence.all.Data (I) := Vector (I);
|
||||
end loop;
|
||||
return (Kind_List, Sequence);
|
||||
end;
|
||||
end Quasiquote_List;
|
||||
return Result;
|
||||
end Qq_Seq;
|
||||
|
||||
begin -- Quasiquote
|
||||
function Starts_With (Sequence : Types.T_Array;
|
||||
Symbol : String) return Boolean is
|
||||
(0 < Sequence'Length
|
||||
and then Sequence (Sequence'First).Kind = Kind_Symbol
|
||||
and then Sequence (Sequence'First).Str.all = Symbol);
|
||||
|
||||
begin
|
||||
case Ast.Kind is
|
||||
when Kind_Vector =>
|
||||
-- When the test is updated, replace Kind_List with Kind_Vector.
|
||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
||||
when Kind_List =>
|
||||
if 0 < Ast.Sequence.all.Length
|
||||
and then Ast.Sequence.all.Data (1).Kind = Kind_Symbol
|
||||
and then Ast.Sequence.all.Data (1).Str.all = "unquote"
|
||||
then
|
||||
if Starts_With (Ast.Sequence.all.Data, "unquote") then
|
||||
Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
|
||||
return Eval (Ast.Sequence.all.Data (2), Env);
|
||||
return Ast.Sequence.all.Data (2);
|
||||
else
|
||||
return Quasiquote_List (Ast.Sequence.all.Data);
|
||||
return Qq_Seq;
|
||||
end if;
|
||||
when Kind_Vector =>
|
||||
return Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("vec")), Qq_Seq));
|
||||
when Kind_Map | Kind_Symbol =>
|
||||
return Types.Sequences.List
|
||||
(((Kind_Symbol, Types.Strings.Alloc ("quote")), Ast));
|
||||
when others =>
|
||||
return Ast;
|
||||
end case;
|
||||
|
@ -46,7 +46,7 @@ package body Types.Atoms is
|
||||
function Swap (Args : in T_Array) return T is
|
||||
begin
|
||||
Err.Check (2 <= Args'Length and then Args (Args'First).Kind = Kind_Atom,
|
||||
"expected an atom, optional arguments then a function");
|
||||
"expected an atom, a function, then optional arguments");
|
||||
declare
|
||||
X : T renames Args (Args'First).Atom.all.Data;
|
||||
F : T renames Args (Args'First + 1);
|
||||
|
@ -208,6 +208,14 @@ package body Types.Sequences is
|
||||
end case;
|
||||
end Rest;
|
||||
|
||||
function Vec (Args : in T_Array) return T is
|
||||
begin
|
||||
Err.Check (Args'Length = 1
|
||||
and then Args (Args'First).Kind in Kind_Sequence,
|
||||
"expects a sequence");
|
||||
return (Kind_Vector, Args (Args'First).Sequence);
|
||||
end Vec;
|
||||
|
||||
function Vector (Args : in T_Array) return T
|
||||
is
|
||||
Ref : constant Sequence_Ptr := Constructor (Args'Length);
|
||||
|
@ -24,6 +24,7 @@ package Types.Sequences is
|
||||
function Map (Args : in T_Array) return T;
|
||||
function Nth (Args : in T_Array) return T;
|
||||
function Rest (Args : in T_Array) return T;
|
||||
function Vec (Args : in T_Array) return T;
|
||||
function Vector (Args : in T_Array) return T;
|
||||
|
||||
-- New instances must be created via this constructor.
|
||||
|
@ -645,6 +645,25 @@ package body Core is
|
||||
end New_Vector;
|
||||
|
||||
|
||||
function Vec (Rest_Handle : Mal_Handle)
|
||||
return Types.Mal_Handle is
|
||||
First_Param : Mal_Handle;
|
||||
begin
|
||||
First_Param := Car (Deref_List (Rest_Handle).all);
|
||||
if Deref (First_Param).Sym_Type /= List then
|
||||
raise Runtime_Exception with "Expecting a sequence";
|
||||
end if;
|
||||
case Deref_List_Class (First_Param).Get_List_Type is
|
||||
when Hashed_List =>
|
||||
raise Runtime_Exception with "Expecting a sequence";
|
||||
when Vector_List =>
|
||||
return First_Param;
|
||||
when List_List =>
|
||||
return New_Vector (First_Param);
|
||||
end case;
|
||||
end Vec;
|
||||
|
||||
|
||||
function New_Map (Rest_Handle : Mal_Handle)
|
||||
return Types.Mal_Handle is
|
||||
Rest_List : List_Mal_Type;
|
||||
@ -1059,6 +1078,10 @@ package body Core is
|
||||
"list?",
|
||||
New_Func_Mal_Type ("list?", Is_List'access));
|
||||
|
||||
Envs.Set (Repl_Env,
|
||||
"vec",
|
||||
New_Func_Mal_Type ("vec", Vec'access));
|
||||
|
||||
Envs.Set (Repl_Env,
|
||||
"vector",
|
||||
New_Func_Mal_Type ("vector", New_Vector'access));
|
||||
|
@ -100,85 +100,78 @@ procedure Step7_Quote is
|
||||
|
||||
end Eval_Ast;
|
||||
|
||||
function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
|
||||
A0 : Mal_Handle;
|
||||
begin
|
||||
if Deref (Ast).Sym_Type /= List
|
||||
or else Deref_List_Class (Ast).Get_List_Type /= List_List
|
||||
or else Deref_List (Ast).Is_Null
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
A0 := Deref_List (Ast).Car;
|
||||
return Deref (A0).Sym_Type = Sym
|
||||
and then Deref_Sym (A0).Get_Sym = Symbol;
|
||||
end Starts_With;
|
||||
|
||||
function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
|
||||
Res, First_Elem, FE_0 : Mal_Handle;
|
||||
Res, Elt, New_Res : Mal_Handle;
|
||||
L : List_Ptr;
|
||||
D_Ptr, Ast_P : List_Class_Ptr;
|
||||
begin
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
-- Create a New List for the result...
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (Res);
|
||||
if Deref (Param).Sym_Type not in Sym | List then
|
||||
-- No need to quote, Eval would not affect these anyway.
|
||||
return Param;
|
||||
end if;
|
||||
|
||||
-- This is the equivalent of Is_Pair
|
||||
if Deref (Param).Sym_Type /= List or else
|
||||
Is_Null (Deref_List_Class (Param).all) then
|
||||
Deref_List_Class (Param).Get_List_Type = Hashed_List then
|
||||
|
||||
-- return a new list containing: a symbol named "quote" and ast.
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (Res);
|
||||
L.Append (New_Symbol_Mal_Type ("quote"));
|
||||
L.Append (Param);
|
||||
return Res;
|
||||
|
||||
end if;
|
||||
|
||||
-- Ast is a non-empty list at this point.
|
||||
|
||||
Ast_P := Deref_List_Class (Param);
|
||||
|
||||
First_Elem := Car (Ast_P.all);
|
||||
|
||||
-- if the first element of ast is a symbol named "unquote":
|
||||
if Deref (First_Elem).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Elem).Get_Sym = "unquote" then
|
||||
|
||||
if Starts_With (Param, "unquote") then
|
||||
-- return the second element of ast.`
|
||||
D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
|
||||
return Car (D_Ptr.all);
|
||||
return Deref_List_Class (Param).Nth (1);
|
||||
|
||||
end if;
|
||||
|
||||
-- if the first element of first element of `ast` (`ast[0][0]`)
|
||||
-- is a symbol named "splice-unquote"
|
||||
if Deref (First_Elem).Sym_Type = List and then
|
||||
not Is_Null (Deref_List_Class (First_Elem).all) then
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
|
||||
D_Ptr := Deref_List_Class (First_Elem);
|
||||
FE_0 := Car (D_Ptr.all);
|
||||
|
||||
if Deref (FE_0).Sym_Type = Sym and then
|
||||
Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
|
||||
|
||||
-- return a new list containing: a symbol named "concat",
|
||||
for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
|
||||
Elt := Deref_List_Class (Param).Nth (I);
|
||||
New_Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (New_Res);
|
||||
if Starts_With (Elt, "splice-unquote") then
|
||||
L.Append (New_Symbol_Mal_Type ("concat"));
|
||||
|
||||
-- the second element of first element of ast (ast[0][1]),
|
||||
D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
|
||||
L.Append (Car (D_Ptr.all));
|
||||
|
||||
-- and the result of calling quasiquote with
|
||||
-- the second through last element of ast.
|
||||
L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
|
||||
|
||||
return Res;
|
||||
|
||||
L.Append (Deref_List (Elt).Nth (1));
|
||||
else
|
||||
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||
L.Append (Quasi_Quote_Processing (Elt));
|
||||
end if;
|
||||
L.Append (Res);
|
||||
Res := New_Res;
|
||||
end loop;
|
||||
|
||||
if Deref_List_Class (Param).Get_List_Type = Vector_List then
|
||||
New_Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (New_Res);
|
||||
L.Append (New_Symbol_Mal_Type ("vec"));
|
||||
L.Append (Res);
|
||||
Res := New_Res;
|
||||
end if;
|
||||
|
||||
-- otherwise: return a new list containing: a symbol named "cons",
|
||||
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||
|
||||
-- the result of calling quasiquote on first element of ast (ast[0]),
|
||||
L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
|
||||
|
||||
-- and result of calling quasiquote with the second through last element of ast.
|
||||
L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
|
||||
|
||||
return Res;
|
||||
|
||||
end Quasi_Quote_Processing;
|
||||
@ -312,6 +305,11 @@ procedure Step7_Quote is
|
||||
|
||||
return Car (Rest_List);
|
||||
|
||||
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then
|
||||
|
||||
return Quasi_Quote_Processing (Car (Rest_List));
|
||||
|
||||
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
||||
|
||||
|
@ -164,85 +164,78 @@ procedure Step8_Macros is
|
||||
|
||||
end Eval_Ast;
|
||||
|
||||
function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
|
||||
A0 : Mal_Handle;
|
||||
begin
|
||||
if Deref (Ast).Sym_Type /= List
|
||||
or else Deref_List_Class (Ast).Get_List_Type /= List_List
|
||||
or else Deref_List (Ast).Is_Null
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
A0 := Deref_List (Ast).Car;
|
||||
return Deref (A0).Sym_Type = Sym
|
||||
and then Deref_Sym (A0).Get_Sym = Symbol;
|
||||
end Starts_With;
|
||||
|
||||
function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
|
||||
Res, First_Elem, FE_0 : Mal_Handle;
|
||||
Res, Elt, New_Res : Mal_Handle;
|
||||
L : List_Ptr;
|
||||
D_Ptr, Ast_P : List_Class_Ptr;
|
||||
begin
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
-- Create a New List for the result...
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (Res);
|
||||
if Deref (Param).Sym_Type not in Sym | List then
|
||||
-- No need to quote, Eval would not affect these anyway.
|
||||
return Param;
|
||||
end if;
|
||||
|
||||
-- This is the equivalent of Is_Pair
|
||||
if Deref (Param).Sym_Type /= List or else
|
||||
Is_Null (Deref_List_Class (Param).all) then
|
||||
Deref_List_Class (Param).Get_List_Type = Hashed_List then
|
||||
|
||||
-- return a new list containing: a symbol named "quote" and ast.
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (Res);
|
||||
L.Append (New_Symbol_Mal_Type ("quote"));
|
||||
L.Append (Param);
|
||||
return Res;
|
||||
|
||||
end if;
|
||||
|
||||
-- Ast is a non-empty list at this point.
|
||||
|
||||
Ast_P := Deref_List_Class (Param);
|
||||
|
||||
First_Elem := Car (Ast_P.all);
|
||||
|
||||
-- if the first element of ast is a symbol named "unquote":
|
||||
if Deref (First_Elem).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Elem).Get_Sym = "unquote" then
|
||||
|
||||
if Starts_With (Param, "unquote") then
|
||||
-- return the second element of ast.`
|
||||
D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
|
||||
return Car (D_Ptr.all);
|
||||
return Deref_List_Class (Param).Nth (1);
|
||||
|
||||
end if;
|
||||
|
||||
-- if the first element of first element of `ast` (`ast[0][0]`)
|
||||
-- is a symbol named "splice-unquote"
|
||||
if Deref (First_Elem).Sym_Type = List and then
|
||||
not Is_Null (Deref_List_Class (First_Elem).all) then
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
|
||||
D_Ptr := Deref_List_Class (First_Elem);
|
||||
FE_0 := Car (D_Ptr.all);
|
||||
|
||||
if Deref (FE_0).Sym_Type = Sym and then
|
||||
Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
|
||||
|
||||
-- return a new list containing: a symbol named "concat",
|
||||
for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
|
||||
Elt := Deref_List_Class (Param).Nth (I);
|
||||
New_Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (New_Res);
|
||||
if Starts_With (Elt, "splice-unquote") then
|
||||
L.Append (New_Symbol_Mal_Type ("concat"));
|
||||
|
||||
-- the second element of first element of ast (ast[0][1]),
|
||||
D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
|
||||
L.Append (Car (D_Ptr.all));
|
||||
|
||||
-- and the result of calling quasiquote with
|
||||
-- the second through last element of ast.
|
||||
L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
|
||||
|
||||
return Res;
|
||||
|
||||
L.Append (Deref_List (Elt).Nth (1));
|
||||
else
|
||||
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||
L.Append (Quasi_Quote_Processing (Elt));
|
||||
end if;
|
||||
L.Append (Res);
|
||||
Res := New_Res;
|
||||
end loop;
|
||||
|
||||
if Deref_List_Class (Param).Get_List_Type = Vector_List then
|
||||
New_Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (New_Res);
|
||||
L.Append (New_Symbol_Mal_Type ("vec"));
|
||||
L.Append (Res);
|
||||
Res := New_Res;
|
||||
end if;
|
||||
|
||||
-- otherwise: return a new list containing: a symbol named "cons",
|
||||
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||
|
||||
-- the result of calling quasiquote on first element of ast (ast[0]),
|
||||
L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
|
||||
|
||||
-- and result of calling quasiquote with the second through last element of ast.
|
||||
L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
|
||||
|
||||
return Res;
|
||||
|
||||
end Quasi_Quote_Processing;
|
||||
@ -388,6 +381,11 @@ procedure Step8_Macros is
|
||||
|
||||
return Car (Rest_List);
|
||||
|
||||
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then
|
||||
|
||||
return Quasi_Quote_Processing (Car (Rest_List));
|
||||
|
||||
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
||||
|
||||
|
@ -164,85 +164,78 @@ procedure Step9_Try is
|
||||
|
||||
end Eval_Ast;
|
||||
|
||||
function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
|
||||
A0 : Mal_Handle;
|
||||
begin
|
||||
if Deref (Ast).Sym_Type /= List
|
||||
or else Deref_List_Class (Ast).Get_List_Type /= List_List
|
||||
or else Deref_List (Ast).Is_Null
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
A0 := Deref_List (Ast).Car;
|
||||
return Deref (A0).Sym_Type = Sym
|
||||
and then Deref_Sym (A0).Get_Sym = Symbol;
|
||||
end Starts_With;
|
||||
|
||||
function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
|
||||
Res, First_Elem, FE_0 : Mal_Handle;
|
||||
Res, Elt, New_Res : Mal_Handle;
|
||||
L : List_Ptr;
|
||||
D_Ptr, Ast_P : List_Class_Ptr;
|
||||
begin
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
-- Create a New List for the result...
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (Res);
|
||||
if Deref (Param).Sym_Type not in Sym | List then
|
||||
-- No need to quote, Eval would not affect these anyway.
|
||||
return Param;
|
||||
end if;
|
||||
|
||||
-- This is the equivalent of Is_Pair
|
||||
if Deref (Param).Sym_Type /= List or else
|
||||
Is_Null (Deref_List_Class (Param).all) then
|
||||
Deref_List_Class (Param).Get_List_Type = Hashed_List then
|
||||
|
||||
-- return a new list containing: a symbol named "quote" and ast.
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (Res);
|
||||
L.Append (New_Symbol_Mal_Type ("quote"));
|
||||
L.Append (Param);
|
||||
return Res;
|
||||
|
||||
end if;
|
||||
|
||||
-- Ast is a non-empty list at this point.
|
||||
|
||||
Ast_P := Deref_List_Class (Param);
|
||||
|
||||
First_Elem := Car (Ast_P.all);
|
||||
|
||||
-- if the first element of ast is a symbol named "unquote":
|
||||
if Deref (First_Elem).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Elem).Get_Sym = "unquote" then
|
||||
|
||||
if Starts_With (Param, "unquote") then
|
||||
-- return the second element of ast.`
|
||||
D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
|
||||
return Car (D_Ptr.all);
|
||||
return Deref_List_Class (Param).Nth (1);
|
||||
|
||||
end if;
|
||||
|
||||
-- if the first element of first element of `ast` (`ast[0][0]`)
|
||||
-- is a symbol named "splice-unquote"
|
||||
if Deref (First_Elem).Sym_Type = List and then
|
||||
not Is_Null (Deref_List_Class (First_Elem).all) then
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
|
||||
D_Ptr := Deref_List_Class (First_Elem);
|
||||
FE_0 := Car (D_Ptr.all);
|
||||
|
||||
if Deref (FE_0).Sym_Type = Sym and then
|
||||
Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
|
||||
|
||||
-- return a new list containing: a symbol named "concat",
|
||||
for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
|
||||
Elt := Deref_List_Class (Param).Nth (I);
|
||||
New_Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (New_Res);
|
||||
if Starts_With (Elt, "splice-unquote") then
|
||||
L.Append (New_Symbol_Mal_Type ("concat"));
|
||||
|
||||
-- the second element of first element of ast (ast[0][1]),
|
||||
D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
|
||||
L.Append (Car (D_Ptr.all));
|
||||
|
||||
-- and the result of calling quasiquote with
|
||||
-- the second through last element of ast.
|
||||
L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
|
||||
|
||||
return Res;
|
||||
|
||||
L.Append (Deref_List (Elt).Nth (1));
|
||||
else
|
||||
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||
L.Append (Quasi_Quote_Processing (Elt));
|
||||
end if;
|
||||
L.Append (Res);
|
||||
Res := New_Res;
|
||||
end loop;
|
||||
|
||||
if Deref_List_Class (Param).Get_List_Type = Vector_List then
|
||||
New_Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (New_Res);
|
||||
L.Append (New_Symbol_Mal_Type ("vec"));
|
||||
L.Append (Res);
|
||||
Res := New_Res;
|
||||
end if;
|
||||
|
||||
-- otherwise: return a new list containing: a symbol named "cons",
|
||||
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||
|
||||
-- the result of calling quasiquote on first element of ast (ast[0]),
|
||||
L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
|
||||
|
||||
-- and result of calling quasiquote with the second through last element of ast.
|
||||
L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
|
||||
|
||||
return Res;
|
||||
|
||||
end Quasi_Quote_Processing;
|
||||
@ -414,6 +407,11 @@ procedure Step9_Try is
|
||||
|
||||
return Car (Rest_List);
|
||||
|
||||
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then
|
||||
|
||||
return Quasi_Quote_Processing (Car (Rest_List));
|
||||
|
||||
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
||||
|
||||
|
@ -164,85 +164,78 @@ procedure StepA_Mal is
|
||||
|
||||
end Eval_Ast;
|
||||
|
||||
function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
|
||||
A0 : Mal_Handle;
|
||||
begin
|
||||
if Deref (Ast).Sym_Type /= List
|
||||
or else Deref_List_Class (Ast).Get_List_Type /= List_List
|
||||
or else Deref_List (Ast).Is_Null
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
A0 := Deref_List (Ast).Car;
|
||||
return Deref (A0).Sym_Type = Sym
|
||||
and then Deref_Sym (A0).Get_Sym = Symbol;
|
||||
end Starts_With;
|
||||
|
||||
function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
|
||||
Res, First_Elem, FE_0 : Mal_Handle;
|
||||
Res, Elt, New_Res : Mal_Handle;
|
||||
L : List_Ptr;
|
||||
D_Ptr, Ast_P : List_Class_Ptr;
|
||||
begin
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
-- Create a New List for the result...
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (Res);
|
||||
if Deref (Param).Sym_Type not in Sym | List then
|
||||
-- No need to quote, Eval would not affect these anyway.
|
||||
return Param;
|
||||
end if;
|
||||
|
||||
-- This is the equivalent of Is_Pair
|
||||
if Deref (Param).Sym_Type /= List or else
|
||||
Is_Null (Deref_List_Class (Param).all) then
|
||||
Deref_List_Class (Param).Get_List_Type = Hashed_List then
|
||||
|
||||
-- return a new list containing: a symbol named "quote" and ast.
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (Res);
|
||||
L.Append (New_Symbol_Mal_Type ("quote"));
|
||||
L.Append (Param);
|
||||
return Res;
|
||||
|
||||
end if;
|
||||
|
||||
-- Ast is a non-empty list at this point.
|
||||
|
||||
Ast_P := Deref_List_Class (Param);
|
||||
|
||||
First_Elem := Car (Ast_P.all);
|
||||
|
||||
-- if the first element of ast is a symbol named "unquote":
|
||||
if Deref (First_Elem).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Elem).Get_Sym = "unquote" then
|
||||
|
||||
if Starts_With (Param, "unquote") then
|
||||
-- return the second element of ast.`
|
||||
D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
|
||||
return Car (D_Ptr.all);
|
||||
return Deref_List_Class (Param).Nth (1);
|
||||
|
||||
end if;
|
||||
|
||||
-- if the first element of first element of `ast` (`ast[0][0]`)
|
||||
-- is a symbol named "splice-unquote"
|
||||
if Deref (First_Elem).Sym_Type = List and then
|
||||
not Is_Null (Deref_List_Class (First_Elem).all) then
|
||||
Res := New_List_Mal_Type (List_List);
|
||||
|
||||
D_Ptr := Deref_List_Class (First_Elem);
|
||||
FE_0 := Car (D_Ptr.all);
|
||||
|
||||
if Deref (FE_0).Sym_Type = Sym and then
|
||||
Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
|
||||
|
||||
-- return a new list containing: a symbol named "concat",
|
||||
for I in reverse 0 .. Deref_List_Class (Param).Length - 1 loop
|
||||
Elt := Deref_List_Class (Param).Nth (I);
|
||||
New_Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (New_Res);
|
||||
if Starts_With (Elt, "splice-unquote") then
|
||||
L.Append (New_Symbol_Mal_Type ("concat"));
|
||||
|
||||
-- the second element of first element of ast (ast[0][1]),
|
||||
D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
|
||||
L.Append (Car (D_Ptr.all));
|
||||
|
||||
-- and the result of calling quasiquote with
|
||||
-- the second through last element of ast.
|
||||
L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
|
||||
|
||||
return Res;
|
||||
|
||||
L.Append (Deref_List (Elt).Nth (1));
|
||||
else
|
||||
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||
L.Append (Quasi_Quote_Processing (Elt));
|
||||
end if;
|
||||
L.Append (Res);
|
||||
Res := New_Res;
|
||||
end loop;
|
||||
|
||||
if Deref_List_Class (Param).Get_List_Type = Vector_List then
|
||||
New_Res := New_List_Mal_Type (List_List);
|
||||
L := Deref_List (New_Res);
|
||||
L.Append (New_Symbol_Mal_Type ("vec"));
|
||||
L.Append (Res);
|
||||
Res := New_Res;
|
||||
end if;
|
||||
|
||||
-- otherwise: return a new list containing: a symbol named "cons",
|
||||
L.Append (New_Symbol_Mal_Type ("cons"));
|
||||
|
||||
-- the result of calling quasiquote on first element of ast (ast[0]),
|
||||
L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
|
||||
|
||||
-- and result of calling quasiquote with the second through last element of ast.
|
||||
L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
|
||||
|
||||
return Res;
|
||||
|
||||
end Quasi_Quote_Processing;
|
||||
@ -414,6 +407,11 @@ procedure StepA_Mal is
|
||||
|
||||
return Car (Rest_List);
|
||||
|
||||
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then
|
||||
|
||||
return Quasi_Quote_Processing (Car (Rest_List));
|
||||
|
||||
elsif Deref (First_Param).Sym_Type = Sym and then
|
||||
Deref_Sym (First_Param).Get_Sym = "quasiquote" then
|
||||
|
||||
|
@ -628,6 +628,24 @@ function core_concat(idx, new_idx, new_len, len, i, lst, lst_idx, lst_len, j)
|
||||
return "(" new_idx
|
||||
}
|
||||
|
||||
function core_vec(idx, new_idx, len)
|
||||
{
|
||||
len = types_heap[idx]["len"]
|
||||
if (len != 2)
|
||||
return "!\"Invalid argument length for builtin function 'vec'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
idx = types_heap[idx][1]
|
||||
if (idx !~ /^[([]/) {
|
||||
return "!\"Incompatible type for argument 1 of builtin function 'vec'. Expects list or vector, supplied " types_typename(idx) "."
|
||||
}
|
||||
idx = substr(idx, 2)
|
||||
len = types_heap[idx]["len"]
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx]["len"] = len
|
||||
while (len--)
|
||||
types_addref(types_heap[new_idx][len] = types_heap[idx][len])
|
||||
return "[" new_idx
|
||||
}
|
||||
|
||||
function core_nth(idx, lst, num, n, lst_idx)
|
||||
{
|
||||
if (types_heap[idx]["len"] != 3) {
|
||||
@ -1078,6 +1096,7 @@ function core_init()
|
||||
|
||||
core_ns["'list"] = "&core_list"
|
||||
core_ns["'list?"] = "&core_listp"
|
||||
core_ns["'vec"] = "&core_vec"
|
||||
core_ns["'vector"] = "&core_vector"
|
||||
core_ns["'vector?"] = "&core_vectorp"
|
||||
core_ns["'hash-map"] = "&core_hash_map"
|
||||
|
@ -9,69 +9,82 @@ function READ(str)
|
||||
return reader_read_str(str)
|
||||
}
|
||||
|
||||
function is_pair(ast)
|
||||
# Return 0, an error or the unquote argument (second element of ast).
|
||||
function starts_with(ast, sym, idx, len)
|
||||
{
|
||||
return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
|
||||
if (ast !~ /^\(/)
|
||||
return 0
|
||||
idx = substr(ast, 2)
|
||||
len = types_heap[idx]["len"]
|
||||
if (!len || types_heap[idx][0] != sym)
|
||||
return 0
|
||||
if (len != 2)
|
||||
return "!\"'" sym "' expects 1 argument, not " (len - 1) "."
|
||||
return types_heap[idx][1]
|
||||
}
|
||||
|
||||
function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
|
||||
function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous)
|
||||
{
|
||||
if (!is_pair(ast)) {
|
||||
if (ast !~ /^[(['{]/) {
|
||||
return ast
|
||||
}
|
||||
if (ast ~ /['\{]/) {
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'quote"
|
||||
types_heap[new_idx][1] = ast
|
||||
types_heap[new_idx]["len"] = 2
|
||||
return "(" new_idx
|
||||
}
|
||||
idx = substr(ast, 2)
|
||||
first = types_heap[idx][0]
|
||||
if (first == "'unquote") {
|
||||
if (types_heap[idx]["len"] != 2) {
|
||||
len = types_heap[idx]["len"]
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(ret = types_heap[idx][1])
|
||||
ret = starts_with(ast, "'unquote")
|
||||
if (ret ~ /^!/) {
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
|
||||
first_idx = substr(first, 2)
|
||||
if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
|
||||
if (types_heap[first_idx]["len"] != 2) {
|
||||
len = types_heap[first_idx]["len"]
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(first = types_heap[first_idx][1])
|
||||
verb = "'concat"
|
||||
} else {
|
||||
types_addref(first)
|
||||
first = quasiquote(first)
|
||||
if (first ~ /^!/) {
|
||||
types_release(ast)
|
||||
return first
|
||||
}
|
||||
verb = "'cons"
|
||||
}
|
||||
lst_idx = types_allocate()
|
||||
len = types_heap[idx]["len"]
|
||||
for (i = 1; i < len; ++i) {
|
||||
types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
|
||||
}
|
||||
types_heap[lst_idx]["len"] = len - 1
|
||||
types_release(ast)
|
||||
ret = quasiquote("(" lst_idx)
|
||||
if (ret ~ /^!/) {
|
||||
types_release(first)
|
||||
if (ret) {
|
||||
types_addref(ret)
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = verb
|
||||
types_heap[new_idx][1] = first
|
||||
types_heap[new_idx][2] = ret
|
||||
types_heap[new_idx]["len"] = 3
|
||||
types_heap[new_idx]["len"] = 0
|
||||
ast_idx = substr(ast, 2)
|
||||
for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
|
||||
elt = types_heap[ast_idx][elt_i]
|
||||
ret = starts_with(elt, "'splice-unquote")
|
||||
if (ret ~ /^!/) {
|
||||
types_release("(" new_idx)
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
if (ret) {
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'concat"
|
||||
types_heap[new_idx][1] = types_addref(ret)
|
||||
types_heap[new_idx][2] = previous
|
||||
types_heap[new_idx]["len"] = 3
|
||||
} else {
|
||||
ret = quasiquote(types_addref(elt))
|
||||
if (ret ~ /^!/) {
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'cons"
|
||||
types_heap[new_idx][1] = ret
|
||||
types_heap[new_idx][2] = previous
|
||||
types_heap[new_idx]["len"] = 3
|
||||
}
|
||||
}
|
||||
if (ast ~ /^\[/) {
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'vec"
|
||||
types_heap[new_idx][1] = previous
|
||||
types_heap[new_idx]["len"] = 2
|
||||
}
|
||||
types_release(ast)
|
||||
return "(" new_idx
|
||||
}
|
||||
|
||||
@ -316,6 +329,15 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env)
|
||||
types_release(ast)
|
||||
env_release(env)
|
||||
return body
|
||||
case "'quasiquoteexpand":
|
||||
env_release(env)
|
||||
if (len != 2) {
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(body = types_heap[idx][1])
|
||||
types_release(ast)
|
||||
return quasiquote(body)
|
||||
case "'quasiquote":
|
||||
if (len != 2) {
|
||||
types_release(ast)
|
||||
|
@ -9,81 +9,93 @@ function READ(str)
|
||||
return reader_read_str(str)
|
||||
}
|
||||
|
||||
function is_pair(ast)
|
||||
# Return 0, an error or the unquote argument (second element of ast).
|
||||
function starts_with(ast, sym, idx, len)
|
||||
{
|
||||
return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
|
||||
if (ast !~ /^\(/)
|
||||
return 0
|
||||
idx = substr(ast, 2)
|
||||
len = types_heap[idx]["len"]
|
||||
if (!len || types_heap[idx][0] != sym)
|
||||
return 0
|
||||
if (len != 2)
|
||||
return "!\"'" sym "' expects 1 argument, not " (len - 1) "."
|
||||
return types_heap[idx][1]
|
||||
}
|
||||
|
||||
function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
|
||||
function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous)
|
||||
{
|
||||
if (!is_pair(ast)) {
|
||||
if (ast !~ /^[(['{]/) {
|
||||
return ast
|
||||
}
|
||||
if (ast ~ /['\{]/) {
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'quote"
|
||||
types_heap[new_idx][1] = ast
|
||||
types_heap[new_idx]["len"] = 2
|
||||
return "(" new_idx
|
||||
}
|
||||
idx = substr(ast, 2)
|
||||
first = types_heap[idx][0]
|
||||
if (first == "'unquote") {
|
||||
if (types_heap[idx]["len"] != 2) {
|
||||
len = types_heap[idx]["len"]
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(ret = types_heap[idx][1])
|
||||
ret = starts_with(ast, "'unquote")
|
||||
if (ret ~ /^!/) {
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
|
||||
first_idx = substr(first, 2)
|
||||
if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
|
||||
if (types_heap[first_idx]["len"] != 2) {
|
||||
len = types_heap[first_idx]["len"]
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(first = types_heap[first_idx][1])
|
||||
verb = "'concat"
|
||||
} else {
|
||||
types_addref(first)
|
||||
first = quasiquote(first)
|
||||
if (first ~ /^!/) {
|
||||
types_release(ast)
|
||||
return first
|
||||
}
|
||||
verb = "'cons"
|
||||
}
|
||||
lst_idx = types_allocate()
|
||||
len = types_heap[idx]["len"]
|
||||
for (i = 1; i < len; ++i) {
|
||||
types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
|
||||
}
|
||||
types_heap[lst_idx]["len"] = len - 1
|
||||
types_release(ast)
|
||||
ret = quasiquote("(" lst_idx)
|
||||
if (ret ~ /^!/) {
|
||||
types_release(first)
|
||||
if (ret) {
|
||||
types_addref(ret)
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = verb
|
||||
types_heap[new_idx][1] = first
|
||||
types_heap[new_idx][2] = ret
|
||||
types_heap[new_idx]["len"] = 3
|
||||
types_heap[new_idx]["len"] = 0
|
||||
ast_idx = substr(ast, 2)
|
||||
for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
|
||||
elt = types_heap[ast_idx][elt_i]
|
||||
ret = starts_with(elt, "'splice-unquote")
|
||||
if (ret ~ /^!/) {
|
||||
types_release("(" new_idx)
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
if (ret) {
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'concat"
|
||||
types_heap[new_idx][1] = types_addref(ret)
|
||||
types_heap[new_idx][2] = previous
|
||||
types_heap[new_idx]["len"] = 3
|
||||
} else {
|
||||
ret = quasiquote(types_addref(elt))
|
||||
if (ret ~ /^!/) {
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'cons"
|
||||
types_heap[new_idx][1] = ret
|
||||
types_heap[new_idx][2] = previous
|
||||
types_heap[new_idx]["len"] = 3
|
||||
}
|
||||
}
|
||||
if (ast ~ /^\[/) {
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'vec"
|
||||
types_heap[new_idx][1] = previous
|
||||
types_heap[new_idx]["len"] = 2
|
||||
}
|
||||
types_release(ast)
|
||||
return "(" new_idx
|
||||
}
|
||||
|
||||
function is_macro_call(ast, env, sym, ret, f)
|
||||
function is_macro_call(ast, env, idx, len, sym, f)
|
||||
{
|
||||
if (!is_pair(ast)) {
|
||||
return 0
|
||||
}
|
||||
sym = types_heap[substr(ast, 2)][0]
|
||||
if (sym !~ /^'/) {
|
||||
return 0
|
||||
}
|
||||
if (ast !~ /^\(/) return 0
|
||||
idx = substr(ast, 2)
|
||||
len = types_heap[idx]["len"]
|
||||
if (len == 0) return 0
|
||||
sym = types_heap[idx][0]
|
||||
if (sym !~ /^'/) return 0
|
||||
f = env_get(env, sym)
|
||||
return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
|
||||
}
|
||||
@ -393,6 +405,15 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env)
|
||||
types_release(ast)
|
||||
env_release(env)
|
||||
return body
|
||||
case "'quasiquoteexpand":
|
||||
env_release(env)
|
||||
if (len != 2) {
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(body = types_heap[idx][1])
|
||||
types_release(ast)
|
||||
return quasiquote(body)
|
||||
case "'quasiquote":
|
||||
if (len != 2) {
|
||||
types_release(ast)
|
||||
|
@ -9,81 +9,93 @@ function READ(str)
|
||||
return reader_read_str(str)
|
||||
}
|
||||
|
||||
function is_pair(ast)
|
||||
# Return 0, an error or the unquote argument (second element of ast).
|
||||
function starts_with(ast, sym, idx, len)
|
||||
{
|
||||
return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
|
||||
if (ast !~ /^\(/)
|
||||
return 0
|
||||
idx = substr(ast, 2)
|
||||
len = types_heap[idx]["len"]
|
||||
if (!len || types_heap[idx][0] != sym)
|
||||
return 0
|
||||
if (len != 2)
|
||||
return "!\"'" sym "' expects 1 argument, not " (len - 1) "."
|
||||
return types_heap[idx][1]
|
||||
}
|
||||
|
||||
function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
|
||||
function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous)
|
||||
{
|
||||
if (!is_pair(ast)) {
|
||||
if (ast !~ /^[(['{]/) {
|
||||
return ast
|
||||
}
|
||||
if (ast ~ /['\{]/) {
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'quote"
|
||||
types_heap[new_idx][1] = ast
|
||||
types_heap[new_idx]["len"] = 2
|
||||
return "(" new_idx
|
||||
}
|
||||
idx = substr(ast, 2)
|
||||
first = types_heap[idx][0]
|
||||
if (first == "'unquote") {
|
||||
if (types_heap[idx]["len"] != 2) {
|
||||
len = types_heap[idx]["len"]
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(ret = types_heap[idx][1])
|
||||
ret = starts_with(ast, "'unquote")
|
||||
if (ret ~ /^!/) {
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
|
||||
first_idx = substr(first, 2)
|
||||
if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
|
||||
if (types_heap[first_idx]["len"] != 2) {
|
||||
len = types_heap[first_idx]["len"]
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(first = types_heap[first_idx][1])
|
||||
verb = "'concat"
|
||||
} else {
|
||||
types_addref(first)
|
||||
first = quasiquote(first)
|
||||
if (first ~ /^!/) {
|
||||
types_release(ast)
|
||||
return first
|
||||
}
|
||||
verb = "'cons"
|
||||
}
|
||||
lst_idx = types_allocate()
|
||||
len = types_heap[idx]["len"]
|
||||
for (i = 1; i < len; ++i) {
|
||||
types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
|
||||
}
|
||||
types_heap[lst_idx]["len"] = len - 1
|
||||
types_release(ast)
|
||||
ret = quasiquote("(" lst_idx)
|
||||
if (ret ~ /^!/) {
|
||||
types_release(first)
|
||||
if (ret) {
|
||||
types_addref(ret)
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = verb
|
||||
types_heap[new_idx][1] = first
|
||||
types_heap[new_idx][2] = ret
|
||||
types_heap[new_idx]["len"] = 3
|
||||
types_heap[new_idx]["len"] = 0
|
||||
ast_idx = substr(ast, 2)
|
||||
for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
|
||||
elt = types_heap[ast_idx][elt_i]
|
||||
ret = starts_with(elt, "'splice-unquote")
|
||||
if (ret ~ /^!/) {
|
||||
types_release("(" new_idx)
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
if (ret) {
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'concat"
|
||||
types_heap[new_idx][1] = types_addref(ret)
|
||||
types_heap[new_idx][2] = previous
|
||||
types_heap[new_idx]["len"] = 3
|
||||
} else {
|
||||
ret = quasiquote(types_addref(elt))
|
||||
if (ret ~ /^!/) {
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'cons"
|
||||
types_heap[new_idx][1] = ret
|
||||
types_heap[new_idx][2] = previous
|
||||
types_heap[new_idx]["len"] = 3
|
||||
}
|
||||
}
|
||||
if (ast ~ /^\[/) {
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'vec"
|
||||
types_heap[new_idx][1] = previous
|
||||
types_heap[new_idx]["len"] = 2
|
||||
}
|
||||
types_release(ast)
|
||||
return "(" new_idx
|
||||
}
|
||||
|
||||
function is_macro_call(ast, env, sym, ret, f)
|
||||
function is_macro_call(ast, env, idx, len, sym, f)
|
||||
{
|
||||
if (!is_pair(ast)) {
|
||||
return 0
|
||||
}
|
||||
sym = types_heap[substr(ast, 2)][0]
|
||||
if (sym !~ /^'/) {
|
||||
return 0
|
||||
}
|
||||
if (ast !~ /^\(/) return 0
|
||||
idx = substr(ast, 2)
|
||||
len = types_heap[idx]["len"]
|
||||
if (len == 0) return 0
|
||||
sym = types_heap[idx][0]
|
||||
if (sym !~ /^'/) return 0
|
||||
f = env_get(env, sym)
|
||||
return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
|
||||
}
|
||||
@ -447,6 +459,15 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret
|
||||
types_release(ast)
|
||||
env_release(env)
|
||||
return body
|
||||
case "'quasiquoteexpand":
|
||||
env_release(env)
|
||||
if (len != 2) {
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(body = types_heap[idx][1])
|
||||
types_release(ast)
|
||||
return quasiquote(body)
|
||||
case "'quasiquote":
|
||||
if (len != 2) {
|
||||
types_release(ast)
|
||||
|
@ -9,81 +9,93 @@ function READ(str)
|
||||
return reader_read_str(str)
|
||||
}
|
||||
|
||||
function is_pair(ast)
|
||||
# Return 0, an error or the unquote argument (second element of ast).
|
||||
function starts_with(ast, sym, idx, len)
|
||||
{
|
||||
return ast ~ /^[([]/ && types_heap[substr(ast, 2)]["len"] != 0
|
||||
if (ast !~ /^\(/)
|
||||
return 0
|
||||
idx = substr(ast, 2)
|
||||
len = types_heap[idx]["len"]
|
||||
if (!len || types_heap[idx][0] != sym)
|
||||
return 0
|
||||
if (len != 2)
|
||||
return "!\"'" sym "' expects 1 argument, not " (len - 1) "."
|
||||
return types_heap[idx][1]
|
||||
}
|
||||
|
||||
function quasiquote(ast, i, len, new_idx, idx, lst_idx, first, first_idx, verb, ret)
|
||||
function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous)
|
||||
{
|
||||
if (!is_pair(ast)) {
|
||||
if (ast !~ /^[(['{]/) {
|
||||
return ast
|
||||
}
|
||||
if (ast ~ /['\{]/) {
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'quote"
|
||||
types_heap[new_idx][1] = ast
|
||||
types_heap[new_idx]["len"] = 2
|
||||
return "(" new_idx
|
||||
}
|
||||
idx = substr(ast, 2)
|
||||
first = types_heap[idx][0]
|
||||
if (first == "'unquote") {
|
||||
if (types_heap[idx]["len"] != 2) {
|
||||
len = types_heap[idx]["len"]
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(ret = types_heap[idx][1])
|
||||
ret = starts_with(ast, "'unquote")
|
||||
if (ret ~ /^!/) {
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
|
||||
first_idx = substr(first, 2)
|
||||
if (is_pair(first) && types_heap[first_idx][0] == "'splice-unquote") {
|
||||
if (types_heap[first_idx]["len"] != 2) {
|
||||
len = types_heap[first_idx]["len"]
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'splice-unquote'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(first = types_heap[first_idx][1])
|
||||
verb = "'concat"
|
||||
} else {
|
||||
types_addref(first)
|
||||
first = quasiquote(first)
|
||||
if (first ~ /^!/) {
|
||||
types_release(ast)
|
||||
return first
|
||||
}
|
||||
verb = "'cons"
|
||||
}
|
||||
lst_idx = types_allocate()
|
||||
len = types_heap[idx]["len"]
|
||||
for (i = 1; i < len; ++i) {
|
||||
types_addref(types_heap[lst_idx][i - 1] = types_heap[idx][i])
|
||||
}
|
||||
types_heap[lst_idx]["len"] = len - 1
|
||||
types_release(ast)
|
||||
ret = quasiquote("(" lst_idx)
|
||||
if (ret ~ /^!/) {
|
||||
types_release(first)
|
||||
if (ret) {
|
||||
types_addref(ret)
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = verb
|
||||
types_heap[new_idx][1] = first
|
||||
types_heap[new_idx][2] = ret
|
||||
types_heap[new_idx]["len"] = 3
|
||||
types_heap[new_idx]["len"] = 0
|
||||
ast_idx = substr(ast, 2)
|
||||
for (elt_i=types_heap[ast_idx]["len"]-1; 0<=elt_i; elt_i--) {
|
||||
elt = types_heap[ast_idx][elt_i]
|
||||
ret = starts_with(elt, "'splice-unquote")
|
||||
if (ret ~ /^!/) {
|
||||
types_release("(" new_idx)
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
if (ret) {
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'concat"
|
||||
types_heap[new_idx][1] = types_addref(ret)
|
||||
types_heap[new_idx][2] = previous
|
||||
types_heap[new_idx]["len"] = 3
|
||||
} else {
|
||||
ret = quasiquote(types_addref(elt))
|
||||
if (ret ~ /^!/) {
|
||||
types_release(ast)
|
||||
return ret
|
||||
}
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'cons"
|
||||
types_heap[new_idx][1] = ret
|
||||
types_heap[new_idx][2] = previous
|
||||
types_heap[new_idx]["len"] = 3
|
||||
}
|
||||
}
|
||||
if (ast ~ /^\[/) {
|
||||
previous = "(" new_idx
|
||||
new_idx = types_allocate()
|
||||
types_heap[new_idx][0] = "'vec"
|
||||
types_heap[new_idx][1] = previous
|
||||
types_heap[new_idx]["len"] = 2
|
||||
}
|
||||
types_release(ast)
|
||||
return "(" new_idx
|
||||
}
|
||||
|
||||
function is_macro_call(ast, env, sym, ret, f)
|
||||
function is_macro_call(ast, env, idx, len, sym, f)
|
||||
{
|
||||
if (!is_pair(ast)) {
|
||||
return 0
|
||||
}
|
||||
sym = types_heap[substr(ast, 2)][0]
|
||||
if (sym !~ /^'/) {
|
||||
return 0
|
||||
}
|
||||
if (ast !~ /^\(/) return 0
|
||||
idx = substr(ast, 2)
|
||||
len = types_heap[idx]["len"]
|
||||
if (len == 0) return 0
|
||||
sym = types_heap[idx][0]
|
||||
if (sym !~ /^'/) return 0
|
||||
f = env_get(env, sym)
|
||||
return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"]
|
||||
}
|
||||
@ -447,6 +459,15 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret
|
||||
types_release(ast)
|
||||
env_release(env)
|
||||
return body
|
||||
case "'quasiquoteexpand":
|
||||
env_release(env)
|
||||
if (len != 2) {
|
||||
types_release(ast)
|
||||
return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "."
|
||||
}
|
||||
types_addref(body = types_heap[idx][1])
|
||||
types_release(ast)
|
||||
return quasiquote(body)
|
||||
case "'quasiquote":
|
||||
if (len != 2) {
|
||||
types_release(ast)
|
||||
|
@ -402,6 +402,7 @@ declare -A core_ns=(
|
||||
[sequential?]=sequential?
|
||||
[cons]=cons
|
||||
[concat]=concat
|
||||
[vec]=vec
|
||||
[nth]=nth
|
||||
[first]=_first
|
||||
[rest]=_rest
|
||||
|
@ -12,42 +12,47 @@ READ () {
|
||||
}
|
||||
|
||||
# eval
|
||||
IS_PAIR () {
|
||||
if _sequential? "${1}"; then
|
||||
_count "${1}"
|
||||
[[ "${r}" > 0 ]] && return 0
|
||||
fi
|
||||
return 1
|
||||
starts_with () {
|
||||
_list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
|
||||
}
|
||||
|
||||
QUASIQUOTE () {
|
||||
if ! IS_PAIR "${1}"; then
|
||||
_symbol quote
|
||||
_list "${r}" "${1}"
|
||||
return
|
||||
_obj_type "$1"
|
||||
case "$r" in
|
||||
list)
|
||||
if starts_with "$1" unquote; then
|
||||
_nth "$1" 1
|
||||
else
|
||||
qqIter "$1"
|
||||
fi ;;
|
||||
vector)
|
||||
_symbol vec; local a="$r"
|
||||
qqIter "$1"
|
||||
_list "$a" "$r" ;;
|
||||
symbol|hash_map)
|
||||
_symbol quote
|
||||
_list "$r" "$1" ;;
|
||||
*)
|
||||
r="$1" ;;
|
||||
esac
|
||||
}
|
||||
|
||||
qqIter () {
|
||||
if _empty? "$1"; then
|
||||
_list
|
||||
else
|
||||
_nth "${1}" 0; local a0="${r}"
|
||||
if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
|
||||
_nth "${1}" 1
|
||||
return
|
||||
elif IS_PAIR "${a0}"; then
|
||||
_nth "${a0}" 0; local a00="${r}"
|
||||
if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
|
||||
_symbol concat; local a="${r}"
|
||||
_nth "${a0}" 1; local b="${r}"
|
||||
_rest "${1}"
|
||||
QUASIQUOTE "${r}"; local c="${r}"
|
||||
_list "${a}" "${b}" "${c}"
|
||||
return
|
||||
fi
|
||||
_nth "${1}" 0; local a0="$r"
|
||||
if starts_with "$a0" splice-unquote; then
|
||||
_symbol concat; local a="$r"
|
||||
_nth "$a0" 1; local b="$r"
|
||||
else
|
||||
_symbol cons; local a="$r"
|
||||
QUASIQUOTE "$a0"; local b="$r"
|
||||
fi
|
||||
_rest "$1"
|
||||
qqIter "$r"
|
||||
_list "$a" "$b" "$r"
|
||||
fi
|
||||
_symbol cons; local a="${r}"
|
||||
QUASIQUOTE "${a0}"; local b="${r}"
|
||||
_rest "${1}"
|
||||
QUASIQUOTE "${r}"; local c="${r}"
|
||||
_list "${a}" "${b}" "${c}"
|
||||
return
|
||||
}
|
||||
|
||||
EVAL_AST () {
|
||||
@ -115,6 +120,9 @@ EVAL () {
|
||||
quote)
|
||||
r="${a1}"
|
||||
return ;;
|
||||
quasiquoteexpand)
|
||||
QUASIQUOTE "${a1}"
|
||||
return ;;
|
||||
quasiquote)
|
||||
QUASIQUOTE "${a1}"
|
||||
ast="${r}"
|
||||
|
@ -12,42 +12,47 @@ READ () {
|
||||
}
|
||||
|
||||
# eval
|
||||
IS_PAIR () {
|
||||
if _sequential? "${1}"; then
|
||||
_count "${1}"
|
||||
[[ "${r}" > 0 ]] && return 0
|
||||
fi
|
||||
return 1
|
||||
starts_with () {
|
||||
_list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
|
||||
}
|
||||
|
||||
QUASIQUOTE () {
|
||||
if ! IS_PAIR "${1}"; then
|
||||
_symbol quote
|
||||
_list "${r}" "${1}"
|
||||
return
|
||||
_obj_type "$1"
|
||||
case "$r" in
|
||||
list)
|
||||
if starts_with "$1" unquote; then
|
||||
_nth "$1" 1
|
||||
else
|
||||
qqIter "$1"
|
||||
fi ;;
|
||||
vector)
|
||||
_symbol vec; local a="$r"
|
||||
qqIter "$1"
|
||||
_list "$a" "$r" ;;
|
||||
symbol|hash_map)
|
||||
_symbol quote
|
||||
_list "$r" "$1" ;;
|
||||
*)
|
||||
r="$1" ;;
|
||||
esac
|
||||
}
|
||||
|
||||
qqIter () {
|
||||
if _empty? "$1"; then
|
||||
_list
|
||||
else
|
||||
_nth "${1}" 0; local a0="${r}"
|
||||
if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
|
||||
_nth "${1}" 1
|
||||
return
|
||||
elif IS_PAIR "${a0}"; then
|
||||
_nth "${a0}" 0; local a00="${r}"
|
||||
if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
|
||||
_symbol concat; local a="${r}"
|
||||
_nth "${a0}" 1; local b="${r}"
|
||||
_rest "${1}"
|
||||
QUASIQUOTE "${r}"; local c="${r}"
|
||||
_list "${a}" "${b}" "${c}"
|
||||
return
|
||||
fi
|
||||
_nth "${1}" 0; local a0="$r"
|
||||
if starts_with "$a0" splice-unquote; then
|
||||
_symbol concat; local a="$r"
|
||||
_nth "$a0" 1; local b="$r"
|
||||
else
|
||||
_symbol cons; local a="$r"
|
||||
QUASIQUOTE "$a0"; local b="$r"
|
||||
fi
|
||||
_rest "$1"
|
||||
qqIter "$r"
|
||||
_list "$a" "$b" "$r"
|
||||
fi
|
||||
_symbol cons; local a="${r}"
|
||||
QUASIQUOTE "${a0}"; local b="${r}"
|
||||
_rest "${1}"
|
||||
QUASIQUOTE "${r}"; local c="${r}"
|
||||
_list "${a}" "${b}" "${c}"
|
||||
return
|
||||
}
|
||||
|
||||
IS_MACRO_CALL () {
|
||||
@ -148,6 +153,9 @@ EVAL () {
|
||||
quote)
|
||||
r="${a1}"
|
||||
return ;;
|
||||
quasiquoteexpand)
|
||||
QUASIQUOTE "${a1}"
|
||||
return ;;
|
||||
quasiquote)
|
||||
QUASIQUOTE "${a1}"
|
||||
ast="${r}"
|
||||
|
@ -12,42 +12,47 @@ READ () {
|
||||
}
|
||||
|
||||
# eval
|
||||
IS_PAIR () {
|
||||
if _sequential? "${1}"; then
|
||||
_count "${1}"
|
||||
[[ "${r}" > 0 ]] && return 0
|
||||
fi
|
||||
return 1
|
||||
starts_with () {
|
||||
_list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
|
||||
}
|
||||
|
||||
QUASIQUOTE () {
|
||||
if ! IS_PAIR "${1}"; then
|
||||
_symbol quote
|
||||
_list "${r}" "${1}"
|
||||
return
|
||||
_obj_type "$1"
|
||||
case "$r" in
|
||||
list)
|
||||
if starts_with "$1" unquote; then
|
||||
_nth "$1" 1
|
||||
else
|
||||
qqIter "$1"
|
||||
fi ;;
|
||||
vector)
|
||||
_symbol vec; local a="$r"
|
||||
qqIter "$1"
|
||||
_list "$a" "$r" ;;
|
||||
symbol|hash_map)
|
||||
_symbol quote
|
||||
_list "$r" "$1" ;;
|
||||
*)
|
||||
r="$1" ;;
|
||||
esac
|
||||
}
|
||||
|
||||
qqIter () {
|
||||
if _empty? "$1"; then
|
||||
_list
|
||||
else
|
||||
_nth "${1}" 0; local a0="${r}"
|
||||
if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
|
||||
_nth "${1}" 1
|
||||
return
|
||||
elif IS_PAIR "${a0}"; then
|
||||
_nth "${a0}" 0; local a00="${r}"
|
||||
if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
|
||||
_symbol concat; local a="${r}"
|
||||
_nth "${a0}" 1; local b="${r}"
|
||||
_rest "${1}"
|
||||
QUASIQUOTE "${r}"; local c="${r}"
|
||||
_list "${a}" "${b}" "${c}"
|
||||
return
|
||||
fi
|
||||
_nth "${1}" 0; local a0="$r"
|
||||
if starts_with "$a0" splice-unquote; then
|
||||
_symbol concat; local a="$r"
|
||||
_nth "$a0" 1; local b="$r"
|
||||
else
|
||||
_symbol cons; local a="$r"
|
||||
QUASIQUOTE "$a0"; local b="$r"
|
||||
fi
|
||||
_rest "$1"
|
||||
qqIter "$r"
|
||||
_list "$a" "$b" "$r"
|
||||
fi
|
||||
_symbol cons; local a="${r}"
|
||||
QUASIQUOTE "${a0}"; local b="${r}"
|
||||
_rest "${1}"
|
||||
QUASIQUOTE "${r}"; local c="${r}"
|
||||
_list "${a}" "${b}" "${c}"
|
||||
return
|
||||
}
|
||||
|
||||
IS_MACRO_CALL () {
|
||||
@ -148,6 +153,9 @@ EVAL () {
|
||||
quote)
|
||||
r="${a1}"
|
||||
return ;;
|
||||
quasiquoteexpand)
|
||||
QUASIQUOTE "${a1}"
|
||||
return ;;
|
||||
quasiquote)
|
||||
QUASIQUOTE "${a1}"
|
||||
ast="${r}"
|
||||
|
@ -12,42 +12,47 @@ READ () {
|
||||
}
|
||||
|
||||
# eval
|
||||
IS_PAIR () {
|
||||
if _sequential? "${1}"; then
|
||||
_count "${1}"
|
||||
[[ "${r}" > 0 ]] && return 0
|
||||
fi
|
||||
return 1
|
||||
starts_with () {
|
||||
_list? "$1" && _first "$1" && _symbol? "$r" && [ "${ANON[$r]}" = "$2" ]
|
||||
}
|
||||
|
||||
QUASIQUOTE () {
|
||||
if ! IS_PAIR "${1}"; then
|
||||
_symbol quote
|
||||
_list "${r}" "${1}"
|
||||
return
|
||||
_obj_type "$1"
|
||||
case "$r" in
|
||||
list)
|
||||
if starts_with "$1" unquote; then
|
||||
_nth "$1" 1
|
||||
else
|
||||
qqIter "$1"
|
||||
fi ;;
|
||||
vector)
|
||||
_symbol vec; local a="$r"
|
||||
qqIter "$1"
|
||||
_list "$a" "$r" ;;
|
||||
symbol|hash_map)
|
||||
_symbol quote
|
||||
_list "$r" "$1" ;;
|
||||
*)
|
||||
r="$1" ;;
|
||||
esac
|
||||
}
|
||||
|
||||
qqIter () {
|
||||
if _empty? "$1"; then
|
||||
_list
|
||||
else
|
||||
_nth "${1}" 0; local a0="${r}"
|
||||
if [[ "${ANON["${a0}"]}" == "unquote" ]]; then
|
||||
_nth "${1}" 1
|
||||
return
|
||||
elif IS_PAIR "${a0}"; then
|
||||
_nth "${a0}" 0; local a00="${r}"
|
||||
if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then
|
||||
_symbol concat; local a="${r}"
|
||||
_nth "${a0}" 1; local b="${r}"
|
||||
_rest "${1}"
|
||||
QUASIQUOTE "${r}"; local c="${r}"
|
||||
_list "${a}" "${b}" "${c}"
|
||||
return
|
||||
fi
|
||||
_nth "${1}" 0; local a0="$r"
|
||||
if starts_with "$a0" splice-unquote; then
|
||||
_symbol concat; local a="$r"
|
||||
_nth "$a0" 1; local b="$r"
|
||||
else
|
||||
_symbol cons; local a="$r"
|
||||
QUASIQUOTE "$a0"; local b="$r"
|
||||
fi
|
||||
_rest "$1"
|
||||
qqIter "$r"
|
||||
_list "$a" "$b" "$r"
|
||||
fi
|
||||
_symbol cons; local a="${r}"
|
||||
QUASIQUOTE "${a0}"; local b="${r}"
|
||||
_rest "${1}"
|
||||
QUASIQUOTE "${r}"; local c="${r}"
|
||||
_list "${a}" "${b}" "${c}"
|
||||
return
|
||||
}
|
||||
|
||||
IS_MACRO_CALL () {
|
||||
@ -148,6 +153,9 @@ EVAL () {
|
||||
quote)
|
||||
r="${a1}"
|
||||
return ;;
|
||||
quasiquoteexpand)
|
||||
QUASIQUOTE "${a1}"
|
||||
return ;;
|
||||
quasiquote)
|
||||
QUASIQUOTE "${a1}"
|
||||
ast="${r}"
|
||||
|
@ -209,6 +209,12 @@ _vector () {
|
||||
}
|
||||
_vector? () { [[ ${1} =~ ^vector_ ]]; }
|
||||
|
||||
vec () {
|
||||
__new_obj_hash_code
|
||||
r="vector_$r"
|
||||
ANON["$r"]=${ANON["$1"]}
|
||||
}
|
||||
|
||||
|
||||
# hash maps (associative arrays)
|
||||
|
||||
|
@ -173,7 +173,7 @@ DO_FUNCTION:
|
||||
|
||||
REM Switch on the function number
|
||||
REM MEMORY DEBUGGING:
|
||||
REM IF G>59 THEN ER=-1:E$="unknown function"+STR$(G):RETURN
|
||||
REM IF G>60 THEN ER=-1:E$="unknown function"+STR$(G):RETURN
|
||||
ON INT(G/10)+1 GOTO DO_1_9,DO_10_19,DO_20_29,DO_30_39,DO_40_49,DO_50_59,DO_60_69
|
||||
|
||||
DO_1_9:
|
||||
@ -189,7 +189,7 @@ DO_FUNCTION:
|
||||
DO_50_59:
|
||||
ON G-49 GOTO DO_CONJ,DO_SEQ,DO_WITH_META,DO_META,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_EVAL,DO_READ_FILE
|
||||
DO_60_69:
|
||||
ON G-59 GOTO DO_PR_MEMORY_SUMMARY
|
||||
ON G-59 GOTO DO_VEC,DO_PR_MEMORY_SUMMARY
|
||||
|
||||
DO_EQUAL_Q:
|
||||
GOSUB EQUAL_Q
|
||||
@ -333,8 +333,7 @@ DO_FUNCTION:
|
||||
GOSUB LIST_Q
|
||||
GOTO RETURN_TRUE_FALSE
|
||||
DO_VECTOR:
|
||||
A=AR:T=7:GOSUB FORCE_SEQ_TYPE
|
||||
RETURN
|
||||
A=AR:T=7:GOTO FORCE_SEQ_TYPE
|
||||
DO_VECTOR_Q:
|
||||
GOSUB TYPE_A
|
||||
R=T=7
|
||||
@ -457,6 +456,8 @@ DO_FUNCTION:
|
||||
GOSUB POP_R: REM pop return value
|
||||
GOSUB POP_Q: REM pop current
|
||||
RETURN
|
||||
DO_VEC:
|
||||
T=7:GOTO FORCE_SEQ_TYPE
|
||||
|
||||
DO_NTH:
|
||||
B=B1
|
||||
@ -625,7 +626,8 @@ INIT_CORE_NS:
|
||||
|
||||
B$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=58
|
||||
B$="read-file":GOSUB INIT_CORE_SET_FUNCTION: REM A=59
|
||||
B$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=60
|
||||
B$="vec":GOSUB INIT_CORE_SET_FUNCTION: REM A=60
|
||||
B$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=61
|
||||
|
||||
REM these are in DO_TCO_FUNCTION
|
||||
A=65
|
||||
|
@ -234,9 +234,9 @@ SUB EVAL
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
REM regular function
|
||||
IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
REM for recur functions (apply, map, swap!), use GOTO
|
||||
IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
|
||||
IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
|
||||
EVAL_DO_FUNCTION_SKIP:
|
||||
|
||||
REM pop and release f/args
|
||||
|
@ -258,9 +258,9 @@ SUB EVAL
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
REM regular function
|
||||
IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
REM for recur functions (apply, map, swap!), use GOTO
|
||||
IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
|
||||
IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
|
||||
EVAL_DO_FUNCTION_SKIP:
|
||||
|
||||
REM pop and release f/args
|
||||
|
@ -258,9 +258,9 @@ SUB EVAL
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
REM regular function
|
||||
IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
REM for recur functions (apply, map, swap!), use GOTO
|
||||
IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
|
||||
IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
|
||||
EVAL_DO_FUNCTION_SKIP:
|
||||
|
||||
REM pop and release f/args
|
||||
|
@ -17,74 +17,114 @@ MAL_READ:
|
||||
|
||||
REM QUASIQUOTE(A) -> R
|
||||
SUB QUASIQUOTE
|
||||
REM pair?
|
||||
GOSUB TYPE_A
|
||||
IF T<6 OR T>7 THEN GOTO QQ_QUOTE
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
|
||||
IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
|
||||
IF T=5 OR T=8 THEN GOTO QQ_QUOTE
|
||||
IF T=7 THEN GOTO QQ_VECTOR
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_LIST
|
||||
R=Z%(A+2)
|
||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
|
||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
|
||||
GOTO QQ_UNQUOTE
|
||||
|
||||
QQ_UNCHANGED:
|
||||
R=A
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_QUOTE:
|
||||
REM ['quote, ast]
|
||||
B$="quote":T=5:GOSUB STRING
|
||||
B=R:A=A:GOSUB LIST2
|
||||
B=R:GOSUB LIST2
|
||||
AY=B:GOSUB RELEASE
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_VECTOR:
|
||||
REM ['vec, (qq_foldr ast)]
|
||||
CALL QQ_FOLDR
|
||||
A=R
|
||||
B$="vec":T=5:GOSUB STRING:B=R
|
||||
GOSUB LIST2
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R=Z%(A+2)
|
||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R=Z%(Z%(A+1)+2)
|
||||
GOSUB INC_REF_R
|
||||
REM [ast[1]]
|
||||
R=Z%(Z%(A+1)+2)
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_DONE
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
QQ_LIST:
|
||||
CALL QQ_FOLDR
|
||||
|
||||
QQ_DONE:
|
||||
END SUB
|
||||
|
||||
REM Quasiquote right fold (A) -> R.
|
||||
REM Used for unquoted lists (GOTO), vectors (GOSUB),
|
||||
REM and recursively (GOSUB).
|
||||
SUB QQ_FOLDR
|
||||
IF A=0 THEN GOTO QQ_EMPTY
|
||||
IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
|
||||
GOTO QQ_NOTEMPTY
|
||||
|
||||
QQ_EMPTY:
|
||||
REM empty list/vector -> empty list
|
||||
R=6
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_FOLDR_DONE
|
||||
|
||||
QQ_NOTEMPTY:
|
||||
REM Execute QQ_FOLDR recursively with (rest A)
|
||||
GOSUB PUSH_A
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A=Z%(A+1):CALL QUASIQUOTE
|
||||
W=R
|
||||
A=Z%(A+1):CALL QQ_FOLDR
|
||||
GOSUB POP_A
|
||||
|
||||
REM set A to ast[0] for last two cases
|
||||
REM Set A to elt = (first A)
|
||||
A=Z%(A+2)
|
||||
|
||||
REM pair?
|
||||
GOSUB TYPE_A
|
||||
IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
||||
REM Quasiquote transition function:
|
||||
REM A: current element, R: accumulator -> R: new accumulator
|
||||
|
||||
REM check if A is a list starting with splice-unquote
|
||||
GOSUB TYPE_A
|
||||
IF T<>6 THEN GOTO QQ_DEFAULT
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
||||
B=Z%(A+2)
|
||||
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
|
||||
|
||||
REM ('concat, A[1], R)
|
||||
B=Z%(Z%(A+1)+2)
|
||||
A=R
|
||||
B$="concat":T=5:GOSUB STRING:C=R
|
||||
A=W:GOSUB LIST3
|
||||
GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
GOTO QQ_FOLDR_DONE
|
||||
|
||||
Q=W:GOSUB PUSH_Q
|
||||
REM A set above to ast[0]
|
||||
CALL QUASIQUOTE
|
||||
B=R
|
||||
GOSUB POP_Q:W=Q
|
||||
QQ_DEFAULT:
|
||||
REM ('cons, quasiquote(A), R)
|
||||
GOSUB PUSH_R
|
||||
CALL QUASIQUOTE
|
||||
B=R
|
||||
B$="cons":T=5:GOSUB STRING:C=R
|
||||
GOSUB POP_A
|
||||
GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
|
||||
B$="cons":T=5:GOSUB STRING:C=R
|
||||
A=W:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
QQ_DONE:
|
||||
QQ_FOLDR_DONE:
|
||||
END SUB
|
||||
|
||||
|
||||
@ -198,6 +238,7 @@ SUB EVAL
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||
IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
|
||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||
IF A$="do" THEN GOTO EVAL_DO
|
||||
IF A$="if" THEN GOTO EVAL_IF
|
||||
@ -290,6 +331,11 @@ SUB EVAL
|
||||
GOSUB INC_REF_R
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTEEXPAND:
|
||||
R=Z%(Z%(A+1)+2)
|
||||
A=R:CALL QUASIQUOTE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R=Z%(Z%(A+1)+2)
|
||||
A=R:CALL QUASIQUOTE
|
||||
@ -348,9 +394,9 @@ SUB EVAL
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
REM regular function
|
||||
IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
REM for recur functions (apply, map, swap!), use GOTO
|
||||
IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
|
||||
IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
|
||||
EVAL_DO_FUNCTION_SKIP:
|
||||
|
||||
REM pop and release f/args
|
||||
|
@ -17,74 +17,114 @@ MAL_READ:
|
||||
|
||||
REM QUASIQUOTE(A) -> R
|
||||
SUB QUASIQUOTE
|
||||
REM pair?
|
||||
GOSUB TYPE_A
|
||||
IF T<6 OR T>7 THEN GOTO QQ_QUOTE
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
|
||||
IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
|
||||
IF T=5 OR T=8 THEN GOTO QQ_QUOTE
|
||||
IF T=7 THEN GOTO QQ_VECTOR
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_LIST
|
||||
R=Z%(A+2)
|
||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
|
||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
|
||||
GOTO QQ_UNQUOTE
|
||||
|
||||
QQ_UNCHANGED:
|
||||
R=A
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_QUOTE:
|
||||
REM ['quote, ast]
|
||||
B$="quote":T=5:GOSUB STRING
|
||||
B=R:A=A:GOSUB LIST2
|
||||
B=R:GOSUB LIST2
|
||||
AY=B:GOSUB RELEASE
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_VECTOR:
|
||||
REM ['vec, (qq_foldr ast)]
|
||||
CALL QQ_FOLDR
|
||||
A=R
|
||||
B$="vec":T=5:GOSUB STRING:B=R
|
||||
GOSUB LIST2
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R=Z%(A+2)
|
||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R=Z%(Z%(A+1)+2)
|
||||
GOSUB INC_REF_R
|
||||
REM [ast[1]]
|
||||
R=Z%(Z%(A+1)+2)
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_DONE
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
QQ_LIST:
|
||||
CALL QQ_FOLDR
|
||||
|
||||
QQ_DONE:
|
||||
END SUB
|
||||
|
||||
REM Quasiquote right fold (A) -> R.
|
||||
REM Used for unquoted lists (GOTO), vectors (GOSUB),
|
||||
REM and recursively (GOSUB).
|
||||
SUB QQ_FOLDR
|
||||
IF A=0 THEN GOTO QQ_EMPTY
|
||||
IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
|
||||
GOTO QQ_NOTEMPTY
|
||||
|
||||
QQ_EMPTY:
|
||||
REM empty list/vector -> empty list
|
||||
R=6
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_FOLDR_DONE
|
||||
|
||||
QQ_NOTEMPTY:
|
||||
REM Execute QQ_FOLDR recursively with (rest A)
|
||||
GOSUB PUSH_A
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A=Z%(A+1):CALL QUASIQUOTE
|
||||
W=R
|
||||
A=Z%(A+1):CALL QQ_FOLDR
|
||||
GOSUB POP_A
|
||||
|
||||
REM set A to ast[0] for last two cases
|
||||
REM Set A to elt = (first A)
|
||||
A=Z%(A+2)
|
||||
|
||||
REM pair?
|
||||
GOSUB TYPE_A
|
||||
IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
||||
REM Quasiquote transition function:
|
||||
REM A: current element, R: accumulator -> R: new accumulator
|
||||
|
||||
REM check if A is a list starting with splice-unquote
|
||||
GOSUB TYPE_A
|
||||
IF T<>6 THEN GOTO QQ_DEFAULT
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
||||
B=Z%(A+2)
|
||||
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
|
||||
|
||||
REM ('concat, A[1], R)
|
||||
B=Z%(Z%(A+1)+2)
|
||||
A=R
|
||||
B$="concat":T=5:GOSUB STRING:C=R
|
||||
A=W:GOSUB LIST3
|
||||
GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
GOTO QQ_FOLDR_DONE
|
||||
|
||||
Q=W:GOSUB PUSH_Q
|
||||
REM A set above to ast[0]
|
||||
CALL QUASIQUOTE
|
||||
B=R
|
||||
GOSUB POP_Q:W=Q
|
||||
QQ_DEFAULT:
|
||||
REM ('cons, quasiquote(A), R)
|
||||
GOSUB PUSH_R
|
||||
CALL QUASIQUOTE
|
||||
B=R
|
||||
B$="cons":T=5:GOSUB STRING:C=R
|
||||
GOSUB POP_A
|
||||
GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
|
||||
B$="cons":T=5:GOSUB STRING:C=R
|
||||
A=W:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
QQ_DONE:
|
||||
QQ_FOLDR_DONE:
|
||||
END SUB
|
||||
|
||||
REM MACROEXPAND(A, E) -> A:
|
||||
@ -238,6 +278,7 @@ SUB EVAL
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||
IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
|
||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
||||
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
||||
@ -332,6 +373,11 @@ SUB EVAL
|
||||
GOSUB INC_REF_R
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTEEXPAND:
|
||||
R=Z%(Z%(A+1)+2)
|
||||
A=R:CALL QUASIQUOTE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R=Z%(Z%(A+1)+2)
|
||||
A=R:CALL QUASIQUOTE
|
||||
@ -415,9 +461,9 @@ SUB EVAL
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
REM regular function
|
||||
IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
REM for recur functions (apply, map, swap!), use GOTO
|
||||
IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
|
||||
IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
|
||||
EVAL_DO_FUNCTION_SKIP:
|
||||
|
||||
REM pop and release f/args
|
||||
|
@ -17,74 +17,114 @@ MAL_READ:
|
||||
|
||||
REM QUASIQUOTE(A) -> R
|
||||
SUB QUASIQUOTE
|
||||
REM pair?
|
||||
GOSUB TYPE_A
|
||||
IF T<6 OR T>7 THEN GOTO QQ_QUOTE
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
|
||||
IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
|
||||
IF T=5 OR T=8 THEN GOTO QQ_QUOTE
|
||||
IF T=7 THEN GOTO QQ_VECTOR
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_LIST
|
||||
R=Z%(A+2)
|
||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
|
||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
|
||||
GOTO QQ_UNQUOTE
|
||||
|
||||
QQ_UNCHANGED:
|
||||
R=A
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_QUOTE:
|
||||
REM ['quote, ast]
|
||||
B$="quote":T=5:GOSUB STRING
|
||||
B=R:A=A:GOSUB LIST2
|
||||
B=R:GOSUB LIST2
|
||||
AY=B:GOSUB RELEASE
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_VECTOR:
|
||||
REM ['vec, (qq_foldr ast)]
|
||||
CALL QQ_FOLDR
|
||||
A=R
|
||||
B$="vec":T=5:GOSUB STRING:B=R
|
||||
GOSUB LIST2
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R=Z%(A+2)
|
||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R=Z%(Z%(A+1)+2)
|
||||
GOSUB INC_REF_R
|
||||
REM [ast[1]]
|
||||
R=Z%(Z%(A+1)+2)
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_DONE
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
QQ_LIST:
|
||||
CALL QQ_FOLDR
|
||||
|
||||
QQ_DONE:
|
||||
END SUB
|
||||
|
||||
REM Quasiquote right fold (A) -> R.
|
||||
REM Used for unquoted lists (GOTO), vectors (GOSUB),
|
||||
REM and recursively (GOSUB).
|
||||
SUB QQ_FOLDR
|
||||
IF A=0 THEN GOTO QQ_EMPTY
|
||||
IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
|
||||
GOTO QQ_NOTEMPTY
|
||||
|
||||
QQ_EMPTY:
|
||||
REM empty list/vector -> empty list
|
||||
R=6
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_FOLDR_DONE
|
||||
|
||||
QQ_NOTEMPTY:
|
||||
REM Execute QQ_FOLDR recursively with (rest A)
|
||||
GOSUB PUSH_A
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A=Z%(A+1):CALL QUASIQUOTE
|
||||
W=R
|
||||
A=Z%(A+1):CALL QQ_FOLDR
|
||||
GOSUB POP_A
|
||||
|
||||
REM set A to ast[0] for last two cases
|
||||
REM Set A to elt = (first A)
|
||||
A=Z%(A+2)
|
||||
|
||||
REM pair?
|
||||
GOSUB TYPE_A
|
||||
IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
||||
REM Quasiquote transition function:
|
||||
REM A: current element, R: accumulator -> R: new accumulator
|
||||
|
||||
REM check if A is a list starting with splice-unquote
|
||||
GOSUB TYPE_A
|
||||
IF T<>6 THEN GOTO QQ_DEFAULT
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
||||
B=Z%(A+2)
|
||||
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
|
||||
|
||||
REM ('concat, A[1], R)
|
||||
B=Z%(Z%(A+1)+2)
|
||||
A=R
|
||||
B$="concat":T=5:GOSUB STRING:C=R
|
||||
A=W:GOSUB LIST3
|
||||
GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
GOTO QQ_FOLDR_DONE
|
||||
|
||||
Q=W:GOSUB PUSH_Q
|
||||
REM A set above to ast[0]
|
||||
CALL QUASIQUOTE
|
||||
B=R
|
||||
GOSUB POP_Q:W=Q
|
||||
QQ_DEFAULT:
|
||||
REM ('cons, quasiquote(A), R)
|
||||
GOSUB PUSH_R
|
||||
CALL QUASIQUOTE
|
||||
B=R
|
||||
B$="cons":T=5:GOSUB STRING:C=R
|
||||
GOSUB POP_A
|
||||
GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
|
||||
B$="cons":T=5:GOSUB STRING:C=R
|
||||
A=W:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
QQ_DONE:
|
||||
QQ_FOLDR_DONE:
|
||||
END SUB
|
||||
|
||||
REM MACROEXPAND(A, E) -> A:
|
||||
@ -238,6 +278,7 @@ SUB EVAL
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||
IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
|
||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
||||
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
||||
@ -333,6 +374,11 @@ SUB EVAL
|
||||
GOSUB INC_REF_R
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTEEXPAND:
|
||||
R=Z%(Z%(A+1)+2)
|
||||
A=R:CALL QUASIQUOTE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R=Z%(Z%(A+1)+2)
|
||||
A=R:CALL QUASIQUOTE
|
||||
@ -448,9 +494,9 @@ SUB EVAL
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
REM regular function
|
||||
IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
REM for recur functions (apply, map, swap!), use GOTO
|
||||
IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
|
||||
IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
|
||||
EVAL_DO_FUNCTION_SKIP:
|
||||
|
||||
REM pop and release f/args
|
||||
|
@ -14,74 +14,114 @@ REM READ is inlined in RE
|
||||
|
||||
REM QUASIQUOTE(A) -> R
|
||||
SUB QUASIQUOTE
|
||||
REM pair?
|
||||
GOSUB TYPE_A
|
||||
IF T<6 OR T>7 THEN GOTO QQ_QUOTE
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
|
||||
IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
|
||||
IF T=5 OR T=8 THEN GOTO QQ_QUOTE
|
||||
IF T=7 THEN GOTO QQ_VECTOR
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_LIST
|
||||
R=Z%(A+2)
|
||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
|
||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
|
||||
GOTO QQ_UNQUOTE
|
||||
|
||||
QQ_UNCHANGED:
|
||||
R=A
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_QUOTE:
|
||||
REM ['quote, ast]
|
||||
B$="quote":T=5:GOSUB STRING
|
||||
B=R:A=A:GOSUB LIST2
|
||||
B=R:GOSUB LIST2
|
||||
AY=B:GOSUB RELEASE
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_VECTOR:
|
||||
REM ['vec, (qq_foldr ast)]
|
||||
CALL QQ_FOLDR
|
||||
A=R
|
||||
B$="vec":T=5:GOSUB STRING:B=R
|
||||
GOSUB LIST2
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R=Z%(A+2)
|
||||
IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R=Z%(Z%(A+1)+2)
|
||||
GOSUB INC_REF_R
|
||||
REM [ast[1]]
|
||||
R=Z%(Z%(A+1)+2)
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_DONE
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
QQ_LIST:
|
||||
CALL QQ_FOLDR
|
||||
|
||||
QQ_DONE:
|
||||
END SUB
|
||||
|
||||
REM Quasiquote right fold (A) -> R.
|
||||
REM Used for unquoted lists (GOTO), vectors (GOSUB),
|
||||
REM and recursively (GOSUB).
|
||||
SUB QQ_FOLDR
|
||||
IF A=0 THEN GOTO QQ_EMPTY
|
||||
IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
|
||||
GOTO QQ_NOTEMPTY
|
||||
|
||||
QQ_EMPTY:
|
||||
REM empty list/vector -> empty list
|
||||
R=6
|
||||
GOSUB INC_REF_R
|
||||
|
||||
GOTO QQ_FOLDR_DONE
|
||||
|
||||
QQ_NOTEMPTY:
|
||||
REM Execute QQ_FOLDR recursively with (rest A)
|
||||
GOSUB PUSH_A
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A=Z%(A+1):CALL QUASIQUOTE
|
||||
W=R
|
||||
A=Z%(A+1):CALL QQ_FOLDR
|
||||
GOSUB POP_A
|
||||
|
||||
REM set A to ast[0] for last two cases
|
||||
REM Set A to elt = (first A)
|
||||
A=Z%(A+2)
|
||||
|
||||
REM pair?
|
||||
GOSUB TYPE_A
|
||||
IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
||||
REM Quasiquote transition function:
|
||||
REM A: current element, R: accumulator -> R: new accumulator
|
||||
|
||||
REM check if A is a list starting with splice-unquote
|
||||
GOSUB TYPE_A
|
||||
IF T<>6 THEN GOTO QQ_DEFAULT
|
||||
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
|
||||
B=Z%(A+2)
|
||||
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
|
||||
|
||||
REM ('concat, A[1], R)
|
||||
B=Z%(Z%(A+1)+2)
|
||||
A=R
|
||||
B$="concat":T=5:GOSUB STRING:C=R
|
||||
A=W:GOSUB LIST3
|
||||
GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
GOTO QQ_DONE
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
GOTO QQ_FOLDR_DONE
|
||||
|
||||
Q=W:GOSUB PUSH_Q
|
||||
REM A set above to ast[0]
|
||||
CALL QUASIQUOTE
|
||||
B=R
|
||||
GOSUB POP_Q:W=Q
|
||||
QQ_DEFAULT:
|
||||
REM ('cons, quasiquote(A), R)
|
||||
GOSUB PUSH_R
|
||||
CALL QUASIQUOTE
|
||||
B=R
|
||||
B$="cons":T=5:GOSUB STRING:C=R
|
||||
GOSUB POP_A
|
||||
GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
|
||||
B$="cons":T=5:GOSUB STRING:C=R
|
||||
A=W:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY=A:GOSUB RELEASE
|
||||
AY=B:GOSUB RELEASE
|
||||
AY=C:GOSUB RELEASE
|
||||
QQ_DONE:
|
||||
QQ_FOLDR_DONE:
|
||||
END SUB
|
||||
|
||||
REM MACROEXPAND(A, E) -> A:
|
||||
@ -235,6 +275,7 @@ SUB EVAL
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||
IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
|
||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
||||
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
||||
@ -330,6 +371,11 @@ SUB EVAL
|
||||
GOSUB INC_REF_R
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTEEXPAND:
|
||||
R=Z%(Z%(A+1)+2)
|
||||
A=R:CALL QUASIQUOTE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R=Z%(Z%(A+1)+2)
|
||||
A=R:CALL QUASIQUOTE
|
||||
@ -445,9 +491,9 @@ SUB EVAL
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
REM regular function
|
||||
IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
|
||||
REM for recur functions (apply, map, swap!), use GOTO
|
||||
IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
|
||||
IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION
|
||||
EVAL_DO_FUNCTION_SKIP:
|
||||
|
||||
REM pop and release f/args
|
||||
|
@ -286,6 +286,10 @@ DEF FNcore_call(fn%, args%)
|
||||
WHEN 60
|
||||
PROCcore_prepare_args("?", "seq")
|
||||
=FNcore_seq(args%(0))
|
||||
DATA vec, 61
|
||||
WHEN 61
|
||||
PROCcore_prepare_args("l", "vec")
|
||||
=FNas_vector(args%(0))
|
||||
DATA "", -1
|
||||
ENDCASE
|
||||
ERROR &40E809F1, "Call to non-existent core function"
|
||||
|
@ -53,25 +53,33 @@ END
|
||||
DEF FNREAD(a$)
|
||||
=FNread_str(FNalloc_string(a$))
|
||||
|
||||
DEF FNis_pair(val%)
|
||||
=FNis_seq(val%) AND NOT FNis_empty(val%)
|
||||
DEF FNstarts_with(ast%, sym$)
|
||||
LOCAL a0%
|
||||
IF NOT FNis_list(ast%) THEN =FALSE
|
||||
a0% = FNfirst(ast%)
|
||||
IF NOT FNis_symbol(a0%) THEN =FALSE
|
||||
=FNunbox_symbol(a0%) = sym$
|
||||
|
||||
DEF FNqq_elts(seq%)
|
||||
LOCAL elt%, acc%
|
||||
IF FNis_empty(seq%) THEN =FNempty
|
||||
elt% = FNfirst(seq%)
|
||||
acc% = FNqq_elts(FNrest(seq%))
|
||||
IF FNstarts_with(elt%, "splice-unquote") THEN
|
||||
=FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%)
|
||||
ENDIF
|
||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%)
|
||||
|
||||
DEF FNquasiquote(ast%)
|
||||
LOCAL car%, caar%
|
||||
IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_symbol(car%) THEN
|
||||
IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
|
||||
IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
|
||||
IF FNis_list(ast%) THEN =FNqq_elts(ast%)
|
||||
IF FNis_vector(ast%) THEN
|
||||
=FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
|
||||
ENDIF
|
||||
IF FNis_pair(car%) THEN
|
||||
caar% = FNfirst(car%)
|
||||
IF FNis_symbol(caar%) THEN
|
||||
IF FNunbox_symbol(caar%) = "splice-unquote" THEN
|
||||
=FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%)))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
|
||||
=FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||
ENDIF
|
||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
|
||||
=ast%
|
||||
|
||||
DEF FNEVAL(ast%, env%)
|
||||
PROCgc_enter
|
||||
@ -124,6 +132,8 @@ DEF FNEVAL_(ast%, env%)
|
||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||
WHEN "quote"
|
||||
=FNnth(ast%, 1)
|
||||
WHEN "quasiquoteexpand"
|
||||
= FNquasiquote(FNnth(ast%, 1))
|
||||
WHEN "quasiquote"
|
||||
ast% = FNquasiquote(FNnth(ast%, 1))
|
||||
REM Loop round for tail-call optimisation
|
||||
|
@ -54,25 +54,33 @@ END
|
||||
DEF FNREAD(a$)
|
||||
=FNread_str(FNalloc_string(a$))
|
||||
|
||||
DEF FNis_pair(val%)
|
||||
=FNis_seq(val%) AND NOT FNis_empty(val%)
|
||||
DEF FNstarts_with(ast%, sym$)
|
||||
LOCAL a0%
|
||||
IF NOT FNis_list(ast%) THEN =FALSE
|
||||
a0% = FNfirst(ast%)
|
||||
IF NOT FNis_symbol(a0%) THEN =FALSE
|
||||
=FNunbox_symbol(a0%) = sym$
|
||||
|
||||
DEF FNqq_elts(seq%)
|
||||
LOCAL elt%, acc%
|
||||
IF FNis_empty(seq%) THEN =FNempty
|
||||
elt% = FNfirst(seq%)
|
||||
acc% = FNqq_elts(FNrest(seq%))
|
||||
IF FNstarts_with(elt%, "splice-unquote") THEN
|
||||
=FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%)
|
||||
ENDIF
|
||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%)
|
||||
|
||||
DEF FNquasiquote(ast%)
|
||||
LOCAL car%, caar%
|
||||
IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_symbol(car%) THEN
|
||||
IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
|
||||
IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
|
||||
IF FNis_list(ast%) THEN =FNqq_elts(ast%)
|
||||
IF FNis_vector(ast%) THEN
|
||||
=FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
|
||||
ENDIF
|
||||
IF FNis_pair(car%) THEN
|
||||
caar% = FNfirst(car%)
|
||||
IF FNis_symbol(caar%) THEN
|
||||
IF FNunbox_symbol(caar%) = "splice-unquote" THEN
|
||||
=FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%)))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
|
||||
=FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||
ENDIF
|
||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
|
||||
=ast%
|
||||
|
||||
DEF FNis_macro_call(ast%, env%)
|
||||
LOCAL car%, val%
|
||||
@ -153,6 +161,8 @@ DEF FNEVAL_(ast%, env%)
|
||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||
WHEN "quote"
|
||||
=FNnth(ast%, 1)
|
||||
WHEN "quasiquoteexpand"
|
||||
= FNquasiquote(FNnth(ast%, 1))
|
||||
WHEN "quasiquote"
|
||||
ast% = FNquasiquote(FNnth(ast%, 1))
|
||||
REM Loop round for tail-call optimisation
|
||||
|
@ -54,25 +54,33 @@ END
|
||||
DEF FNREAD(a$)
|
||||
=FNread_str(FNalloc_string(a$))
|
||||
|
||||
DEF FNis_pair(val%)
|
||||
=FNis_seq(val%) AND NOT FNis_empty(val%)
|
||||
DEF FNstarts_with(ast%, sym$)
|
||||
LOCAL a0%
|
||||
IF NOT FNis_list(ast%) THEN =FALSE
|
||||
a0% = FNfirst(ast%)
|
||||
IF NOT FNis_symbol(a0%) THEN =FALSE
|
||||
=FNunbox_symbol(a0%) = sym$
|
||||
|
||||
DEF FNqq_elts(seq%)
|
||||
LOCAL elt%, acc%
|
||||
IF FNis_empty(seq%) THEN =FNempty
|
||||
elt% = FNfirst(seq%)
|
||||
acc% = FNqq_elts(FNrest(seq%))
|
||||
IF FNstarts_with(elt%, "splice-unquote") THEN
|
||||
=FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%)
|
||||
ENDIF
|
||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%)
|
||||
|
||||
DEF FNquasiquote(ast%)
|
||||
LOCAL car%, caar%
|
||||
IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_symbol(car%) THEN
|
||||
IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
|
||||
IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
|
||||
IF FNis_list(ast%) THEN =FNqq_elts(ast%)
|
||||
IF FNis_vector(ast%) THEN
|
||||
=FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
|
||||
ENDIF
|
||||
IF FNis_pair(car%) THEN
|
||||
caar% = FNfirst(car%)
|
||||
IF FNis_symbol(caar%) THEN
|
||||
IF FNunbox_symbol(caar%) = "splice-unquote" THEN
|
||||
=FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%)))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
|
||||
=FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||
ENDIF
|
||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
|
||||
=ast%
|
||||
|
||||
DEF FNis_macro_call(ast%, env%)
|
||||
LOCAL car%, val%
|
||||
@ -195,6 +203,8 @@ DEF FNEVAL_(ast%, env%)
|
||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||
WHEN "quote"
|
||||
=FNnth(ast%, 1)
|
||||
WHEN "quasiquoteexpand"
|
||||
= FNquasiquote(FNnth(ast%, 1))
|
||||
WHEN "quasiquote"
|
||||
ast% = FNquasiquote(FNnth(ast%, 1))
|
||||
REM Loop round for tail-call optimisation
|
||||
|
@ -56,25 +56,33 @@ END
|
||||
DEF FNREAD(a$)
|
||||
=FNread_str(FNalloc_string(a$))
|
||||
|
||||
DEF FNis_pair(val%)
|
||||
=FNis_seq(val%) AND NOT FNis_empty(val%)
|
||||
DEF FNstarts_with(ast%, sym$)
|
||||
LOCAL a0%
|
||||
IF NOT FNis_list(ast%) THEN =FALSE
|
||||
a0% = FNfirst(ast%)
|
||||
IF NOT FNis_symbol(a0%) THEN =FALSE
|
||||
=FNunbox_symbol(a0%) = sym$
|
||||
|
||||
DEF FNqq_elts(seq%)
|
||||
LOCAL elt%, acc%
|
||||
IF FNis_empty(seq%) THEN =FNempty
|
||||
elt% = FNfirst(seq%)
|
||||
acc% = FNqq_elts(FNrest(seq%))
|
||||
IF FNstarts_with(elt%, "splice-unquote") THEN
|
||||
=FNalloc_list3(FNalloc_symbol("concat"), FNnth(elt%, 1), acc%)
|
||||
ENDIF
|
||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(elt%), acc%)
|
||||
|
||||
DEF FNquasiquote(ast%)
|
||||
LOCAL car%, caar%
|
||||
IF NOT FNis_pair(ast%) THEN =FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_symbol(car%) THEN
|
||||
IF FNunbox_symbol(car%) = "unquote" THEN =FNnth(ast%, 1)
|
||||
IF FNstarts_with(ast%, "unquote") THEN =FNnth(ast%, 1)
|
||||
IF FNis_list(ast%) THEN =FNqq_elts(ast%)
|
||||
IF FNis_vector(ast%) THEN
|
||||
=FNalloc_list2(FNalloc_symbol("vec"), FNqq_elts(ast%))
|
||||
ENDIF
|
||||
IF FNis_pair(car%) THEN
|
||||
caar% = FNfirst(car%)
|
||||
IF FNis_symbol(caar%) THEN
|
||||
IF FNunbox_symbol(caar%) = "splice-unquote" THEN
|
||||
=FNalloc_list3(FNalloc_symbol("concat"), FNnth(car%, 1), FNquasiquote(FNrest(ast%)))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) OR FNis_hashmap(ast%) THEN
|
||||
=FNalloc_list2(FNalloc_symbol("quote"), ast%)
|
||||
ENDIF
|
||||
=FNalloc_list3(FNalloc_symbol("cons"), FNquasiquote(car%), FNquasiquote(FNrest(ast%)))
|
||||
=ast%
|
||||
|
||||
DEF FNis_macro_call(ast%, env%)
|
||||
LOCAL car%, val%
|
||||
@ -197,6 +205,8 @@ DEF FNEVAL_(ast%, env%)
|
||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||
WHEN "quote"
|
||||
=FNnth(ast%, 1)
|
||||
WHEN "quasiquoteexpand"
|
||||
= FNquasiquote(FNnth(ast%, 1))
|
||||
WHEN "quasiquote"
|
||||
ast% = FNquasiquote(FNnth(ast%, 1))
|
||||
REM Loop round for tail-call optimisation
|
||||
|
@ -330,6 +330,24 @@ MalVal *concat(MalVal *args) {
|
||||
return lst;
|
||||
}
|
||||
|
||||
MalVal *vec(MalVal *seq) {
|
||||
switch(seq->type) {
|
||||
case MAL_VECTOR:
|
||||
return seq;
|
||||
case MAL_LIST: {
|
||||
const GArray * const src = seq->val.array;
|
||||
const int len = src->len;
|
||||
GArray * const dst = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len);
|
||||
int i;
|
||||
for (i=0; i<len; i++)
|
||||
g_array_append_val(dst, g_array_index(seq->val.array, MalVal*, i));
|
||||
return malval_new_list(MAL_VECTOR, dst);
|
||||
}
|
||||
default:
|
||||
_error("vec called with non-sequential");
|
||||
}
|
||||
}
|
||||
|
||||
MalVal *nth(MalVal *seq, MalVal *idx) {
|
||||
return _nth(seq, idx->val.intnum);
|
||||
}
|
||||
@ -505,7 +523,7 @@ MalVal *swap_BANG(MalVal *args) {
|
||||
|
||||
|
||||
|
||||
core_ns_entry core_ns[61] = {
|
||||
core_ns_entry core_ns[] = {
|
||||
{"=", (void*(*)(void*))equal_Q, 2},
|
||||
{"throw", (void*(*)(void*))throw, 1},
|
||||
{"nil?", (void*(*)(void*))nil_Q, 1},
|
||||
@ -553,6 +571,7 @@ core_ns_entry core_ns[61] = {
|
||||
{"sequential?", (void*(*)(void*))sequential_Q, 1},
|
||||
{"cons", (void*(*)(void*))cons, 2},
|
||||
{"concat", (void*(*)(void*))concat, -1},
|
||||
{"vec", (void*(*)(void*))vec, 1},
|
||||
{"nth", (void*(*)(void*))nth, 2},
|
||||
{"first", (void*(*)(void*))_first, 1},
|
||||
{"rest", (void*(*)(void*))_rest, 1},
|
||||
|
@ -10,6 +10,6 @@ typedef struct {
|
||||
int arg_cnt;
|
||||
} core_ns_entry;
|
||||
|
||||
extern core_ns_entry core_ns[61];
|
||||
extern core_ns_entry core_ns[62];
|
||||
|
||||
#endif
|
||||
|
@ -10,6 +10,7 @@
|
||||
|
||||
// Declarations
|
||||
MalVal *EVAL(MalVal *ast, Env *env);
|
||||
MalVal *quasiquote(MalVal *ast);
|
||||
|
||||
// read
|
||||
MalVal *READ(char prompt[], char *str) {
|
||||
@ -30,30 +31,40 @@ MalVal *READ(char prompt[], char *str) {
|
||||
}
|
||||
|
||||
// eval
|
||||
int is_pair(MalVal *x) {
|
||||
return _sequential_Q(x) && (_count(x) > 0);
|
||||
int starts_with(MalVal *ast, const char *sym) {
|
||||
if (ast->type != MAL_LIST)
|
||||
return 0;
|
||||
const MalVal * const a0 = _first(ast);
|
||||
return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string);
|
||||
}
|
||||
|
||||
MalVal *qq_iter(GArray *xs) {
|
||||
MalVal *acc = _listX(0);
|
||||
int i;
|
||||
for (i=xs->len-1; 0<=i; i--) {
|
||||
MalVal * const elt = g_array_index(xs, MalVal*, i);
|
||||
if (starts_with(elt, "splice-unquote"))
|
||||
acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc);
|
||||
else
|
||||
acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc);
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
MalVal *quasiquote(MalVal *ast) {
|
||||
if (!is_pair(ast)) {
|
||||
return _listX(2, malval_new_symbol("quote"), ast);
|
||||
} else {
|
||||
MalVal *a0 = _nth(ast, 0);
|
||||
if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("unquote", a0->val.string) == 0) {
|
||||
switch (ast->type) {
|
||||
case MAL_LIST:
|
||||
if (starts_with(ast, "unquote"))
|
||||
return _nth(ast, 1);
|
||||
} else if (is_pair(a0)) {
|
||||
MalVal *a00 = _nth(a0, 0);
|
||||
if ((a00->type & MAL_SYMBOL) &&
|
||||
strcmp("splice-unquote", a00->val.string) == 0) {
|
||||
return _listX(3, malval_new_symbol("concat"),
|
||||
_nth(a0, 1),
|
||||
quasiquote(_rest(ast)));
|
||||
}
|
||||
}
|
||||
return _listX(3, malval_new_symbol("cons"),
|
||||
quasiquote(a0),
|
||||
quasiquote(_rest(ast)));
|
||||
else
|
||||
return qq_iter(ast->val.array);
|
||||
case MAL_VECTOR:
|
||||
return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
|
||||
case MAL_HASH_MAP:
|
||||
case MAL_SYMBOL:
|
||||
return _listX(2, malval_new_symbol("quote"), ast);
|
||||
default:
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -137,6 +148,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
|
||||
strcmp("quote", a0->val.string) == 0) {
|
||||
//g_print("eval apply quote\n");
|
||||
return _nth(ast, 1);
|
||||
} else if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("quasiquoteexpand", a0->val.string) == 0) {
|
||||
return quasiquote(_nth(ast, 1));
|
||||
} else if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("quasiquote", a0->val.string) == 0) {
|
||||
//g_print("eval apply quasiquote\n");
|
||||
|
@ -10,6 +10,7 @@
|
||||
|
||||
// Declarations
|
||||
MalVal *EVAL(MalVal *ast, Env *env);
|
||||
MalVal *quasiquote(MalVal *ast);
|
||||
MalVal *macroexpand(MalVal *ast, Env *env);
|
||||
|
||||
// read
|
||||
@ -31,30 +32,40 @@ MalVal *READ(char prompt[], char *str) {
|
||||
}
|
||||
|
||||
// eval
|
||||
int is_pair(MalVal *x) {
|
||||
return _sequential_Q(x) && (_count(x) > 0);
|
||||
int starts_with(MalVal *ast, const char *sym) {
|
||||
if (ast->type != MAL_LIST)
|
||||
return 0;
|
||||
const MalVal * const a0 = _first(ast);
|
||||
return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string);
|
||||
}
|
||||
|
||||
MalVal *qq_iter(GArray *xs) {
|
||||
MalVal *acc = _listX(0);
|
||||
int i;
|
||||
for (i=xs->len-1; 0<=i; i--) {
|
||||
MalVal * const elt = g_array_index(xs, MalVal*, i);
|
||||
if (starts_with(elt, "splice-unquote"))
|
||||
acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc);
|
||||
else
|
||||
acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc);
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
MalVal *quasiquote(MalVal *ast) {
|
||||
if (!is_pair(ast)) {
|
||||
return _listX(2, malval_new_symbol("quote"), ast);
|
||||
} else {
|
||||
MalVal *a0 = _nth(ast, 0);
|
||||
if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("unquote", a0->val.string) == 0) {
|
||||
switch (ast->type) {
|
||||
case MAL_LIST:
|
||||
if (starts_with(ast, "unquote"))
|
||||
return _nth(ast, 1);
|
||||
} else if (is_pair(a0)) {
|
||||
MalVal *a00 = _nth(a0, 0);
|
||||
if ((a00->type & MAL_SYMBOL) &&
|
||||
strcmp("splice-unquote", a00->val.string) == 0) {
|
||||
return _listX(3, malval_new_symbol("concat"),
|
||||
_nth(a0, 1),
|
||||
quasiquote(_rest(ast)));
|
||||
}
|
||||
}
|
||||
return _listX(3, malval_new_symbol("cons"),
|
||||
quasiquote(a0),
|
||||
quasiquote(_rest(ast)));
|
||||
else
|
||||
return qq_iter(ast->val.array);
|
||||
case MAL_VECTOR:
|
||||
return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
|
||||
case MAL_HASH_MAP:
|
||||
case MAL_SYMBOL:
|
||||
return _listX(2, malval_new_symbol("quote"), ast);
|
||||
default:
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -163,6 +174,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
|
||||
strcmp("quote", a0->val.string) == 0) {
|
||||
//g_print("eval apply quote\n");
|
||||
return _nth(ast, 1);
|
||||
} else if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("quasiquoteexpand", a0->val.string) == 0) {
|
||||
return quasiquote(_nth(ast, 1));
|
||||
} else if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("quasiquote", a0->val.string) == 0) {
|
||||
//g_print("eval apply quasiquote\n");
|
||||
|
@ -11,6 +11,7 @@
|
||||
|
||||
// Declarations
|
||||
MalVal *EVAL(MalVal *ast, Env *env);
|
||||
MalVal *quasiquote(MalVal *ast);
|
||||
MalVal *macroexpand(MalVal *ast, Env *env);
|
||||
|
||||
// read
|
||||
@ -32,30 +33,40 @@ MalVal *READ(char prompt[], char *str) {
|
||||
}
|
||||
|
||||
// eval
|
||||
int is_pair(MalVal *x) {
|
||||
return _sequential_Q(x) && (_count(x) > 0);
|
||||
int starts_with(MalVal *ast, const char *sym) {
|
||||
if (ast->type != MAL_LIST)
|
||||
return 0;
|
||||
const MalVal * const a0 = _first(ast);
|
||||
return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string);
|
||||
}
|
||||
|
||||
MalVal *qq_iter(GArray *xs) {
|
||||
MalVal *acc = _listX(0);
|
||||
int i;
|
||||
for (i=xs->len-1; 0<=i; i--) {
|
||||
MalVal * const elt = g_array_index(xs, MalVal*, i);
|
||||
if (starts_with(elt, "splice-unquote"))
|
||||
acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc);
|
||||
else
|
||||
acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc);
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
MalVal *quasiquote(MalVal *ast) {
|
||||
if (!is_pair(ast)) {
|
||||
return _listX(2, malval_new_symbol("quote"), ast);
|
||||
} else {
|
||||
MalVal *a0 = _nth(ast, 0);
|
||||
if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("unquote", a0->val.string) == 0) {
|
||||
switch (ast->type) {
|
||||
case MAL_LIST:
|
||||
if (starts_with(ast, "unquote"))
|
||||
return _nth(ast, 1);
|
||||
} else if (is_pair(a0)) {
|
||||
MalVal *a00 = _nth(a0, 0);
|
||||
if ((a00->type & MAL_SYMBOL) &&
|
||||
strcmp("splice-unquote", a00->val.string) == 0) {
|
||||
return _listX(3, malval_new_symbol("concat"),
|
||||
_nth(a0, 1),
|
||||
quasiquote(_rest(ast)));
|
||||
}
|
||||
}
|
||||
return _listX(3, malval_new_symbol("cons"),
|
||||
quasiquote(a0),
|
||||
quasiquote(_rest(ast)));
|
||||
else
|
||||
return qq_iter(ast->val.array);
|
||||
case MAL_VECTOR:
|
||||
return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
|
||||
case MAL_HASH_MAP:
|
||||
case MAL_SYMBOL:
|
||||
return _listX(2, malval_new_symbol("quote"), ast);
|
||||
default:
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -164,6 +175,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
|
||||
strcmp("quote", a0->val.string) == 0) {
|
||||
//g_print("eval apply quote\n");
|
||||
return _nth(ast, 1);
|
||||
} else if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("quasiquoteexpand", a0->val.string) == 0) {
|
||||
return quasiquote(_nth(ast, 1));
|
||||
} else if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("quasiquote", a0->val.string) == 0) {
|
||||
//g_print("eval apply quasiquote\n");
|
||||
|
@ -11,6 +11,7 @@
|
||||
|
||||
// Declarations
|
||||
MalVal *EVAL(MalVal *ast, Env *env);
|
||||
MalVal *quasiquote(MalVal *ast);
|
||||
MalVal *macroexpand(MalVal *ast, Env *env);
|
||||
|
||||
// read
|
||||
@ -32,30 +33,40 @@ MalVal *READ(char prompt[], char *str) {
|
||||
}
|
||||
|
||||
// eval
|
||||
int is_pair(MalVal *x) {
|
||||
return _sequential_Q(x) && (_count(x) > 0);
|
||||
int starts_with(MalVal *ast, const char *sym) {
|
||||
if (ast->type != MAL_LIST)
|
||||
return 0;
|
||||
const MalVal * const a0 = _first(ast);
|
||||
return (a0->type & MAL_SYMBOL) && ! strcmp(sym, a0->val.string);
|
||||
}
|
||||
|
||||
MalVal *qq_iter(GArray *xs) {
|
||||
MalVal *acc = _listX(0);
|
||||
int i;
|
||||
for (i=xs->len-1; 0<=i; i--) {
|
||||
MalVal * const elt = g_array_index(xs, MalVal*, i);
|
||||
if (starts_with(elt, "splice-unquote"))
|
||||
acc = _listX(3, malval_new_symbol("concat"), _nth(elt, 1), acc);
|
||||
else
|
||||
acc = _listX(3, malval_new_symbol("cons"), quasiquote(elt), acc);
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
MalVal *quasiquote(MalVal *ast) {
|
||||
if (!is_pair(ast)) {
|
||||
return _listX(2, malval_new_symbol("quote"), ast);
|
||||
} else {
|
||||
MalVal *a0 = _nth(ast, 0);
|
||||
if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("unquote", a0->val.string) == 0) {
|
||||
switch (ast->type) {
|
||||
case MAL_LIST:
|
||||
if (starts_with(ast, "unquote"))
|
||||
return _nth(ast, 1);
|
||||
} else if (is_pair(a0)) {
|
||||
MalVal *a00 = _nth(a0, 0);
|
||||
if ((a00->type & MAL_SYMBOL) &&
|
||||
strcmp("splice-unquote", a00->val.string) == 0) {
|
||||
return _listX(3, malval_new_symbol("concat"),
|
||||
_nth(a0, 1),
|
||||
quasiquote(_rest(ast)));
|
||||
}
|
||||
}
|
||||
return _listX(3, malval_new_symbol("cons"),
|
||||
quasiquote(a0),
|
||||
quasiquote(_rest(ast)));
|
||||
else
|
||||
return qq_iter(ast->val.array);
|
||||
case MAL_VECTOR:
|
||||
return _listX(2, malval_new_symbol("vec"), qq_iter(ast->val.array));
|
||||
case MAL_HASH_MAP:
|
||||
case MAL_SYMBOL:
|
||||
return _listX(2, malval_new_symbol("quote"), ast);
|
||||
default:
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -164,6 +175,9 @@ MalVal *EVAL(MalVal *ast, Env *env) {
|
||||
strcmp("quote", a0->val.string) == 0) {
|
||||
//g_print("eval apply quote\n");
|
||||
return _nth(ast, 1);
|
||||
} else if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("quasiquoteexpand", a0->val.string) == 0) {
|
||||
return quasiquote(_nth(ast, 1));
|
||||
} else if ((a0->type & MAL_SYMBOL) &&
|
||||
strcmp("quasiquote", a0->val.string) == 0) {
|
||||
//g_print("eval apply quasiquote\n");
|
||||
|
@ -10,7 +10,7 @@ public class Core
|
||||
"pr-str", "str", "prn", "println",
|
||||
"read-string", "slurp",
|
||||
"atom", "atom?", "deref", "reset!", "swap!",
|
||||
"cons", "concat",
|
||||
"vec", "cons", "concat",
|
||||
"nth", "first", "rest",
|
||||
"throw",
|
||||
"apply", "map",
|
||||
@ -52,6 +52,7 @@ new MalDeref @=> Core.ns["deref"];
|
||||
new MalDoReset @=> Core.ns["reset!"];
|
||||
new MalDoSwap @=> Core.ns["swap!"];
|
||||
|
||||
new MalVec @=> Core.ns["vec"];
|
||||
new MalCons @=> Core.ns["cons"];
|
||||
new MalConcat @=> Core.ns["concat"];
|
||||
|
||||
|
@ -27,50 +27,52 @@ fun MalObject READ(string input)
|
||||
return Reader.read_str(input);
|
||||
}
|
||||
|
||||
fun int isPair(MalObject m)
|
||||
fun int starts_with(MalObject a[], string sym)
|
||||
{
|
||||
if( (m.type == "list" || m.type == "vector") &&
|
||||
Util.sequenceToMalObjectArray(m).size() > 0 )
|
||||
{
|
||||
return true;
|
||||
}
|
||||
else
|
||||
if (a.size() != 2)
|
||||
{
|
||||
return false;
|
||||
}
|
||||
a[0] @=> MalObject a0;
|
||||
return a0.type == "symbol" && (a0$MalSymbol).value() == sym;
|
||||
}
|
||||
fun MalList qq_loop(MalObject elt, MalList acc)
|
||||
{
|
||||
if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") )
|
||||
{
|
||||
return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]);
|
||||
}
|
||||
return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]);
|
||||
}
|
||||
fun MalList qq_foldr(MalObject a[])
|
||||
{
|
||||
MalObject empty[0]; // empty, but typed
|
||||
MalList.create(empty) @=> MalList acc;
|
||||
for( a.size() - 1 => int i; 0 <= i; i-- )
|
||||
{
|
||||
qq_loop(a[i], acc) @=> acc;
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
fun MalObject quasiquote(MalObject ast)
|
||||
{
|
||||
if( !isPair(ast) )
|
||||
ast.type => string type;
|
||||
if (type == "list") {
|
||||
if (starts_with((ast$MalList).value(), "unquote"))
|
||||
{
|
||||
return (ast$MalList).value()[1];
|
||||
}
|
||||
return qq_foldr((ast$MalList).value());
|
||||
}
|
||||
if (type == "vector")
|
||||
{
|
||||
return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]);
|
||||
}
|
||||
if (type == "symbol" || type == "hashmap")
|
||||
{
|
||||
return MalList.create([MalSymbol.create("quote"), ast]);
|
||||
}
|
||||
|
||||
Util.sequenceToMalObjectArray(ast) @=> MalObject a[];
|
||||
a[0] @=> MalObject a0;
|
||||
|
||||
if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" )
|
||||
{
|
||||
return a[1];
|
||||
}
|
||||
|
||||
if( isPair(a0) )
|
||||
{
|
||||
Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[];
|
||||
a0_[0] @=> MalObject a0_0;
|
||||
|
||||
if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" )
|
||||
{
|
||||
return MalList.create(
|
||||
[MalSymbol.create("concat"), a0_[1],
|
||||
quasiquote(MalList.create(MalObject.slice(a, 1)))]);
|
||||
}
|
||||
}
|
||||
|
||||
return MalList.create(
|
||||
[MalSymbol.create("cons"), quasiquote(a[0]),
|
||||
quasiquote(MalList.create(MalObject.slice(a, 1)))]);
|
||||
return ast;
|
||||
}
|
||||
|
||||
fun MalObject EVAL(MalObject m, Env env)
|
||||
@ -132,6 +134,10 @@ fun MalObject EVAL(MalObject m, Env env)
|
||||
{
|
||||
return ast[1];
|
||||
}
|
||||
else if( a0 == "quasiquoteexpand" )
|
||||
{
|
||||
return quasiquote(ast[1]);
|
||||
}
|
||||
else if( a0 == "quasiquote" )
|
||||
{
|
||||
quasiquote(ast[1]) @=> m;
|
||||
|
@ -27,50 +27,52 @@ fun MalObject READ(string input)
|
||||
return Reader.read_str(input);
|
||||
}
|
||||
|
||||
fun int isPair(MalObject m)
|
||||
fun int starts_with(MalObject a[], string sym)
|
||||
{
|
||||
if( (m.type == "list" || m.type == "vector") &&
|
||||
Util.sequenceToMalObjectArray(m).size() > 0 )
|
||||
{
|
||||
return true;
|
||||
}
|
||||
else
|
||||
if (a.size() != 2)
|
||||
{
|
||||
return false;
|
||||
}
|
||||
a[0] @=> MalObject a0;
|
||||
return a0.type == "symbol" && (a0$MalSymbol).value() == sym;
|
||||
}
|
||||
fun MalList qq_loop(MalObject elt, MalList acc)
|
||||
{
|
||||
if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") )
|
||||
{
|
||||
return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]);
|
||||
}
|
||||
return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]);
|
||||
}
|
||||
fun MalList qq_foldr(MalObject a[])
|
||||
{
|
||||
MalObject empty[0]; // empty, but typed
|
||||
MalList.create(empty) @=> MalList acc;
|
||||
for( a.size() - 1 => int i; 0 <= i; i-- )
|
||||
{
|
||||
qq_loop(a[i], acc) @=> acc;
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
fun MalObject quasiquote(MalObject ast)
|
||||
{
|
||||
if( !isPair(ast) )
|
||||
ast.type => string type;
|
||||
if (type == "list") {
|
||||
if (starts_with((ast$MalList).value(), "unquote"))
|
||||
{
|
||||
return (ast$MalList).value()[1];
|
||||
}
|
||||
return qq_foldr((ast$MalList).value());
|
||||
}
|
||||
if (type == "vector")
|
||||
{
|
||||
return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]);
|
||||
}
|
||||
if (type == "symbol" || type == "hashmap")
|
||||
{
|
||||
return MalList.create([MalSymbol.create("quote"), ast]);
|
||||
}
|
||||
|
||||
Util.sequenceToMalObjectArray(ast) @=> MalObject a[];
|
||||
a[0] @=> MalObject a0;
|
||||
|
||||
if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" )
|
||||
{
|
||||
return a[1];
|
||||
}
|
||||
|
||||
if( isPair(a0) )
|
||||
{
|
||||
Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[];
|
||||
a0_[0] @=> MalObject a0_0;
|
||||
|
||||
if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" )
|
||||
{
|
||||
return MalList.create(
|
||||
[MalSymbol.create("concat"), a0_[1],
|
||||
quasiquote(MalList.create(MalObject.slice(a, 1)))]);
|
||||
}
|
||||
}
|
||||
|
||||
return MalList.create(
|
||||
[MalSymbol.create("cons"), quasiquote(a[0]),
|
||||
quasiquote(MalList.create(MalObject.slice(a, 1)))]);
|
||||
return ast;
|
||||
}
|
||||
|
||||
fun int isMacroCall(MalObject ast, Env env)
|
||||
@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
|
||||
{
|
||||
return ast[1];
|
||||
}
|
||||
else if( a0 == "quasiquoteexpand" )
|
||||
{
|
||||
return quasiquote(ast[1]);
|
||||
}
|
||||
else if( a0 == "quasiquote" )
|
||||
{
|
||||
quasiquote(ast[1]) @=> m;
|
||||
|
@ -27,50 +27,52 @@ fun MalObject READ(string input)
|
||||
return Reader.read_str(input);
|
||||
}
|
||||
|
||||
fun int isPair(MalObject m)
|
||||
fun int starts_with(MalObject a[], string sym)
|
||||
{
|
||||
if( (m.type == "list" || m.type == "vector") &&
|
||||
Util.sequenceToMalObjectArray(m).size() > 0 )
|
||||
{
|
||||
return true;
|
||||
}
|
||||
else
|
||||
if (a.size() != 2)
|
||||
{
|
||||
return false;
|
||||
}
|
||||
a[0] @=> MalObject a0;
|
||||
return a0.type == "symbol" && (a0$MalSymbol).value() == sym;
|
||||
}
|
||||
fun MalList qq_loop(MalObject elt, MalList acc)
|
||||
{
|
||||
if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") )
|
||||
{
|
||||
return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]);
|
||||
}
|
||||
return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]);
|
||||
}
|
||||
fun MalList qq_foldr(MalObject a[])
|
||||
{
|
||||
MalObject empty[0]; // empty, but typed
|
||||
MalList.create(empty) @=> MalList acc;
|
||||
for( a.size() - 1 => int i; 0 <= i; i-- )
|
||||
{
|
||||
qq_loop(a[i], acc) @=> acc;
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
fun MalObject quasiquote(MalObject ast)
|
||||
{
|
||||
if( !isPair(ast) )
|
||||
ast.type => string type;
|
||||
if (type == "list") {
|
||||
if (starts_with((ast$MalList).value(), "unquote"))
|
||||
{
|
||||
return (ast$MalList).value()[1];
|
||||
}
|
||||
return qq_foldr((ast$MalList).value());
|
||||
}
|
||||
if (type == "vector")
|
||||
{
|
||||
return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]);
|
||||
}
|
||||
if (type == "symbol" || type == "hashmap")
|
||||
{
|
||||
return MalList.create([MalSymbol.create("quote"), ast]);
|
||||
}
|
||||
|
||||
Util.sequenceToMalObjectArray(ast) @=> MalObject a[];
|
||||
a[0] @=> MalObject a0;
|
||||
|
||||
if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" )
|
||||
{
|
||||
return a[1];
|
||||
}
|
||||
|
||||
if( isPair(a0) )
|
||||
{
|
||||
Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[];
|
||||
a0_[0] @=> MalObject a0_0;
|
||||
|
||||
if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" )
|
||||
{
|
||||
return MalList.create(
|
||||
[MalSymbol.create("concat"), a0_[1],
|
||||
quasiquote(MalList.create(MalObject.slice(a, 1)))]);
|
||||
}
|
||||
}
|
||||
|
||||
return MalList.create(
|
||||
[MalSymbol.create("cons"), quasiquote(a[0]),
|
||||
quasiquote(MalList.create(MalObject.slice(a, 1)))]);
|
||||
return ast;
|
||||
}
|
||||
|
||||
fun int isMacroCall(MalObject ast, Env env)
|
||||
@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
|
||||
{
|
||||
return ast[1];
|
||||
}
|
||||
else if( a0 == "quasiquoteexpand" )
|
||||
{
|
||||
return quasiquote(ast[1]);
|
||||
}
|
||||
else if( a0 == "quasiquote" )
|
||||
{
|
||||
quasiquote(ast[1]) @=> m;
|
||||
|
@ -27,50 +27,52 @@ fun MalObject READ(string input)
|
||||
return Reader.read_str(input);
|
||||
}
|
||||
|
||||
fun int isPair(MalObject m)
|
||||
fun int starts_with(MalObject a[], string sym)
|
||||
{
|
||||
if( (m.type == "list" || m.type == "vector") &&
|
||||
Util.sequenceToMalObjectArray(m).size() > 0 )
|
||||
{
|
||||
return true;
|
||||
}
|
||||
else
|
||||
if (a.size() != 2)
|
||||
{
|
||||
return false;
|
||||
}
|
||||
a[0] @=> MalObject a0;
|
||||
return a0.type == "symbol" && (a0$MalSymbol).value() == sym;
|
||||
}
|
||||
fun MalList qq_loop(MalObject elt, MalList acc)
|
||||
{
|
||||
if( elt.type == "list" && starts_with ((elt$MalList).value(), "splice-unquote") )
|
||||
{
|
||||
return MalList.create([MalSymbol.create("concat"), (elt$MalList).value()[1], acc]);
|
||||
}
|
||||
return MalList.create([MalSymbol.create("cons"), quasiquote(elt), acc]);
|
||||
}
|
||||
fun MalList qq_foldr(MalObject a[])
|
||||
{
|
||||
MalObject empty[0]; // empty, but typed
|
||||
MalList.create(empty) @=> MalList acc;
|
||||
for( a.size() - 1 => int i; 0 <= i; i-- )
|
||||
{
|
||||
qq_loop(a[i], acc) @=> acc;
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
fun MalObject quasiquote(MalObject ast)
|
||||
{
|
||||
if( !isPair(ast) )
|
||||
ast.type => string type;
|
||||
if (type == "list") {
|
||||
if (starts_with((ast$MalList).value(), "unquote"))
|
||||
{
|
||||
return (ast$MalList).value()[1];
|
||||
}
|
||||
return qq_foldr((ast$MalList).value());
|
||||
}
|
||||
if (type == "vector")
|
||||
{
|
||||
return MalList.create([MalSymbol.create("vec"), qq_foldr((ast$MalVector).value())]);
|
||||
}
|
||||
if (type == "symbol" || type == "hashmap")
|
||||
{
|
||||
return MalList.create([MalSymbol.create("quote"), ast]);
|
||||
}
|
||||
|
||||
Util.sequenceToMalObjectArray(ast) @=> MalObject a[];
|
||||
a[0] @=> MalObject a0;
|
||||
|
||||
if( a0.type == "symbol" && (a0$MalSymbol).value() == "unquote" )
|
||||
{
|
||||
return a[1];
|
||||
}
|
||||
|
||||
if( isPair(a0) )
|
||||
{
|
||||
Util.sequenceToMalObjectArray(a0) @=> MalObject a0_[];
|
||||
a0_[0] @=> MalObject a0_0;
|
||||
|
||||
if( a0_0.type == "symbol" && (a0_0$MalSymbol).value() == "splice-unquote" )
|
||||
{
|
||||
return MalList.create(
|
||||
[MalSymbol.create("concat"), a0_[1],
|
||||
quasiquote(MalList.create(MalObject.slice(a, 1)))]);
|
||||
}
|
||||
}
|
||||
|
||||
return MalList.create(
|
||||
[MalSymbol.create("cons"), quasiquote(a[0]),
|
||||
quasiquote(MalList.create(MalObject.slice(a, 1)))]);
|
||||
return ast;
|
||||
}
|
||||
|
||||
fun int isMacroCall(MalObject ast, Env env)
|
||||
@ -184,6 +186,10 @@ fun MalObject EVAL(MalObject m, Env env)
|
||||
{
|
||||
return ast[1];
|
||||
}
|
||||
else if( a0 == "quasiquoteexpand" )
|
||||
{
|
||||
return quasiquote(ast[1]);
|
||||
}
|
||||
else if( a0 == "quasiquote" )
|
||||
{
|
||||
quasiquote(ast[1]) @=> m;
|
||||
|
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)))]
|
||||
|
||||
['sequential? sequential?]
|
||||
['vec vec]
|
||||
['cons cons]
|
||||
['concat #(apply list (apply concat %&))]
|
||||
['nth nth]
|
||||
|
@ -13,22 +13,25 @@
|
||||
|
||||
;; eval
|
||||
(declare EVAL)
|
||||
(defn is-pair [x]
|
||||
(and (sequential? x) (> (count x) 0)))
|
||||
|
||||
(declare quasiquote)
|
||||
(defn starts_with [ast sym]
|
||||
(and (seq? ast)
|
||||
(= (first ast) sym)))
|
||||
(defn qq-iter [seq]
|
||||
(if (empty? seq)
|
||||
()
|
||||
(let [elt (first seq)
|
||||
acc (qq-iter (rest seq))]
|
||||
(if (starts_with elt 'splice-unquote)
|
||||
(list 'concat (second elt) acc)
|
||||
(list 'cons (quasiquote elt) acc)))))
|
||||
(defn quasiquote [ast]
|
||||
(cond
|
||||
(not (is-pair ast))
|
||||
(list 'quote ast)
|
||||
|
||||
(= 'unquote (first ast))
|
||||
(second ast)
|
||||
|
||||
(and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
|
||||
(list 'concat (-> ast first second) (quasiquote (rest ast)))
|
||||
|
||||
:else
|
||||
(list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
|
||||
(cond (starts_with ast 'unquote) (second ast)
|
||||
(seq? ast) (qq-iter ast)
|
||||
(vector? ast) (list 'vec (qq-iter ast))
|
||||
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||
:else ast))
|
||||
|
||||
(defn eval-ast [ast env]
|
||||
(cond
|
||||
@ -69,6 +72,9 @@
|
||||
'quote
|
||||
a1
|
||||
|
||||
'quasiquoteexpand
|
||||
(quasiquote a1)
|
||||
|
||||
'quasiquote
|
||||
(recur (quasiquote a1) env)
|
||||
|
||||
|
@ -14,22 +14,25 @@
|
||||
|
||||
;; eval
|
||||
(declare EVAL)
|
||||
(defn is-pair [x]
|
||||
(and (sequential? x) (> (count x) 0)))
|
||||
|
||||
(declare quasiquote)
|
||||
(defn starts_with [ast sym]
|
||||
(and (seq? ast)
|
||||
(= (first ast) sym)))
|
||||
(defn qq-iter [seq]
|
||||
(if (empty? seq)
|
||||
()
|
||||
(let [elt (first seq)
|
||||
acc (qq-iter (rest seq))]
|
||||
(if (starts_with elt 'splice-unquote)
|
||||
(list 'concat (second elt) acc)
|
||||
(list 'cons (quasiquote elt) acc)))))
|
||||
(defn quasiquote [ast]
|
||||
(cond
|
||||
(not (is-pair ast))
|
||||
(list 'quote ast)
|
||||
|
||||
(= 'unquote (first ast))
|
||||
(second ast)
|
||||
|
||||
(and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
|
||||
(list 'concat (-> ast first second) (quasiquote (rest ast)))
|
||||
|
||||
:else
|
||||
(list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
|
||||
(cond (starts_with ast 'unquote) (second ast)
|
||||
(seq? ast) (qq-iter ast)
|
||||
(vector? ast) (list 'vec (qq-iter ast))
|
||||
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||
:else ast))
|
||||
|
||||
(defn is-macro-call [ast env]
|
||||
(and (seq? ast)
|
||||
@ -88,6 +91,9 @@
|
||||
'quote
|
||||
a1
|
||||
|
||||
'quasiquoteexpand
|
||||
(quasiquote a1)
|
||||
|
||||
'quasiquote
|
||||
(recur (quasiquote a1) env)
|
||||
|
||||
|
@ -14,22 +14,25 @@
|
||||
|
||||
;; eval
|
||||
(declare EVAL)
|
||||
(defn is-pair [x]
|
||||
(and (sequential? x) (> (count x) 0)))
|
||||
|
||||
(declare quasiquote)
|
||||
(defn starts_with [ast sym]
|
||||
(and (seq? ast)
|
||||
(= (first ast) sym)))
|
||||
(defn qq-iter [seq]
|
||||
(if (empty? seq)
|
||||
()
|
||||
(let [elt (first seq)
|
||||
acc (qq-iter (rest seq))]
|
||||
(if (starts_with elt 'splice-unquote)
|
||||
(list 'concat (second elt) acc)
|
||||
(list 'cons (quasiquote elt) acc)))))
|
||||
(defn quasiquote [ast]
|
||||
(cond
|
||||
(not (is-pair ast))
|
||||
(list 'quote ast)
|
||||
|
||||
(= 'unquote (first ast))
|
||||
(second ast)
|
||||
|
||||
(and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
|
||||
(list 'concat (-> ast first second) (quasiquote (rest ast)))
|
||||
|
||||
:else
|
||||
(list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
|
||||
(cond (starts_with ast 'unquote) (second ast)
|
||||
(seq? ast) (qq-iter ast)
|
||||
(vector? ast) (list 'vec (qq-iter ast))
|
||||
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||
:else ast))
|
||||
|
||||
(defn is-macro-call [ast env]
|
||||
(and (seq? ast)
|
||||
@ -88,6 +91,9 @@
|
||||
'quote
|
||||
a1
|
||||
|
||||
'quasiquoteexpand
|
||||
(quasiquote a1)
|
||||
|
||||
'quasiquote
|
||||
(recur (quasiquote a1) env)
|
||||
|
||||
|
@ -14,22 +14,25 @@
|
||||
|
||||
;; eval
|
||||
(declare EVAL)
|
||||
(defn is-pair [x]
|
||||
(and (sequential? x) (> (count x) 0)))
|
||||
|
||||
(declare quasiquote)
|
||||
(defn starts_with [ast sym]
|
||||
(and (seq? ast)
|
||||
(= (first ast) sym)))
|
||||
(defn qq-iter [seq]
|
||||
(if (empty? seq)
|
||||
()
|
||||
(let [elt (first seq)
|
||||
acc (qq-iter (rest seq))]
|
||||
(if (starts_with elt 'splice-unquote)
|
||||
(list 'concat (second elt) acc)
|
||||
(list 'cons (quasiquote elt) acc)))))
|
||||
(defn quasiquote [ast]
|
||||
(cond
|
||||
(not (is-pair ast))
|
||||
(list 'quote ast)
|
||||
|
||||
(= 'unquote (first ast))
|
||||
(second ast)
|
||||
|
||||
(and (is-pair (first ast)) (= 'splice-unquote (ffirst ast)))
|
||||
(list 'concat (-> ast first second) (quasiquote (rest ast)))
|
||||
|
||||
:else
|
||||
(list 'cons (quasiquote (first ast)) (quasiquote (rest ast)))))
|
||||
(cond (starts_with ast 'unquote) (second ast)
|
||||
(seq? ast) (qq-iter ast)
|
||||
(vector? ast) (list 'vec (qq-iter ast))
|
||||
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||
:else ast))
|
||||
|
||||
(defn is-macro-call [ast env]
|
||||
(and (seq? ast)
|
||||
@ -88,6 +91,9 @@
|
||||
'quote
|
||||
a1
|
||||
|
||||
'quasiquoteexpand
|
||||
(quasiquote a1)
|
||||
|
||||
'quasiquote
|
||||
(recur (quasiquote a1) env)
|
||||
|
||||
|
@ -84,6 +84,7 @@ exports.ns = {
|
||||
'sequential?': types._sequential_Q,
|
||||
'cons': (a,b) -> [a].concat(b),
|
||||
'concat': (a=[],b...) -> a.concat(b...),
|
||||
'vec': (a) -> types._vector a...,
|
||||
'nth': (a,b) -> if a.length > b then a[b] else
|
||||
throw new Error "nth: index out of bounds",
|
||||
'first': (a) -> if a != null and a.length > 0 then a[0] else null,
|
||||
|
@ -9,15 +9,19 @@ core = require("./core.coffee")
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
is_pair = (x) -> types._sequential_Q(x) && x.length > 0
|
||||
starts_with = (ast, sym) ->
|
||||
types._list_Q(ast) && 0<ast.length && ast[0]!=null && types._symbol_Q(ast[0]) && ast[0].name==sym
|
||||
|
||||
qq_iter = (accumulator, elt) ->
|
||||
if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator]
|
||||
else [types._symbol('cons'), quasiquote(elt), accumulator]
|
||||
|
||||
quasiquote = (ast) ->
|
||||
if !is_pair(ast) then [types._symbol('quote'), ast]
|
||||
else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
|
||||
else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
|
||||
[types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
|
||||
else
|
||||
[types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
if starts_with(ast, 'unquote') then ast[1]
|
||||
else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
|
||||
else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
|
||||
else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
|
||||
else ast
|
||||
|
||||
|
||||
|
||||
@ -51,6 +55,8 @@ EVAL = (ast, env) ->
|
||||
env = let_env
|
||||
when "quote"
|
||||
return a1
|
||||
when "quasiquoteexpand"
|
||||
return quasiquote(a1)
|
||||
when "quasiquote"
|
||||
ast = quasiquote(a1)
|
||||
when "do"
|
||||
|
@ -9,15 +9,19 @@ core = require("./core.coffee")
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
is_pair = (x) -> types._sequential_Q(x) && x.length > 0
|
||||
starts_with = (ast, sym) ->
|
||||
types._list_Q(ast) && 0<ast.length && ast[0]!=null && types._symbol_Q(ast[0]) && ast[0].name==sym
|
||||
|
||||
qq_iter = (accumulator, elt) ->
|
||||
if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator]
|
||||
else [types._symbol('cons'), quasiquote(elt), accumulator]
|
||||
|
||||
quasiquote = (ast) ->
|
||||
if !is_pair(ast) then [types._symbol('quote'), ast]
|
||||
else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
|
||||
else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
|
||||
[types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
|
||||
else
|
||||
[types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
if starts_with(ast, 'unquote') then ast[1]
|
||||
else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
|
||||
else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
|
||||
else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
|
||||
else ast
|
||||
|
||||
is_macro_call = (ast, env) ->
|
||||
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
||||
@ -63,6 +67,8 @@ EVAL = (ast, env) ->
|
||||
env = let_env
|
||||
when "quote"
|
||||
return a1
|
||||
when "quasiquoteexpand"
|
||||
return quasiquote(a1)
|
||||
when "quasiquote"
|
||||
ast = quasiquote(a1)
|
||||
when "defmacro!"
|
||||
|
@ -9,15 +9,19 @@ core = require("./core.coffee")
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
is_pair = (x) -> types._sequential_Q(x) && x.length > 0
|
||||
starts_with = (ast, sym) ->
|
||||
types._list_Q(ast) && 0<ast.length && ast[0]!=null && types._symbol_Q(ast[0]) && ast[0].name==sym
|
||||
|
||||
qq_iter = (accumulator, elt) ->
|
||||
if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator]
|
||||
else [types._symbol('cons'), quasiquote(elt), accumulator]
|
||||
|
||||
quasiquote = (ast) ->
|
||||
if !is_pair(ast) then [types._symbol('quote'), ast]
|
||||
else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
|
||||
else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
|
||||
[types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
|
||||
else
|
||||
[types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
if starts_with(ast, 'unquote') then ast[1]
|
||||
else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
|
||||
else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
|
||||
else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
|
||||
else ast
|
||||
|
||||
is_macro_call = (ast, env) ->
|
||||
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
||||
@ -63,6 +67,8 @@ EVAL = (ast, env) ->
|
||||
env = let_env
|
||||
when "quote"
|
||||
return a1
|
||||
when "quasiquoteexpand"
|
||||
return quasiquote(a1)
|
||||
when "quasiquote"
|
||||
ast = quasiquote(a1)
|
||||
when "defmacro!"
|
||||
|
@ -9,15 +9,19 @@ core = require("./core.coffee")
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
is_pair = (x) -> types._sequential_Q(x) && x.length > 0
|
||||
starts_with = (ast, sym) ->
|
||||
types._list_Q(ast) && 0<ast.length && ast[0]!=null && types._symbol_Q(ast[0]) && ast[0].name==sym
|
||||
|
||||
qq_iter = (accumulator, elt) ->
|
||||
if starts_with(elt, 'splice-unquote') then [types._symbol('concat'), elt[1], accumulator]
|
||||
else [types._symbol('cons'), quasiquote(elt), accumulator]
|
||||
|
||||
quasiquote = (ast) ->
|
||||
if !is_pair(ast) then [types._symbol('quote'), ast]
|
||||
else if ast[0] != null && ast[0].name == 'unquote' then ast[1]
|
||||
else if is_pair(ast[0]) && ast[0][0].name == 'splice-unquote'
|
||||
[types._symbol('concat'), ast[0][1], quasiquote(ast[1..])]
|
||||
else
|
||||
[types._symbol('cons'), quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
if starts_with(ast, 'unquote') then ast[1]
|
||||
else if types._list_Q(ast) then ast.reduceRight(qq_iter, [])
|
||||
else if types._vector_Q(ast) then [types._symbol('vec'), ast.reduceRight(qq_iter, [])]
|
||||
else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast]
|
||||
else ast
|
||||
|
||||
is_macro_call = (ast, env) ->
|
||||
return types._list_Q(ast) && types._symbol_Q(ast[0]) &&
|
||||
@ -63,6 +67,8 @@ EVAL = (ast, env) ->
|
||||
env = let_env
|
||||
when "quote"
|
||||
return a1
|
||||
when "quasiquoteexpand"
|
||||
return quasiquote(a1)
|
||||
when "quasiquote"
|
||||
ast = quasiquote(a1)
|
||||
when "defmacro!"
|
||||
|
@ -133,6 +133,9 @@
|
||||
(apply (mal-data-value fn)
|
||||
(append (list (mal-data-value atom)) args))))
|
||||
|
||||
(defmal vec (list)
|
||||
(make-mal-vector (listify (mal-data-value list))))
|
||||
|
||||
(defmal cons (element list)
|
||||
(make-mal-list (cons element (listify (mal-data-value list)))))
|
||||
|
||||
|
@ -31,8 +31,10 @@
|
||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||
(defvar mal-quote (make-mal-symbol "quote"))
|
||||
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
||||
(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
|
||||
(defvar mal-unquote (make-mal-symbol "unquote"))
|
||||
(defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
|
||||
(defvar mal-vec (make-mal-symbol "vec"))
|
||||
(defvar mal-cons (make-mal-symbol "cons"))
|
||||
(defvar mal-concat (make-mal-symbol "concat"))
|
||||
|
||||
@ -58,29 +60,24 @@
|
||||
(types:hash-map (eval-hash-map ast env))
|
||||
(types:any ast)))
|
||||
|
||||
(defun is-pair (value)
|
||||
(and (or (mal-list-p value)
|
||||
(mal-vector-p value))
|
||||
(< 0 (length (mal-data-value value)))))
|
||||
|
||||
(defun qq-reducer (elt acc)
|
||||
(make-mal-list
|
||||
(if (and (mal-list-p elt)
|
||||
(mal-data-value= (first (mal-data-value elt)) mal-splice-unquote))
|
||||
(list mal-concat (second (mal-data-value elt)) acc)
|
||||
(list mal-cons (quasiquote elt) acc))))
|
||||
(defun qq-iter (elts)
|
||||
(reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ())))
|
||||
(defun quasiquote (ast)
|
||||
(if (not (is-pair ast))
|
||||
(make-mal-list (list mal-quote ast))
|
||||
(let ((forms (map 'list #'identity (mal-data-value ast))))
|
||||
(cond
|
||||
((mal-data-value= mal-unquote (first forms))
|
||||
(second forms))
|
||||
(switch-mal-type ast
|
||||
(types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
|
||||
(second (mal-data-value ast))
|
||||
(qq-iter (mal-data-value ast))))
|
||||
(types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
|
||||
(types:hash-map (make-mal-list (list mal-quote ast)))
|
||||
(types:symbol (make-mal-list (list mal-quote ast)))
|
||||
(types:any ast)))
|
||||
|
||||
((and (is-pair (first forms))
|
||||
(mal-data-value= mal-splice-unquote
|
||||
(first (mal-data-value (first forms)))))
|
||||
(make-mal-list (list mal-concat
|
||||
(second (mal-data-value (first forms)))
|
||||
(quasiquote (make-mal-list (cdr forms))))))
|
||||
|
||||
(t (make-mal-list (list mal-cons
|
||||
(quasiquote (first forms))
|
||||
(quasiquote (make-mal-list (cdr forms))))))))))
|
||||
|
||||
(defun mal-read (string)
|
||||
(reader:read-str string))
|
||||
@ -96,6 +93,9 @@
|
||||
((mal-data-value= mal-quote (first forms))
|
||||
(return (second forms)))
|
||||
|
||||
((mal-data-value= mal-quasiquoteexpand (first forms))
|
||||
(return (quasiquote (second forms))))
|
||||
|
||||
((mal-data-value= mal-quasiquote (first forms))
|
||||
(setf ast (quasiquote (second forms))))
|
||||
|
||||
|
@ -43,8 +43,10 @@
|
||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||
(defvar mal-quote (make-mal-symbol "quote"))
|
||||
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
||||
(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
|
||||
(defvar mal-unquote (make-mal-symbol "unquote"))
|
||||
(defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
|
||||
(defvar mal-vec (make-mal-symbol "vec"))
|
||||
(defvar mal-cons (make-mal-symbol "cons"))
|
||||
(defvar mal-concat (make-mal-symbol "concat"))
|
||||
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
||||
@ -72,29 +74,23 @@
|
||||
(types:hash-map (eval-hash-map ast env))
|
||||
(types:any ast)))
|
||||
|
||||
(defun is-pair (value)
|
||||
(and (or (mal-list-p value)
|
||||
(mal-vector-p value))
|
||||
(< 0 (length (mal-data-value value)))))
|
||||
|
||||
(defun qq-reducer (elt acc)
|
||||
(make-mal-list
|
||||
(if (and (mal-list-p elt)
|
||||
(mal-data-value= (first (mal-data-value elt)) mal-splice-unquote))
|
||||
(list mal-concat (second (mal-data-value elt)) acc)
|
||||
(list mal-cons (quasiquote elt) acc))))
|
||||
(defun qq-iter (elts)
|
||||
(reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ())))
|
||||
(defun quasiquote (ast)
|
||||
(if (not (is-pair ast))
|
||||
(make-mal-list (list mal-quote ast))
|
||||
(let ((forms (map 'list #'identity (mal-data-value ast))))
|
||||
(cond
|
||||
((mal-data-value= mal-unquote (first forms))
|
||||
(second forms))
|
||||
|
||||
((and (is-pair (first forms))
|
||||
(mal-data-value= mal-splice-unquote
|
||||
(first (mal-data-value (first forms)))))
|
||||
(make-mal-list (list mal-concat
|
||||
(second (mal-data-value (first forms)))
|
||||
(quasiquote (make-mal-list (cdr forms))))))
|
||||
|
||||
(t (make-mal-list (list mal-cons
|
||||
(quasiquote (first forms))
|
||||
(quasiquote (make-mal-list (cdr forms))))))))))
|
||||
(switch-mal-type ast
|
||||
(types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
|
||||
(second (mal-data-value ast))
|
||||
(qq-iter (mal-data-value ast))))
|
||||
(types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
|
||||
(types:hash-map (make-mal-list (list mal-quote ast)))
|
||||
(types:symbol (make-mal-list (list mal-quote ast)))
|
||||
(types:any ast)))
|
||||
|
||||
(defun is-macro-call (ast env)
|
||||
(when (mal-list-p ast)
|
||||
@ -129,6 +125,9 @@
|
||||
((mal-data-value= mal-quote (first forms))
|
||||
(return (second forms)))
|
||||
|
||||
((mal-data-value= mal-quasiquoteexpand (first forms))
|
||||
(return (quasiquote (second forms))))
|
||||
|
||||
((mal-data-value= mal-quasiquote (first forms))
|
||||
(setf ast (quasiquote (second forms))))
|
||||
|
||||
|
@ -43,8 +43,10 @@
|
||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||
(defvar mal-quote (make-mal-symbol "quote"))
|
||||
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
||||
(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
|
||||
(defvar mal-unquote (make-mal-symbol "unquote"))
|
||||
(defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
|
||||
(defvar mal-vec (make-mal-symbol "vec"))
|
||||
(defvar mal-cons (make-mal-symbol "cons"))
|
||||
(defvar mal-concat (make-mal-symbol "concat"))
|
||||
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
||||
@ -75,29 +77,23 @@
|
||||
(types:hash-map (eval-hash-map ast env))
|
||||
(types:any ast)))
|
||||
|
||||
(defun is-pair (value)
|
||||
(and (or (mal-list-p value)
|
||||
(mal-vector-p value))
|
||||
(< 0 (length (mal-data-value value)))))
|
||||
|
||||
(defun qq-reducer (elt acc)
|
||||
(make-mal-list
|
||||
(if (and (mal-list-p elt)
|
||||
(mal-data-value= (first (mal-data-value elt)) mal-splice-unquote))
|
||||
(list mal-concat (second (mal-data-value elt)) acc)
|
||||
(list mal-cons (quasiquote elt) acc))))
|
||||
(defun qq-iter (elts)
|
||||
(reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ())))
|
||||
(defun quasiquote (ast)
|
||||
(if (not (is-pair ast))
|
||||
(make-mal-list (list mal-quote ast))
|
||||
(let ((forms (map 'list #'identity (mal-data-value ast))))
|
||||
(cond
|
||||
((mal-data-value= mal-unquote (first forms))
|
||||
(second forms))
|
||||
|
||||
((and (is-pair (first forms))
|
||||
(mal-data-value= mal-splice-unquote
|
||||
(first (mal-data-value (first forms)))))
|
||||
(make-mal-list (list mal-concat
|
||||
(second (mal-data-value (first forms)))
|
||||
(quasiquote (make-mal-list (cdr forms))))))
|
||||
|
||||
(t (make-mal-list (list mal-cons
|
||||
(quasiquote (first forms))
|
||||
(quasiquote (make-mal-list (cdr forms))))))))))
|
||||
(switch-mal-type ast
|
||||
(types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
|
||||
(second (mal-data-value ast))
|
||||
(qq-iter (mal-data-value ast))))
|
||||
(types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
|
||||
(types:hash-map (make-mal-list (list mal-quote ast)))
|
||||
(types:symbol (make-mal-list (list mal-quote ast)))
|
||||
(types:any ast)))
|
||||
|
||||
(defun is-macro-call (ast env)
|
||||
(when (mal-list-p ast)
|
||||
@ -132,6 +128,9 @@
|
||||
((mal-data-value= mal-quote (first forms))
|
||||
(return (second forms)))
|
||||
|
||||
((mal-data-value= mal-quasiquoteexpand (first forms))
|
||||
(return (quasiquote (second forms))))
|
||||
|
||||
((mal-data-value= mal-quasiquote (first forms))
|
||||
(setf ast (quasiquote (second forms))))
|
||||
|
||||
|
@ -42,8 +42,10 @@
|
||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||
(defvar mal-quote (make-mal-symbol "quote"))
|
||||
(defvar mal-quasiquote (make-mal-symbol "quasiquote"))
|
||||
(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand"))
|
||||
(defvar mal-unquote (make-mal-symbol "unquote"))
|
||||
(defvar mal-splice-unquote (make-mal-symbol "splice-unquote"))
|
||||
(defvar mal-vec (make-mal-symbol "vec"))
|
||||
(defvar mal-cons (make-mal-symbol "cons"))
|
||||
(defvar mal-concat (make-mal-symbol "concat"))
|
||||
(defvar mal-defmacro! (make-mal-symbol "defmacro!"))
|
||||
@ -74,29 +76,23 @@
|
||||
(types:hash-map (eval-hash-map ast env))
|
||||
(types:any ast)))
|
||||
|
||||
(defun is-pair (value)
|
||||
(and (or (mal-list-p value)
|
||||
(mal-vector-p value))
|
||||
(< 0 (length (mal-data-value value)))))
|
||||
|
||||
(defun qq-reducer (elt acc)
|
||||
(make-mal-list
|
||||
(if (and (mal-list-p elt)
|
||||
(mal-data-value= (first (mal-data-value elt)) mal-splice-unquote))
|
||||
(list mal-concat (second (mal-data-value elt)) acc)
|
||||
(list mal-cons (quasiquote elt) acc))))
|
||||
(defun qq-iter (elts)
|
||||
(reduce #'qq-reducer elts :from-end t :initial-value (make-mal-list ())))
|
||||
(defun quasiquote (ast)
|
||||
(if (not (is-pair ast))
|
||||
(make-mal-list (list mal-quote ast))
|
||||
(let ((forms (map 'list #'identity (mal-data-value ast))))
|
||||
(cond
|
||||
((mal-data-value= mal-unquote (first forms))
|
||||
(second forms))
|
||||
|
||||
((and (is-pair (first forms))
|
||||
(mal-data-value= mal-splice-unquote
|
||||
(first (mal-data-value (first forms)))))
|
||||
(make-mal-list (list mal-concat
|
||||
(second (mal-data-value (first forms)))
|
||||
(quasiquote (make-mal-list (cdr forms))))))
|
||||
|
||||
(t (make-mal-list (list mal-cons
|
||||
(quasiquote (first forms))
|
||||
(quasiquote (make-mal-list (cdr forms))))))))))
|
||||
(switch-mal-type ast
|
||||
(types:list (if (mal-data-value= (first (mal-data-value ast)) mal-unquote)
|
||||
(second (mal-data-value ast))
|
||||
(qq-iter (mal-data-value ast))))
|
||||
(types:vector (make-mal-list (list mal-vec (qq-iter (listify (mal-data-value ast))))))
|
||||
(types:hash-map (make-mal-list (list mal-quote ast)))
|
||||
(types:symbol (make-mal-list (list mal-quote ast)))
|
||||
(types:any ast)))
|
||||
|
||||
(defun is-macro-call (ast env)
|
||||
(when (mal-list-p ast)
|
||||
@ -131,6 +127,9 @@
|
||||
((mal-data-value= mal-quote (first forms))
|
||||
(return (second forms)))
|
||||
|
||||
((mal-data-value= mal-quasiquoteexpand (first forms))
|
||||
(return (quasiquote (second forms))))
|
||||
|
||||
((mal-data-value= mal-quasiquote (first forms))
|
||||
(setf ast (quasiquote (second forms))))
|
||||
|
||||
|
@ -509,6 +509,13 @@ BUILTIN("vals")
|
||||
return hash->values();
|
||||
}
|
||||
|
||||
BUILTIN("vec")
|
||||
{
|
||||
CHECK_ARGS_IS(1);
|
||||
ARG(malSequence, s);
|
||||
return mal::vector(s->begin(), s->end());
|
||||
}
|
||||
|
||||
BUILTIN("vector")
|
||||
{
|
||||
return mal::vector(argsBegin, argsEnd);
|
||||
|
@ -146,6 +146,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
|
||||
continue; // TCO
|
||||
}
|
||||
|
||||
if (special == "quasiquoteexpand") {
|
||||
checkArgsIs("quasiquote", 1, argCount);
|
||||
return quasiquote(list->item(1));
|
||||
}
|
||||
|
||||
if (special == "quasiquote") {
|
||||
checkArgsIs("quasiquote", 1, argCount);
|
||||
ast = quasiquote(list->item(1));
|
||||
@ -192,44 +197,41 @@ static bool isSymbol(malValuePtr obj, const String& text)
|
||||
return sym && (sym->value() == text);
|
||||
}
|
||||
|
||||
static const malSequence* isPair(malValuePtr obj)
|
||||
// Return arg when ast matches ('sym, arg), else NULL.
|
||||
static malValuePtr starts_with(const malValuePtr ast, const char* sym)
|
||||
{
|
||||
const malSequence* list = DYNAMIC_CAST(malSequence, obj);
|
||||
return list && !list->isEmpty() ? list : NULL;
|
||||
const malList* list = DYNAMIC_CAST(malList, ast);
|
||||
if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
|
||||
return NULL;
|
||||
checkArgsIs(sym, 1, list->count() - 1);
|
||||
return list->item(1);
|
||||
}
|
||||
|
||||
static malValuePtr quasiquote(malValuePtr obj)
|
||||
{
|
||||
const malSequence* seq = isPair(obj);
|
||||
if (!seq) {
|
||||
if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
|
||||
return mal::list(mal::symbol("quote"), obj);
|
||||
}
|
||||
|
||||
if (isSymbol(seq->item(0), "unquote")) {
|
||||
// (qq (uq form)) -> form
|
||||
checkArgsIs("unquote", 1, seq->count() - 1);
|
||||
return seq->item(1);
|
||||
}
|
||||
const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
|
||||
if (!seq)
|
||||
return obj;
|
||||
|
||||
const malSequence* innerSeq = isPair(seq->item(0));
|
||||
if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
|
||||
checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
|
||||
// (qq (sq '(a b c))) -> a b c
|
||||
return mal::list(
|
||||
mal::symbol("concat"),
|
||||
innerSeq->item(1),
|
||||
quasiquote(seq->rest())
|
||||
);
|
||||
}
|
||||
else {
|
||||
// (qq (a b c)) -> (list (qq a) (qq b) (qq c))
|
||||
// (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
|
||||
return mal::list(
|
||||
mal::symbol("cons"),
|
||||
quasiquote(seq->first()),
|
||||
quasiquote(seq->rest())
|
||||
);
|
||||
const malValuePtr unquoted = starts_with(obj, "unquote");
|
||||
if (unquoted)
|
||||
return unquoted;
|
||||
|
||||
malValuePtr res = mal::list(new malValueVec(0));
|
||||
for (int i=seq->count()-1; 0<=i; i--) {
|
||||
const malValuePtr elt = seq->item(i);
|
||||
const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
|
||||
if (spl_unq)
|
||||
res = mal::list(mal::symbol("concat"), spl_unq, res);
|
||||
else
|
||||
res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
|
||||
}
|
||||
if (DYNAMIC_CAST(malVector, obj))
|
||||
res = mal::list(mal::symbol("vec"), res);
|
||||
return res;
|
||||
}
|
||||
|
||||
static const char* malFunctionTable[] = {
|
||||
|
@ -168,6 +168,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
|
||||
return macroExpand(list->item(1), env);
|
||||
}
|
||||
|
||||
if (special == "quasiquoteexpand") {
|
||||
checkArgsIs("quasiquote", 1, argCount);
|
||||
return quasiquote(list->item(1));
|
||||
}
|
||||
|
||||
if (special == "quasiquote") {
|
||||
checkArgsIs("quasiquote", 1, argCount);
|
||||
ast = quasiquote(list->item(1));
|
||||
@ -214,50 +219,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
|
||||
return sym && (sym->value() == text);
|
||||
}
|
||||
|
||||
static const malSequence* isPair(malValuePtr obj)
|
||||
// Return arg when ast matches ('sym, arg), else NULL.
|
||||
static malValuePtr starts_with(const malValuePtr ast, const char* sym)
|
||||
{
|
||||
const malSequence* list = DYNAMIC_CAST(malSequence, obj);
|
||||
return list && !list->isEmpty() ? list : NULL;
|
||||
const malList* list = DYNAMIC_CAST(malList, ast);
|
||||
if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
|
||||
return NULL;
|
||||
checkArgsIs(sym, 1, list->count() - 1);
|
||||
return list->item(1);
|
||||
}
|
||||
|
||||
static malValuePtr quasiquote(malValuePtr obj)
|
||||
{
|
||||
const malSequence* seq = isPair(obj);
|
||||
if (!seq) {
|
||||
if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
|
||||
return mal::list(mal::symbol("quote"), obj);
|
||||
}
|
||||
|
||||
if (isSymbol(seq->item(0), "unquote")) {
|
||||
// (qq (uq form)) -> form
|
||||
checkArgsIs("unquote", 1, seq->count() - 1);
|
||||
return seq->item(1);
|
||||
}
|
||||
const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
|
||||
if (!seq)
|
||||
return obj;
|
||||
|
||||
const malSequence* innerSeq = isPair(seq->item(0));
|
||||
if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
|
||||
checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
|
||||
// (qq (sq '(a b c))) -> a b c
|
||||
return mal::list(
|
||||
mal::symbol("concat"),
|
||||
innerSeq->item(1),
|
||||
quasiquote(seq->rest())
|
||||
);
|
||||
}
|
||||
else {
|
||||
// (qq (a b c)) -> (list (qq a) (qq b) (qq c))
|
||||
// (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
|
||||
return mal::list(
|
||||
mal::symbol("cons"),
|
||||
quasiquote(seq->first()),
|
||||
quasiquote(seq->rest())
|
||||
);
|
||||
const malValuePtr unquoted = starts_with(obj, "unquote");
|
||||
if (unquoted)
|
||||
return unquoted;
|
||||
|
||||
malValuePtr res = mal::list(new malValueVec(0));
|
||||
for (int i=seq->count()-1; 0<=i; i--) {
|
||||
const malValuePtr elt = seq->item(i);
|
||||
const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
|
||||
if (spl_unq)
|
||||
res = mal::list(mal::symbol("concat"), spl_unq, res);
|
||||
else
|
||||
res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
|
||||
}
|
||||
if (DYNAMIC_CAST(malVector, obj))
|
||||
res = mal::list(mal::symbol("vec"), res);
|
||||
return res;
|
||||
}
|
||||
|
||||
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
||||
{
|
||||
if (const malSequence* seq = isPair(obj)) {
|
||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
|
||||
const malList* seq = DYNAMIC_CAST(malList, obj);
|
||||
if (seq && !seq->isEmpty()) {
|
||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
|
||||
if (malEnvPtr symEnv = env->find(sym->value())) {
|
||||
malValuePtr value = sym->eval(symEnv);
|
||||
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
||||
|
@ -171,6 +171,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
|
||||
return macroExpand(list->item(1), env);
|
||||
}
|
||||
|
||||
if (special == "quasiquoteexpand") {
|
||||
checkArgsIs("quasiquote", 1, argCount);
|
||||
return quasiquote(list->item(1));
|
||||
}
|
||||
|
||||
if (special == "quasiquote") {
|
||||
checkArgsIs("quasiquote", 1, argCount);
|
||||
ast = quasiquote(list->item(1));
|
||||
@ -263,50 +268,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
|
||||
return sym && (sym->value() == text);
|
||||
}
|
||||
|
||||
static const malSequence* isPair(malValuePtr obj)
|
||||
// Return arg when ast matches ('sym, arg), else NULL.
|
||||
static malValuePtr starts_with(const malValuePtr ast, const char* sym)
|
||||
{
|
||||
const malSequence* list = DYNAMIC_CAST(malSequence, obj);
|
||||
return list && !list->isEmpty() ? list : NULL;
|
||||
const malList* list = DYNAMIC_CAST(malList, ast);
|
||||
if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
|
||||
return NULL;
|
||||
checkArgsIs(sym, 1, list->count() - 1);
|
||||
return list->item(1);
|
||||
}
|
||||
|
||||
static malValuePtr quasiquote(malValuePtr obj)
|
||||
{
|
||||
const malSequence* seq = isPair(obj);
|
||||
if (!seq) {
|
||||
if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
|
||||
return mal::list(mal::symbol("quote"), obj);
|
||||
}
|
||||
|
||||
if (isSymbol(seq->item(0), "unquote")) {
|
||||
// (qq (uq form)) -> form
|
||||
checkArgsIs("unquote", 1, seq->count() - 1);
|
||||
return seq->item(1);
|
||||
}
|
||||
const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
|
||||
if (!seq)
|
||||
return obj;
|
||||
|
||||
const malSequence* innerSeq = isPair(seq->item(0));
|
||||
if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
|
||||
checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
|
||||
// (qq (sq '(a b c))) -> a b c
|
||||
return mal::list(
|
||||
mal::symbol("concat"),
|
||||
innerSeq->item(1),
|
||||
quasiquote(seq->rest())
|
||||
);
|
||||
}
|
||||
else {
|
||||
// (qq (a b c)) -> (list (qq a) (qq b) (qq c))
|
||||
// (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
|
||||
return mal::list(
|
||||
mal::symbol("cons"),
|
||||
quasiquote(seq->first()),
|
||||
quasiquote(seq->rest())
|
||||
);
|
||||
const malValuePtr unquoted = starts_with(obj, "unquote");
|
||||
if (unquoted)
|
||||
return unquoted;
|
||||
|
||||
malValuePtr res = mal::list(new malValueVec(0));
|
||||
for (int i=seq->count()-1; 0<=i; i--) {
|
||||
const malValuePtr elt = seq->item(i);
|
||||
const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
|
||||
if (spl_unq)
|
||||
res = mal::list(mal::symbol("concat"), spl_unq, res);
|
||||
else
|
||||
res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
|
||||
}
|
||||
if (DYNAMIC_CAST(malVector, obj))
|
||||
res = mal::list(mal::symbol("vec"), res);
|
||||
return res;
|
||||
}
|
||||
|
||||
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
||||
{
|
||||
if (const malSequence* seq = isPair(obj)) {
|
||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
|
||||
const malList* seq = DYNAMIC_CAST(malList, obj);
|
||||
if (seq && !seq->isEmpty()) {
|
||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
|
||||
if (malEnvPtr symEnv = env->find(sym->value())) {
|
||||
malValuePtr value = sym->eval(symEnv);
|
||||
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
||||
|
@ -172,6 +172,11 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
|
||||
return macroExpand(list->item(1), env);
|
||||
}
|
||||
|
||||
if (special == "quasiquoteexpand") {
|
||||
checkArgsIs("quasiquote", 1, argCount);
|
||||
return quasiquote(list->item(1));
|
||||
}
|
||||
|
||||
if (special == "quasiquote") {
|
||||
checkArgsIs("quasiquote", 1, argCount);
|
||||
ast = quasiquote(list->item(1));
|
||||
@ -264,50 +269,48 @@ static bool isSymbol(malValuePtr obj, const String& text)
|
||||
return sym && (sym->value() == text);
|
||||
}
|
||||
|
||||
static const malSequence* isPair(malValuePtr obj)
|
||||
// Return arg when ast matches ('sym, arg), else NULL.
|
||||
static malValuePtr starts_with(const malValuePtr ast, const char* sym)
|
||||
{
|
||||
const malSequence* list = DYNAMIC_CAST(malSequence, obj);
|
||||
return list && !list->isEmpty() ? list : NULL;
|
||||
const malList* list = DYNAMIC_CAST(malList, ast);
|
||||
if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
|
||||
return NULL;
|
||||
checkArgsIs(sym, 1, list->count() - 1);
|
||||
return list->item(1);
|
||||
}
|
||||
|
||||
static malValuePtr quasiquote(malValuePtr obj)
|
||||
{
|
||||
const malSequence* seq = isPair(obj);
|
||||
if (!seq) {
|
||||
if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
|
||||
return mal::list(mal::symbol("quote"), obj);
|
||||
}
|
||||
|
||||
if (isSymbol(seq->item(0), "unquote")) {
|
||||
// (qq (uq form)) -> form
|
||||
checkArgsIs("unquote", 1, seq->count() - 1);
|
||||
return seq->item(1);
|
||||
}
|
||||
const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
|
||||
if (!seq)
|
||||
return obj;
|
||||
|
||||
const malSequence* innerSeq = isPair(seq->item(0));
|
||||
if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
|
||||
checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
|
||||
// (qq (sq '(a b c))) -> a b c
|
||||
return mal::list(
|
||||
mal::symbol("concat"),
|
||||
innerSeq->item(1),
|
||||
quasiquote(seq->rest())
|
||||
);
|
||||
}
|
||||
else {
|
||||
// (qq (a b c)) -> (list (qq a) (qq b) (qq c))
|
||||
// (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
|
||||
return mal::list(
|
||||
mal::symbol("cons"),
|
||||
quasiquote(seq->first()),
|
||||
quasiquote(seq->rest())
|
||||
);
|
||||
const malValuePtr unquoted = starts_with(obj, "unquote");
|
||||
if (unquoted)
|
||||
return unquoted;
|
||||
|
||||
malValuePtr res = mal::list(new malValueVec(0));
|
||||
for (int i=seq->count()-1; 0<=i; i--) {
|
||||
const malValuePtr elt = seq->item(i);
|
||||
const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
|
||||
if (spl_unq)
|
||||
res = mal::list(mal::symbol("concat"), spl_unq, res);
|
||||
else
|
||||
res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
|
||||
}
|
||||
if (DYNAMIC_CAST(malVector, obj))
|
||||
res = mal::list(mal::symbol("vec"), res);
|
||||
return res;
|
||||
}
|
||||
|
||||
static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
|
||||
{
|
||||
if (const malSequence* seq = isPair(obj)) {
|
||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
|
||||
const malList* seq = DYNAMIC_CAST(malList, obj);
|
||||
if (seq && !seq->isEmpty()) {
|
||||
if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
|
||||
if (malEnvPtr symEnv = env->find(sym->value())) {
|
||||
malValuePtr value = sym->eval(symEnv);
|
||||
if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
|
||||
|
@ -88,6 +88,12 @@ module Mal
|
||||
end
|
||||
end
|
||||
|
||||
def self.vec(args)
|
||||
arg = args.first.unwrap
|
||||
arg.is_a? Array || eval_error "argument of vec must be a sequence"
|
||||
arg.to_mal(Mal::Vector)
|
||||
end
|
||||
|
||||
def self.nth(args)
|
||||
a0, a1 = args[0].unwrap, args[1].unwrap
|
||||
eval_error "1st argument of nth must be list or vector" unless a0.is_a? Array
|
||||
@ -410,6 +416,7 @@ module Mal
|
||||
"slurp" => func(:slurp),
|
||||
"cons" => func(:cons),
|
||||
"concat" => func(:concat),
|
||||
"vec" => func(:vec),
|
||||
"nth" => func(:nth),
|
||||
"first" => func(:first),
|
||||
"rest" => func(:rest),
|
||||
|
@ -51,36 +51,49 @@ module Mal
|
||||
read_str str
|
||||
end
|
||||
|
||||
macro is_pair(list)
|
||||
{{list}}.is_a?(Array) && !{{list}}.empty?
|
||||
def starts_with(list, symbol)
|
||||
if list.size == 2
|
||||
head = list.first.unwrap
|
||||
head.is_a? Mal::Symbol && head.str == symbol
|
||||
end
|
||||
end
|
||||
|
||||
def quasiquote_elts(list)
|
||||
acc = Mal::Type.new(Mal::List.new)
|
||||
list.reverse.each do |elt|
|
||||
elt_val = elt.unwrap
|
||||
if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote")
|
||||
acc = Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc
|
||||
)
|
||||
else
|
||||
acc = Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc
|
||||
)
|
||||
end
|
||||
end
|
||||
acc
|
||||
end
|
||||
|
||||
def quasiquote(ast)
|
||||
list = ast.unwrap
|
||||
|
||||
unless is_pair(list)
|
||||
return Mal::Type.new(
|
||||
ast_val = ast.unwrap
|
||||
case ast_val
|
||||
when Mal::List
|
||||
if starts_with(ast_val,"unquote")
|
||||
ast_val[1]
|
||||
else
|
||||
quasiquote_elts(ast_val)
|
||||
end
|
||||
when Mal::Vector
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val)
|
||||
)
|
||||
when Mal::HashMap, Mal::Symbol
|
||||
Mal::Type.new (
|
||||
Mal::List.new << gen_type(Mal::Symbol, "quote") << ast
|
||||
)
|
||||
end
|
||||
|
||||
head = list.first.unwrap
|
||||
|
||||
case
|
||||
# ("unquote" ...)
|
||||
when head.is_a?(Mal::Symbol) && head.str == "unquote"
|
||||
list[1]
|
||||
# (("splice-unquote" ...) ...)
|
||||
when is_pair(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote"
|
||||
tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail)
|
||||
)
|
||||
else
|
||||
tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
|
||||
)
|
||||
ast
|
||||
end
|
||||
end
|
||||
|
||||
@ -161,6 +174,8 @@ module Mal
|
||||
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
||||
when "quote"
|
||||
list[1]
|
||||
when "quasiquoteexpand"
|
||||
quasiquote list[1]
|
||||
when "quasiquote"
|
||||
ast = quasiquote list[1]
|
||||
next # TCO
|
||||
|
@ -51,36 +51,49 @@ module Mal
|
||||
read_str str
|
||||
end
|
||||
|
||||
macro pair?(list)
|
||||
{{list}}.is_a?(Array) && !{{list}}.empty?
|
||||
def starts_with(list, symbol)
|
||||
if list.size == 2
|
||||
head = list.first.unwrap
|
||||
head.is_a? Mal::Symbol && head.str == symbol
|
||||
end
|
||||
end
|
||||
|
||||
def quasiquote_elts(list)
|
||||
acc = Mal::Type.new(Mal::List.new)
|
||||
list.reverse.each do |elt|
|
||||
elt_val = elt.unwrap
|
||||
if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote")
|
||||
acc = Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc
|
||||
)
|
||||
else
|
||||
acc = Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc
|
||||
)
|
||||
end
|
||||
end
|
||||
acc
|
||||
end
|
||||
|
||||
def quasiquote(ast)
|
||||
list = ast.unwrap
|
||||
|
||||
unless pair?(list)
|
||||
return Mal::Type.new(
|
||||
ast_val = ast.unwrap
|
||||
case ast_val
|
||||
when Mal::List
|
||||
if starts_with(ast_val,"unquote")
|
||||
ast_val[1]
|
||||
else
|
||||
quasiquote_elts(ast_val)
|
||||
end
|
||||
when Mal::Vector
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val)
|
||||
)
|
||||
when Mal::HashMap, Mal::Symbol
|
||||
Mal::Type.new (
|
||||
Mal::List.new << gen_type(Mal::Symbol, "quote") << ast
|
||||
)
|
||||
end
|
||||
|
||||
head = list.first.unwrap
|
||||
|
||||
case
|
||||
# ("unquote" ...)
|
||||
when head.is_a?(Mal::Symbol) && head.str == "unquote"
|
||||
list[1]
|
||||
# (("splice-unquote" ...) ...)
|
||||
when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote"
|
||||
tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail)
|
||||
)
|
||||
else
|
||||
tail = Mal::Type.new list[1..-1].each_with_object(Mal::List.new) { |e, l| l << e }
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
|
||||
)
|
||||
ast
|
||||
end
|
||||
end
|
||||
|
||||
@ -200,6 +213,8 @@ module Mal
|
||||
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
||||
when "quote"
|
||||
list[1]
|
||||
when "quasiquoteexpand"
|
||||
quasiquote list[1]
|
||||
when "quasiquote"
|
||||
ast = quasiquote list[1]
|
||||
next # TCO
|
||||
|
@ -51,36 +51,49 @@ module Mal
|
||||
read_str str
|
||||
end
|
||||
|
||||
macro pair?(list)
|
||||
{{list}}.is_a?(Array) && !{{list}}.empty?
|
||||
def starts_with(list, symbol)
|
||||
if list.size == 2
|
||||
head = list.first.unwrap
|
||||
head.is_a? Mal::Symbol && head.str == symbol
|
||||
end
|
||||
end
|
||||
|
||||
def quasiquote_elts(list)
|
||||
acc = Mal::Type.new(Mal::List.new)
|
||||
list.reverse.each do |elt|
|
||||
elt_val = elt.unwrap
|
||||
if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote")
|
||||
acc = Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc
|
||||
)
|
||||
else
|
||||
acc = Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc
|
||||
)
|
||||
end
|
||||
end
|
||||
acc
|
||||
end
|
||||
|
||||
def quasiquote(ast)
|
||||
list = ast.unwrap
|
||||
|
||||
unless pair?(list)
|
||||
return Mal::Type.new(
|
||||
ast_val = ast.unwrap
|
||||
case ast_val
|
||||
when Mal::List
|
||||
if starts_with(ast_val,"unquote")
|
||||
ast_val[1]
|
||||
else
|
||||
quasiquote_elts(ast_val)
|
||||
end
|
||||
when Mal::Vector
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val)
|
||||
)
|
||||
when Mal::HashMap, Mal::Symbol
|
||||
Mal::Type.new (
|
||||
Mal::List.new << gen_type(Mal::Symbol, "quote") << ast
|
||||
)
|
||||
end
|
||||
|
||||
head = list.first.unwrap
|
||||
|
||||
case
|
||||
# ("unquote" ...)
|
||||
when head.is_a?(Mal::Symbol) && head.str == "unquote"
|
||||
list[1]
|
||||
# (("splice-unquote" ...) ...)
|
||||
when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote"
|
||||
tail = Mal::Type.new list[1..-1].to_mal
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail)
|
||||
)
|
||||
else
|
||||
tail = Mal::Type.new list[1..-1].to_mal
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
|
||||
)
|
||||
ast
|
||||
end
|
||||
end
|
||||
|
||||
@ -200,6 +213,8 @@ module Mal
|
||||
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
||||
when "quote"
|
||||
list[1]
|
||||
when "quasiquoteexpand"
|
||||
quasiquote list[1]
|
||||
when "quasiquote"
|
||||
ast = quasiquote list[1]
|
||||
next # TCO
|
||||
|
@ -52,36 +52,49 @@ module Mal
|
||||
read_str str
|
||||
end
|
||||
|
||||
macro pair?(list)
|
||||
{{list}}.is_a?(Array) && !{{list}}.empty?
|
||||
def starts_with(list, symbol)
|
||||
if list.size == 2
|
||||
head = list.first.unwrap
|
||||
head.is_a? Mal::Symbol && head.str == symbol
|
||||
end
|
||||
end
|
||||
|
||||
def quasiquote_elts(list)
|
||||
acc = Mal::Type.new(Mal::List.new)
|
||||
list.reverse.each do |elt|
|
||||
elt_val = elt.unwrap
|
||||
if elt_val.is_a? Mal::List && starts_with(elt_val, "splice-unquote")
|
||||
acc = Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "concat") << elt_val[1] << acc
|
||||
)
|
||||
else
|
||||
acc = Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(elt) << acc
|
||||
)
|
||||
end
|
||||
end
|
||||
acc
|
||||
end
|
||||
|
||||
def quasiquote(ast)
|
||||
list = ast.unwrap
|
||||
|
||||
unless pair?(list)
|
||||
return Mal::Type.new(
|
||||
ast_val = ast.unwrap
|
||||
case ast_val
|
||||
when Mal::List
|
||||
if starts_with(ast_val,"unquote")
|
||||
ast_val[1]
|
||||
else
|
||||
quasiquote_elts(ast_val)
|
||||
end
|
||||
when Mal::Vector
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "vec") << quasiquote_elts(ast_val)
|
||||
)
|
||||
when Mal::HashMap, Mal::Symbol
|
||||
Mal::Type.new (
|
||||
Mal::List.new << gen_type(Mal::Symbol, "quote") << ast
|
||||
)
|
||||
end
|
||||
|
||||
head = list.first.unwrap
|
||||
|
||||
case
|
||||
# ("unquote" ...)
|
||||
when head.is_a?(Mal::Symbol) && head.str == "unquote"
|
||||
list[1]
|
||||
# (("splice-unquote" ...) ...)
|
||||
when pair?(head) && (arg0 = head.first.unwrap).is_a?(Mal::Symbol) && arg0.str == "splice-unquote"
|
||||
tail = Mal::Type.new list[1..-1].to_mal
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "concat") << head[1] << quasiquote(tail)
|
||||
)
|
||||
else
|
||||
tail = Mal::Type.new list[1..-1].to_mal
|
||||
Mal::Type.new(
|
||||
Mal::List.new << gen_type(Mal::Symbol, "cons") << quasiquote(list.first) << quasiquote(tail)
|
||||
)
|
||||
ast
|
||||
end
|
||||
end
|
||||
|
||||
@ -206,6 +219,8 @@ module Mal
|
||||
Mal::Closure.new(list[2], params, env, func_of(env, params, list[2]))
|
||||
when "quote"
|
||||
list[1]
|
||||
when "quasiquoteexpand"
|
||||
quasiquote list[1]
|
||||
when "quasiquote"
|
||||
ast = quasiquote list[1]
|
||||
next # TCO
|
||||
|
@ -371,6 +371,7 @@ namespace Mal {
|
||||
{"sequential?", sequential_Q},
|
||||
{"cons", cons},
|
||||
{"concat", concat},
|
||||
{"vec", new MalFunc(a => new MalVector(((MalList)a[0]).getValue()))},
|
||||
{"nth", nth},
|
||||
{"first", first},
|
||||
{"rest", rest},
|
||||
|
@ -21,30 +21,41 @@ namespace Mal {
|
||||
}
|
||||
|
||||
// eval
|
||||
public static bool is_pair(MalVal x) {
|
||||
return x is MalList && ((MalList)x).size() > 0;
|
||||
public static bool starts_with(MalVal ast, string sym) {
|
||||
if (ast is MalList && !(ast is MalVector)) {
|
||||
MalList list = (MalList)ast;
|
||||
if (list.size() == 2 && list[0] is MalSymbol) {
|
||||
MalSymbol a0 = (MalSymbol)list[0];
|
||||
return a0.getName() == sym;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
public static MalVal qq_loop(MalList ast) {
|
||||
MalVal acc = new MalList();
|
||||
for(int i=ast.size()-1; 0<=i; i-=1) {
|
||||
MalVal elt = ast[i];
|
||||
if (starts_with(elt, "splice-unquote")) {
|
||||
acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc);
|
||||
} else {
|
||||
acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc);
|
||||
}
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
public static MalVal quasiquote(MalVal ast) {
|
||||
if (!is_pair(ast)) {
|
||||
// Check Vector subclass before List.
|
||||
if (ast is MalVector) {
|
||||
return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast)));
|
||||
} else if (starts_with(ast, "unquote")) {
|
||||
return ((MalList)ast)[1];
|
||||
} else if (ast is MalList) {
|
||||
return qq_loop((MalList)ast);
|
||||
} else if (ast is MalSymbol || ast is MalHashMap) {
|
||||
return new MalList(new MalSymbol("quote"), ast);
|
||||
} else {
|
||||
MalVal a0 = ((MalList)ast)[0];
|
||||
if ((a0 is MalSymbol) &&
|
||||
(((MalSymbol)a0).getName() == "unquote")) {
|
||||
return ((MalList)ast)[1];
|
||||
} else if (is_pair(a0)) {
|
||||
MalVal a00 = ((MalList)a0)[0];
|
||||
if ((a00 is MalSymbol) &&
|
||||
(((MalSymbol)a00).getName() == "splice-unquote")) {
|
||||
return new MalList(new MalSymbol("concat"),
|
||||
((MalList)a0)[1],
|
||||
quasiquote(((MalList)ast).rest()));
|
||||
}
|
||||
}
|
||||
return new MalList(new MalSymbol("cons"),
|
||||
quasiquote(a0),
|
||||
quasiquote(((MalList)ast).rest()));
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -113,6 +124,8 @@ namespace Mal {
|
||||
break;
|
||||
case "quote":
|
||||
return ast[1];
|
||||
case "quasiquoteexpand":
|
||||
return quasiquote(ast[1]);
|
||||
case "quasiquote":
|
||||
orig_ast = quasiquote(ast[1]);
|
||||
break;
|
||||
|
@ -21,30 +21,41 @@ namespace Mal {
|
||||
}
|
||||
|
||||
// eval
|
||||
public static bool is_pair(MalVal x) {
|
||||
return x is MalList && ((MalList)x).size() > 0;
|
||||
public static bool starts_with(MalVal ast, string sym) {
|
||||
if (ast is MalList && !(ast is MalVector)) {
|
||||
MalList list = (MalList)ast;
|
||||
if (list.size() == 2 && list[0] is MalSymbol) {
|
||||
MalSymbol a0 = (MalSymbol)list[0];
|
||||
return a0.getName() == sym;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
public static MalVal qq_loop(MalList ast) {
|
||||
MalVal acc = new MalList();
|
||||
for(int i=ast.size()-1; 0<=i; i-=1) {
|
||||
MalVal elt = ast[i];
|
||||
if (starts_with(elt, "splice-unquote")) {
|
||||
acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc);
|
||||
} else {
|
||||
acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc);
|
||||
}
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
public static MalVal quasiquote(MalVal ast) {
|
||||
if (!is_pair(ast)) {
|
||||
// Check Vector subclass before List.
|
||||
if (ast is MalVector) {
|
||||
return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast)));
|
||||
} else if (starts_with(ast, "unquote")) {
|
||||
return ((MalList)ast)[1];
|
||||
} else if (ast is MalList) {
|
||||
return qq_loop((MalList)ast);
|
||||
} else if (ast is MalSymbol || ast is MalHashMap) {
|
||||
return new MalList(new MalSymbol("quote"), ast);
|
||||
} else {
|
||||
MalVal a0 = ((MalList)ast)[0];
|
||||
if ((a0 is MalSymbol) &&
|
||||
(((MalSymbol)a0).getName() == "unquote")) {
|
||||
return ((MalList)ast)[1];
|
||||
} else if (is_pair(a0)) {
|
||||
MalVal a00 = ((MalList)a0)[0];
|
||||
if ((a00 is MalSymbol) &&
|
||||
(((MalSymbol)a00).getName() == "splice-unquote")) {
|
||||
return new MalList(new MalSymbol("concat"),
|
||||
((MalList)a0)[1],
|
||||
quasiquote(((MalList)ast).rest()));
|
||||
}
|
||||
}
|
||||
return new MalList(new MalSymbol("cons"),
|
||||
quasiquote(a0),
|
||||
quasiquote(((MalList)ast).rest()));
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -142,6 +153,8 @@ namespace Mal {
|
||||
break;
|
||||
case "quote":
|
||||
return ast[1];
|
||||
case "quasiquoteexpand":
|
||||
return quasiquote(ast[1]);
|
||||
case "quasiquote":
|
||||
orig_ast = quasiquote(ast[1]);
|
||||
break;
|
||||
|
@ -21,30 +21,41 @@ namespace Mal {
|
||||
}
|
||||
|
||||
// eval
|
||||
public static bool is_pair(MalVal x) {
|
||||
return x is MalList && ((MalList)x).size() > 0;
|
||||
public static bool starts_with(MalVal ast, string sym) {
|
||||
if (ast is MalList && !(ast is MalVector)) {
|
||||
MalList list = (MalList)ast;
|
||||
if (list.size() == 2 && list[0] is MalSymbol) {
|
||||
MalSymbol a0 = (MalSymbol)list[0];
|
||||
return a0.getName() == sym;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
public static MalVal qq_loop(MalList ast) {
|
||||
MalVal acc = new MalList();
|
||||
for(int i=ast.size()-1; 0<=i; i-=1) {
|
||||
MalVal elt = ast[i];
|
||||
if (starts_with(elt, "splice-unquote")) {
|
||||
acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc);
|
||||
} else {
|
||||
acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc);
|
||||
}
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
public static MalVal quasiquote(MalVal ast) {
|
||||
if (!is_pair(ast)) {
|
||||
// Check Vector subclass before List.
|
||||
if (ast is MalVector) {
|
||||
return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast)));
|
||||
} else if (starts_with(ast, "unquote")) {
|
||||
return ((MalList)ast)[1];
|
||||
} else if (ast is MalList) {
|
||||
return qq_loop((MalList)ast);
|
||||
} else if (ast is MalSymbol || ast is MalHashMap) {
|
||||
return new MalList(new MalSymbol("quote"), ast);
|
||||
} else {
|
||||
MalVal a0 = ((MalList)ast)[0];
|
||||
if ((a0 is MalSymbol) &&
|
||||
(((MalSymbol)a0).getName() == "unquote")) {
|
||||
return ((MalList)ast)[1];
|
||||
} else if (is_pair(a0)) {
|
||||
MalVal a00 = ((MalList)a0)[0];
|
||||
if ((a00 is MalSymbol) &&
|
||||
(((MalSymbol)a00).getName() == "splice-unquote")) {
|
||||
return new MalList(new MalSymbol("concat"),
|
||||
((MalList)a0)[1],
|
||||
quasiquote(((MalList)ast).rest()));
|
||||
}
|
||||
}
|
||||
return new MalList(new MalSymbol("cons"),
|
||||
quasiquote(a0),
|
||||
quasiquote(((MalList)ast).rest()));
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -142,6 +153,8 @@ namespace Mal {
|
||||
break;
|
||||
case "quote":
|
||||
return ast[1];
|
||||
case "quasiquoteexpand":
|
||||
return quasiquote(ast[1]);
|
||||
case "quasiquote":
|
||||
orig_ast = quasiquote(ast[1]);
|
||||
break;
|
||||
|
@ -21,30 +21,41 @@ namespace Mal {
|
||||
}
|
||||
|
||||
// eval
|
||||
public static bool is_pair(MalVal x) {
|
||||
return x is MalList && ((MalList)x).size() > 0;
|
||||
public static bool starts_with(MalVal ast, string sym) {
|
||||
if (ast is MalList && !(ast is MalVector)) {
|
||||
MalList list = (MalList)ast;
|
||||
if (list.size() == 2 && list[0] is MalSymbol) {
|
||||
MalSymbol a0 = (MalSymbol)list[0];
|
||||
return a0.getName() == sym;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
public static MalVal qq_loop(MalList ast) {
|
||||
MalVal acc = new MalList();
|
||||
for(int i=ast.size()-1; 0<=i; i-=1) {
|
||||
MalVal elt = ast[i];
|
||||
if (starts_with(elt, "splice-unquote")) {
|
||||
acc = new MalList(new MalSymbol("concat"), ((MalList)elt)[1], acc);
|
||||
} else {
|
||||
acc = new MalList(new MalSymbol("cons"), quasiquote(elt), acc);
|
||||
}
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
public static MalVal quasiquote(MalVal ast) {
|
||||
if (!is_pair(ast)) {
|
||||
// Check Vector subclass before List.
|
||||
if (ast is MalVector) {
|
||||
return new MalList(new MalSymbol("vec"), qq_loop(((MalList)ast)));
|
||||
} else if (starts_with(ast, "unquote")) {
|
||||
return ((MalList)ast)[1];
|
||||
} else if (ast is MalList) {
|
||||
return qq_loop((MalList)ast);
|
||||
} else if (ast is MalSymbol || ast is MalHashMap) {
|
||||
return new MalList(new MalSymbol("quote"), ast);
|
||||
} else {
|
||||
MalVal a0 = ((MalList)ast)[0];
|
||||
if ((a0 is MalSymbol) &&
|
||||
(((MalSymbol)a0).getName() == "unquote")) {
|
||||
return ((MalList)ast)[1];
|
||||
} else if (is_pair(a0)) {
|
||||
MalVal a00 = ((MalList)a0)[0];
|
||||
if ((a00 is MalSymbol) &&
|
||||
(((MalSymbol)a00).getName() == "splice-unquote")) {
|
||||
return new MalList(new MalSymbol("concat"),
|
||||
((MalList)a0)[1],
|
||||
quasiquote(((MalList)ast).rest()));
|
||||
}
|
||||
}
|
||||
return new MalList(new MalSymbol("cons"),
|
||||
quasiquote(a0),
|
||||
quasiquote(((MalList)ast).rest()));
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -142,6 +153,8 @@ namespace Mal {
|
||||
break;
|
||||
case "quote":
|
||||
return ast[1];
|
||||
case "quasiquoteexpand":
|
||||
return quasiquote(ast[1]);
|
||||
case "quasiquote":
|
||||
orig_ast = quasiquote(ast[1]);
|
||||
break;
|
||||
|
@ -213,6 +213,12 @@ static MalType mal_concat(MalType[] a ...)
|
||||
return new MalList(res);
|
||||
}
|
||||
|
||||
static MalType mal_vec(MalType[] a ...)
|
||||
{
|
||||
verify_args_count(a, 1);
|
||||
return new MalVector(verify_cast!MalSequential(a[0]).elements);
|
||||
}
|
||||
|
||||
static MalType mal_nth(MalType[] a ...)
|
||||
{
|
||||
verify_args_count(a, 2);
|
||||
@ -397,6 +403,7 @@ static this()
|
||||
"sequential?": (a ...) => mal_type_q!MalSequential(a),
|
||||
"cons": &mal_cons,
|
||||
"concat": &mal_concat,
|
||||
"vec": &mal_vec,
|
||||
"nth": &mal_nth,
|
||||
"first": &mal_first,
|
||||
"rest": &mal_rest,
|
||||
|
@ -13,36 +13,36 @@ import reader;
|
||||
import printer;
|
||||
import types;
|
||||
|
||||
bool is_pair(MalType ast)
|
||||
bool starts_with(MalType ast, MalSymbol sym)
|
||||
{
|
||||
auto lst = cast(MalSequential) ast;
|
||||
auto lst = cast(MalList) ast;
|
||||
if (lst is null) return false;
|
||||
return lst.elements.length > 0;
|
||||
auto lste = lst.elements;
|
||||
return lste.length > 0 && lste[0] == sym;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast)
|
||||
{
|
||||
if (!is_pair(ast))
|
||||
{
|
||||
if (cast(MalSymbol)ast || cast(MalHashmap)ast)
|
||||
return new MalList([sym_quote, ast]);
|
||||
}
|
||||
auto ast_seq = verify_cast!MalSequential(ast);
|
||||
|
||||
auto ast_seq = cast(MalSequential) ast;
|
||||
if (ast_seq is null)
|
||||
return ast;
|
||||
|
||||
auto aste = ast_seq.elements;
|
||||
if (aste[0] == sym_unquote)
|
||||
{
|
||||
if (starts_with(ast, sym_unquote))
|
||||
return aste[1];
|
||||
}
|
||||
|
||||
if (is_pair(aste[0]))
|
||||
{
|
||||
auto ast0_seq = verify_cast!MalSequential(aste[0]);
|
||||
if (ast0_seq.elements[0] == sym_splice_unquote)
|
||||
{
|
||||
return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
|
||||
}
|
||||
}
|
||||
|
||||
return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
|
||||
MalType res = new MalList([]);;
|
||||
foreach_reverse (elt; ast_seq.elements)
|
||||
if (starts_with(elt, sym_splice_unquote))
|
||||
res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
|
||||
else
|
||||
res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
|
||||
if (cast(MalVector) ast)
|
||||
res = new MalList([new MalSymbol("vec"), res]);
|
||||
return res;
|
||||
}
|
||||
|
||||
MalType READ(string str)
|
||||
@ -120,6 +120,9 @@ MalType EVAL(MalType ast, Env env)
|
||||
case "quote":
|
||||
return aste[1];
|
||||
|
||||
case "quasiquoteexpand":
|
||||
return quasiquote(aste[1]);
|
||||
|
||||
case "quasiquote":
|
||||
ast = quasiquote(aste[1]);
|
||||
continue; // TCO
|
||||
|
@ -13,36 +13,36 @@ import reader;
|
||||
import printer;
|
||||
import types;
|
||||
|
||||
bool is_pair(MalType ast)
|
||||
bool starts_with(MalType ast, MalSymbol sym)
|
||||
{
|
||||
auto lst = cast(MalSequential) ast;
|
||||
auto lst = cast(MalList) ast;
|
||||
if (lst is null) return false;
|
||||
return lst.elements.length > 0;
|
||||
auto lste = lst.elements;
|
||||
return lste.length > 0 && lste[0] == sym;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast)
|
||||
{
|
||||
if (!is_pair(ast))
|
||||
{
|
||||
if (cast(MalSymbol)ast || cast(MalHashmap)ast)
|
||||
return new MalList([sym_quote, ast]);
|
||||
}
|
||||
auto ast_seq = verify_cast!MalSequential(ast);
|
||||
|
||||
auto ast_seq = cast(MalSequential) ast;
|
||||
if (ast_seq is null)
|
||||
return ast;
|
||||
|
||||
auto aste = ast_seq.elements;
|
||||
if (aste[0] == sym_unquote)
|
||||
{
|
||||
if (starts_with(ast, sym_unquote))
|
||||
return aste[1];
|
||||
}
|
||||
|
||||
if (is_pair(aste[0]))
|
||||
{
|
||||
auto ast0_seq = verify_cast!MalSequential(aste[0]);
|
||||
if (ast0_seq.elements[0] == sym_splice_unquote)
|
||||
{
|
||||
return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
|
||||
}
|
||||
}
|
||||
|
||||
return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
|
||||
MalType res = new MalList([]);;
|
||||
foreach_reverse (elt; ast_seq.elements)
|
||||
if (starts_with(elt, sym_splice_unquote))
|
||||
res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
|
||||
else
|
||||
res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
|
||||
if (cast(MalVector) ast)
|
||||
res = new MalList([new MalSymbol("vec"), res]);
|
||||
return res;
|
||||
}
|
||||
|
||||
bool is_macro_call(MalType ast, Env env)
|
||||
@ -155,6 +155,9 @@ MalType EVAL(MalType ast, Env env)
|
||||
case "quote":
|
||||
return aste[1];
|
||||
|
||||
case "quasiquoteexpand":
|
||||
return quasiquote(aste[1]);
|
||||
|
||||
case "quasiquote":
|
||||
ast = quasiquote(aste[1]);
|
||||
continue; // TCO
|
||||
|
@ -13,36 +13,36 @@ import reader;
|
||||
import printer;
|
||||
import types;
|
||||
|
||||
bool is_pair(MalType ast)
|
||||
bool starts_with(MalType ast, MalSymbol sym)
|
||||
{
|
||||
auto lst = cast(MalSequential) ast;
|
||||
auto lst = cast(MalList) ast;
|
||||
if (lst is null) return false;
|
||||
return lst.elements.length > 0;
|
||||
auto lste = lst.elements;
|
||||
return lste.length > 0 && lste[0] == sym;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast)
|
||||
{
|
||||
if (!is_pair(ast))
|
||||
{
|
||||
if (cast(MalSymbol)ast || cast(MalHashmap)ast)
|
||||
return new MalList([sym_quote, ast]);
|
||||
}
|
||||
auto ast_seq = verify_cast!MalSequential(ast);
|
||||
|
||||
auto ast_seq = cast(MalSequential) ast;
|
||||
if (ast_seq is null)
|
||||
return ast;
|
||||
|
||||
auto aste = ast_seq.elements;
|
||||
if (aste[0] == sym_unquote)
|
||||
{
|
||||
if (starts_with(ast, sym_unquote))
|
||||
return aste[1];
|
||||
}
|
||||
|
||||
if (is_pair(aste[0]))
|
||||
{
|
||||
auto ast0_seq = verify_cast!MalSequential(aste[0]);
|
||||
if (ast0_seq.elements[0] == sym_splice_unquote)
|
||||
{
|
||||
return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
|
||||
}
|
||||
}
|
||||
|
||||
return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
|
||||
MalType res = new MalList([]);;
|
||||
foreach_reverse (elt; ast_seq.elements)
|
||||
if (starts_with(elt, sym_splice_unquote))
|
||||
res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
|
||||
else
|
||||
res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
|
||||
if (cast(MalVector) ast)
|
||||
res = new MalList([new MalSymbol("vec"), res]);
|
||||
return res;
|
||||
}
|
||||
|
||||
bool is_macro_call(MalType ast, Env env)
|
||||
@ -155,6 +155,9 @@ MalType EVAL(MalType ast, Env env)
|
||||
case "quote":
|
||||
return aste[1];
|
||||
|
||||
case "quasiquoteexpand":
|
||||
return quasiquote(aste[1]);
|
||||
|
||||
case "quasiquote":
|
||||
ast = quasiquote(aste[1]);
|
||||
continue; // TCO
|
||||
|
@ -14,36 +14,36 @@ import reader;
|
||||
import printer;
|
||||
import types;
|
||||
|
||||
bool is_pair(MalType ast)
|
||||
bool starts_with(MalType ast, MalSymbol sym)
|
||||
{
|
||||
auto lst = cast(MalSequential) ast;
|
||||
auto lst = cast(MalList) ast;
|
||||
if (lst is null) return false;
|
||||
return lst.elements.length > 0;
|
||||
auto lste = lst.elements;
|
||||
return lste.length > 0 && lste[0] == sym;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast)
|
||||
{
|
||||
if (!is_pair(ast))
|
||||
{
|
||||
if (cast(MalSymbol)ast || cast(MalHashmap)ast)
|
||||
return new MalList([sym_quote, ast]);
|
||||
}
|
||||
auto ast_seq = verify_cast!MalSequential(ast);
|
||||
|
||||
auto ast_seq = cast(MalSequential) ast;
|
||||
if (ast_seq is null)
|
||||
return ast;
|
||||
|
||||
auto aste = ast_seq.elements;
|
||||
if (aste[0] == sym_unquote)
|
||||
{
|
||||
if (starts_with(ast, sym_unquote))
|
||||
return aste[1];
|
||||
}
|
||||
|
||||
if (is_pair(aste[0]))
|
||||
{
|
||||
auto ast0_seq = verify_cast!MalSequential(aste[0]);
|
||||
if (ast0_seq.elements[0] == sym_splice_unquote)
|
||||
{
|
||||
return new MalList([new MalSymbol("concat"), ast0_seq.elements[1], quasiquote(new MalList(aste[1..$]))]);
|
||||
}
|
||||
}
|
||||
|
||||
return new MalList([new MalSymbol("cons"), quasiquote(aste[0]), quasiquote(new MalList(aste[1..$]))]);
|
||||
MalType res = new MalList([]);;
|
||||
foreach_reverse (elt; ast_seq.elements)
|
||||
if (starts_with(elt, sym_splice_unquote))
|
||||
res = new MalList([new MalSymbol("concat"), (cast(MalList) elt).elements[1], res]);
|
||||
else
|
||||
res = new MalList([new MalSymbol("cons"), quasiquote(elt), res]);
|
||||
if (cast(MalVector) ast)
|
||||
res = new MalList([new MalSymbol("vec"), res]);
|
||||
return res;
|
||||
}
|
||||
|
||||
bool is_macro_call(MalType ast, Env env)
|
||||
@ -156,6 +156,9 @@ MalType EVAL(MalType ast, Env env)
|
||||
case "quote":
|
||||
return aste[1];
|
||||
|
||||
case "quasiquoteexpand":
|
||||
return quasiquote(aste[1]);
|
||||
|
||||
case "quasiquote":
|
||||
ast = quasiquote(aste[1]);
|
||||
continue; // TCO
|
||||
|
@ -125,6 +125,13 @@ Map<MalSymbol, MalBuiltin> ns = <MalSymbol, MalBuiltin>{
|
||||
}
|
||||
return new MalList(results);
|
||||
}),
|
||||
new MalSymbol('vec'): new MalBuiltin((List<MalType> args) {
|
||||
if (args.length == 1) {
|
||||
if (args[0] is MalVector) return args[0];
|
||||
if (args[0] is MalList) return new MalVector(args[0].elements);
|
||||
}
|
||||
throw new MalException(new MalString("vec: wrong arguments"));
|
||||
}),
|
||||
new MalSymbol('nth'): new MalBuiltin((List<MalType> args) {
|
||||
var indexable = args[0] as MalIterable;
|
||||
var index = args[1] as MalInt;
|
||||
|
@ -23,31 +23,33 @@ void setupEnv(List<String> argv) {
|
||||
"(fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))");
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast) {
|
||||
bool isPair(MalType ast) {
|
||||
return ast is MalIterable && ast.isNotEmpty;
|
||||
}
|
||||
bool starts_with(MalType ast, String sym) {
|
||||
return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
|
||||
}
|
||||
|
||||
if (!isPair(ast)) {
|
||||
MalType qq_loop(List<MalType> xs) {
|
||||
var acc = new MalList([]);
|
||||
for (var i=xs.length-1; 0<=i; i-=1) {
|
||||
if (starts_with(xs[i], "splice-unquote")) {
|
||||
acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]);
|
||||
} else {
|
||||
acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]);
|
||||
}
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast) {
|
||||
if (starts_with(ast, "unquote")) {
|
||||
return (ast as MalList).elements[1];
|
||||
} else if (ast is MalList) {
|
||||
return qq_loop(ast.elements);
|
||||
} else if (ast is MalVector) {
|
||||
return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]);
|
||||
} else if (ast is MalSymbol || ast is MalHashMap) {
|
||||
return new MalList([new MalSymbol("quote"), ast]);
|
||||
} else {
|
||||
var list = ast as MalIterable;
|
||||
if (list.first == new MalSymbol("unquote")) {
|
||||
return list[1];
|
||||
} else if (isPair(list.first) &&
|
||||
(list.first as MalIterable).first == new MalSymbol("splice-unquote")) {
|
||||
return new MalList([
|
||||
new MalSymbol("concat"),
|
||||
(list.first as MalIterable)[1],
|
||||
quasiquote(new MalList(list.sublist(1)))
|
||||
]);
|
||||
} else {
|
||||
return new MalList([
|
||||
new MalSymbol("cons"),
|
||||
quasiquote(list[0]),
|
||||
quasiquote(new MalList(list.sublist(1)))
|
||||
]);
|
||||
}
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -142,6 +144,8 @@ MalType EVAL(MalType ast, Env env) {
|
||||
EVAL(args[1], new Env(env, params, funcArgs)));
|
||||
} else if (symbol.value == "quote") {
|
||||
return args.single;
|
||||
} else if (symbol.value == "quasiquoteexpand") {
|
||||
return quasiquote(args.first);
|
||||
} else if (symbol.value == "quasiquote") {
|
||||
ast = quasiquote(args.first);
|
||||
continue;
|
||||
|
@ -58,31 +58,33 @@ MalType macroexpand(MalType ast, Env env) {
|
||||
return ast;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast) {
|
||||
bool isPair(MalType ast) {
|
||||
return ast is MalIterable && ast.isNotEmpty;
|
||||
}
|
||||
bool starts_with(MalType ast, String sym) {
|
||||
return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
|
||||
}
|
||||
|
||||
if (!isPair(ast)) {
|
||||
MalType qq_loop(List<MalType> xs) {
|
||||
var acc = new MalList([]);
|
||||
for (var i=xs.length-1; 0<=i; i-=1) {
|
||||
if (starts_with(xs[i], "splice-unquote")) {
|
||||
acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]);
|
||||
} else {
|
||||
acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]);
|
||||
}
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast) {
|
||||
if (starts_with(ast, "unquote")) {
|
||||
return (ast as MalList).elements[1];
|
||||
} else if (ast is MalList) {
|
||||
return qq_loop(ast.elements);
|
||||
} else if (ast is MalVector) {
|
||||
return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]);
|
||||
} else if (ast is MalSymbol || ast is MalHashMap) {
|
||||
return new MalList([new MalSymbol("quote"), ast]);
|
||||
} else {
|
||||
var list = ast as MalIterable;
|
||||
if (list.first == new MalSymbol("unquote")) {
|
||||
return list[1];
|
||||
} else if (isPair(list.first) &&
|
||||
(list.first as MalIterable).first == new MalSymbol("splice-unquote")) {
|
||||
return new MalList([
|
||||
new MalSymbol("concat"),
|
||||
(list.first as MalIterable)[1],
|
||||
quasiquote(new MalList(list.sublist(1)))
|
||||
]);
|
||||
} else {
|
||||
return new MalList([
|
||||
new MalSymbol("cons"),
|
||||
quasiquote(list[0]),
|
||||
quasiquote(new MalList(list.sublist(1)))
|
||||
]);
|
||||
}
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -184,6 +186,8 @@ MalType EVAL(MalType ast, Env env) {
|
||||
EVAL(args[1], new Env(env, params, funcArgs)));
|
||||
} else if (symbol.value == "quote") {
|
||||
return args.single;
|
||||
} else if (symbol.value == "quasiquoteexpand") {
|
||||
return quasiquote(args.first);
|
||||
} else if (symbol.value == "quasiquote") {
|
||||
ast = quasiquote(args.first);
|
||||
continue;
|
||||
|
@ -58,31 +58,33 @@ MalType macroexpand(MalType ast, Env env) {
|
||||
return ast;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast) {
|
||||
bool isPair(MalType ast) {
|
||||
return ast is MalIterable && ast.isNotEmpty;
|
||||
}
|
||||
bool starts_with(MalType ast, String sym) {
|
||||
return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
|
||||
}
|
||||
|
||||
if (!isPair(ast)) {
|
||||
MalType qq_loop(List<MalType> xs) {
|
||||
var acc = new MalList([]);
|
||||
for (var i=xs.length-1; 0<=i; i-=1) {
|
||||
if (starts_with(xs[i], "splice-unquote")) {
|
||||
acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]);
|
||||
} else {
|
||||
acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]);
|
||||
}
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast) {
|
||||
if (starts_with(ast, "unquote")) {
|
||||
return (ast as MalList).elements[1];
|
||||
} else if (ast is MalList) {
|
||||
return qq_loop(ast.elements);
|
||||
} else if (ast is MalVector) {
|
||||
return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]);
|
||||
} else if (ast is MalSymbol || ast is MalHashMap) {
|
||||
return new MalList([new MalSymbol("quote"), ast]);
|
||||
} else {
|
||||
var list = ast as MalIterable;
|
||||
if (list.first == new MalSymbol("unquote")) {
|
||||
return list[1];
|
||||
} else if (isPair(list.first) &&
|
||||
(list.first as MalIterable).first == new MalSymbol("splice-unquote")) {
|
||||
return new MalList([
|
||||
new MalSymbol("concat"),
|
||||
(list.first as MalIterable)[1],
|
||||
quasiquote(new MalList(list.sublist(1)))
|
||||
]);
|
||||
} else {
|
||||
return new MalList([
|
||||
new MalSymbol("cons"),
|
||||
quasiquote(list[0]),
|
||||
quasiquote(new MalList(list.sublist(1)))
|
||||
]);
|
||||
}
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -184,6 +186,8 @@ MalType EVAL(MalType ast, Env env) {
|
||||
EVAL(args[1], new Env(env, params, funcArgs)));
|
||||
} else if (symbol.value == "quote") {
|
||||
return args.single;
|
||||
} else if (symbol.value == "quasiquoteexpand") {
|
||||
return quasiquote(args.first);
|
||||
} else if (symbol.value == "quasiquote") {
|
||||
ast = quasiquote(args.first);
|
||||
continue;
|
||||
|
@ -60,31 +60,33 @@ MalType macroexpand(MalType ast, Env env) {
|
||||
return ast;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast) {
|
||||
bool isPair(MalType ast) {
|
||||
return ast is MalIterable && ast.isNotEmpty;
|
||||
}
|
||||
bool starts_with(MalType ast, String sym) {
|
||||
return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym);
|
||||
}
|
||||
|
||||
if (!isPair(ast)) {
|
||||
MalType qq_loop(List<MalType> xs) {
|
||||
var acc = new MalList([]);
|
||||
for (var i=xs.length-1; 0<=i; i-=1) {
|
||||
if (starts_with(xs[i], "splice-unquote")) {
|
||||
acc = new MalList([new MalSymbol("concat"), (xs[i] as MalList)[1], acc]);
|
||||
} else {
|
||||
acc = new MalList([new MalSymbol("cons"), quasiquote(xs[i]), acc]);
|
||||
}
|
||||
}
|
||||
return acc;
|
||||
}
|
||||
|
||||
MalType quasiquote(MalType ast) {
|
||||
if (starts_with(ast, "unquote")) {
|
||||
return (ast as MalList).elements[1];
|
||||
} else if (ast is MalList) {
|
||||
return qq_loop(ast.elements);
|
||||
} else if (ast is MalVector) {
|
||||
return new MalList([new MalSymbol("vec"), qq_loop(ast.elements)]);
|
||||
} else if (ast is MalSymbol || ast is MalHashMap) {
|
||||
return new MalList([new MalSymbol("quote"), ast]);
|
||||
} else {
|
||||
var list = ast as MalIterable;
|
||||
if (list.first == new MalSymbol("unquote")) {
|
||||
return list[1];
|
||||
} else if (isPair(list.first) &&
|
||||
(list.first as MalIterable).first == new MalSymbol("splice-unquote")) {
|
||||
return new MalList([
|
||||
new MalSymbol("concat"),
|
||||
(list.first as MalIterable)[1],
|
||||
quasiquote(new MalList(list.sublist(1)))
|
||||
]);
|
||||
} else {
|
||||
return new MalList([
|
||||
new MalSymbol("cons"),
|
||||
quasiquote(list[0]),
|
||||
quasiquote(new MalList(list.sublist(1)))
|
||||
]);
|
||||
}
|
||||
return ast;
|
||||
}
|
||||
}
|
||||
|
||||
@ -186,6 +188,8 @@ MalType EVAL(MalType ast, Env env) {
|
||||
EVAL(args[1], new Env(env, params, funcArgs)));
|
||||
} else if (symbol.value == "quote") {
|
||||
return args.single;
|
||||
} else if (symbol.value == "quasiquoteexpand") {
|
||||
return quasiquote(args.first);
|
||||
} else if (symbol.value == "quasiquote") {
|
||||
ast = quasiquote(args.first);
|
||||
continue;
|
||||
|
@ -1,79 +1,52 @@
|
||||
(require 'cl-lib)
|
||||
|
||||
(defun mal-seq-p (mal-object)
|
||||
(let ((type (mal-type mal-object)))
|
||||
(if (or (eq type 'list) (eq type 'vector))
|
||||
mal-true
|
||||
mal-false)))
|
||||
(memq (mal-type mal-object) '(list vector)))
|
||||
|
||||
(defun mal-listify (mal-object)
|
||||
(let ((type (mal-type mal-object)))
|
||||
(if (eq type 'vector)
|
||||
(append (mal-value mal-object) nil)
|
||||
(mal-value mal-object))))
|
||||
(cl-ecase (mal-type mal-object)
|
||||
(list (mal-value mal-object))
|
||||
(vector (append (mal-value mal-object) nil))))
|
||||
|
||||
(defun mal-= (a b)
|
||||
(let ((a-type (mal-type a))
|
||||
(b-type (mal-type b)))
|
||||
(cond
|
||||
((and (and (not (eq a-type 'map))
|
||||
(not (eq a-type 'list))
|
||||
(not (eq a-type 'vector)))
|
||||
(and (not (eq b-type 'map))
|
||||
(not (eq b-type 'list))
|
||||
(not (eq b-type 'vector))))
|
||||
(mal-atom-= a b))
|
||||
((and (or (eq a-type 'list) (eq a-type 'vector))
|
||||
(or (eq b-type 'list) (eq b-type 'vector)))
|
||||
(mal-seq-= a b))
|
||||
((and (eq a-type 'map) (eq b-type 'map))
|
||||
(mal-map-= a b))
|
||||
(t
|
||||
;; incompatible types
|
||||
nil))))
|
||||
|
||||
(defun mal-atom-= (a b)
|
||||
(equal (mal-value a) (mal-value b)))
|
||||
(cl-case (mal-type a)
|
||||
((list vector) (and (mal-seq-p b)
|
||||
(mal-seq-= (mal-listify a) (mal-listify b))))
|
||||
(map (and (mal-map-p b)
|
||||
(mal-map-= (mal-value a) (mal-value b))))
|
||||
(t (equal (mal-value a) (mal-value b)))))
|
||||
|
||||
(defun mal-seq-= (a b)
|
||||
(when (= (length (mal-value a))
|
||||
(length (mal-value b)))
|
||||
(when (everyp 'mal-= (mal-listify a) (mal-listify b))
|
||||
t)))
|
||||
|
||||
(defun everyp (predicate list-a list-b)
|
||||
(let ((everyp t))
|
||||
(while (and everyp list-a list-b)
|
||||
(let ((item-a (pop list-a))
|
||||
(item-b (pop list-b)))
|
||||
(when (not (funcall predicate item-a item-b))
|
||||
(setq everyp nil))))
|
||||
everyp))
|
||||
(if a
|
||||
(and b
|
||||
(mal-= (car a) (car b))
|
||||
(mal-seq-= (cdr a) (cdr b)))
|
||||
(null b)))
|
||||
|
||||
(defun mal-map-= (a b)
|
||||
(catch 'return
|
||||
(let ((a* (mal-value a))
|
||||
(b* (mal-value b)))
|
||||
(when (= (hash-table-count a*)
|
||||
(hash-table-count b*))
|
||||
(maphash (lambda (key a-value)
|
||||
(let ((b-value (gethash key b*)))
|
||||
(if b-value
|
||||
(when (not (mal-= a-value b-value))
|
||||
(throw 'return nil))
|
||||
(throw 'return nil))))
|
||||
a*)
|
||||
;; if we made it this far, the maps are equal
|
||||
t))))
|
||||
(when (= (hash-table-count a)
|
||||
(hash-table-count b))
|
||||
(catch 'return
|
||||
(maphash (lambda (key a-value)
|
||||
(let ((b-value (gethash key b)))
|
||||
(unless (and b-value
|
||||
(mal-= a-value b-value))
|
||||
(throw 'return nil))))
|
||||
a)
|
||||
;; if we made it this far, the maps are equal
|
||||
t)))
|
||||
|
||||
(define-hash-table-test 'mal-= 'mal-= 'sxhash)
|
||||
|
||||
(defun mal-conj (seq &rest args)
|
||||
(let ((type (mal-type seq))
|
||||
(value (mal-value seq)))
|
||||
(if (eq type 'vector)
|
||||
(mal-vector (vconcat (append (append value nil) args)))
|
||||
(let ((value (mal-value seq)))
|
||||
(cl-ecase (mal-type seq)
|
||||
(vector
|
||||
(mal-vector (vconcat (append (append value nil) args))))
|
||||
(list
|
||||
(while args
|
||||
(push (pop args) value))
|
||||
(mal-list value))))
|
||||
(mal-list value)))))
|
||||
|
||||
(defun elisp-to-mal (arg)
|
||||
(cond
|
||||
@ -143,6 +116,7 @@
|
||||
(value (apply (mal-value fn*) args*)))
|
||||
(setf (aref atom 1) value)))))
|
||||
|
||||
(vec . ,(mal-fn (lambda (seq) (if (mal-vector-p seq) seq (mal-vector (mal-value seq))))))
|
||||
(cons . ,(mal-fn (lambda (arg list) (mal-list (cons arg (mal-listify list))))))
|
||||
(concat . ,(mal-fn (lambda (&rest lists)
|
||||
(let ((lists* (mapcar (lambda (item) (mal-listify item)) lists)))
|
||||
@ -156,10 +130,8 @@
|
||||
(first . ,(mal-fn (lambda (seq)
|
||||
(if (mal-nil-p seq)
|
||||
mal-nil
|
||||
(let* ((list (mal-listify seq))
|
||||
(value (car list)))
|
||||
(or value mal-nil))))))
|
||||
(rest . ,(mal-fn (lambda (seq) (mal-list (cdr (mal-listify seq))))))
|
||||
(or (car (mal-listify seq)) mal-nil)))))
|
||||
(rest . ,(mal-fn (lambda (seq) (mal-list (unless (mal-nil-p seq) (cdr (mal-listify seq)))))))
|
||||
|
||||
(throw . ,(mal-fn (lambda (mal-object) (signal 'mal-custom (list mal-object)))))
|
||||
|
||||
@ -185,7 +157,7 @@
|
||||
(map? . ,(mal-fn (lambda (arg) (if (mal-map-p arg) mal-true mal-false))))
|
||||
|
||||
(symbol . ,(mal-fn (lambda (string) (mal-symbol (intern (mal-value string))))))
|
||||
(keyword . ,(mal-fn (lambda (string) (mal-keyword (intern (concat ":" (mal-value string)))))))
|
||||
(keyword . ,(mal-fn (lambda (x) (if (mal-keyword-p x) x (mal-keyword (intern (concat ":" (mal-value x))))))))
|
||||
(vector . ,(mal-fn (lambda (&rest args) (mal-vector (vconcat args)))))
|
||||
(hash-map . ,(mal-fn (lambda (&rest args)
|
||||
(let ((map (make-hash-table :test 'mal-=)))
|
||||
@ -193,7 +165,7 @@
|
||||
(puthash (pop args) (pop args) map))
|
||||
(mal-map map)))))
|
||||
|
||||
(sequential? . ,(mal-fn 'mal-seq-p))
|
||||
(sequential? . ,(mal-fn (lambda (mal-object) (if (mal-seq-p mal-object) mal-true mal-false))))
|
||||
(fn? . ,(mal-fn (lambda (arg) (if (or (mal-fn-p arg)
|
||||
(and (mal-func-p arg)
|
||||
(not (mal-func-macro-p arg))))
|
||||
|
@ -1,34 +1,35 @@
|
||||
(require 'cl-lib)
|
||||
|
||||
(defun pr-str (form &optional print-readably)
|
||||
(let ((type (mal-type form))
|
||||
(value (mal-value form)))
|
||||
(cond
|
||||
((eq type 'nil)
|
||||
(let ((value (mal-value form)))
|
||||
(cl-ecase (mal-type form)
|
||||
('nil
|
||||
"nil")
|
||||
((eq type 'true)
|
||||
(true
|
||||
"true")
|
||||
((eq type 'false)
|
||||
(false
|
||||
"false")
|
||||
((eq type 'number)
|
||||
(number-to-string (mal-value form)))
|
||||
((eq type 'string)
|
||||
(number
|
||||
(number-to-string value))
|
||||
(string
|
||||
(if print-readably
|
||||
(let ((print-escape-newlines t))
|
||||
(prin1-to-string value))
|
||||
value))
|
||||
((or (eq type 'symbol) (eq type 'keyword))
|
||||
((symbol keyword)
|
||||
(symbol-name value))
|
||||
((eq type 'list)
|
||||
(list
|
||||
(pr-list value print-readably))
|
||||
((eq type 'vector)
|
||||
(vector
|
||||
(pr-vector value print-readably))
|
||||
((eq type 'map)
|
||||
(map
|
||||
(pr-map value print-readably))
|
||||
((eq type 'fn)
|
||||
(fn
|
||||
"#<fn>")
|
||||
((eq type 'func)
|
||||
(func
|
||||
"#<func>")
|
||||
((eq type 'atom)
|
||||
(format "(atom %s)" (mal-value value))))))
|
||||
(atom
|
||||
(format "(atom %s)" (pr-str value print-readably))))))
|
||||
|
||||
(defun pr-list (form print-readably)
|
||||
(let ((items (mapconcat
|
||||
|
@ -1,3 +1,5 @@
|
||||
(require 'cl-lib)
|
||||
|
||||
;; HACK: `text-quoting-style' prettifies quotes in error messages on
|
||||
;; Emacs 25, but no longer does from 26 upwards...
|
||||
(when (= emacs-major-version 25)
|
||||
@ -33,29 +35,28 @@
|
||||
(nreverse output))))
|
||||
|
||||
(defun read-form ()
|
||||
(let ((token (peek)))
|
||||
(cond
|
||||
((string= token "'")
|
||||
(pcase (peek)
|
||||
("'"
|
||||
(read-quote))
|
||||
((string= token "`")
|
||||
("`"
|
||||
(read-quasiquote))
|
||||
((string= token "~")
|
||||
("~"
|
||||
(read-unquote))
|
||||
((string= token "~@")
|
||||
("~@"
|
||||
(read-splice-unquote))
|
||||
((string= token "@")
|
||||
("@"
|
||||
(read-deref))
|
||||
((string= token "^")
|
||||
("^"
|
||||
(read-with-meta))
|
||||
((string= token "(")
|
||||
("("
|
||||
(read-list))
|
||||
((string= token "[")
|
||||
("["
|
||||
(read-vector))
|
||||
((string= token "{")
|
||||
("{"
|
||||
(read-map))
|
||||
(t
|
||||
(_
|
||||
;; assume anything else is an atom
|
||||
(read-atom)))))
|
||||
(read-atom))))
|
||||
|
||||
(defun read-simple-reader-macro (symbol)
|
||||
(next) ; pop reader macro token
|
||||
|
@ -35,14 +35,12 @@
|
||||
;; empty input, carry on
|
||||
)
|
||||
(unterminated-sequence
|
||||
(let* ((type (cadr err))
|
||||
(end
|
||||
(cond
|
||||
((eq type 'string) ?\")
|
||||
((eq type 'list) ?\))
|
||||
((eq type 'vector) ?\])
|
||||
((eq type 'map) ?}))))
|
||||
(princ (format "Expected '%c', got EOF\n" end))))
|
||||
(princ (format "Expected '%c', got EOF\n"
|
||||
(cl-case (cadr err)
|
||||
(string ?\")
|
||||
(list ?\))
|
||||
(vector ?\])
|
||||
(map ?})))))
|
||||
(error ; catch-all
|
||||
(println (error-message-string err))
|
||||
(backtrace)))
|
||||
|
@ -20,20 +20,19 @@
|
||||
(eval-ast ast env)))
|
||||
|
||||
(defun eval-ast (ast env)
|
||||
(let ((type (mal-type ast))
|
||||
(value (mal-value ast)))
|
||||
(cond
|
||||
((eq type 'symbol)
|
||||
(let ((value (mal-value ast)))
|
||||
(cl-case (mal-type ast)
|
||||
(symbol
|
||||
(let ((definition (gethash value env)))
|
||||
(or definition (error "Definition not found"))))
|
||||
((eq type 'list)
|
||||
(list
|
||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||
((eq type 'vector)
|
||||
(vector
|
||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||
((eq type 'map)
|
||||
(map
|
||||
(let ((map (copy-hash-table value)))
|
||||
(maphash (lambda (key value)
|
||||
(puthash key (EVAL value env) map))
|
||||
(maphash (lambda (key val)
|
||||
(puthash key (EVAL val env) map))
|
||||
map)
|
||||
(mal-map map)))
|
||||
(t
|
||||
@ -67,14 +66,12 @@
|
||||
;; empty input, carry on
|
||||
)
|
||||
(unterminated-sequence
|
||||
(let* ((type (cadr err))
|
||||
(end
|
||||
(cond
|
||||
((eq type 'string) ?\")
|
||||
((eq type 'list) ?\))
|
||||
((eq type 'vector) ?\])
|
||||
((eq type 'map) ?}))))
|
||||
(princ (format "Expected '%c', got EOF\n" end))))
|
||||
(princ (format "Expected '%c', got EOF\n"
|
||||
(cl-case (cadr err)
|
||||
(string ?\")
|
||||
(list ?\))
|
||||
(vector ?\])
|
||||
(map ?})))))
|
||||
(error ; catch-all
|
||||
(println (error-message-string err))
|
||||
(backtrace)))
|
||||
|
@ -15,17 +15,15 @@
|
||||
(defun EVAL (ast env)
|
||||
(if (and (mal-list-p ast) (mal-value ast))
|
||||
(let* ((a (mal-value ast))
|
||||
(a0 (car a))
|
||||
(a0* (mal-value a0))
|
||||
(a1 (cadr a))
|
||||
(a1* (mal-value a1))
|
||||
(a2 (nth 2 a)))
|
||||
(cond
|
||||
((eq a0* 'def!)
|
||||
(cl-case (mal-value (car a))
|
||||
(def!
|
||||
(let ((identifier a1*)
|
||||
(value (EVAL a2 env)))
|
||||
(mal-env-set env identifier value)))
|
||||
((eq a0* 'let*)
|
||||
(let*
|
||||
(let ((env* (mal-env env))
|
||||
(bindings (if (vectorp a1*) (append a1* nil) a1*))
|
||||
(form a2))
|
||||
@ -43,20 +41,19 @@
|
||||
(eval-ast ast env)))
|
||||
|
||||
(defun eval-ast (ast env)
|
||||
(let ((type (mal-type ast))
|
||||
(value (mal-value ast)))
|
||||
(cond
|
||||
((eq type 'symbol)
|
||||
(let ((value (mal-value ast)))
|
||||
(cl-case (mal-type ast)
|
||||
(symbol
|
||||
(let ((definition (mal-env-get env value)))
|
||||
(or definition (error "Definition not found"))))
|
||||
((eq type 'list)
|
||||
(list
|
||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||
((eq type 'vector)
|
||||
(vector
|
||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||
((eq type 'map)
|
||||
(map
|
||||
(let ((map (copy-hash-table value)))
|
||||
(maphash (lambda (key value)
|
||||
(puthash key (EVAL value env) map))
|
||||
(maphash (lambda (key val)
|
||||
(puthash key (EVAL val env) map))
|
||||
map)
|
||||
(mal-map map)))
|
||||
(t
|
||||
@ -90,14 +87,12 @@
|
||||
;; empty input, carry on
|
||||
)
|
||||
(unterminated-sequence
|
||||
(let* ((type (cadr err))
|
||||
(end
|
||||
(cond
|
||||
((eq type 'string) ?\")
|
||||
((eq type 'list) ?\))
|
||||
((eq type 'vector) ?\])
|
||||
((eq type 'map) ?}))))
|
||||
(princ (format "Expected '%c', got EOF\n" end))))
|
||||
(princ (format "Expected '%c', got EOF\n"
|
||||
(cl-case (cadr err)
|
||||
(string ?\")
|
||||
(list ?\))
|
||||
(vector ?\])
|
||||
(map ?})))))
|
||||
(error ; catch-all
|
||||
(println (error-message-string err))))
|
||||
(setq eof t)
|
||||
|
@ -19,29 +19,26 @@
|
||||
(defun EVAL (ast env)
|
||||
(if (and (mal-list-p ast) (mal-value ast))
|
||||
(let* ((a (mal-value ast))
|
||||
(a0 (car a))
|
||||
(a0* (mal-value a0))
|
||||
(a1 (cadr a))
|
||||
(a2 (nth 2 a))
|
||||
(a3 (nth 3 a)))
|
||||
(cond
|
||||
((eq a0* 'def!)
|
||||
(cl-case (mal-value (car a))
|
||||
(def!
|
||||
(let ((identifier (mal-value a1))
|
||||
(value (EVAL a2 env)))
|
||||
(mal-env-set env identifier value)))
|
||||
((eq a0* 'let*)
|
||||
(let* ((env* (mal-env env))
|
||||
(a1* (mal-value a1))
|
||||
(bindings (if (vectorp a1*) (append a1* nil) a1*))
|
||||
(form a2))
|
||||
(let*
|
||||
(let ((env* (mal-env env))
|
||||
(bindings (mal-listify a1))
|
||||
(form a2))
|
||||
(while bindings
|
||||
(let ((key (mal-value (pop bindings)))
|
||||
(value (EVAL (pop bindings) env*)))
|
||||
(mal-env-set env* key value)))
|
||||
(EVAL form env*)))
|
||||
((eq a0* 'do)
|
||||
(do
|
||||
(car (last (mal-value (eval-ast (mal-list (cdr a)) env)))))
|
||||
((eq a0* 'if)
|
||||
(if
|
||||
(let* ((condition (EVAL a1 env))
|
||||
(condition-type (mal-type condition))
|
||||
(then a2)
|
||||
@ -52,7 +49,7 @@
|
||||
(if else
|
||||
(EVAL else env)
|
||||
mal-nil))))
|
||||
((eq a0* 'fn*)
|
||||
(fn*
|
||||
(let ((binds (mapcar 'mal-value (mal-value a1)))
|
||||
(body a2))
|
||||
(mal-fn
|
||||
@ -62,31 +59,25 @@
|
||||
(t
|
||||
;; not a special form
|
||||
(let* ((ast* (mal-value (eval-ast ast env)))
|
||||
(fn (car ast*))
|
||||
(fn* (cond
|
||||
((functionp fn)
|
||||
fn)
|
||||
((mal-fn-p fn)
|
||||
(mal-value fn))))
|
||||
(fn* (mal-value (car ast*)))
|
||||
(args (cdr ast*)))
|
||||
(apply fn* args)))))
|
||||
(eval-ast ast env)))
|
||||
|
||||
(defun eval-ast (ast env)
|
||||
(let ((type (mal-type ast))
|
||||
(value (mal-value ast)))
|
||||
(cond
|
||||
((eq type 'symbol)
|
||||
(let ((value (mal-value ast)))
|
||||
(cl-case (mal-type ast)
|
||||
(symbol
|
||||
(let ((definition (mal-env-get env value)))
|
||||
(or definition (error "Definition not found"))))
|
||||
((eq type 'list)
|
||||
(list
|
||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||
((eq type 'vector)
|
||||
(vector
|
||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||
((eq type 'map)
|
||||
(map
|
||||
(let ((map (copy-hash-table value)))
|
||||
(maphash (lambda (key value)
|
||||
(puthash key (EVAL value env) map))
|
||||
(maphash (lambda (key val)
|
||||
(puthash key (EVAL val env) map))
|
||||
map)
|
||||
(mal-map map)))
|
||||
(t
|
||||
@ -122,14 +113,12 @@
|
||||
;; empty input, carry on
|
||||
)
|
||||
(unterminated-sequence
|
||||
(let* ((type (cadr err))
|
||||
(end
|
||||
(cond
|
||||
((eq type 'string) ?\")
|
||||
((eq type 'list) ?\))
|
||||
((eq type 'vector) ?\])
|
||||
((eq type 'map) ?}))))
|
||||
(princ (format "Expected '%c', got EOF\n" end))))
|
||||
(princ (format "Expected '%c', got EOF\n"
|
||||
(cl-case (cadr err)
|
||||
(string ?\")
|
||||
(list ?\))
|
||||
(vector ?\])
|
||||
(map ?})))))
|
||||
(error ; catch-all
|
||||
(println (error-message-string err))))
|
||||
(setq eof t)
|
||||
|
@ -23,36 +23,32 @@
|
||||
(while t
|
||||
(if (and (mal-list-p ast) (mal-value ast))
|
||||
(let* ((a (mal-value ast))
|
||||
(a0 (car a))
|
||||
(a0* (mal-value a0))
|
||||
(a1 (cadr a))
|
||||
(a2 (nth 2 a))
|
||||
(a3 (nth 3 a)))
|
||||
(cond
|
||||
((eq a0* 'def!)
|
||||
(cl-case (mal-value (car a))
|
||||
(def!
|
||||
(let ((identifier (mal-value a1))
|
||||
(value (EVAL a2 env)))
|
||||
(throw 'return (mal-env-set env identifier value))))
|
||||
((eq a0* 'let*)
|
||||
(let* ((env* (mal-env env))
|
||||
(bindings (mal-value a1))
|
||||
(form a2))
|
||||
(when (vectorp bindings)
|
||||
(setq bindings (append bindings nil)))
|
||||
(let*
|
||||
(let ((env* (mal-env env))
|
||||
(bindings (mal-listify a1))
|
||||
(form a2))
|
||||
(while bindings
|
||||
(let ((key (mal-value (pop bindings)))
|
||||
(value (EVAL (pop bindings) env*)))
|
||||
(mal-env-set env* key value)))
|
||||
(setq env env*
|
||||
ast form))) ; TCO
|
||||
((eq a0* 'do)
|
||||
(do
|
||||
(let* ((a0... (cdr a))
|
||||
(butlast (butlast a0...))
|
||||
(last (car (last a0...))))
|
||||
(when butlast
|
||||
(eval-ast (mal-list butlast) env))
|
||||
(setq ast last))) ; TCO
|
||||
((eq a0* 'if)
|
||||
(if
|
||||
(let* ((condition (EVAL a1 env))
|
||||
(condition-type (mal-type condition))
|
||||
(then a2)
|
||||
@ -63,7 +59,7 @@
|
||||
(if else
|
||||
(setq ast else) ; TCO
|
||||
(throw 'return mal-nil)))))
|
||||
((eq a0* 'fn*)
|
||||
(fn*
|
||||
(let* ((binds (mapcar 'mal-value (mal-value a1)))
|
||||
(body a2)
|
||||
(fn (mal-fn
|
||||
@ -82,29 +78,24 @@
|
||||
args)))
|
||||
(setq env env*
|
||||
ast (mal-func-ast fn))) ; TCO
|
||||
(let ((fn* (if (mal-fn-p fn)
|
||||
;; unbox user-defined function
|
||||
(mal-value fn)
|
||||
;; use built-in function
|
||||
fn)))
|
||||
(let ((fn* (mal-value fn)))
|
||||
(throw 'return (apply fn* args))))))))
|
||||
(throw 'return (eval-ast ast env))))))
|
||||
|
||||
(defun eval-ast (ast env)
|
||||
(let ((type (mal-type ast))
|
||||
(value (mal-value ast)))
|
||||
(cond
|
||||
((eq type 'symbol)
|
||||
(let ((value (mal-value ast)))
|
||||
(cl-case (mal-type ast)
|
||||
(symbol
|
||||
(let ((definition (mal-env-get env value)))
|
||||
(or definition (error "Definition not found"))))
|
||||
((eq type 'list)
|
||||
(list
|
||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||
((eq type 'vector)
|
||||
(vector
|
||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||
((eq type 'map)
|
||||
(map
|
||||
(let ((map (copy-hash-table value)))
|
||||
(maphash (lambda (key value)
|
||||
(puthash key (EVAL value env) map))
|
||||
(maphash (lambda (key val)
|
||||
(puthash key (EVAL val env) map))
|
||||
map)
|
||||
(mal-map map)))
|
||||
(t
|
||||
@ -140,14 +131,12 @@
|
||||
;; empty input, carry on
|
||||
)
|
||||
(unterminated-sequence
|
||||
(let* ((type (cadr err))
|
||||
(end
|
||||
(cond
|
||||
((eq type 'string) ?\")
|
||||
((eq type 'list) ?\))
|
||||
((eq type 'vector) ?\])
|
||||
((eq type 'map) ?}))))
|
||||
(princ (format "Expected '%c', got EOF\n" end))))
|
||||
(princ (format "Expected '%c', got EOF\n"
|
||||
(cl-case (cadr err)
|
||||
(string ?\")
|
||||
(list ?\))
|
||||
(vector ?\])
|
||||
(map ?})))))
|
||||
(error ; catch-all
|
||||
(println (error-message-string err))))
|
||||
(setq eof t)
|
||||
|
@ -22,36 +22,32 @@
|
||||
(while t
|
||||
(if (and (mal-list-p ast) (mal-value ast))
|
||||
(let* ((a (mal-value ast))
|
||||
(a0 (car a))
|
||||
(a0* (mal-value a0))
|
||||
(a1 (cadr a))
|
||||
(a2 (nth 2 a))
|
||||
(a3 (nth 3 a)))
|
||||
(cond
|
||||
((eq a0* 'def!)
|
||||
(cl-case (mal-value (car a))
|
||||
(def!
|
||||
(let ((identifier (mal-value a1))
|
||||
(value (EVAL a2 env)))
|
||||
(throw 'return (mal-env-set env identifier value))))
|
||||
((eq a0* 'let*)
|
||||
(let* ((env* (mal-env env))
|
||||
(bindings (mal-value a1))
|
||||
(form a2))
|
||||
(when (vectorp bindings)
|
||||
(setq bindings (append bindings nil)))
|
||||
(let*
|
||||
(let ((env* (mal-env env))
|
||||
(bindings (mal-listify a1))
|
||||
(form a2))
|
||||
(while bindings
|
||||
(let ((key (mal-value (pop bindings)))
|
||||
(value (EVAL (pop bindings) env*)))
|
||||
(mal-env-set env* key value)))
|
||||
(setq env env*
|
||||
ast form))) ; TCO
|
||||
((eq a0* 'do)
|
||||
(do
|
||||
(let* ((a0... (cdr a))
|
||||
(butlast (butlast a0...))
|
||||
(last (car (last a0...))))
|
||||
(when butlast
|
||||
(eval-ast (mal-list butlast) env))
|
||||
(setq ast last))) ; TCO
|
||||
((eq a0* 'if)
|
||||
(if
|
||||
(let* ((condition (EVAL a1 env))
|
||||
(condition-type (mal-type condition))
|
||||
(then a2)
|
||||
@ -62,7 +58,7 @@
|
||||
(if else
|
||||
(setq ast else) ; TCO
|
||||
(throw 'return mal-nil)))))
|
||||
((eq a0* 'fn*)
|
||||
(fn*
|
||||
(let* ((binds (mapcar 'mal-value (mal-value a1)))
|
||||
(body a2)
|
||||
(fn (mal-fn
|
||||
@ -87,20 +83,19 @@
|
||||
(throw 'return (eval-ast ast env))))))
|
||||
|
||||
(defun eval-ast (ast env)
|
||||
(let ((type (mal-type ast))
|
||||
(value (mal-value ast)))
|
||||
(cond
|
||||
((eq type 'symbol)
|
||||
(let ((value (mal-value ast)))
|
||||
(cl-case (mal-type ast)
|
||||
(symbol
|
||||
(let ((definition (mal-env-get env value)))
|
||||
(or definition (error "Definition not found"))))
|
||||
((eq type 'list)
|
||||
(list
|
||||
(mal-list (mapcar (lambda (item) (EVAL item env)) value)))
|
||||
((eq type 'vector)
|
||||
(vector
|
||||
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
|
||||
((eq type 'map)
|
||||
(map
|
||||
(let ((map (copy-hash-table value)))
|
||||
(maphash (lambda (key value)
|
||||
(puthash key (EVAL value env) map))
|
||||
(maphash (lambda (key val)
|
||||
(puthash key (EVAL val env) map))
|
||||
map)
|
||||
(mal-map map)))
|
||||
(t
|
||||
@ -136,14 +131,12 @@
|
||||
;; empty input, carry on
|
||||
)
|
||||
(unterminated-sequence
|
||||
(let* ((type (cadr err))
|
||||
(end
|
||||
(cond
|
||||
((eq type 'string) ?\")
|
||||
((eq type 'list) ?\))
|
||||
((eq type 'vector) ?\])
|
||||
((eq type 'map) ?}))))
|
||||
(princ (format "Expected '%c', got EOF\n" end))))
|
||||
(princ (format "Expected '%c', got EOF\n"
|
||||
(cl-case (cadr err)
|
||||
(string ?\")
|
||||
(list ?\))
|
||||
(vector ?\])
|
||||
(map ?})))))
|
||||
(error ; catch-all
|
||||
(println (error-message-string err)))))
|
||||
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user