Calc now creates simpler parse trees

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