Simplified calculator example with only addition and subtraction of integers

2 files changed, 239 insertions, 1 deletions

diff --git a/example/simple_calc.adb b/example/simple_calc.adb
new file mode 100644
index 0000000..4c85887
--- /dev/null
+++ b/example/simple_calc.adb
@@ -0,0 +1,237 @@
+
+
+--  This source is licensed under the Sunset License v1.0
+
+
+with
+
+    Ada.Text_IO,
+    Ada.Strings.Unbounded,
+    Ada.Strings.Maps,
+    Ada.Command_Line,
+    Packrat.Standard,
+    Packrat.Utilities;
+
+use
+
+    Ada.Text_IO;
+
+
+procedure Simple_Calc is
+
+
+    type Lexer_Labels is (Whitespace, Number, Operator);
+    type Parser_Labels is (Sum, Factor);
+
+    package My_Rat is new Packrat.Standard
+        (Lexer_Labels, Parser_Labels, Character, String);
+
+
+
+
+    --  Lexer Grammar
+
+    --  <number> ::= <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 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 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, Number'Access, Operator'Access));
+
+
+
+
+    --  Parser Grammar
+
+    --  <expr> ::= <sum> <endofinput>
+    --  <sum> ::= <sum> + <factor> | <sum> - <factor> | <factor>
+    --  <factor> ::= <number>
+
+
+    package Sum_Redir is new My_Rat.Parsers.Redirect;
+
+    function Is_Number is new My_Rat.Lexer_Tokens.Is_Label (Number);
+    function Sat_Number is new My_Rat.Parsers.Satisfy (Is_Number);
+    function Factor is new My_Rat.Parsers.Stamp (Factor, Sat_Number);
+
+    function Is_Minus is new My_Rat.Lexer_Tokens.Is_Value ("-");
+    function Sat_Minus is new My_Rat.Parsers.Satisfy (Is_Minus);
+    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, Factor'Access));
+    function Sum_Minus is new My_Rat.Parsers.Sequence
+        ((Sum_Redir.Call'Access, Sat_Minus'Access, Factor'Access));
+    function Sum_Choice is new My_Rat.Parsers.Choice
+        ((Sum_Plus'Access, Sum_Minus'Access, Factor'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 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);
+    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 Factor =>
+                return Calc_Result (Integer'Value (Value (Position)));
+        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);
+
+
+    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 ("Simplified 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 all numbers are positive integers.");
+        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 Simple_Calc;
+
+
diff --git a/examples.gpr b/examples.gpr
index 2f63bc2..c113750 100644
--- a/examples.gpr
+++ b/examples.gpr
@@ -12,13 +12,14 @@ project Examples is
     for Source_Dirs use ("example/**");
     for Object_Dir use "obj";
     for Exec_Dir use "bin";
-    for Main use ("sentence.adb", "ssss.adb", "calc.adb");
+    for Main use ("sentence.adb", "ssss.adb", "calc.adb", "simple_calc.adb");
 
 
     package Builder is
         for Executable ("sentence.adb") use "sentence";
         for Executable ("ssss.adb") use "ssss";
         for Executable ("calc.adb") use "calc";
+        for Executable ("simple_calc.adb") use "simplecalc";
     end Builder;