diff options
Diffstat (limited to 'example/simple_calc.adb')
| -rw-r--r-- | example/simple_calc.adb | 237 |
1 files changed, 0 insertions, 237 deletions
diff --git a/example/simple_calc.adb b/example/simple_calc.adb deleted file mode 100644 index e1a66c1..0000000 --- a/example/simple_calc.adb +++ /dev/null @@ -1,237 +0,0 @@ - - --- 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.Discard (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; - - |