From 3fa431a2268a11dec6fd82c8f9b59cc2d0af9a93 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Wed, 13 Jan 2021 18:31:27 +1100
Subject: Stamp/Ignore now Stamp/Discard/Ignore
---
example/calc.adb | 2 +-
example/sentence.adb | 2 +-
example/simple_calc.adb | 2 +-
src/packrat-lexers.adb | 4 ++--
src/packrat-lexers.ads | 2 +-
src/packrat-parsers.adb | 40 ++++++++++++++++++++++++++++++++++++++++
src/packrat-parsers.ads | 13 +++++++++++++
test/rat_tests-lexers.adb | 12 ++++++------
test/rat_tests-lexers.ads | 6 +++---
9 files changed, 68 insertions(+), 15 deletions(-)
diff --git a/example/calc.adb b/example/calc.adb
index 0dd0e71..e94aaf2 100644
--- a/example/calc.adb
+++ b/example/calc.adb
@@ -58,7 +58,7 @@ procedure Calc is
function Sat_Blank is new My_Rat.Lexers.Satisfy (Packrat.Utilities.Is_Whitespace);
function Many_Blank is new My_Rat.Lexers.Many (Sat_Blank, 1);
- function Whitespace is new My_Rat.Lexers.Ignore (Whitespace, Many_Blank);
+ function Whitespace is new My_Rat.Lexers.Discard (Whitespace, Many_Blank);
package Scanner is new My_Rat.Lexers.Scan_Once
((Whitespace'Access, Decimal'Access, Number'Access,
diff --git a/example/sentence.adb b/example/sentence.adb
index b6cded9..bd69e5b 100644
--- a/example/sentence.adb
+++ b/example/sentence.adb
@@ -34,7 +34,7 @@ procedure Sentence is
function Sat_Blank is new My_Rat.Lexers.Satisfy (Packrat.Utilities.Is_Whitespace);
function Many_Blank is new My_Rat.Lexers.Many (Sat_Blank, 1);
- function Whitespace is new My_Rat.Lexers.Ignore (Whitespace, Many_Blank);
+ function Whitespace is new My_Rat.Lexers.Discard (Whitespace, Many_Blank);
package Scanner is new My_Rat.Lexers.Scan_Once ((Word'Access, Whitespace'Access));
diff --git a/example/simple_calc.adb b/example/simple_calc.adb
index 4c85887..e1a66c1 100644
--- a/example/simple_calc.adb
+++ b/example/simple_calc.adb
@@ -47,7 +47,7 @@ procedure Simple_Calc is
function Sat_Blank is new My_Rat.Lexers.Satisfy (Packrat.Utilities.Is_Whitespace);
function Many_Blank is new My_Rat.Lexers.Many (Sat_Blank, 1);
- function Whitespace is new My_Rat.Lexers.Ignore (Whitespace, Many_Blank);
+ function Whitespace is new My_Rat.Lexers.Discard (Whitespace, Many_Blank);
package Scanner is new My_Rat.Lexers.Scan_Once
((Whitespace'Access, Number'Access, Operator'Access));
diff --git a/src/packrat-lexers.adb b/src/packrat-lexers.adb
index 3a51e1a..bf5d109 100644
--- a/src/packrat-lexers.adb
+++ b/src/packrat-lexers.adb
@@ -363,7 +363,7 @@ package body Packrat.Lexers is
end Stamp;
- function Ignore
+ function Discard
(Input : in Traits.Element_Array;
Context : in out Lexer_Context)
return Component_Result
@@ -402,7 +402,7 @@ package body Packrat.Lexers is
Context.Error_Labels.Clear;
return Component_Success;
- end Ignore;
+ end Discard;
diff --git a/src/packrat-lexers.ads b/src/packrat-lexers.ads
index 9fd61e2..ac0ba2b 100644
--- a/src/packrat-lexers.ads
+++ b/src/packrat-lexers.ads
@@ -143,7 +143,7 @@ package Packrat.Lexers is
(Input : in Traits.Element_Array;
Start : in Positive)
return Combinator_Result;
- function Ignore
+ function Discard
(Input : in Traits.Element_Array;
Context : in out Lexer_Context)
return Component_Result;
diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb
index e4fa97d..0ddd864 100644
--- a/src/packrat-parsers.adb
+++ b/src/packrat-parsers.adb
@@ -622,6 +622,46 @@ package body Packrat.Parsers is
end Stamp;
+ function Discard
+ (Input : in Traits.Element_Array;
+ Context : in out Parser_Context;
+ Start : in Positive)
+ return Combinator_Result
+ is
+ function Actual
+ (Context : in out Parser_Context)
+ return Combinator_Result
+ is
+ Salt : Combinator_Result := Combo (Input, Context, Start);
+ Processed : Result_Sets.Set;
+ begin
+ if Salt.Status = Failure then
+ declare
+ Error : String := Packrat.Errors.Encode
+ (Traits.Label_Enum'Image (Label), Start);
+ begin
+ if Ada.Strings.Unbounded.Index (Context.Error_String, Error) = 0 then
+ Ada.Strings.Unbounded.Append (Context.Error_String, Error);
+ end if;
+ end;
+ return Salt;
+ end if;
+ for R of Salt.Results loop
+ Processed.Include
+ ((Finish => R.Finish,
+ Value => Elem_Holds.Empty_Holder,
+ Tokens => Tok_Holds.Empty_Holder));
+ end loop;
+ Salt.Results := Processed;
+ return Salt;
+ end Actual;
+ function Memo is new Memoize (To_Key (Start, Discard'Access), Actual);
+ function Curt is new Curtailment (To_Key (Start, Discard'Access), Input, Memo);
+ begin
+ return Curt (Context);
+ end Discard;
+
+
function Ignore
(Input : in Traits.Element_Array;
Context : in out Parser_Context;
diff --git a/src/packrat-parsers.ads b/src/packrat-parsers.ads
index e11d623..1e058dc 100644
--- a/src/packrat-parsers.ads
+++ b/src/packrat-parsers.ads
@@ -115,6 +115,19 @@ package Packrat.Parsers is
Start : in Positive)
return Combinator_Result;
+ generic
+ Label : in Traits.Label_Enum;
+ with function Combo
+ (Input : in Traits.Element_Array;
+ Context : in out Parser_Context;
+ Start : in Positive)
+ return Combinator_Result;
+ function Discard
+ (Input : in Traits.Element_Array;
+ Context : in out Parser_Context;
+ Start : in Positive)
+ return Combinator_Result;
+
generic
with function Combo
(Input : in Traits.Element_Array;
diff --git a/test/rat_tests-lexers.adb b/test/rat_tests-lexers.adb
index 17fd20f..15a5d6f 100644
--- a/test/rat_tests-lexers.adb
+++ b/test/rat_tests-lexers.adb
@@ -582,13 +582,13 @@ package body Rat_Tests.Lexers is
end Stamp_Check;
- function Ignore_Check
+ function Discard_Check
return Test_Result
is
use type Packrat.Result_Status;
function Match_Abc is new Slexy.Multimatch ("abc");
- function My_Ignore is new Slexy.Ignore (Two, Match_Abc);
+ function My_Discard is new Slexy.Discard (Two, Match_Abc);
Test_Str1 : String := "abcdefghi";
Test_Str2 : String := "ab";
@@ -598,21 +598,21 @@ package body Rat_Tests.Lexers is
Comp_Code : Slexy.Component_Result;
begin
- Comp_Code := My_Ignore (Test_Str1, Context1);
+ Comp_Code := My_Discard (Test_Str1, Context1);
if Slebug.So_Far (Context1).Length /= 0 or
Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or
Slebug.Has_Pass (Context1)
then
return Fail;
end if;
- Comp_Code := My_Ignore (Test_Str1, Context1);
+ Comp_Code := My_Discard (Test_Str1, Context1);
if Slebug.So_Far (Context1).Length /= 0 or
Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or
Slebug.Has_Pass (Context1)
then
return Fail;
end if;
- Comp_Code := My_Ignore (Test_Str2, Context2);
+ Comp_Code := My_Discard (Test_Str2, Context2);
if Slebug.So_Far (Context2).Length /= 0 or
Slebug.Position (Context2) /= 1 or Slebug.Status (Context2) /= Packrat.Needs_More or
(not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab")
@@ -620,7 +620,7 @@ package body Rat_Tests.Lexers is
return Fail;
end if;
return Pass;
- end Ignore_Check;
+ end Discard_Check;
diff --git a/test/rat_tests-lexers.ads b/test/rat_tests-lexers.ads
index 23d18d2..af9b221 100644
--- a/test/rat_tests-lexers.ads
+++ b/test/rat_tests-lexers.ads
@@ -62,7 +62,7 @@ package Rat_Tests.Lexers is
function Stamp_Check return Test_Result;
- function Ignore_Check return Test_Result;
+ function Discard_Check return Test_Result;
function Scan_Parts_Check return Test_Result;
function Scan_Once_Check return Test_Result;
@@ -78,7 +78,7 @@ package Rat_Tests.Lexers is
Lexer_Tests : Test_Array :=
((+"Stamp", Stamp_Check'Access),
- (+"Ignore", Ignore_Check'Access),
+ (+"Discard", Discard_Check'Access),
(+"Scan_Parts", Scan_Parts_Check'Access),
(+"Scan_Once", Scan_Once_Check'Access),
(+"Scan_With", Scan_With_Check'Access),
@@ -123,7 +123,7 @@ private
function Many_Whitespace is new Swordy.Many (Satisfy_Whitespace, 1);
function Stamp_Word is new Swordy.Stamp (Word, Many_Letter);
- function Ignore_Whitespace is new Swordy.Ignore (Whitespace, Many_Whitespace);
+ function Ignore_Whitespace is new Swordy.Discard (Whitespace, Many_Whitespace);
end Rat_Tests.Lexers;
--
cgit