summaryrefslogtreecommitdiff
path: root/example/sentence.adb
diff options
context:
space:
mode:
Diffstat (limited to 'example/sentence.adb')
-rw-r--r--example/sentence.adb120
1 files changed, 68 insertions, 52 deletions
diff --git a/example/sentence.adb b/example/sentence.adb
index bd69e5b..93379d7 100644
--- a/example/sentence.adb
+++ b/example/sentence.adb
@@ -24,81 +24,97 @@ procedure Sentence is
package My_Rat is new Packrat.Standard
(Lexer_Labels, Parser_Labels, Character, String);
+ use My_Rat;
- function Sat_Alpha is new My_Rat.Lexers.Satisfy (Packrat.Utilities.Is_Letter);
- function Many_Alpha is new My_Rat.Lexers.Many (Sat_Alpha, 1);
- function Word is new My_Rat.Lexers.Stamp (Word, Many_Alpha);
+ -- Lexer grammar to group letters into words and get rid of whitespace
- 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.Discard (Whitespace, Many_Blank);
+ function Sat_Alpha is new Lexers.Satisfy (Packrat.Utilities.Is_Letter);
+ function Many_Alpha is new Lexers.Many (Sat_Alpha, 1);
+ function Word is new Lexers.Stamp (Word, Many_Alpha);
- package Scanner is new My_Rat.Lexers.Scan_Once ((Word'Access, Whitespace'Access));
+ function Sat_Blank is new Lexers.Satisfy (Packrat.Utilities.Is_Whitespace);
+ function Many_Blank is new Lexers.Many (Sat_Blank, 1);
+ function Whitespace is new Lexers.Discard (Whitespace, Many_Blank);
+ package Scanner is new Lexers.Scan_Once ((Word'Access, Whitespace'Access));
- function Is_In is new My_Rat.Lexer_Tokens.Is_Value ("in");
- function Is_With is new My_Rat.Lexer_Tokens.Is_Value ("with");
- function Sat_In is new My_Rat.Parsers.Satisfy (Is_In);
- function Sat_With is new My_Rat.Parsers.Satisfy (Is_With);
- function Prep_Choice is new My_Rat.Parsers.Choice ((Sat_In'Access, Sat_With'Access));
- function Prep is new My_Rat.Parsers.Stamp (Prep, Prep_Choice);
- function Is_Saw is new My_Rat.Lexer_Tokens.Is_Value ("saw");
- function Sat_Saw is new My_Rat.Parsers.Satisfy (Is_Saw);
- function Verb is new My_Rat.Parsers.Stamp (Verb, Sat_Saw);
+ -- Parser grammar from page 2 of
+ -- Parser Combinators for Ambiguous Left-Recursive Grammars
+ -- (Richard A. Frost, Rahmatullah Hafiz, Paul Callaghan, 2008)
- function Is_I is new My_Rat.Lexer_Tokens.Is_Value ("i");
- function Is_Man is new My_Rat.Lexer_Tokens.Is_Value ("man");
- function Is_Park is new My_Rat.Lexer_Tokens.Is_Value ("park");
- function Is_Bat is new My_Rat.Lexer_Tokens.Is_Value ("bat");
- function Sat_I is new My_Rat.Parsers.Satisfy (Is_I);
- function Sat_Man is new My_Rat.Parsers.Satisfy (Is_Man);
- function Sat_Park is new My_Rat.Parsers.Satisfy (Is_Park);
- function Sat_Bat is new My_Rat.Parsers.Satisfy (Is_Bat);
- function Noun_Choice is new My_Rat.Parsers.Choice
+ -- s ::= np vp | s pp
+ -- np ::= noun | det noun | np pp
+ -- pp ::= prep np
+ -- vp ::= verb np
+ -- det ::= "a" | "the"
+ -- noun ::= "i" | "man" | "park" | "bat"
+ -- verb ::= "saw"
+ -- prep ::= "in" | "with"
+
+ function Is_In is new Lexer_Tokens.Is_Value ("in");
+ function Is_With is new Lexer_Tokens.Is_Value ("with");
+ function Sat_In is new Parsers.Satisfy (Is_In);
+ function Sat_With is new Parsers.Satisfy (Is_With);
+ function Prep_Choice is new Parsers.Choice_2 (Sat_In, Sat_With);
+ function Prep is new Parsers.Stamp (Prep, Prep_Choice);
+
+ function Is_Saw is new Lexer_Tokens.Is_Value ("saw");
+ function Sat_Saw is new Parsers.Satisfy (Is_Saw);
+ function Verb is new Parsers.Stamp (Verb, Sat_Saw);
+
+ function Is_I is new Lexer_Tokens.Is_Value ("i");
+ function Is_Man is new Lexer_Tokens.Is_Value ("man");
+ function Is_Park is new Lexer_Tokens.Is_Value ("park");
+ function Is_Bat is new Lexer_Tokens.Is_Value ("bat");
+ function Sat_I is new Parsers.Satisfy (Is_I);
+ function Sat_Man is new Parsers.Satisfy (Is_Man);
+ function Sat_Park is new Parsers.Satisfy (Is_Park);
+ function Sat_Bat is new Parsers.Satisfy (Is_Bat);
+ function Noun_Choice is new Parsers.Choice
((Sat_I'Access, Sat_Man'Access, Sat_Park'Access, Sat_Bat'Access));
- function Noun is new My_Rat.Parsers.Stamp (Noun, Noun_Choice);
+ function Noun is new Parsers.Stamp (Noun, Noun_Choice);
- function Is_A is new My_Rat.Lexer_Tokens.Is_Value ("a");
- function Is_The is new My_Rat.Lexer_Tokens.Is_Value ("the");
- function Sat_A is new My_Rat.Parsers.Satisfy (Is_A);
- function Sat_The is new My_Rat.Parsers.Satisfy (Is_The);
- function Det_Choice is new My_Rat.Parsers.Choice ((Sat_A'Access, Sat_The'Access));
- function Det is new My_Rat.Parsers.Stamp (Det, Det_Choice);
+ function Is_A is new Lexer_Tokens.Is_Value ("a");
+ function Is_The is new Lexer_Tokens.Is_Value ("the");
+ function Sat_A is new Parsers.Satisfy (Is_A);
+ function Sat_The is new Parsers.Satisfy (Is_The);
+ function Det_Choice is new Parsers.Choice_2 (Sat_A, Sat_The);
+ function Det is new Parsers.Stamp (Det, Det_Choice);
-- These redirectors are needed to resolve circular references in the instantiations.
- package NP_Redir is new My_Rat.Parsers.Redirect;
- package S_Redir is new My_Rat.Parsers.Redirect;
+ package NP_Redir is new Parsers.Redirect;
+ package S_Redir is new Parsers.Redirect;
- function VP_Seq is new My_Rat.Parsers.Sequence ((Verb'Access, NP_Redir.Call'Access));
- function VP is new My_Rat.Parsers.Stamp (VP, VP_Seq);
+ function VP_Seq is new Parsers.Sequence_2 (Verb, NP_Redir.Call);
+ function VP is new Parsers.Stamp (VP, VP_Seq);
- function PP_Seq is new My_Rat.Parsers.Sequence ((Prep'Access, NP_Redir.Call'Access));
- function PP is new My_Rat.Parsers.Stamp (PP, PP_Seq);
+ function PP_Seq is new Parsers.Sequence_2 (Prep, NP_Redir.Call);
+ function PP is new Parsers.Stamp (PP, PP_Seq);
- function NP_Seq_1 is new My_Rat.Parsers.Sequence ((Det'Access, Noun'Access));
- function NP_Seq_2 is new My_Rat.Parsers.Sequence ((NP_Redir.Call'Access, PP'Access));
- function NP_Choice is new My_Rat.Parsers.Choice
+ function NP_Seq_1 is new Parsers.Sequence_2 (Det, Noun);
+ function NP_Seq_2 is new Parsers.Sequence_2 (NP_Redir.Call, PP);
+ function NP_Choice is new Parsers.Choice
((Noun'Access, NP_Seq_1'Access, NP_Seq_2'Access));
- function NP is new My_Rat.Parsers.Stamp (NP, NP_Choice);
+ function NP is new Parsers.Stamp (NP, NP_Choice);
- function S_Seq_1 is new My_Rat.Parsers.Sequence ((NP'Access, VP'Access));
- function S_Seq_2 is new My_Rat.Parsers.Sequence ((S_Redir.Call'Access, PP'Access));
- function S_Choice is new My_Rat.Parsers.Choice ((S_Seq_1'Access, S_Seq_2'Access));
- function S is new My_Rat.Parsers.Stamp (S, S_Choice);
+ function S_Seq_1 is new Parsers.Sequence_2 (NP, VP);
+ function S_Seq_2 is new Parsers.Sequence_2 (S_Redir.Call, PP);
+ function S_Choice is new Parsers.Choice_2 (S_Seq_1, S_Seq_2);
+ function S is new Parsers.Stamp (S, S_Choice);
- package Parser is new My_Rat.Parsers.Parse_Once (S);
+ package Parser is new Parsers.Parse_Once (S);
- Lexed_Tokens : My_Rat.Lexer_Result := Scanner.Scan (Input);
- Result_Graph : My_Rat.Parser_Result;
+ Lexed_Tokens : Lexer_Result := Scanner.Scan (Input);
+ Result_Graph : Parser_Result;
begin
@@ -118,17 +134,17 @@ begin
Put_Line ("Lexer token output:");
for T of Lexed_Tokens loop
- Put (My_Rat.Lexer_Tokens.Debug_String (T));
+ Put (Lexer_Tokens.Debug_String (T));
end loop;
New_Line;
Put_Line ("Parser graph output:");
- Put_Line (My_Rat.Parse_Graphs.Debug_String (Result_Graph));
+ Put_Line (Parse_Graphs.Debug_String (Result_Graph));
New_Line;
Put_Line ("Root tokens:");
for T of Result_Graph.Root_Elements loop
- Put (My_Rat.Parser_Tokens.Debug_String (T));
+ Put (Parser_Tokens.Debug_String (T));
end loop;