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/calc.adb | 176 +++++++++++++++++++++++++++++-------------------------- 1 file changed, 93 insertions(+), 83 deletions(-) (limited to 'example/calc.adb') 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 -- ::= 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; -- cgit