From 7c2ecebc8f68320fd159e1a9b810fa74daab7ca4 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 25 Dec 2020 23:15:03 +1100 Subject: Calc now creates simpler parse trees --- example/calc.adb | 125 +++++++++++++++++++++++++++---------------------------- 1 file changed, 62 insertions(+), 63 deletions(-) (limited to 'example/calc.adb') 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 -- ::= * | / | -- ::= ^ | -- ::= ( ) | | - -- := - + -- ::= - + -- 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 -- cgit