summaryrefslogtreecommitdiff
path: root/example/calc.adb
diff options
context:
space:
mode:
Diffstat (limited to 'example/calc.adb')
-rw-r--r--example/calc.adb176
1 files changed, 93 insertions, 83 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;