From 7c1db8ca1988ff9a9c9054be012eac830674f9d3 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 23 Jan 2021 18:37:42 +1100 Subject: Slight improvements to example code --- example/sentence.adb | 120 +++++++++++++++++++++++++++++---------------------- 1 file changed, 68 insertions(+), 52 deletions(-) (limited to 'example/sentence.adb') 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; -- cgit