-- This source is licensed under the Sunset License v1.0 with Ada.Text_IO, Ada.Strings.Fixed, Ada.Command_Line, Packrat.No_Lex, Packrat.Utilities; use Ada.Text_IO, Ada.Strings.Fixed; procedure Ssss is type Parser_Labels is (S, X); package My_Rat is new Packrat.No_Lex (Parser_Labels, Character, String); use My_Rat; -- Parser grammar from page 5 of -- Parser Combinators for Ambiguous Left-Recursive Grammars -- (Richard A. Frost, Rahmatullah Hafiz, Paul Callaghan, 2008) -- s ::= "x" s s | empty package S_Redir is new Parsers.Redirect; function Match_X is new Parsers.Match ('x'); function Let_X is new Parsers.Stamp (X, Match_X); function S_Seq is new Parsers.Sequence ((Let_X'Access, S_Redir.Call'Access, S_Redir.Call'Access)); function S_Choice is new Parsers.Choice_2 (S_Seq, My_Rat.Parsers.Empty); function S is new Parsers.Stamp (S, S_Choice); package Parser is new Parsers.Parse_Once (S); function Is_Digits (Str : in String) return Boolean is begin return (for all C of Str => C in '0' .. '9'); end Is_Digits; package Comlin renames Ada.Command_Line; Result_Graph : Parser_Result; Silent_Running : Boolean := False; Input_Length : Positive := 4; begin S_Redir.Set (S'Access); for I in 1 .. Comlin.Argument_Count loop if Comlin.Argument (I) = "--help" then Put_Line ("Simple Yet Highly Ambiguous Grammar Stress Tester"); New_Line; Put_Line ("s ::= 'x' s s | "); New_Line; Put_Line ("Command like switchs are --help or --silent"); Put_Line ("You may also provide the length of input, with the default being 4."); return; elsif Comlin.Argument (I) = "--silent" then Silent_Running := True; elsif Is_Digits (Comlin.Argument (I)) and then Integer'Value (Comlin.Argument (I)) > 0 then Input_Length := Integer'Value (Comlin.Argument (I)); end if; end loop; Result_Graph := Parser.Parse (Input_Length * 'x'); if not Silent_Running then Put_Line ("Input:"); Put_Line (Input_Length * 'x'); New_Line; Put_Line ("Parser graph output:"); Put_Line (Parse_Graphs.Debug_String (Result_Graph)); New_Line; Put_Line ("Root tokens:"); for T of Result_Graph.Root_Elements loop Put (Parser_Tokens.Debug_String (T)); end loop; end if; end Ssss;