Added redirects for self-referential combinators

3 files changed, 128 insertions, 202 deletions

diff --git a/example/sentence.adb b/example/sentence.adb
index d4a707f..7e9114b 100644
--- a/example/sentence.adb
+++ b/example/sentence.adb
@@ -29,244 +29,122 @@ procedure Sentence is
     type Lexer_Labels is (Word, Whitespace);
     type Parser_Labels is (S, NP, PP, VP, Det, Noun, Verb, Prep);
 
-
     package My_Rat is new Packrat.Text.Standard (Lexer_Labels, Parser_Labels);
 
 
 
 
-    package Lexer_Parts is
-
-        function Word
-               (Input   : in     String;
-                Context : in out My_Rat.Lexers.Lexer_Context)
-            return My_Rat.Lexers.Component_Result;
+    function Sat_Alpha is new My_Rat.Lexers.Satisfy (Packrat.Utilities.Is_Letter);
+    function Many_Alpha is new My_Rat.Lexers.Many (Sat_Alpha, 1);
+    function Word is new My_Rat.Lexers.Stamp (Word, Many_Alpha);
 
-        function Whitespace
-               (Input   : in     String;
-                Context : in out My_Rat.Lexers.Lexer_Context)
-            return My_Rat.Lexers.Component_Result;
+    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);
 
-    end Lexer_Parts;
+    function Scanner is new My_Rat.Lexers.Scan_Only ((Word'Access, Whitespace'Access));
 
 
-    package body Lexer_Parts is
 
-        function Sat_Alpha is new My_Rat.Lexers.Satisfy (Packrat.Utilities.Is_Letter);
-        function Many_Alpha is new My_Rat.Lexers.Many (Sat_Alpha, 1);
-        function Word_Inst is new My_Rat.Lexers.Stamp (Word, Many_Alpha);
 
-        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_Inst is new My_Rat.Lexers.Ignore (Whitespace, Many_Blank);
+    generic
+        Match : in String;
+    function Is_Value
+           (Element : in My_Rat.Lexer_Traits.Tokens.Token)
+        return Boolean;
 
-        function Word
-               (Input   : in     String;
-                Context : in out My_Rat.Lexers.Lexer_Context)
-            return My_Rat.Lexers.Component_Result renames Word_Inst;
+    function Is_Value
+           (Element : in My_Rat.Lexer_Traits.Tokens.Token)
+        return Boolean is
+    begin
+        return My_Rat.Lexer_Traits.Tokens.Value (Element) = Match;
+    end Is_Value;
 
-        function Whitespace
-               (Input   : in     String;
-                Context : in out My_Rat.Lexers.Lexer_Context)
-            return My_Rat.Lexers.Component_Result renames Whitespace_Inst;
+    function Is_I is new Is_Value ("i");
+    function Is_Saw is new Is_Value ("saw");
+    function Is_A is new Is_Value ("a");
+    function Is_Man is new Is_Value ("man");
+    function Is_In is new Is_Value ("in");
+    function Is_The is new Is_Value ("the");
+    function Is_Park is new Is_Value ("park");
+    function Is_With is new Is_Value ("with");
+    function Is_Bat is new Is_Value ("bat");
 
-    end Lexer_Parts;
+    function Sat_In is new My_Rat.Parsers.Satisfy (Is_In);
+    function Sat_With is new My_Rat.Parsers.Satisfy (Is_With);
+    function Prep_Choice is new My_Rat.Parsers.Choice ((Sat_In'Access, Sat_With'Access));
+    function Prep is new My_Rat.Parsers.Stamp (Prep, Prep_Choice);
 
+    function Sat_Saw is new My_Rat.Parsers.Satisfy (Is_Saw);
+    function Verb is new My_Rat.Parsers.Stamp (Verb, Sat_Saw);
 
-    function Scanner is new My_Rat.Lexers.Scan_Only
-        ((Lexer_Parts.Word'Access, Lexer_Parts.Whitespace'Access));
+    function Sat_I is new My_Rat.Parsers.Satisfy (Is_I);
+    function Sat_Man is new My_Rat.Parsers.Satisfy (Is_Man);
+    function Sat_Park is new My_Rat.Parsers.Satisfy (Is_Park);
+    function Sat_Bat is new My_Rat.Parsers.Satisfy (Is_Bat);
+    function Noun_Choice is new My_Rat.Parsers.Choice
+        ((Sat_I'Access, Sat_Man'Access, Sat_Park'Access, Sat_Bat'Access));
+    function Noun is new My_Rat.Parsers.Stamp (Noun, Noun_Choice);
 
+    function Sat_A is new My_Rat.Parsers.Satisfy (Is_A);
+    function Sat_The is new My_Rat.Parsers.Satisfy (Is_The);
+    function Det_Choice is new My_Rat.Parsers.Choice ((Sat_A'Access, Sat_The'Access));
+    function Det is new My_Rat.Parsers.Stamp (Det, Det_Choice);
 
+    package NP_Redir is new My_Rat.Parsers.Redirect;
+    package S_Redir is new My_Rat.Parsers.Redirect;
 
+    function VP_Seq is new My_Rat.Parsers.Sequence ((Verb'Access, NP_Redir.Call'Access));
+    function VP is new My_Rat.Parsers.Stamp (VP, VP_Seq);
 
-    package Parser_Parts is
+    function PP_Seq is new My_Rat.Parsers.Sequence ((Prep'Access, NP_Redir.Call'Access));
+    function PP is new My_Rat.Parsers.Stamp (PP, PP_Seq);
 
-        function Prep
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result;
+    function NP_Seq_1 is new My_Rat.Parsers.Sequence ((Det'Access, Noun'Access));
+    function NP_Seq_2 is new My_Rat.Parsers.Sequence ((NP_Redir.Call'Access, PP'Access));
+    function NP_Choice is new My_Rat.Parsers.Choice
+        ((Noun'Access, NP_Seq_1'Access, NP_Seq_2'Access));
+    function NP is new My_Rat.Parsers.Stamp (NP, NP_Choice);
 
-        function Verb
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result;
+    function S_Seq_1 is new My_Rat.Parsers.Sequence ((NP'Access, VP'Access));
+    function S_Seq_2 is new My_Rat.Parsers.Sequence ((S_Redir.Call'Access, PP'Access));
+    function S_Choice is new My_Rat.Parsers.Choice ((S_Seq_1'Access, S_Seq_2'Access));
+    function S is new My_Rat.Parsers.Stamp (S, S_Choice);
 
-        function Noun
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result;
+    function Parser is new My_Rat.Parsers.Parse_Only (S);
 
-        function Det
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result;
 
-        function VP
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result;
 
-        function PP
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result;
 
-        function NP
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result;
-
-        function S
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result;
-
-    end Parser_Parts;
-
-
-    package body Parser_Parts is
-
-        generic
-            Match : in String;
-        function Is_Value
-               (Element : in My_Rat.Lexer_Traits.Tokens.Token)
-            return Boolean;
-
-        function Is_Value
-               (Element : in My_Rat.Lexer_Traits.Tokens.Token)
-            return Boolean is
-        begin
-            return My_Rat.Lexer_Traits.Tokens.Value (Element) = Match;
-        end Is_Value;
-
-        function Is_I is new Is_Value ("i");
-        function Is_Saw is new Is_Value ("saw");
-        function Is_A is new Is_Value ("a");
-        function Is_Man is new Is_Value ("man");
-        function Is_In is new Is_Value ("in");
-        function Is_The is new Is_Value ("the");
-        function Is_Park is new Is_Value ("park");
-        function Is_With is new Is_Value ("with");
-        function Is_Bat is new Is_Value ("bat");
-
-        function Sat_In is new My_Rat.Parsers.Satisfy (Is_In);
-        function Sat_With is new My_Rat.Parsers.Satisfy (Is_With);
-        function Prep_Choice is new My_Rat.Parsers.Choice ((Sat_In'Access, Sat_With'Access));
-        function Prep_Inst is new My_Rat.Parsers.Stamp (Prep, Prep_Choice);
-
-        function Sat_Saw is new My_Rat.Parsers.Satisfy (Is_Saw);
-        function Verb_Inst is new My_Rat.Parsers.Stamp (Verb, Sat_Saw);
-
-        function Sat_I is new My_Rat.Parsers.Satisfy (Is_I);
-        function Sat_Man is new My_Rat.Parsers.Satisfy (Is_Man);
-        function Sat_Park is new My_Rat.Parsers.Satisfy (Is_Park);
-        function Sat_Bat is new My_Rat.Parsers.Satisfy (Is_Bat);
-        function Noun_Choice is new My_Rat.Parsers.Choice
-            ((Sat_I'Access, Sat_Man'Access, Sat_Park'Access, Sat_Bat'Access));
-        function Noun_Inst is new My_Rat.Parsers.Stamp (Noun, Noun_Choice);
-
-        function Sat_A is new My_Rat.Parsers.Satisfy (Is_A);
-        function Sat_The is new My_Rat.Parsers.Satisfy (Is_The);
-        function Det_Choice is new My_Rat.Parsers.Choice ((Sat_A'Access, Sat_The'Access));
-        function Det_Inst is new My_Rat.Parsers.Stamp (Det, Det_Choice);
-
-        function VP_Seq is new My_Rat.Parsers.Sequence ((Verb'Access, NP'Access));
-        function VP_Inst is new My_Rat.Parsers.Stamp (VP, VP_Seq);
-
-        function PP_Seq is new My_Rat.Parsers.Sequence ((Prep'Access, NP'Access));
-        function PP_Inst is new My_Rat.Parsers.Stamp (PP, PP_Seq);
-
-        function NP_Seq_1 is new My_Rat.Parsers.Sequence ((Det'Access, Noun'Access));
-        function NP_Seq_2 is new My_Rat.Parsers.Sequence ((NP'Access, PP'Access));
-        function NP_Choice is new My_Rat.Parsers.Choice
-            ((Noun'Access, NP_Seq_1'Access, NP_Seq_2'Access));
-        function NP_Inst is new My_Rat.Parsers.Stamp (NP, NP_Choice);
-
-        function S_Seq_1 is new My_Rat.Parsers.Sequence ((NP'Access, VP'Access));
-        function S_Seq_2 is new My_Rat.Parsers.Sequence ((S'Access, PP'Access));
-        function S_Choice is new My_Rat.Parsers.Choice ((S_Seq_1'Access, S_Seq_2'Access));
-        function S_Inst is new My_Rat.Parsers.Stamp (S, S_Choice);
-
-        function Prep
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result renames Prep_Inst;
-
-        function Verb
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result renames Verb_Inst;
-
-        function Noun
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result renames Noun_Inst;
-
-        function Det
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result renames Det_Inst;
-
-        function VP
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result renames VP_Inst;
-
-        function PP
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result renames PP_Inst;
-
-        function NP
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result renames NP_Inst;
-
-        function S
-               (Input   : in     My_Rat.Lexer_Traits.Tokens.Token_Array;
-                Context : in out My_Rat.Parsers.Parser_Context;
-                Start   : in     Positive)
-            return My_Rat.Parsers.Combinator_Result renames S_Inst;
-
-    end Parser_Parts;
-
-
-    function Parser is new My_Rat.Parsers.Parse_Only (Parser_Parts.S);
-
-
-
-
-    My_Lexer_Context : My_Rat.Lexers.Lexer_Context :=
-        My_Rat.Lexers.Empty_Context;
-    My_Parser_Context : My_Rat.Parsers.Parser_Context :=
-        My_Rat.Parsers.Empty_Context;
+    My_Lexer_Context : My_Rat.Lexers.Lexer_Context := My_Rat.Lexers.Empty_Context;
+    My_Parser_Context : My_Rat.Parsers.Parser_Context := My_Rat.Parsers.Empty_Context;
 
     Lexed_Tokens : My_Rat.Lexer_Result := Scanner (Input, My_Lexer_Context);
-    Result_Graph : My_Rat.Parser_Result := Parser (Lexed_Tokens, My_Parser_Context);
+    Result_Graph : My_Rat.Parser_Result;
 
 
 begin
 
 
-    Put_Line ("Input:" & Input);
+    --  Very important!
+    --  If these aren't set before calling the parser, an exception will be raised.
+    NP_Redir.Set (NP'Access);
+    S_Redir.Set (S'Access);
+
+    Result_Graph := Parser (Lexed_Tokens, My_Parser_Context);
+
+
+    Put_Line ("Input:");
+    Put_Line (Input);
+    New_Line;
+
+    Put_Line ("Lexer token output:");
+    for T of Lexed_Tokens loop
+        Put (My_Rat.Lexer_Traits.Tokens.Debug_String (T));
+    end loop;
     New_Line;
 
-    Put_Line ("Output:");
+    Put_Line ("Parser graph output:");
     Put_Line (My_Rat.Parse_Graphs.Debug_String (Result_Graph));
 
 
diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb
index f639195..df88e71 100644
--- a/src/packrat-parsers.adb
+++ b/src/packrat-parsers.adb
@@ -582,6 +582,33 @@ package body Packrat.Parsers is
 
 
 
+    package body Redirect is
+
+        procedure Set
+               (Target : in Combinator) is
+        begin
+            Combo := Target;
+        end Set;
+
+        function Call
+               (Input   : in     Traits.Element_Array;
+                Context : in out Parser_Context;
+                Start   : in     Positive)
+            return Combinator_Result is
+        begin
+            if Combo = null then
+                raise Parser_Error;
+            else
+                return Combo (Input, Context, Start);
+            end if;
+        end Call;
+
+    end Redirect;
+
+
+
+
+
     function Sequence
            (Input   : in     Traits.Element_Array;
             Context : in out Parser_Context;
diff --git a/src/packrat-parsers.ads b/src/packrat-parsers.ads
index 99dbee7..8d0ba68 100644
--- a/src/packrat-parsers.ads
+++ b/src/packrat-parsers.ads
@@ -114,6 +114,27 @@ package Packrat.Parsers is
 
 
     generic
+    package Redirect is
+
+        procedure Set
+               (Target : in Combinator);
+
+        function Call
+               (Input   : in     Traits.Element_Array;
+                Context : in out Parser_Context;
+                Start   : in     Positive)
+            return Combinator_Result;
+
+    private
+
+        Combo : Combinator := null;
+
+    end Redirect;
+
+
+
+
+    generic
         Params : in Combinator_Array;
     function Sequence
            (Input   : in     Traits.Element_Array;