summaryrefslogtreecommitdiff
path: root/example/calc.adb
diff options
context:
space:
mode:
Diffstat (limited to 'example/calc.adb')
-rw-r--r--example/calc.adb340
1 files changed, 340 insertions, 0 deletions
diff --git a/example/calc.adb b/example/calc.adb
new file mode 100644
index 0000000..f7899f4
--- /dev/null
+++ b/example/calc.adb
@@ -0,0 +1,340 @@
+
+
+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, Product, Power, Factor, Negative);
+
+ package My_Rat is new Packrat.Standard
+ (Lexer_Labels, Parser_Labels, Character, String);
+
+
+
+
+ -- Lexer Grammar
+
+ -- <number> ::= <digits> . <digits> | <digits>
+ -- <digits> ::= <zerotonine> <digits> | <zerotonine>
+ -- <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_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.Ignore (Whitespace, Many_Blank);
+
+ package Scanner is new My_Rat.Lexers.Scan_Once
+ ((Whitespace'Access, Decimal'Access, Number'Access,
+ Bracket'Access, Operator'Access));
+
+
+
+
+ -- Parser Grammar
+
+ -- <expr> ::= <sum> <endofinput>
+ -- <sum> ::= <sum> + <product> | <sum> - <product> | <product>
+ -- <product> ::= <product> * <power> | <product> / <power> | <power>
+ -- <power> ::= <factor> ^ <factor> | <factor>
+ -- <factor> ::= ( <sum> ) | <negative> | <number>
+ -- <negative> := - <sum>
+
+
+ package Sum_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 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 Fac_Between is new My_Rat.Parsers.Between
+ (Sat_Left_Parens, Sum_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);
+
+ function Is_Exp is new My_Rat.Lexer_Tokens.Is_Value ("^");
+ function Sat_Exp is new My_Rat.Parsers.Satisfy (Is_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);
+
+ package Product_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 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 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 Expr is new My_Rat.Parsers.Sequence_2 (Sum, 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 =>
+ 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;
+ 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));
+ end if;
+ 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));
+ end if;
+ when Factor =>
+ if Subgroups'Length = 0 then
+ return To_Result (Value (Position));
+ else
+ return Evaluate (Graph, Element (Subgroups, 1));
+ end if;
+ 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
+
+
+ Sum_Redir.Set (Sum'Access);
+ Product_Redir.Set (Product'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;
+
+