path: root/src/packrat-parse_graphs.ads

with

    Ada.Containers,
    Packrat.Traits;

private with

    Ada.Containers.Vectors,
    Ada.Containers.Ordered_Maps,
    Directed_Graphs;


generic

    with package Traits is new Packrat.Traits (<>);

package Packrat.Parse_Graphs is


    type Parse_Graph is tagged private;

    function "="
           (Left, Right : in Parse_Graph)
        return Boolean;

    Empty_Graph : constant Parse_Graph;

    type Token_Group is private with Type_Invariant => Integer (Length (Token_Group)) > 0;
    type Token_Group_Array is array (Positive range <>) of Token_Group;

    function "<"
           (Left, Right : in Token_Group)
        return Boolean;




    procedure Assign
           (Target : in out Parse_Graph;
            Source : in     Parse_Graph);

    function Copy
           (Source : in Parse_Graph)
        return Parse_Graph;

    procedure Move
           (Target, Source : in out Parse_Graph);




    function Is_Empty
           (Container : in Parse_Graph)
        return Boolean;

    procedure Clear
           (Container : in out Parse_Graph);




    function Debug_String
           (Container : in Parse_Graph)
        return String;




    function Contains
           (Container : in Parse_Graph;
            Token     : in Traits.Tokens.Token_Type)
        return Boolean;

    function Contains
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Boolean;

    function Contains
           (Container : in Parse_Graph;
            Grouping  : in Token_Group)
        return Boolean;

    function Reachable
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Boolean
    with Pre => Container.Has_Root;

    function All_Reachable
           (Container : in Parse_Graph)
        return Boolean
    with Pre => Container.Has_Root;

    function Valid_Token
           (Fin_Token : in Traits.Tokens.Finished_Token_Type)
        return Boolean;

    function Valid_Starts_Finishes
           (Parent    : in Traits.Tokens.Finished_Token_Type;
            Subtokens : in Traits.Tokens.Finished_Token_Array)
        return Boolean
    with Pre => Subtokens'Length > 0;

    function Loops_Introduced
           (Container : in Parse_Graph;
            Parent    : in Traits.Tokens.Finished_Token_Type;
            Subtokens : in Traits.Tokens.Finished_Token_Array)
        return Boolean
    with Pre => Subtokens'Length > 0 and
            Valid_Starts_Finishes (Parent, Subtokens);

    function Is_Sorted
           (Finishes : in Traits.Tokens.Finish_Array)
        return Boolean;

    function Is_Sorted
           (Positions : in Traits.Tokens.Finished_Token_Array)
        return Boolean;

    function Is_Sorted
           (Groupings : in Token_Group_Array)
        return Boolean;

    function No_Duplicates
           (Finishes : in Traits.Tokens.Finish_Array)
        return Boolean;

    function No_Duplicates
           (Positions : in Traits.Tokens.Finished_Token_Array)
        return Boolean;

    function No_Duplicates
           (Groupings : in Token_Group_Array)
        return Boolean;




    procedure Include
           (Container : in out Parse_Graph;
            Token     : in     Traits.Tokens.Token_Type)
    with Post => Container.Contains (Token);

    procedure Connect
           (Container : in out Parse_Graph;
            Parent    : in     Traits.Tokens.Finished_Token_Type;
            Subtokens : in     Traits.Tokens.Finished_Token_Array)
    with Pre => Subtokens'Length > 0 and
            Valid_Starts_Finishes (Parent, Subtokens) and
            not Container.Loops_Introduced (Parent, Subtokens);

    procedure Prune
           (Container : in out Parse_Graph;
            Token     : in     Traits.Tokens.Token_Type)
    with Post => not Container.Contains (Token);

    procedure Prune
           (Container : in out Parse_Graph;
            Position  : in     Traits.Tokens.Finished_Token_Type)
    with Post => not Container.Contains (Position);

    procedure Prune
           (Container : in out Parse_Graph;
            Grouping  : in     Token_Group)
    with Post => not Container.Contains (Grouping);

    procedure Delete_Unreachable
           (Container : in out Parse_Graph)
    with Pre => Container.Has_Root,
        Post => Container.All_Reachable;




    function Has_Root
           (Container : in Parse_Graph)
        return Boolean;

    procedure Set_Root
           (Container : in out Parse_Graph;
            Tokens    : in     Traits.Tokens.Finished_Token_Array)
    with Pre => (for all F of Tokens => Container.Contains (F.Token)),
        Post => Container.Has_Root;

    procedure Clear_Root
           (Container : in out Parse_Graph)
    with Post => not Container.Has_Root;

    function Root_Elements
           (Container : in Parse_Graph)
        return Traits.Tokens.Finished_Token_Array
    with Pre => Container.Has_Root;




    function Finish_List
           (Container : in Parse_Graph;
            Token     : in Traits.Tokens.Token_Type)
        return Traits.Tokens.Finish_Array
    with Pre => Container.Contains (Token),
        Post => Is_Sorted (Finish_List'Result) and
            No_Duplicates (Finish_List'Result);

    function Is_Leaf
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Boolean
    with Pre => Container.Contains (Position);

    function Is_Branch
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Boolean
    with Pre => Container.Contains (Position);




    function Subgroups
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Token_Group_Array
    with Pre => Container.Contains (Position),
        Post => Is_Sorted (Subgroups'Result) and
            No_Duplicates (Subgroups'Result) and
            (for all G of Subgroups'Result => Finish (G) = Position.Finish);

    function First_Index
           (Grouping : in Token_Group)
        return Positive;

    function Last_Index
           (Grouping : in Token_Group)
        return Positive;

    function Length
           (Grouping : in Token_Group)
        return Ada.Containers.Count_Type;

    function Element
           (Grouping : in Token_Group;
            Index    : in Positive)
        return Traits.Tokens.Finished_Token_Type
    with Pre => Index in First_Index (Grouping) .. Last_Index (Grouping);

    function Elements
           (Grouping : in Token_Group)
        return Traits.Tokens.Finished_Token_Array
    with Post => Is_Sorted (Elements'Result) and
            Valid_Starts_Finishes (Parent (Grouping), Elements'Result);

    function Parent
           (Grouping : in Token_Group)
        return Traits.Tokens.Finished_Token_Type;

    function Finish
           (Grouping : in Token_Group)
        return Traits.Tokens.Finish_Type;




    --  An ambiguous graph means that either some node exists with multiple groups
    --  attached to it with the same Group_Finish value, or the root node has multiple
    --  groups of any Group_Finish value attached to it, or there are multiple
    --  root nodes.

    function Is_Root_Ambiguous
           (Container : in Parse_Graph)
        return Boolean
    with Pre => Container.Has_Root;

    function Is_Ambiguous
           (Container : in Parse_Graph)
        return Boolean;

    function Ambiguities
           (Container      : in     Parse_Graph;
            Ambiguous_Root :    out Boolean)
        return Traits.Tokens.Finished_Token_Array
    with Post => Is_Sorted (Ambiguities'Result) and
            No_Duplicates (Ambiguities'Result);




    function Isomorphic
           (Left, Right : in Parse_Graph)
        return Boolean
    with Pre => Left.Has_Root and Right.Has_Root;

    function Isomorphic_Subgraph
           (Left_Graph     : in Parse_Graph;
            Left_Position  : in Traits.Tokens.Finished_Token_Type;
            Right_Graph    : in Parse_Graph;
            Right_Position : in Traits.Tokens.Finished_Token_Type)
        return Boolean
    with Pre => Left_Graph.Contains (Left_Position) and
            Right_Graph.Contains (Right_Position);


private


    use type Traits.Label_Enum;
    use type Traits.Element_Type;
    use type Traits.Element_Array;




    type Node_ID_Type is new Positive;
    type Edge_ID_Type is new Positive;

    subtype Node_Label_Type is Traits.Tokens.Token_Type;

    subtype Group_ID_Type is Positive;

    type Edge_Label_Type is record
        Group_ID       : Group_ID_Type;
        Group_Finish   : Traits.Tokens.Finish_Type;
        Subnode_Finish : Traits.Tokens.Finish_Type;
    end record;




    function To_Node
           (Container : in Parse_Graph;
            Token     : in Traits.Tokens.Token_Type)
        return Node_ID_Type;

    function To_Node
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Node_ID_Type;

    function Locally_Reachable
           (Container : in Parse_Graph;
            Node      : in Node_ID_Type)
        return Boolean;




    --  This 'use type' is to avoid some ambiguities with "=" functions when
    --  instantiating the Base package.
    use type Traits.Tokens.Token_Type;

    package Base is new Directed_Graphs
       (Node_ID_Type    => Node_ID_Type,
        Edge_ID_Type    => Edge_ID_Type,
        Node_Label_Type => Node_Label_Type,
        Edge_Label_Type => Edge_Label_Type);





    package Finished_Token_Vectors is new Ada.Containers.Vectors
       (Index_Type   => Positive,
        Element_Type => Traits.Tokens.Finished_Token_Type,
        "="          => Traits.Tokens."=");

    function "<"
           (Left, Right : in Finished_Token_Vectors.Vector)
        return Boolean;

    type Token_Group is record
        Parent : Traits.Tokens.Finished_Token_Type;
        Elems  : Finished_Token_Vectors.Vector;
    end record;





    package Finish_Vectors is new Ada.Containers.Vectors
       (Index_Type   => Positive,
        Element_Type => Traits.Tokens.Finish_Type);

    package Finish_Sort is new Finish_Vectors.Generic_Sorting;

    package Node_Label_Maps is new Ada.Containers.Ordered_Maps
       (Key_Type     => Traits.Tokens.Token_Type,
        Element_Type => Node_ID_Type,
        "<"          => Traits.Tokens."<");

    type Parse_Graph is tagged record
        Internal_Graph : Base.Graph                    := Base.Empty_Graph;
        Root_Elems     : Finished_Token_Vectors.Vector := Finished_Token_Vectors.Empty_Vector;
        Label_Map      : Node_Label_Maps.Map           := Node_Label_Maps.Empty_Map;
    end record;




    --  should a lot of these actually be ordered sets instead?
    package Node_Vectors is new Ada.Containers.Vectors
       (Index_Type   => Positive,
        Element_Type => Node_ID_Type);

    package Group_ID_Vectors is new Ada.Containers.Vectors
       (Index_Type   => Positive,
        Element_Type => Group_ID_Type);

    package Token_Group_Vectors is new Ada.Containers.Vectors
       (Index_Type   => Positive,
        Element_Type => Token_Group);

    package Finished_Token_Sort is new
        Finished_Token_Vectors.Generic_Sorting ("<" => Traits.Tokens."<");
    package Token_Group_Sort is new Token_Group_Vectors.Generic_Sorting;

    package Group_Finished_Token_Maps is new Ada.Containers.Ordered_Maps
       (Key_Type     => Group_ID_Type,
        Element_Type => Finished_Token_Vectors.Vector,
        "="          => Finished_Token_Vectors."=");

    package Finish_Group_Maps is new Ada.Containers.Ordered_Maps
       (Key_Type     => Traits.Tokens.Finish_Type,
        Element_Type => Group_ID_Type);

    package Enum_Node_Maps is new Ada.Containers.Ordered_Maps
       (Key_Type     => Traits.Label_Enum,
        Element_Type => Node_Vectors.Vector,
        "="          => Node_Vectors."=");





    package Isomorph_Maps is new Ada.Containers.Ordered_Maps
       (Key_Type     => Traits.Tokens.Finished_Token_Type,
        Element_Type => Finished_Token_Vectors.Vector,
        "="          => Finished_Token_Vectors."=",
        "<"          => Traits.Tokens."<");

    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     Traits.Tokens.Finished_Token_Type;
            Right_Graph    : in     Parse_Graph;
            Right_Position : in     Traits.Tokens.Finished_Token_Type;
            Offset         : in     Integer;
            Mapping        : in out Isomorph_Maps.Map)
        return Boolean;




    Empty_Graph : constant Parse_Graph :=
       (Internal_Graph => Base.Empty_Graph,
        Root_Elems     => Finished_Token_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;
        with function "<" (Left, Right : in Base_Type) return Boolean is <>;
    function Sorted
           (Input : in Array_Type)
        return Boolean;

    generic
        type Base_Type is private;
        type Array_Type is array (Positive range <>) of Base_Type;
        with function "=" (Left, Right : in Base_Type) return Boolean is <>;
    function No_Dups
           (Input : in Array_Type)
        return Boolean;

    generic
        type Base_Type is private;
        type Array_Type is array (Positive range <>) of Base_Type;
        with package Type_Vectors is new Ada.Containers.Vectors
           (Index_Type   => Positive,
            Element_Type => Base_Type);
    function Vector_To_Array
           (Input : in Type_Vectors.Vector)
        return Array_Type;


end Packrat.Parse_Graphs;