diff options
| -rw-r--r-- | example/calc.adb | 176 | ||||
| -rw-r--r-- | example/sentence.adb | 120 | ||||
| -rw-r--r-- | example/ssss.adb | 28 |
3 files changed, 178 insertions, 146 deletions
diff --git a/example/calc.adb b/example/calc.adb index e94aaf2..84faa22 100644 --- a/example/calc.adb +++ b/example/calc.adb @@ -10,8 +10,10 @@ with Ada.Strings.Maps, Ada.Strings.Fixed, Ada.Command_Line, + Ada.Exceptions, Packrat.Standard, - Packrat.Utilities; + Packrat.Utilities, + Packrat.Errors; use @@ -26,6 +28,7 @@ procedure Calc is package My_Rat is new Packrat.Standard (Lexer_Labels, Parser_Labels, Character, String); + use My_Rat; @@ -37,30 +40,28 @@ procedure Calc is -- <zerotonine> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 - function Is_Operator is new Packrat.Utilities.In_Set - (Ada.Strings.Maps.To_Set ("+-*/^")); - function Sat_Operator is new My_Rat.Lexers.Satisfy (Is_Operator); - function Operator is new My_Rat.Lexers.Stamp (Operator, Sat_Operator); + function Is_Operator is new Packrat.Utilities.In_Set (Ada.Strings.Maps.To_Set ("+-*/^")); + function Sat_Operator is new Lexers.Satisfy (Is_Operator); + function Operator is new Lexers.Stamp (Operator, Sat_Operator); - function Is_Parens is new Packrat.Utilities.In_Set - (Ada.Strings.Maps.To_Set ("()")); - function Sat_Parens is new My_Rat.Lexers.Satisfy (Is_Parens); - function Bracket is new My_Rat.Lexers.Stamp (Bracket, Sat_Parens); + function Is_Parens is new Packrat.Utilities.In_Set (Ada.Strings.Maps.To_Set ("()")); + function Sat_Parens is new Lexers.Satisfy (Is_Parens); + function Bracket is new Lexers.Stamp (Bracket, Sat_Parens); - function Sat_Digit is new My_Rat.Lexers.Satisfy (Packrat.Utilities.Is_Digit); - function Some_Digits is new My_Rat.Lexers.Many (Sat_Digit, 1); - function Number is new My_Rat.Lexers.Stamp (Number, Some_Digits); + function Sat_Digit is new Lexers.Satisfy (Packrat.Utilities.Is_Digit); + function Some_Digits is new Lexers.Many (Sat_Digit, 1); + function Number is new Lexers.Stamp (Number, Some_Digits); - function Match_Point is new My_Rat.Lexers.Match ('.'); - function Decimal_Seq is new My_Rat.Lexers.Sequence + function Match_Point is new Lexers.Match ('.'); + function Decimal_Seq is new Lexers.Sequence ((Some_Digits'Access, Match_Point'Access, Some_Digits'Access)); - function Decimal is new My_Rat.Lexers.Stamp (Decimal, Decimal_Seq); + function Decimal is new Lexers.Stamp (Decimal, Decimal_Seq); - 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_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 My_Rat.Lexers.Scan_Once + package Scanner is new Lexers.Scan_Once ((Whitespace'Access, Decimal'Access, Number'Access, Bracket'Access, Operator'Access)); @@ -81,73 +82,73 @@ procedure Calc is -- order to ensure the finished parse tree doesn't contain extra chaff. - package Addsub_Redir is new My_Rat.Parsers.Redirect; - - function Is_Minus is new My_Rat.Lexer_Tokens.Is_Value ("-"); - function Sat_Minus is new My_Rat.Parsers.Satisfy (Is_Minus); - function Ignore_Minus is new My_Rat.Parsers.Ignore (Sat_Minus); - function Neg_Seq is new My_Rat.Parsers.Sequence_2 (Ignore_Minus, Addsub_Redir.Call); - function Negative is new My_Rat.Parsers.Stamp (Negative, Neg_Seq); - - function Is_Decimal is new My_Rat.Lexer_Tokens.Is_Label (Decimal); - function Is_Number is new My_Rat.Lexer_Tokens.Is_Label (Number); - function Is_Left_Parens is new My_Rat.Lexer_Tokens.Is_Value ("("); - function Is_Right_Parens is new My_Rat.Lexer_Tokens.Is_Value (")"); - function Sat_Decimal is new My_Rat.Parsers.Satisfy (Is_Decimal); - function Sat_Number is new My_Rat.Parsers.Satisfy (Is_Number); - function Sat_Left_Parens is new My_Rat.Parsers.Satisfy (Is_Left_Parens); - function Sat_Right_Parens is new My_Rat.Parsers.Satisfy (Is_Right_Parens); - function Fac_Num is new My_Rat.Parsers.Choice_2 (Sat_Decimal, Sat_Number); - function Factor is new My_Rat.Parsers.Stamp (Factor, Fac_Num); - function Fac_Between is new My_Rat.Parsers.Between + package Addsub_Redir is new Parsers.Redirect; + + function Is_Minus is new Lexer_Tokens.Is_Value ("-"); + function Sat_Minus is new Parsers.Satisfy (Is_Minus); + function Ignore_Minus is new Parsers.Ignore (Sat_Minus); + function Neg_Seq is new Parsers.Sequence_2 (Ignore_Minus, Addsub_Redir.Call); + function Negative is new Parsers.Stamp (Negative, Neg_Seq); + + function Is_Decimal is new Lexer_Tokens.Is_Label (Decimal); + function Is_Number is new Lexer_Tokens.Is_Label (Number); + function Is_Left_Parens is new Lexer_Tokens.Is_Value ("("); + function Is_Right_Parens is new Lexer_Tokens.Is_Value (")"); + function Sat_Decimal is new Parsers.Satisfy (Is_Decimal); + function Sat_Number is new Parsers.Satisfy (Is_Number); + function Sat_Left_Parens is new Parsers.Satisfy (Is_Left_Parens); + function Sat_Right_Parens is new Parsers.Satisfy (Is_Right_Parens); + function Fac_Num is new Parsers.Choice_2 (Sat_Decimal, Sat_Number); + function Factor is new Parsers.Stamp (Factor, Fac_Num); + function Fac_Between is new Parsers.Between (Sat_Left_Parens, Addsub_Redir.Call, Sat_Right_Parens); - function Fac_Choice is new My_Rat.Parsers.Choice + function Fac_Choice is new Parsers.Choice ((Fac_Between'Access, Negative'Access, Factor'Access)); - function Is_Exp is new My_Rat.Lexer_Tokens.Is_Value ("^"); - function Sat_Exp is new My_Rat.Parsers.Satisfy (Is_Exp); - function Ignore_Exp is new My_Rat.Parsers.Ignore (Sat_Exp); - function Pow_Seq is new My_Rat.Parsers.Sequence + function Is_Exp is new Lexer_Tokens.Is_Value ("^"); + function Sat_Exp is new Parsers.Satisfy (Is_Exp); + function Ignore_Exp is new Parsers.Ignore (Sat_Exp); + function Pow_Seq is new Parsers.Sequence ((Fac_Choice'Access, Ignore_Exp'Access, Fac_Choice'Access)); - function Power is new My_Rat.Parsers.Stamp (Power, Pow_Seq); - function Pow_Choice is new My_Rat.Parsers.Choice_2 (Power, Fac_Choice); + function Power is new Parsers.Stamp (Power, Pow_Seq); + function Pow_Choice is new Parsers.Choice_2 (Power, Fac_Choice); - package Muldiv_Redir is new My_Rat.Parsers.Redirect; + package Muldiv_Redir is new Parsers.Redirect; - function Is_Mult is new My_Rat.Lexer_Tokens.Is_Value ("*"); - function Sat_Mult is new My_Rat.Parsers.Satisfy (Is_Mult); - function Ignore_Mult is new My_Rat.Parsers.Ignore (Sat_Mult); - function Product_Seq is new My_Rat.Parsers.Sequence + function Is_Mult is new Lexer_Tokens.Is_Value ("*"); + function Sat_Mult is new Parsers.Satisfy (Is_Mult); + function Ignore_Mult is new Parsers.Ignore (Sat_Mult); + function Product_Seq is new Parsers.Sequence ((Muldiv_Redir.Call'Access, Ignore_Mult'Access, Pow_Choice'Access)); - function Product is new My_Rat.Parsers.Stamp (Product, Product_Seq); + function Product is new Parsers.Stamp (Product, Product_Seq); - function Is_Div is new My_Rat.Lexer_Tokens.Is_Value ("/"); - function Sat_Div is new My_Rat.Parsers.Satisfy (Is_Div); - function Ignore_Div is new My_Rat.Parsers.Ignore (Sat_Div); - function Quotient_Seq is new My_Rat.Parsers.Sequence + function Is_Div is new Lexer_Tokens.Is_Value ("/"); + function Sat_Div is new Parsers.Satisfy (Is_Div); + function Ignore_Div is new Parsers.Ignore (Sat_Div); + function Quotient_Seq is new Parsers.Sequence ((Muldiv_Redir.Call'Access, Ignore_Div'Access, Pow_Choice'Access)); - function Quotient is new My_Rat.Parsers.Stamp (Quotient, Quotient_Seq); + function Quotient is new Parsers.Stamp (Quotient, Quotient_Seq); - function Muldiv_Choice is new My_Rat.Parsers.Choice + function Muldiv_Choice is new Parsers.Choice ((Product'Access, Quotient'Access, Pow_Choice'Access)); - function Difference_Seq is new My_Rat.Parsers.Sequence + function Difference_Seq is new Parsers.Sequence ((Addsub_Redir.Call'Access, Ignore_Minus'Access, Muldiv_Choice'Access)); - function Difference is new My_Rat.Parsers.Stamp (Difference, Difference_Seq); + function Difference is new Parsers.Stamp (Difference, Difference_Seq); - function Is_Plus is new My_Rat.Lexer_Tokens.Is_Value ("+"); - function Sat_Plus is new My_Rat.Parsers.Satisfy (Is_Plus); - function Ignore_Plus is new My_Rat.Parsers.Ignore (Sat_Plus); - function Sum_Seq is new My_Rat.Parsers.Sequence + function Is_Plus is new Lexer_Tokens.Is_Value ("+"); + function Sat_Plus is new Parsers.Satisfy (Is_Plus); + function Ignore_Plus is new Parsers.Ignore (Sat_Plus); + function Sum_Seq is new Parsers.Sequence ((Addsub_Redir.Call'Access, Ignore_Plus'Access, Muldiv_Choice'Access)); - function Sum is new My_Rat.Parsers.Stamp (Sum, Sum_Seq); + function Sum is new Parsers.Stamp (Sum, Sum_Seq); - function Addsub_Choice is new My_Rat.Parsers.Choice + function Addsub_Choice is new Parsers.Choice ((Sum'Access, Difference'Access, Muldiv_Choice'Access)); - function Expr is new My_Rat.Parsers.Sequence_2 (Addsub_Choice, My_Rat.Parsers.End_Of_Input); + function Expr is new Parsers.Sequence_2 (Addsub_Choice, My_Rat.Parsers.End_Of_Input); - package Parser is new My_Rat.Parsers.Parse_Once (Expr); + package Parser is new Parsers.Parse_Once (Expr); @@ -156,26 +157,25 @@ procedure Calc is function Value - (Tok : in My_Rat.Parser_Tokens.Finished_Token_Type) + (Tok : in Parser_Tokens.Finished_Token_Type) return String is - Lexed : My_Rat.Lexer_Tokens.Token_Array := - My_Rat.Parser_Tokens.Value (Tok.Token); + Lexed : Lexer_Tokens.Token_Array := Parser_Tokens.Value (Tok.Token); begin if Lexed'Length = 0 then return ""; else - return My_Rat.Lexer_Tokens.Value (Lexed (Lexed'First)); + return Lexer_Tokens.Value (Lexed (Lexed'First)); end if; end Value; function Element - (Subs : in My_Rat.Parse_Graphs.Token_Group_Array; + (Subs : in Parse_Graphs.Token_Group_Array; Ind : in Positive) - return My_Rat.Parser_Tokens.Finished_Token_Type is + return Parser_Tokens.Finished_Token_Type is begin - return My_Rat.Parse_Graphs.Element (Subs (Subs'First), Ind); + return Parse_Graphs.Element (Subs (Subs'First), Ind); end Element; @@ -204,14 +204,14 @@ procedure Calc is function Evaluate - (Graph : in My_Rat.Parser_Result; - Position : in My_Rat.Parser_Tokens.Finished_Token_Type) + (Graph : in Parser_Result; + Position : in Parser_Tokens.Finished_Token_Type) return Calc_Result is - Subgroups : My_Rat.Parse_Graphs.Token_Group_Array := Graph.Subgroups (Position); + Subgroups : Parse_Graphs.Token_Group_Array := Graph.Subgroups (Position); Temp : Calc_Result; begin - case My_Rat.Parser_Tokens.Label (Position.Token) is + case Parser_Tokens.Label (Position.Token) is when Sum => return Evaluate (Graph, Element (Subgroups, 1)) + Evaluate (Graph, Element (Subgroups, 2)); @@ -303,8 +303,8 @@ begin declare Input : String := SU.To_String (Comlin_Input); - Lexed_Tokens : My_Rat.Lexer_Result := Scanner.Scan (Input); - Result_Graph : My_Rat.Parser_Result := Parser.Parse (Lexed_Tokens); + Lexed_Tokens : Lexer_Result := Scanner.Scan (Input); + Result_Graph : Parser_Result := Parser.Parse (Lexed_Tokens); Calculated : Calc_Result := Evaluate (Result_Graph, Result_Graph.Root_Elements (1)); begin if Silent_Running then @@ -318,17 +318,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; New_Line; @@ -337,6 +337,16 @@ begin end; +exception + + when Msg : Packrat.Lexer_Error => + Put_Line ("Lexer Error:"); + Put (Packrat.Errors.Debug_String (Ada.Exceptions.Exception_Message (Msg))); + + when Msg : Packrat.Parser_Error => + Put_Line ("Parser Error:"); + Put (Packrat.Errors.Debug_String (Ada.Exceptions.Exception_Message (Msg))); + end Calc; 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; diff --git a/example/ssss.adb b/example/ssss.adb index 2c29b2f..25faa21 100644 --- a/example/ssss.adb +++ b/example/ssss.adb @@ -23,22 +23,28 @@ procedure Ssss is type Parser_Labels is (S, X); package My_Rat is new Packrat.No_Lex (Parser_Labels, Character, String); + use My_Rat; - package S_Redir is new My_Rat.Parsers.Redirect; + -- Parser grammar from page 5 of + -- Parser Combinators for Ambiguous Left-Recursive Grammars + -- (Richard A. Frost, Rahmatullah Hafiz, Paul Callaghan, 2008) - function Match_X is new My_Rat.Parsers.Match ('x'); - function Let_X is new My_Rat.Parsers.Stamp (X, Match_X); + -- s ::= "x" s s | empty - function S_Seq is new My_Rat.Parsers.Sequence + package S_Redir is new Parsers.Redirect; + + function Match_X is new Parsers.Match ('x'); + function Let_X is new Parsers.Stamp (X, Match_X); + + function S_Seq is new Parsers.Sequence ((Let_X'Access, S_Redir.Call'Access, S_Redir.Call'Access)); - function S_Choice is new My_Rat.Parsers.Choice - ((S_Seq'Access, My_Rat.Parsers.Empty'Access)); - function S is new My_Rat.Parsers.Stamp (S, S_Choice); + function S_Choice is new Parsers.Choice_2 (S_Seq, My_Rat.Parsers.Empty); + 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); @@ -55,7 +61,7 @@ procedure Ssss is package Comlin renames Ada.Command_Line; - Result_Graph : My_Rat.Parser_Result; + Result_Graph : Parser_Result; Silent_Running : Boolean := False; Input_Length : Positive := 4; @@ -95,12 +101,12 @@ begin 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; end if; |