summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/packrat-parsers.adb370
-rw-r--r--src/packrat-parsers.ads89
2 files changed, 385 insertions, 74 deletions
diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb
index 955c5cc..fcc69b8 100644
--- a/src/packrat-parsers.adb
+++ b/src/packrat-parsers.adb
@@ -9,7 +9,7 @@ package body Packrat.Parsers is
function "<"
- (Left, Right : in Elem_Array_Holders.Holder)
+ (Left, Right : in Elem_Holds.Holder)
return Boolean
is
use Traits;
@@ -19,7 +19,7 @@ package body Packrat.Parsers is
function "<"
- (Left, Right : in Token_Array_Holders.Holder)
+ (Left, Right : in Tok_Holds.Holder)
return Boolean
is
use Traits.Tokens;
@@ -44,7 +44,7 @@ package body Packrat.Parsers is
(Left, Right : in Combo_Result_Part)
return Boolean
is
- use type Elem_Array_Holders.Holder;
+ use type Elem_Holds.Holder;
begin
if Left.Finish = Right.Finish then
if Left.Value = Right.Value then
@@ -71,6 +71,129 @@ package body Packrat.Parsers is
+ function To_Key
+ (Start : in Positive;
+ Func : access function
+ (Input : in Traits.Element_Array;
+ Context : in out Parser_Context;
+ Start : in Positive)
+ return Combinator_Result)
+ return Combo_Key is
+ begin
+ return (Start => Start, Func => Func);
+ end To_Key;
+
+
+
+
+
+ function Reusable
+ (Result : in Combinator_Result;
+ Position : in Positive;
+ Leftrecs : in Leftrectables.Map)
+ return Boolean
+ is
+ Working_Key : Combo_Key;
+ begin
+ for Cursor in Result.Curtails.Iterate loop
+ Working_Key := To_Key (Position, Curtail_Maps.Key (Cursor));
+ if Leftrecs.Contains (Working_Key) and then
+ Curtail_Maps.Element (Cursor) > Leftrecs.Element (Working_Key)
+ then
+ return False;
+ end if;
+ end loop;
+ return True;
+ end Reusable;
+
+
+ function Memoize
+ (Context : in out Parser_Context)
+ return Combinator_Result
+ is
+ Result : Combinator_Result;
+ begin
+ if Context.Memotable.Contains (My_Key) then
+ Result := Context.Memotable.Element (My_Key);
+ if Reusable (Result, My_Key.Start, Context.Leftrectable) then
+ return Result;
+ end if;
+ end if;
+ Result := Actual (Context);
+ if Context.Memotable.Contains (My_Key) then
+ Context.Memotable.Replace (My_Key, Result);
+ else
+ Context.Memotable.Insert (My_Key, Result);
+ end if;
+ return Result;
+ end Memoize;
+
+
+
+
+
+ procedure Inc_Leftrec
+ (Key : in Combo_Key;
+ Context : in out Parser_Context) is
+ begin
+ if Context.Leftrectable.Contains (Key) then
+ Context.Leftrectable.Replace (Key, Context.Leftrectable.Element (Key) + 1);
+ else
+ Context.Leftrectable.Insert (Key, 1);
+ end if;
+ end Inc_Leftrec;
+
+
+ procedure Dec_Leftrec
+ (Key : in Combo_Key;
+ Context : in out Parser_Context) is
+ begin
+ if Context.Leftrectable.Contains (Key) then
+ if Context.Leftrectable.Element (Key) = 1 then
+ Context.Leftrectable.Delete (Key);
+ else
+ Context.Leftrectable.Replace (Key, Context.Leftrectable.Element (Key) - 1);
+ end if;
+ end if;
+ end Dec_Leftrec;
+
+
+ function Exceeds_Curtail
+ (Key : in Combo_Key;
+ Context : in Parser_Context;
+ Input : in Traits.Element_Array)
+ return Boolean is
+ begin
+ return Context.Leftrectable.Contains (Key) and then
+ Context.Leftrectable.Element (Key) > Input'Last - (Key.Start - 1) + 1;
+ end Exceeds_Curtail;
+
+
+ function Curtailment
+ (Context : in out Parser_Context)
+ return Combinator_Result
+ is
+ My_Result : Combinator_Result;
+ My_Curtails : Curtail_Maps.Map;
+ begin
+ Inc_Leftrec (My_Key, Context);
+ if Exceeds_Curtail (My_Key, Context, Input) then
+ My_Curtails.Insert (My_Key.Func, Context.Leftrectable.Element (My_Key));
+ My_Result :=
+ (Results => Result_Sets.Empty_Set,
+ Curtails => My_Curtails,
+ Status => Failure);
+ else
+ My_Result := Actual (Context);
+ end if;
+ Dec_Leftrec (My_Key, Context);
+ return My_Result;
+ end Curtailment;
+
+
+
+
+
function Root
(Input : in Traits.Element_Array;
Context : in out Parser_Context;
@@ -78,6 +201,7 @@ package body Packrat.Parsers is
return Component_Result
is
begin
+ -- to-do
return (Status => Failure);
end Root;
@@ -91,6 +215,7 @@ package body Packrat.Parsers is
Result : out Graphs.Parse_Graph)
is
begin
+ -- to-do
null;
end Parse;
@@ -101,6 +226,7 @@ package body Packrat.Parsers is
return Graphs.Parse_Graph
is
begin
+ -- to-do
return Graphs.Empty_Graph;
end Parse_Only;
@@ -111,6 +237,7 @@ package body Packrat.Parsers is
return Graphs.Parse_Graph
is
begin
+ -- to-do
return Graphs.Empty_Graph;
end Parse_With;
@@ -125,6 +252,7 @@ package body Packrat.Parsers is
return Combinator_Result
is
begin
+ -- to-do
return
(Results => Result_Sets.Empty_Set,
Curtails => Curtail_Maps.Empty_Map,
@@ -139,6 +267,7 @@ package body Packrat.Parsers is
return Combinator_Result
is
begin
+ -- to-do
return
(Results => Result_Sets.Empty_Set,
Curtails => Curtail_Maps.Empty_Map,
@@ -156,6 +285,7 @@ package body Packrat.Parsers is
return Combinator_Result
is
begin
+ -- to-do
return
(Results => Result_Sets.Empty_Set,
Curtails => Curtail_Maps.Empty_Map,
@@ -170,6 +300,7 @@ package body Packrat.Parsers is
return Combinator_Result
is
begin
+ -- to-do
return
(Results => Result_Sets.Empty_Set,
Curtails => Curtail_Maps.Empty_Map,
@@ -184,6 +315,7 @@ package body Packrat.Parsers is
return Combinator_Result
is
begin
+ -- to-do
return
(Results => Result_Sets.Empty_Set,
Curtails => Curtail_Maps.Empty_Map,
@@ -198,6 +330,7 @@ package body Packrat.Parsers is
return Combinator_Result
is
begin
+ -- to-do
return
(Results => Result_Sets.Empty_Set,
Curtails => Curtail_Maps.Empty_Map,
@@ -212,6 +345,7 @@ package body Packrat.Parsers is
return Combinator_Result
is
begin
+ -- to-do
return
(Results => Result_Sets.Empty_Set,
Curtails => Curtail_Maps.Empty_Map,
@@ -228,11 +362,26 @@ package body Packrat.Parsers is
Start : in Positive)
return Combinator_Result
is
+ use type Traits.Element_Type;
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result is
+ begin
+ if Start > Input'Last or else not Test (Input (Start)) then
+ return Empty_Fail;
+ else
+ return
+ (Results => Result_Sets.To_Set
+ ((Finish => Start,
+ Value => Elem_Holds.To_Holder (Input (Start .. Start)),
+ Tokens => Tok_Holds.Empty_Holder)),
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => Success);
+ end if;
+ end Actual;
+ function Call is new Memoize (To_Key (Start, Satisfy'Access), Actual);
begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
+ return Call (Context);
end Satisfy;
@@ -242,11 +391,26 @@ package body Packrat.Parsers is
Start : in Positive)
return Combinator_Result
is
+ use type Traits.Element_Type;
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result is
+ begin
+ if Start > Input'Last or else not Test (Change (Input (Start))) then
+ return Empty_Fail;
+ else
+ return
+ (Results => Result_Sets.To_Set
+ ((Finish => Start,
+ Value => Elem_Holds.To_Holder (Input (Start .. Start)),
+ Tokens => Tok_Holds.Empty_Holder)),
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => Success);
+ end if;
+ end Actual;
+ function Call is new Memoize (To_Key (Start, Satisfy_With'Access), Actual);
begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
+ return Call (Context);
end Satisfy_With;
@@ -256,11 +420,26 @@ package body Packrat.Parsers is
Start : in Positive)
return Combinator_Result
is
+ use type Traits.Element_Type;
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result is
+ begin
+ if Start > Input'Last or else Input (Start) /= Item then
+ return Empty_Fail;
+ else
+ return
+ (Results => Result_Sets.To_Set
+ ((Finish => Start,
+ Value => Elem_Holds.To_Holder (Input (Start .. Start)),
+ Tokens => Tok_Holds.Empty_Holder)),
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => Success);
+ end if;
+ end Actual;
+ function Call is new Memoize (To_Key (Start, Match'Access), Actual);
begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
+ return Call (Context);
end Match;
@@ -270,11 +449,26 @@ package body Packrat.Parsers is
Start : in Positive)
return Combinator_Result
is
+ use type Traits.Element_Type;
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result is
+ begin
+ if Start > Input'Last or else Change (Input (Start)) /= Item then
+ return Empty_Fail;
+ else
+ return
+ (Results => Result_Sets.To_Set
+ ((Finish => Start,
+ Value => Elem_Holds.To_Holder (Input (Start .. Start)),
+ Tokens => Tok_Holds.Empty_Holder)),
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => Success);
+ end if;
+ end Actual;
+ function Call is new Memoize (To_Key (Start, Match_With'Access), Actual);
begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
+ return Call (Context);
end Match_With;
@@ -284,11 +478,35 @@ package body Packrat.Parsers is
Start : in Positive)
return Combinator_Result
is
+ use type Traits.Element_Array;
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result
+ is
+ My_Offset : Natural;
+ begin
+ if Start > Input'Last then
+ return Empty_Fail;
+ elsif Items'Length = 0 then
+ return Empty (Input, Context, Start);
+ end if;
+ My_Offset := Natural'Min (Input'Last - Start, Items'Length - 1);
+ if Input (Start .. Start + My_Offset) /=
+ Items (Items'First .. Items'First + My_Offset)
+ then
+ return Empty_Fail;
+ end if;
+ return
+ (Results => Result_Sets.To_Set
+ ((Finish => Start + My_Offset,
+ Value => Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)),
+ Tokens => Tok_Holds.Empty_Holder)),
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => (if My_Offset < Items'Length - 1 then Needs_More else Success));
+ end Actual;
+ function Call is new Memoize (To_Key (Start, Multimatch'Access), Actual);
begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
+ return Call (Context);
end Multimatch;
@@ -298,11 +516,27 @@ package body Packrat.Parsers is
Start : in Positive)
return Combinator_Result
is
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result
+ is
+ My_Offset : Natural;
+ begin
+ if Start > Input'Last then
+ return Empty_Fail;
+ end if;
+ My_Offset := Natural'Min (Input'Last - Start, Number - 1);
+ return
+ (Results => Result_Sets.To_Set
+ ((Finish => Start + My_Offset,
+ Value => Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)),
+ Tokens => Tok_Holds.Empty_Holder)),
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => (if My_Offset < Number - 1 then Needs_More else Success));
+ end Actual;
+ function Call is new Memoize (To_Key (Start, Take'Access), Actual);
begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
+ return Call (Context);
end Take;
@@ -312,11 +546,30 @@ package body Packrat.Parsers is
Start : in Positive)
return Combinator_Result
is
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result
+ is
+ My_Finish : Positive := Start;
+ begin
+ if Start > Input'Last or else not Test (Input (Start)) then
+ return Empty_Fail;
+ end if;
+ while My_Finish <= Input'Last and then Test (Input (My_Finish)) loop
+ My_Finish := My_Finish + 1;
+ end loop;
+ My_Finish := My_Finish - 1;
+ return
+ (Results => Result_Sets.To_Set
+ ((Finish => My_Finish,
+ Value => Elem_Holds.To_Holder (Input (Start .. My_Finish)),
+ Tokens => Tok_Holds.Empty_Holder)),
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => (if My_Finish = Input'Last then Optional_More else Success));
+ end Actual;
+ function Call is new Memoize (To_Key (Start, Take_While'Access), Actual);
begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
+ return Call (Context);
end Take_While;
@@ -326,43 +579,50 @@ package body Packrat.Parsers is
Start : in Positive)
return Combinator_Result
is
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result
+ is
+ My_Finish : Positive := Start;
+ begin
+ if Start > Input'Last or else Test (Input (Start)) then
+ return Empty_Fail;
+ end if;
+ while My_Finish <= Input'Last and then not Test (Input (My_Finish)) loop
+ My_Finish := My_Finish + 1;
+ end loop;
+ My_Finish := My_Finish - 1;
+ return
+ (Results => Result_Sets.To_Set
+ ((Finish => My_Finish,
+ Value => Elem_Holds.To_Holder (Input (Start .. My_Finish)),
+ Tokens => Tok_Holds.Empty_Holder)),
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => (if My_Finish = Input'Last then Optional_More else Success));
+ end Actual;
+ function Call is new Memoize (To_Key (Start, Take_Until'Access), Actual);
begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
+ return Call (Context);
end Take_Until;
- function Line_End
+ function Empty
(Input : in Traits.Element_Array;
Context : in out Parser_Context;
Start : in Positive)
- return Combinator_Result
- is
+ return Combinator_Result is
begin
return
- (Results => Result_Sets.Empty_Set,
+ (Results => Result_Sets.To_Set
+ ((Finish => Start - 1,
+ Value => Elem_Holds.Empty_Holder,
+ Tokens => Tok_Holds.Empty_Holder)),
Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
- end Line_End;
-
-
- function Input_End
- (Input : in Traits.Element_Array;
- Context : in out Parser_Context;
- Start : in Positive)
- return Combinator_Result
- is
- begin
- return
- (Results => Result_Sets.Empty_Set,
- Curtails => Curtail_Maps.Empty_Map,
- Status => Failure);
- end Input_End;
+ Status => Success);
+ end Empty;
end Packrat.Parsers;
diff --git a/src/packrat-parsers.ads b/src/packrat-parsers.ads
index 8a0f39c..55cb12a 100644
--- a/src/packrat-parsers.ads
+++ b/src/packrat-parsers.ads
@@ -289,17 +289,7 @@ package Packrat.Parsers is
- generic
- EOL_Item : in Traits.Element_Type;
- function Line_End
- (Input : in Traits.Element_Array;
- Context : in out Parser_Context;
- Start : in Positive)
- return Combinator_Result;
-
- generic
- EOF_Item : in Traits.Element_Type;
- function Input_End
+ function Empty
(Input : in Traits.Element_Array;
Context : in out Parser_Context;
Start : in Positive)
@@ -325,20 +315,20 @@ private
-- for a given combinator/position
- package Elem_Array_Holders is new Ada.Containers.Indefinite_Holders
+ package Elem_Holds is new Ada.Containers.Indefinite_Holders
(Element_Type => Traits.Element_Array,
"=" => Traits."=");
- package Token_Array_Holders is new Ada.Containers.Indefinite_Holders
+ package Tok_Holds is new Ada.Containers.Indefinite_Holders
(Element_Type => Traits.Tokens.Token_Array,
"=" => Traits.Tokens."=");
function "<"
- (Left, Right : in Elem_Array_Holders.Holder)
+ (Left, Right : in Elem_Holds.Holder)
return Boolean;
function "<"
- (Left, Right : in Token_Array_Holders.Holder)
+ (Left, Right : in Tok_Holds.Holder)
return Boolean;
@@ -353,13 +343,24 @@ private
(Left, Right : in Combo_Key)
return Boolean;
+ -- This is needed to avoid some issues with using non-anonymous
+ -- access values in a generic subprogram instantiation.
+ function To_Key
+ (Start : in Positive;
+ Func : access function
+ (Input : in Traits.Element_Array;
+ Context : in out Parser_Context;
+ Start : in Positive)
+ return Combinator_Result)
+ return Combo_Key;
+
type Combo_Result_Part is record
Finish : Natural;
- Value : Elem_Array_Holders.Holder;
- Tokens : Token_Array_Holders.Holder;
+ Value : Elem_Holds.Holder;
+ Tokens : Tok_Holds.Holder;
end record;
function "<"
@@ -395,6 +396,11 @@ private
Status : Result_Status;
end record;
+ Empty_Fail : constant Combinator_Result :=
+ (Results => Result_Sets.Empty_Set,
+ Curtails => Curtail_Maps.Empty_Map,
+ Status => Failure);
+
@@ -414,7 +420,7 @@ private
Position : Positive := 1;
Offset : Natural := 0;
Status : Result_Status := Success;
- Pass_Forward : Elem_Array_Holders.Holder;
+ Pass_Forward : Elem_Holds.Holder;
Memotable : Memotables.Map;
Leftrectable : Leftrectables.Map;
Allow_Incomplete : Boolean := True;
@@ -425,12 +431,57 @@ private
Position => 1,
Offset => 0,
Status => Success,
- Pass_Forward => Elem_Array_Holders.Empty_Holder,
+ Pass_Forward => Elem_Holds.Empty_Holder,
Memotable => Memotables.Empty_Map,
Leftrectable => Leftrectables.Empty_Map,
Allow_Incomplete => True);
+
+
+ function Reusable
+ (Result : in Combinator_Result;
+ Position : in Positive;
+ Leftrecs : in Leftrectables.Map)
+ return Boolean;
+
+ generic
+ My_Key : in Combo_Key;
+ with function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result;
+ function Memoize
+ (Context : in out Parser_Context)
+ return Combinator_Result;
+
+
+
+
+ procedure Inc_Leftrec
+ (Key : in Combo_Key;
+ Context : in out Parser_Context);
+
+ procedure Dec_Leftrec
+ (Key : in Combo_Key;
+ Context : in out Parser_Context);
+
+ function Exceeds_Curtail
+ (Key : in Combo_Key;
+ Context : in Parser_Context;
+ Input : in Traits.Element_Array)
+ return Boolean;
+
+ generic
+ My_Key : in Combo_Key;
+ Input : in Traits.Element_Array;
+ with function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result;
+ function Curtailment
+ (Context : in out Parser_Context)
+ return Combinator_Result;
+
+
end Packrat.Parsers;