summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2020-12-03 15:48:43 +1100
committerJed Barber <jjbarber@y7mail.com>2020-12-03 15:48:43 +1100
commit393870127fe767a0359182ccf80ee9fb48573f97 (patch)
treed7b8199a1bc904125d46afb30450fb70a5a24982
parent698f793f34436e9c27d969b6d838aa96336f04f4 (diff)
Main parse functions implemented
-rw-r--r--src/packrat-parsers.adb140
-rw-r--r--src/packrat-parsers.ads33
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;