summaryrefslogtreecommitdiff
path: root/example/calc.adb
diff options
context:
space:
mode:
Diffstat (limited to 'example/calc.adb')
-rw-r--r--example/calc.adb125
1 files changed, 62 insertions, 63 deletions
diff --git a/example/calc.adb b/example/calc.adb
index c891333..0dd0e71 100644
--- a/example/calc.adb
+++ b/example/calc.adb
@@ -22,7 +22,7 @@ procedure Calc is
type Lexer_Labels is (Whitespace, Decimal, Number, Bracket, Operator);
- type Parser_Labels is (Sum, Product, Power, Factor, Negative);
+ type Parser_Labels is (Sum, Difference, Product, Quotient, Power, Factor, Negative);
package My_Rat is new Packrat.Standard
(Lexer_Labels, Parser_Labels, Character, String);
@@ -74,14 +74,19 @@ procedure Calc is
-- <product> ::= <product> * <power> | <product> / <power> | <power>
-- <power> ::= <factor> ^ <factor> | <factor>
-- <factor> ::= ( <sum> ) | <negative> | <number>
- -- <negative> := - <sum>
+ -- <negative> ::= - <sum>
+ -- Or at least the above is what I started with, anyway.
+ -- The grammar became modified slightly to take advantage of Ignore/Stamp in
+ -- order to ensure the finished parse tree doesn't contain extra chaff.
- package Sum_Redir is new My_Rat.Parsers.Redirect;
+
+ 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 Neg_Seq is new My_Rat.Parsers.Sequence_2 (Sat_Minus, Sum_Redir.Call);
+ 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);
@@ -93,44 +98,54 @@ procedure Calc is
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
- (Sat_Left_Parens, Sum_Redir.Call, Sat_Right_Parens);
+ (Sat_Left_Parens, Addsub_Redir.Call, Sat_Right_Parens);
function Fac_Choice is new My_Rat.Parsers.Choice
- ((Fac_Between'Access, Negative'Access, Fac_Num'Access));
- function Factor is new My_Rat.Parsers.Stamp (Factor, Fac_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
- ((Factor'Access, Sat_Exp'Access, Factor'Access));
- function Pow_Choice is new My_Rat.Parsers.Choice_2 (Pow_Seq, Factor);
- function Power is new My_Rat.Parsers.Stamp (Power, Pow_Choice);
+ ((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);
- package Product_Redir is new My_Rat.Parsers.Redirect;
+ package Muldiv_Redir is new My_Rat.Parsers.Redirect;
function Is_Mult is new My_Rat.Lexer_Tokens.Is_Value ("*");
- function Is_Div 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
+ ((Muldiv_Redir.Call'Access, Ignore_Mult'Access, Pow_Choice'Access));
+ function Product is new My_Rat.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 Prod_Mul is new My_Rat.Parsers.Sequence
- ((Product_Redir.Call'Access, Sat_Mult'Access, Power'Access));
- function Prod_Div is new My_Rat.Parsers.Sequence
- ((Product_Redir.Call'Access, Sat_Div'Access, Power'Access));
- function Prod_Choice is new My_Rat.Parsers.Choice
- ((Prod_Mul'Access, Prod_Div'Access, Power'Access));
- function Product is new My_Rat.Parsers.Stamp (Product, Prod_Choice);
+ function Ignore_Div is new My_Rat.Parsers.Ignore (Sat_Div);
+ function Quotient_Seq is new My_Rat.Parsers.Sequence
+ ((Muldiv_Redir.Call'Access, Ignore_Div'Access, Pow_Choice'Access));
+ function Quotient is new My_Rat.Parsers.Stamp (Quotient, Quotient_Seq);
+
+ function Muldiv_Choice is new My_Rat.Parsers.Choice
+ ((Product'Access, Quotient'Access, Pow_Choice'Access));
+
+ function Difference_Seq is new My_Rat.Parsers.Sequence
+ ((Addsub_Redir.Call'Access, Ignore_Minus'Access, Muldiv_Choice'Access));
+ function Difference is new My_Rat.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 Sum_Plus is new My_Rat.Parsers.Sequence
- ((Sum_Redir.Call'Access, Sat_Plus'Access, Product'Access));
- function Sum_Minus is new My_Rat.Parsers.Sequence
- ((Sum_Redir.Call'Access, Sat_Minus'Access, Product'Access));
- function Sum_Choice is new My_Rat.Parsers.Choice
- ((Sum_Plus'Access, Sum_Minus'Access, Product'Access));
- function Sum is new My_Rat.Parsers.Stamp (Sum, Sum_Choice);
+ function Ignore_Plus is new My_Rat.Parsers.Ignore (Sat_Plus);
+ function Sum_Seq is new My_Rat.Parsers.Sequence
+ ((Addsub_Redir.Call'Access, Ignore_Plus'Access, Muldiv_Choice'Access));
+ function Sum is new My_Rat.Parsers.Stamp (Sum, Sum_Seq);
+
+ function Addsub_Choice is new My_Rat.Parsers.Choice
+ ((Sum'Access, Difference'Access, Muldiv_Choice'Access));
- function Expr is new My_Rat.Parsers.Sequence_2 (Sum, My_Rat.Parsers.End_Of_Input);
+ function Expr is new My_Rat.Parsers.Sequence_2 (Addsub_Choice, My_Rat.Parsers.End_Of_Input);
package Parser is new My_Rat.Parsers.Parse_Once (Expr);
@@ -198,45 +213,29 @@ procedure Calc is
begin
case My_Rat.Parser_Tokens.Label (Position.Token) is
when Sum =>
- if Value (Position) = "+" then
- return Evaluate (Graph, Element (Subgroups, 1)) +
- Evaluate (Graph, Element (Subgroups, 2));
- elsif Value (Position) = "-" then
- return Evaluate (Graph, Element (Subgroups, 1)) -
- Evaluate (Graph, Element (Subgroups, 2));
- else
- return Evaluate (Graph, Element (Subgroups, 1));
- end if;
+ return Evaluate (Graph, Element (Subgroups, 1)) +
+ Evaluate (Graph, Element (Subgroups, 2));
+ when Difference =>
+ return Evaluate (Graph, Element (Subgroups, 1)) -
+ Evaluate (Graph, Element (Subgroups, 2));
when Product =>
- if Value (Position) = "*" then
- return Evaluate (Graph, Element (Subgroups, 1)) *
- Evaluate (Graph, Element (Subgroups, 2));
- elsif Value (Position) = "/" then
- Temp := Evaluate (Graph, Element (Subgroups, 2));
- if Temp = 0.0 then
- raise Constraint_Error with "Div by zero";
- end if;
- return Evaluate (Graph, Element (Subgroups, 1)) / Temp;
- else
- return Evaluate (Graph, Element (Subgroups, 1));
+ return Evaluate (Graph, Element (Subgroups, 1)) *
+ Evaluate (Graph, Element (Subgroups, 2));
+ when Quotient =>
+ Temp := Evaluate (Graph, Element (Subgroups, 2));
+ if Temp = 0.0 then
+ raise Constraint_Error with "Div by zero";
end if;
+ return Evaluate (Graph, Element (Subgroups, 1)) / Temp;
when Power =>
- if Value (Position) = "^" then
- Temp := Evaluate (Graph, Element (Subgroups, 2));
- if not Is_Integer (Temp) then
- raise Constraint_Error with "Non integer exponent";
- end if;
- return Calc_Result
- (Long_Float (Evaluate (Graph, Element (Subgroups, 1))) ** Integer (Temp));
- else
- return Evaluate (Graph, Element (Subgroups, 1));
+ Temp := Evaluate (Graph, Element (Subgroups, 2));
+ if not Is_Integer (Temp) then
+ raise Constraint_Error with "Non-integer exponent";
end if;
+ return Calc_Result
+ (Long_Float (Evaluate (Graph, Element (Subgroups, 1))) ** Integer (Temp));
when Factor =>
- if Subgroups'Length = 0 then
- return To_Result (Value (Position));
- else
- return Evaluate (Graph, Element (Subgroups, 1));
- end if;
+ return To_Result (Value (Position));
when Negative =>
return Calc_Result'(0.0) - Evaluate (Graph, Element (Subgroups, 1));
end case;
@@ -264,8 +263,8 @@ procedure Calc is
begin
- Sum_Redir.Set (Sum'Access);
- Product_Redir.Set (Product'Access);
+ Addsub_Redir.Set (Addsub_Choice'Access);
+ Muldiv_Redir.Set (Muldiv_Choice'Access);
for I in 1 .. Comlin.Argument_Count loop