path: root/src/packrat.ads

with

    Ada.Strings.Unbounded,
    Ada.Finalization;


package Packrat is


    type Result_Status is (Failure, Needs_More, Optional_More, Success);


    Parser_Error : exception;
    Lexer_Error  : exception;




    package Errors is


        subtype Error_Message is String
            with Dynamic_Predicate => Valid_Message (Error_Message);

        type Error_Info is record
            Symbol   : Ada.Strings.Unbounded.Unbounded_String;
            Position : Natural;
        end record;

        type Error_Info_Array is array (Positive range <>) of Error_Info;


        --  Note: No consideration is given to ordering of Error_Info items
        --        encoded into an Error_Message string.

        --  Note: Using "&" to join two Valid Error_Messages together
        --        will result in an Error_Message that is also Valid,
        --        but for best results Join should be used instead to
        --        prevent duplication of Error_Info in the message.


        function Valid_Identifier
               (Check : in String)
            return Boolean;

        function Valid_Identifier
               (Check : in Ada.Strings.Unbounded.Unbounded_String)
            return Boolean;

        function Valid_Identifier_Array
               (Check : in Error_Info_Array)
            return Boolean;

        function Valid_Message
               (Check : in String)
            return Boolean;

        function Debug_String
               (This : in Error_Message)
            return String;


        function Join
               (Left, Right : in Error_Message)
            return Error_Message;


        function Encode
               (Name : in String;
                Pos  : in Natural)
            return Error_Message
            with Pre => Valid_Identifier (Name);

        function Encode
               (Name : in Ada.Strings.Unbounded.Unbounded_String;
                Pos  : in Natural)
            return Error_Message
            with Pre => Valid_Identifier (Name);

        function Encode
               (Info : in Error_Info)
            return Error_Message
            with Pre => Valid_Identifier (Info.Symbol);

        function Encode_Array
               (Info : in Error_Info_Array)
            return Error_Message
            with Pre => Valid_Identifier_Array (Info);

        function Decode
               (Msg : in Error_Message)
            return Error_Info_Array;


    end Errors;




    generic
        type Label_Enum is (<>);
        type Element is private;
        type Element_Array is array (Positive range <>) of Element;
    package Tokens is


        type Token is new Ada.Finalization.Controlled with private;
        type Token_Array is array (Positive range <>) of Token;


        function Create
               (Ident  : in Label_Enum;
                Start  : in Positive;
                Finish : in Natural;
                Value  : in Element_Array)
            return Token;

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


        --  Note: The Start and Finish indices indicate where the token was found
        --        in whatever array it was lexed from. The Value does *not* have
        --        to correspond with whatever is found in the Start .. Finish range.


        function Initialized
               (This : in Token)
            return Boolean;

        function Debug_String
               (This : in Token)
            return String;


        function Label
               (This : in Token)
            return Label_Enum
            with Pre => Initialized (This);

        function Start
               (This : in Token)
            return Positive;

        function Finish
               (This : in Token)
            return Natural;

        function Value
               (This : in Token)
            return Element_Array
            with Pre => Initialized (This);


    private


        type Element_Array_Access is access Element_Array;


        type Token is new Ada.Finalization.Controlled with record
            Identifier  : Label_Enum;
            Start_At    : Positive;
            Finish_At   : Natural;
            Token_Value : Element_Array_Access;
        end record;


        overriding procedure Initialize
               (This : in out Token);

        overriding procedure Adjust
               (This : in out Token);

        overriding procedure Finalize
               (This : in out Token);


    end Tokens;




    generic
        type Label_Enum is (<>);
        type Element is private;
        type Element_Array is array (Positive range <>) of Element;
    package Interfaces is


        type Node is interface;


        function Leaf
               (New_Item : in Element_Array;
                Start    : in Positive;
                Finish   : in Natural)
            return Node is abstract
        with Pre'Class =>
                Finish + 1 >= Start,
            Post'Class =>
                Is_Leaf (Leaf'Result);

        function Branch
               (Label  : in Label_Enum;
                Start  : in Positive;
                Finish : in Natural)
            return Node is abstract
        with Pre'Class =>
                Finish + 1 >= Start,
            Post'Class =>
                Is_Branch (Branch'Result);


        function Is_Leaf
               (This : in Node)
            return Boolean is abstract;

        function Is_Branch
               (This : in Node)
            return Boolean is abstract;


        function Label
               (This : in Node)
            return Label_Enum is abstract
        with Pre'Class =>
                This.Is_Branch;

        function Elements
               (This : in Node)
            return Element_Array is abstract
        with Pre'Class =>
                This.Is_Leaf;

        function Start
               (This : in Node)
            return Positive is abstract;

        function Finish
               (This : in Node)
            return Natural is abstract;




        type Cursor is interface;


        function Is_Nothing
               (Position : in Cursor)
            return Boolean is abstract;


        function Depth
               (Position : in Cursor)
            return Natural is abstract
        with Pre'Class =>
                not Position.Is_Nothing;

        function Is_Node
               (Position : in Cursor)
            return Boolean is abstract
        with Post'Class =>
               (if Is_Node'Result then not Position.Is_Nothing);

        function Is_Root
               (Position : in Cursor)
            return Boolean is abstract
        with Post'Class =>
               (if Is_Root'Result then
                not Position.Is_Nothing and
                Position.Parent.Is_Nothing and
                Position.Depth = 0);

        function Is_Branch
               (Position : in Cursor)
            return Boolean is abstract
        with Post'Class =>
               (if Is_Branch'Result then not Position.Is_Nothing);

        function Is_Leaf
               (Position : in Cursor)
            return Boolean is abstract
        with Post'Class =>
               (if Is_Leaf'Result then not Position.Is_Nothing);


        function Label
               (Position : in Cursor)
            return Label_Enum is abstract
        with Pre'Class =>
                Position.Is_Branch;

        function Elements
               (Position : in Cursor)
            return Element_Array is abstract
        with Pre'Class =>
                Position.Is_Leaf;

        function Start
               (Position : in Cursor)
            return Positive is abstract
        with Pre'Class =>
                not Position.Is_Nothing;

        function Finish
               (Position : in Cursor)
            return Natural is abstract
        with Pre'Class =>
                not Position.Is_Nothing;

        function Choices
               (Position : in Cursor)
            return Natural is abstract;


        function Parent
               (Position : in Cursor)
            return Cursor is abstract;

        function Child_Count
               (Position : in Cursor;
                Choice   : in Positive)
            return Natural is abstract
        with Pre'Class =>
                Choice <= Position.Choices;

        function Child_Count
               (Position : in Cursor)
            return Natural is abstract;

        function All_Child_Count
               (Position : in Cursor)
            return Natural is abstract;

        function First_Child
               (Position : in Cursor;
                Choice   : in Positive)
            return Cursor is abstract
        with Pre'Class =>
                Choice <= Position.Choices,
            Post'Class =>
                First_Child'Result.Is_Nothing or
                First_Child'Result.Parent = Position;

        function Last_Child
               (Position : in Cursor;
                Choice   : in Positive)
            return Cursor is abstract
        with Pre'Class =>
                Choice <= Position.Choices,
            Post'Class =>
                Last_Child'Result.Is_Nothing or
                Last_Child'Result.Parent = Position;

        function First_Child
               (Position : in Cursor)
            return Cursor is abstract
        with Post'Class =>
                First_Child'Result.Is_Nothing or
                First_Child'Result.Parent = Position;

        function Last_Child
               (Position : in Cursor)
            return Cursor is abstract
        with Post'Class =>
                Last_Child'Result.Is_Nothing or
                Last_Child'Result.Parent = Position;

        function Next_Sibling
               (Position : in Cursor)
            return Cursor is abstract
        with Post'Class =>
                Next_Sibling'Result.Is_Nothing or
                Next_Sibling'Result.Parent = Position.Parent;

        function Prev_Sibling
               (Position : in Cursor)
            return Cursor is abstract
        with Post'Class =>
                Prev_Sibling'Result.Is_Nothing or
                Prev_Sibling'Result.Parent = Position.Parent;

        procedure Delete_Children
               (Position : in out Cursor;
                Choice   : in     Positive) is abstract
        with Pre'Class =>
                Choice <= Position.Choices,
            Post'Class =>
                Position.Child_Count (Choice) = 0;

        procedure Delete_Children
               (Position : in out Cursor) is abstract
        with Post'Class =>
                Position.Child_Count = 0;

        procedure Delete_All_Children
               (Position : in out Cursor) is abstract
        with Post'Class =>
                Position.All_Child_Count = 0;


        function Equal_Subgraph
               (Left, Right : in Cursor)
            return Boolean is abstract;

        function Subgraph_Node_Count
               (Position : in Cursor)
            return Natural is abstract;

        function Find_In_Subgraph
               (Position : in Cursor;
                Item     : in Element_Array)
            return Cursor is abstract
        with Post'Class =>
                Find_In_Subgraph'Result.Is_Nothing or
                Find_In_Subgraph'Result.Is_Leaf;




        type Graph is interface;


        function Contains
               (Container : in Graph;
                Position  : in Cursor'Class)
            return Boolean is abstract
        with Post'Class =>
               (if Contains'Result then not Position.Is_Nothing);


        function Singleton
               (Input : in Node'Class)
            return Graph is abstract
        with Post'Class =>
                Singleton'Result.Node_Count = 1;


        function Is_Empty
               (Container : in Graph)
            return Boolean is abstract
        with Post'Class =>
                (if Is_Empty'Result then Container.Node_Count = 0 else Container.Node_Count /= 0);

        function Is_Ambiguous
               (Container : in Graph)
            return Boolean is abstract;

        function Node_Count
               (Container : in Graph)
            return Natural is abstract;


        function Root_Count
               (Container : in Graph)
            return Natural is abstract
        with Post'Class =>
                (if Container.Is_Empty then Root_Count'Result = 0 else Root_Count'Result > 0);

        function Root
               (Container : in Graph;
                Index     : in Positive)
            return Cursor'Class is abstract
        with Pre'Class =>
                Index <= Container.Root_Count;


        procedure Append
               (Container : in out Graph;
                Addition  : in     Graph) is abstract
        with Pre'Class =>
                Container.Is_Empty or else Addition.Is_Empty or else
                Container.Root (Container.Root_Count).Finish <
                    Addition.Root (1).Start;

        procedure Prepend
               (Container : in out Graph;
                Addition  : in     Graph) is abstract
        with Pre'Class =>
                Container.Is_Empty or else Addition.Is_Empty or else
                Container.Root (1).Start >
                    Addition.Root (Addition.Root_Count).Finish;

        procedure Attach_Choice
               (Container : in out Graph;
                Position  : in     Cursor'Class;
                Addition  : in     Graph) is abstract
        with Pre'Class =>
                Container.Contains (Position) and Position.Is_Branch and
                (Addition.Is_Empty or else
                   (Position.Start <= Addition.Root (1).Start and
                    Position.Finish >= Addition.Root (Addition.Root_Count).Finish));


        procedure Clear
               (Container : in out Graph) is abstract
        with Post'Class =>
                Container.Is_Empty;

        procedure Delete_Position
               (Container : in out Graph;
                Position  : in out Cursor'Class) is abstract
        with Pre'Class =>
                Container.Contains (Position),
            Post'Class =>
                not Container.Contains (Position);


        function Find
               (Container : in Graph;
                Item      : in Element_Array)
            return Cursor'Class is abstract
        with Post'Class =>
                Find'Result.Is_Leaf or
                Find'Result.Is_Nothing;


    end Interfaces;




private


    function "+"
           (S : in String)
        return Ada.Strings.Unbounded.Unbounded_String
        renames Ada.Strings.Unbounded.To_Unbounded_String;

    function "-"
           (US : in Ada.Strings.Unbounded.Unbounded_String)
        return String
        renames Ada.Strings.Unbounded.To_String;


end Packrat;