Isomorphism functions complete

2 files changed, 152 insertions, 11 deletions

diff --git a/src/packrat-parse_graphs.adb b/src/packrat-parse_graphs.adb
index c9171c6..1705d36 100644
--- a/src/packrat-parse_graphs.adb
+++ b/src/packrat-parse_graphs.adb
@@ -985,13 +985,119 @@ package body Packrat.Parse_Graphs is
 
 
 
+    --  there is an isomorphism between two finished_tokens in a graph iff:
+    --    - the starting and finishing points of the tokens slid along a consistent offset are equal
+    --    - the enum_labels and values of the tokens are equal
+    --    - there is some isomorphic match between the token_groups of each finished_token (n^2)
+
+    --  there is an isomorphism between two token_groups iff:
+    --    - the length of both groups is the same
+    --    - each pair of successive finished_tokens, in order, is isomorphic
+
+    --  should be possible to keep track of finished_tokens that are considered to be isomorphic
+    --  with a finished_token -> finished_token map, and if a finished_token is encountered that is
+    --  already in the map then if it matches up short circuit true
+
+    function Group_Isomorph
+           (Left_Graph        : in     Parse_Graph;
+            Left_Token_Group  : in     Token_Group;
+            Right_Graph       : in     Parse_Graph;
+            Right_Token_Group : in     Token_Group;
+            Offset            : in     Integer;
+            Mapping           : in out Isomorph_Maps.Map)
+        return Boolean
+    is
+        use type Ada.Containers.Count_Type;
+    begin
+        if Length (Left_Token_Group) /= Length (Right_Token_Group) then
+            return False;
+        end if;
+        for Index in First_Index (Left_Token_Group) .. Last_Index (Left_Token_Group) loop
+            if not Token_Isomorph
+               (Left_Graph, Element (Left_Token_Group, Index),
+                Right_Graph, Element (Right_Token_Group, Index),
+                Offset, Mapping)
+            then
+                return False;
+            end if;
+        end loop;
+        return True;
+    end Group_Isomorph;
+
+
+    function Token_Isomorph
+           (Left_Graph     : in     Parse_Graph;
+            Left_Position  : in     Finished_Token;
+            Right_Graph    : in     Parse_Graph;
+            Right_Position : in     Finished_Token;
+            Offset         : in     Integer;
+            Mapping        : in out Isomorph_Maps.Map)
+        return Boolean
+    is
+        Left_Groups  : Token_Group_Array := Left_Graph.Subgroups (Left_Position);
+        Right_Groups : Token_Group_Array := Right_Graph.Subgroups (Right_Position);
+    begin
+        if Mapping.Contains (Left_Position) and then
+            Mapping.Constant_Reference (Left_Position).Contains (Right_Position)
+        then
+            return True;
+        end if;
+        if Gen_Tokens.Start (Left_Position.Token) + Offset /=
+            Gen_Tokens.Start (Right_Position.Token) or else
+            Left_Position.Finish + Offset /= Right_Position.Finish
+        then
+            return False;
+        end if;
+        if Gen_Tokens.Label (Left_Position.Token) /= Gen_Tokens.Label (Right_Position.Token) or else
+            Gen_Tokens.Value (Left_Position.Token) /= Gen_Tokens.Value (Right_Position.Token)
+        then
+            return False;
+        end if;
+        declare
+            Left_Groups  : Token_Group_Array := Left_Graph.Subgroups (Left_Position);
+            Right_Groups : Token_Group_Array := Right_Graph.Subgroups (Right_Position);
+        begin
+            if Left_Groups'Length /= Right_Groups'Length then
+                return False;
+            end if;
+            --  This loop only works because of the Subgroups already being sorted
+            --  and any isomorphism only differing in the starts/finishes by a constant.
+            for Index in Left_Groups'Range loop
+                if not Group_Isomorph
+                   (Left_Graph, Left_Groups (Index),
+                    Right_Graph, Right_Groups (Index),
+                    Offset, Mapping)
+                then
+                    return False;
+                end if;
+            end loop;
+        end;
+        if not Mapping.Contains (Left_Position) then
+            Mapping.Insert (Left_Position, Finished_Token_Vectors.Empty_Vector);
+        end if;
+        Mapping.Reference (Left_Position).Append (Right_Position);
+        return True;
+    end Token_Isomorph;
+
+
     function Isomorphic
            (Left, Right : in Parse_Graph)
         return Boolean
     is
+        Offset : Integer :=
+            Gen_Tokens.Start (Right.Root_Token) - Gen_Tokens.Start (Left.Root_Token);
+        Left_Finishes : Finish_Array := Left.Root_Finish_List;
+        Right_Finishes : Finish_Array := Right.Root_Finish_List;
+        Mapping : Isomorph_Maps.Map;
     begin
-        --  to-do
-        return False;
+        if Left_Finishes'Length /= Right_Finishes'Length then
+            return False;
+        end if;
+        return (for all Index in Left_Finishes'Range =>
+            Token_Isomorph
+               (Left, (Left.Root_Token, Left_Finishes (Index)),
+                Right, (Right.Root_Token, Right_Finishes (Index)),
+                Offset, Mapping));
     end Isomorphic;
 
 
@@ -1002,9 +1108,14 @@ package body Packrat.Parse_Graphs is
             Right_Position : in Finished_Token)
         return Boolean
     is
+        Offset : Integer :=
+            Gen_Tokens.Start (Right_Position.Token) - Gen_Tokens.Start (Left_Position.Token);
+        Mapping : Isomorph_Maps.Map;
     begin
-        --  to-do
-        return False;
+        return Token_Isomorph
+           (Left_Graph, Left_Position,
+            Right_Graph, Right_Position,
+            Offset, Mapping);
     end Isomorphic_Subgraph;
 
 
diff --git a/src/packrat-parse_graphs.ads b/src/packrat-parse_graphs.ads
index aced9d3..2912110 100644
--- a/src/packrat-parse_graphs.ads
+++ b/src/packrat-parse_graphs.ads
@@ -343,7 +343,8 @@ package Packrat.Parse_Graphs is
 
     function Isomorphic
            (Left, Right : in Parse_Graph)
-        return Boolean;
+        return Boolean
+    with Pre => Left.Has_Root and Right.Has_Root;
 
     function Isomorphic_Subgraph
            (Left_Graph     : in Parse_Graph;
@@ -422,12 +423,6 @@ private
         Label_Map      : Node_Label_Maps.Map        := Node_Label_Maps.Empty_Map;
     end record;
 
-    Empty_Graph : constant Parse_Graph :=
-       (Internal_Graph => Base.Empty_Graph,
-        Root_Node      => Base.No_Node,
-        Root_Finishes  => Finish_Vectors.Empty_Vector,
-        Label_Map      => Node_Label_Maps.Empty_Map);
-
 
 
 
@@ -479,6 +474,41 @@ private
 
 
 
+    package Isomorph_Maps is new Ada.Containers.Ordered_Maps
+       (Key_Type     => Finished_Token,
+        Element_Type => Finished_Token_Vectors.Vector,
+        "="          => Finished_Token_Vectors."=");
+
+    function Group_Isomorph
+           (Left_Graph        : in     Parse_Graph;
+            Left_Token_Group  : in     Token_Group;
+            Right_Graph       : in     Parse_Graph;
+            Right_Token_Group : in     Token_Group;
+            Offset            : in     Integer;
+            Mapping           : in out Isomorph_Maps.Map)
+        return Boolean;
+
+    function Token_Isomorph
+           (Left_Graph     : in     Parse_Graph;
+            Left_Position  : in     Finished_Token;
+            Right_Graph    : in     Parse_Graph;
+            Right_Position : in     Finished_Token;
+            Offset         : in     Integer;
+            Mapping        : in out Isomorph_Maps.Map)
+        return Boolean;
+
+
+
+
+    Empty_Graph : constant Parse_Graph :=
+       (Internal_Graph => Base.Empty_Graph,
+        Root_Node      => Base.No_Node,
+        Root_Finishes  => Finish_Vectors.Empty_Vector,
+        Label_Map      => Node_Label_Maps.Empty_Map);
+
+
+
+
     generic
         type Base_Type is private;
         type Array_Type is array (Positive range <>) of Base_Type;