1 files changed, 115 insertions, 4 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;