Reification, including Term flattening and Treeification

1 files changed, 147 insertions, 0 deletions

diff --git a/src/kompsos-advanced_reify.adb b/src/kompsos-advanced_reify.adb
new file mode 100644
index 0000000..42df1e7
--- /dev/null
+++ b/src/kompsos-advanced_reify.adb
@@ -0,0 +1,147 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Licensed under the Sunset License v1.0
+
+--  See license.txt for further details
+
+
+package body Kompsos.Advanced_Reify is
+
+
+    --  Term->Array Conversion  --
+
+    function Flatten
+           (Item : in Term)
+        return Element_Array is
+    begin
+        case Item.Kind is
+        when Null_Term =>
+            return (1 => Null_Element);
+        when Atom_Term =>
+            return (1 => Item.Atom);
+        when Var_Term =>
+            return (1 => Variable_Convert (Item));
+        when Pair_Term =>
+            if Item.Right = Empty_Term then
+                return Flatten (Item.Left);
+            else
+                return Flatten (Item.Left) & Flatten (Item.Right);
+            end if;
+        end case;
+    end Flatten;
+
+
+
+    --  Term->Tree Conversion  --
+
+    function To_Tree
+           (Item : in Term)
+        return Element_Trees.Tree is
+    begin
+        return Result : Element_Trees.Tree := Element_Trees.Empty_Tree do
+            case Item.Kind is
+            when Null_Term =>
+                Result.Append_Child (Result.Root, Null_Element);
+            when Atom_Term =>
+                Result.Append_Child (Result.Root, Item.Atom);
+            when Var_Term =>
+                Result.Append_Child (Result.Root, Variable_Convert (Item));
+            when Pair_Term =>
+                declare
+                    The_Subtree : Element_Trees.Tree := To_Tree (Item.Left);
+                    The_Place   : Element_Trees.Cursor;
+                begin
+                    if Item.Left.Kind = Pair_Term then
+                        Result.Insert_Child
+                           (Result.Root,
+                            Element_Trees.No_Element,
+                            Null_Element,
+                            The_Place);
+                    else
+                        The_Place := Result.Root;
+                    end if;
+                    Result.Splice_Children
+                       (The_Place,
+                        Element_Trees.No_Element,
+                        The_Subtree,
+                        The_Subtree.Root);
+                    if Item.Right /= Empty_Term then
+                        The_Subtree := To_Tree (Item.Right);
+                        Result.Splice_Children
+                           (Result.Root,
+                            Element_Trees.No_Element,
+                            The_Subtree,
+                            The_Subtree.Root);
+                    end if;
+                end;
+            end case;
+        end return;
+    end To_Tree;
+
+
+
+    --  Tree Reification  --
+
+    function Treeify
+           (Item  : in Term;
+            Subst : in State)
+        return Element_Trees.Tree is
+    begin
+        return To_Tree (Item.Resolve (Subst));
+    end Treeify;
+
+
+    function Treeify_First
+           (Subst : in State)
+        return Element_Trees.Tree is
+    begin
+        if Subst.LVars.Is_Empty then
+            return Element_Trees.Empty_Tree;
+        end if;
+        for Iter in Subst.Ident.Iterate loop
+            if ID_Number_Maps.Element (Iter) = Subst.LVars.First_Index then
+                return Treeify (Term (T (Variable'(
+                    Ident => ID_Number_Maps.Key (Iter),
+                    Name  => Subst.LVars.Element (ID_Number_Maps.Element (Iter))))),
+                    Subst);
+            end if;
+        end loop;
+        return Element_Trees.Empty_Tree;
+    end Treeify_First;
+
+
+    function Treeify_First
+           (Subst : in State;
+            Name  : in String)
+        return Element_Trees.Tree is
+    begin
+        return Treeify_First (Subst, +Name);
+    end Treeify_First;
+
+
+    function Treeify_First
+           (Subst : in State;
+            Name  : in Nametag)
+        return Element_Trees.Tree
+    is
+        Name_Index : constant Name_Vectors.Extended_Index := Subst.LVars.Find_Index (Name);
+    begin
+        if Name_Index = Name_Vectors.No_Index then
+            return Element_Trees.Empty_Tree;
+        end if;
+        for Iter in Subst.Ident.Iterate loop
+            if ID_Number_Maps.Element (Iter) = Name_Index then
+                return Treeify (Term (T (Variable'(
+                    Ident => ID_Number_Maps.Key (Iter),
+                    Name  => Subst.LVars.Element (ID_Number_Maps.Element (Iter))))),
+                    Subst);
+            end if;
+        end loop;
+        return Element_Trees.Empty_Tree;
+    end Treeify_First;
+
+
+end Kompsos.Advanced_Reify;
+
+