diff options
| -rw-r--r-- | example/sentence.adb | 282 | ||||
| -rw-r--r-- | src/packrat-parsers.adb | 27 | ||||
| -rw-r--r-- | src/packrat-parsers.ads | 21 |
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; |