diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/packrat-parsers.adb | 140 | ||||
| -rw-r--r-- | src/packrat-parsers.ads | 33 |
2 files changed, 146 insertions, 27 deletions
diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb index 8533b96..946bfdd 100644 --- a/src/packrat-parsers.adb +++ b/src/packrat-parsers.adb @@ -2,6 +2,7 @@ with + Packrat.Errors, System; @@ -119,7 +120,13 @@ package body Packrat.Parsers is return Result; end if; end if; + if My_Key.Start < Context.Current_Position then + raise Constraint_Error; + end if; Result := Actual (Context); + if Result.Status = Needs_More or Result.Status = Optional_More then + Context.Needs_More.Insert (My_Key.Start); + end if; if Context.Memotable.Contains (My_Key) then Context.Memotable.Replace (My_Key, Result); else @@ -306,6 +313,21 @@ package body Packrat.Parsers is + function Slide + (Input : in Traits.Element_Array; + Position : in Positive) + return Traits.Element_Array + is + subtype Slider is Traits.Element_Array + (Position .. Position + Input'Length - 1); + begin + return Slider (Input); + end Slide; + + + + + function Root (Input : in Traits.Element_Array; Context : in out Parser_Context; @@ -316,7 +338,10 @@ package body Packrat.Parsers is Index : Positive := 1; Root_Elems : Graphs.Finished_Token_Array (1 .. Integer (Salt.Results.Length)); begin - if Salt.Status /= Success then + if Salt.Status = Failure then + raise Parser_Error with Packrat.Errors.Encode + (Traits.Label_Enum'Image (Label), Start); + elsif Salt.Status /= Success then return (Status => Salt.Status); end if; for R of Salt.Results loop @@ -337,25 +362,89 @@ package body Packrat.Parsers is + procedure Tidy_Context + (Input : in Traits.Element_Array; + Context : in out Parser_Context) + is + Delete_Keys : Combo_Key_Vectors.Vector; + begin + if Context.Result_So_Far.Has_Root then + raise Constraint_Error; + end if; + Context.Needs_More.Clear; + Context.Leftrectable.Clear; + if not Context.Used_Before then + Context.Used_Before := True; + Context.Global_Start := Input'First; + Context.Current_Position := Input'First; + end if; + for C in Context.Memotable.Iterate loop + if Memotables.Element (C).Status = Optional_More or + Memotables.Element (C).Status = Needs_More + then + Delete_Keys.Append (Memotables.Key (C)); + end if; + end loop; + for K of Delete_Keys loop + Context.Memotable.Delete (K); + end loop; + end Tidy_Context; + + procedure Parse (Input : in Traits.Element_Array; Context : in out Parser_Context; - Result : out Graphs.Parse_Graph) - is + Result : out Graphs.Parse_Graph) is begin - -- to-do - null; + Tidy_Context (Input, Context); + Context.Allow_Incomplete := (Input'Length /= 0); + declare + use type Traits.Element_Array; + Real_Input : Traits.Element_Array := + (if Context.Pass_Forward.Is_Empty + then Slide (Input, Context.Current_Position) + else Context.Pass_Forward.Element & Input); + begin + if Root_Component (Real_Input, Context, Context.Global_Start).Status = Failure then + raise Parser_Error; + end if; + if Input'Length = 0 then + Result := Context.Result_So_Far; + Result.Delete_Unreachable; + return; + end if; + if not Context.Needs_More.Is_Empty then + Context.Current_Position := Context.Needs_More.First_Element; + Context.Pass_Forward.Replace_Element + (Real_Input (Context.Current_Position .. Real_Input'Last)); + else + Context.Current_Position := Real_Input'Last + 1; + Context.Pass_Forward.Clear; + end if; + end; end Parse; function Parse_Only (Input : in Traits.Element_Array; Context : in out Parser_Context) - return Graphs.Parse_Graph - is + return Graphs.Parse_Graph is begin - -- to-do - return Graphs.Empty_Graph; + Tidy_Context (Input, Context); + Context.Allow_Incomplete := False; + declare + use type Traits.Element_Array; + Real_Input : Traits.Element_Array := + (if Context.Pass_Forward.Is_Empty + then Slide (Input, Context.Current_Position) + else Context.Pass_Forward.Element & Input); + begin + if Root_Component (Real_Input, Context, Context.Global_Start).Status /= Success then + raise Parser_Error; + end if; + Context.Result_So_Far.Delete_Unreachable; + return Context.Result_So_Far; + end; end Parse_Only; @@ -364,9 +453,18 @@ package body Packrat.Parsers is Context : in out Parser_Context) return Graphs.Parse_Graph is + procedure My_Parse is new Parse (Root_Component); + Result : Graphs.Parse_Graph; begin - -- to-do - return Graphs.Empty_Graph; + loop + declare + Next_Input : Traits.Element_Array := Input.all; + begin + My_Parse (Next_Input, Context, Result); + exit when Next_Input'Length = 0; + end; + end loop; + return Result; end Parse_With; @@ -387,17 +485,20 @@ package body Packrat.Parsers is Current : Graphs.Finished_Token; Processed : Result_Sets.Set; begin - if Salt.Status /= Success then - return Salt; + if Salt.Status = Failure then + raise Parser_Error with Packrat.Errors.Encode + (Traits.Label_Enum'Image (Label), Start); end if; for R of Salt.Results loop Current := (Token => Traits.Tokens.Create (Label, Start, R.Value.Element), Finish => R.Finish); - if R.Tokens.Element'Length > 0 then - Context.Result_So_Far.Connect (Current, R.Tokens.Element); - else - Context.Result_So_Far.Include (Current.Token); + if Salt.Status = Success then + if R.Tokens.Element'Length > 0 then + Context.Result_So_Far.Connect (Current, R.Tokens.Element); + else + Context.Result_So_Far.Include (Current.Token); + end if; end if; Processed.Insert ((Finish => R.Finish, @@ -426,8 +527,9 @@ package body Packrat.Parsers is Salt : Combinator_Result := Combo (Input, Context, Start); Processed : Result_Sets.Set; begin - if Salt.Status /= Success then - return Salt; + if Salt.Status = Failure then + raise Parser_Error with Packrat.Errors.Encode + (Traits.Label_Enum'Image (Label), Start); end if; for R of Salt.Results loop Processed.Insert diff --git a/src/packrat-parsers.ads b/src/packrat-parsers.ads index 7ed2c89..6568238 100644 --- a/src/packrat-parsers.ads +++ b/src/packrat-parsers.ads @@ -7,6 +7,7 @@ with private with + Ada.Containers.Vectors, Ada.Containers.Ordered_Maps, Ada.Containers.Ordered_Sets, Ada.Containers.Indefinite_Holders; @@ -133,6 +134,7 @@ package Packrat.Parsers is return Combinator_Result; generic + Label : in Traits.Label_Enum; with function Combo (Input : in Traits.Element_Array; Context : in out Parser_Context; @@ -367,6 +369,10 @@ private (Left, Right : in Combo_Key) return Boolean; + package Combo_Key_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Combo_Key); + -- This is needed to avoid some issues with using non-anonymous -- access values in a generic subprogram instantiation. function To_Key @@ -411,8 +417,6 @@ private -- If there's anything in the Curtails, then Results should be empty -- and vice versa... union? - -- need to add an error string to percolate upwards for exceptions - -- need to add a record of the total length of input available when -- result was computed, to allow for knowing when to recompute -- optional_more/need_more results @@ -437,6 +441,9 @@ private + package Needs_Sets is new Ada.Containers.Ordered_Sets + (Element_Type => Positive); + package Memotables is new Ada.Containers.Ordered_Maps (Key_Type => Combo_Key, Element_Type => Combinator_Result); @@ -450,9 +457,10 @@ private type Parser_Context is record Result_So_Far : Graphs.Parse_Graph; - Position : Positive := 1; - Offset : Natural := 0; - Status : Result_Status := Success; + Used_Before : Boolean := False; + Global_Start : Positive := 1; + Current_Position : Positive := 1; + Needs_More : Needs_Sets.Set; Pass_Forward : Elem_Holds.Holder; Memotable : Memotables.Map; Leftrectable : Leftrectables.Map; @@ -461,9 +469,10 @@ private Empty_Context : constant Parser_Context := (Result_So_Far => Graphs.Empty_Graph, - Position => 1, - Offset => 0, - Status => Success, + Used_Before => False, + Global_Start => 1, + Current_Position => 1, + Needs_More => Needs_Sets.Empty_Set, Pass_Forward => Elem_Holds.Empty_Holder, Memotable => Memotables.Empty_Map, Leftrectable => Leftrectables.Empty_Map, @@ -555,6 +564,14 @@ private Allow : in Boolean); + + + function Slide + (Input : in Traits.Element_Array; + Position : in Positive) + return Traits.Element_Array; + + end Packrat.Parsers; |