Calculator example program added

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;
+
+