diff options
Diffstat (limited to 'example')
| -rw-r--r-- | example/simple_calc.adb | 237 |
1 files changed, 237 insertions, 0 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; + + |