summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--example/simple_calc.adb237
-rw-r--r--examples.gpr3
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;