-- This source is licensed under the Sunset License v1.0 with Ada.Text_IO, Ada.Strings.Unbounded, Ada.Strings.Maps, Ada.Strings.Fixed, Ada.Command_Line, Packrat.Standard, Packrat.Utilities; use Ada.Text_IO; procedure Calc is type Lexer_Labels is (Whitespace, Decimal, Number, Bracket, Operator); type Parser_Labels is (Sum, Difference, Product, Quotient, Power, Factor, Negative); package My_Rat is new Packrat.Standard (Lexer_Labels, Parser_Labels, Character, String); -- Lexer Grammar -- ::= . | -- ::= | -- ::= 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_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 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 Match_Point is new My_Rat.Lexers.Match ('.'); function Decimal_Seq is new My_Rat.Lexers.Sequence ((Some_Digits'Access, Match_Point'Access, Some_Digits'Access)); function Decimal is new My_Rat.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); package Scanner is new My_Rat.Lexers.Scan_Once ((Whitespace'Access, Decimal'Access, Number'Access, Bracket'Access, Operator'Access)); -- Parser Grammar -- ::= -- ::= + | - | -- ::= * | / | -- ::= ^ | -- ::= ( ) | | -- ::= - -- 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 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 (Sat_Left_Parens, Addsub_Redir.Call, Sat_Right_Parens); function Fac_Choice is new My_Rat.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 ((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 Muldiv_Redir is new My_Rat.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 ((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 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 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 (Addsub_Choice, My_Rat.Parsers.End_Of_Input); package Parser is new My_Rat.Parsers.Parse_Once (Expr); type Calc_Result is delta 10.0**(-9) digits 18; function Value (Tok : in My_Rat.Parser_Tokens.Finished_Token_Type) return String is Lexed : My_Rat.Lexer_Tokens.Token_Array := My_Rat.Parser_Tokens.Value (Tok.Token); begin if Lexed'Length = 0 then return ""; else return My_Rat.Lexer_Tokens.Value (Lexed (Lexed'First)); end if; end Value; function Element (Subs : in My_Rat.Parse_Graphs.Token_Group_Array; Ind : in Positive) return My_Rat.Parser_Tokens.Finished_Token_Type is begin return My_Rat.Parse_Graphs.Element (Subs (Subs'First), Ind); end Element; function Is_Integer (Val : in Calc_Result) return Boolean is begin return Val = Calc_Result (Integer (Val)); end Is_Integer; function To_Result (Str : in String) return Calc_Result is Point : Natural := Ada.Strings.Fixed.Index (Str, "."); begin if Point = 0 then return Calc_Result (Integer'Value (Str)); else return Calc_Result (Integer'Value (Str (Str'First .. Point - 1))) + Calc_Result (Integer'Value (Str (Point + 1 .. Str'Last))) / Calc_Result (10 ** (Str'Last - Point)); end if; end To_Result; function Evaluate (Graph : in My_Rat.Parser_Result; Position : in My_Rat.Parser_Tokens.Finished_Token_Type) return Calc_Result is Subgroups : My_Rat.Parse_Graphs.Token_Group_Array := Graph.Subgroups (Position); Temp : Calc_Result; begin case My_Rat.Parser_Tokens.Label (Position.Token) is when Sum => 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 => 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 => 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 => return To_Result (Value (Position)); when Negative => return Calc_Result'(0.0) - Evaluate (Graph, Element (Subgroups, 1)); end case; end Evaluate; function Image (Val : in Calc_Result) return String is begin return Val'Image; end Image; package SU renames Ada.Strings.Unbounded; package Comlin renames Ada.Command_Line; Comlin_Input : SU.Unbounded_String; Silent_Running : Boolean := False; Real_Arg_Count : Natural := 0; begin Addsub_Redir.Set (Addsub_Choice'Access); Muldiv_Redir.Set (Muldiv_Choice'Access); for I in 1 .. Comlin.Argument_Count loop if Comlin.Argument (I) /= "--silent" then Real_Arg_Count := Real_Arg_Count + 1; end if; end loop; if Real_Arg_Count = 0 then Put_Line ("Command Line Calculator"); New_Line; Put_Line ("This program calculates elementary mathematical"); Put_Line ("expressions it receives as command line arguments."); Put_Line ("Naturally, it needs you to supply arguments for that."); Put_Line ("You may have to use quotes to ensure the shell doesn't mess with input."); New_Line; Put_Line ("Accepted operators are + - * / ^ ()"); Put_Line ("Please ensure exponents are always integers and divisors are never zero."); New_Line; Put_Line ("If you do not want to see any output beyond the answer,"); Put_Line ("then use the --silent switch."); return; end if; for I in 1 .. Comlin.Argument_Count loop if Comlin.Argument (I) = "--silent" then Silent_Running := True; else SU.Append (Comlin_Input, Comlin.Argument (I) & " "); end if; end loop; SU.Delete (Comlin_Input, SU.Length (Comlin_Input), SU.Length (Comlin_Input)); 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); Calculated : Calc_Result := Evaluate (Result_Graph, Result_Graph.Root_Elements (1)); begin if Silent_Running then Put_Line (Image (Calculated)); return; end if; Put_Line ("Input:"); Put_Line (Input); New_Line; Put_Line ("Lexer token output:"); for T of Lexed_Tokens loop Put (My_Rat.Lexer_Tokens.Debug_String (T)); end loop; New_Line; Put_Line ("Parser graph output:"); Put_Line (My_Rat.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)); end loop; New_Line; Put_Line ("Calculated result:"); Put_Line (Image (Calculated)); end; end Calc;