summaryrefslogtreecommitdiff
path: root/example/sentence.adb
blob: b6cded9f5f90768f542c6f15165c7a407e88bf9b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137


--  This source is licensed under the Sunset License v1.0


with

    Ada.Text_IO,
    Packrat.Standard,
    Packrat.Utilities;

use

    Ada.Text_IO;


procedure Sentence is


    Input : String := "i saw a man in the park with a bat";

    type Lexer_Labels is (Word, Whitespace);
    type Parser_Labels is (S, NP, PP, VP, Det, Noun, Verb, Prep);

    package My_Rat is new Packrat.Standard
        (Lexer_Labels, Parser_Labels, Character, String);




    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 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 ((Word'Access, Whitespace'Access));




    function Is_In is new My_Rat.Lexer_Tokens.Is_Value ("in");
    function Is_With is new My_Rat.Lexer_Tokens.Is_Value ("with");
    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 Is_Saw is new My_Rat.Lexer_Tokens.Is_Value ("saw");
    function Sat_Saw is new My_Rat.Parsers.Satisfy (Is_Saw);
    function Verb is new My_Rat.Parsers.Stamp (Verb, Sat_Saw);

    function Is_I is new My_Rat.Lexer_Tokens.Is_Value ("i");
    function Is_Man is new My_Rat.Lexer_Tokens.Is_Value ("man");
    function Is_Park is new My_Rat.Lexer_Tokens.Is_Value ("park");
    function Is_Bat is new My_Rat.Lexer_Tokens.Is_Value ("bat");
    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 Is_A is new My_Rat.Lexer_Tokens.Is_Value ("a");
    function Is_The is new My_Rat.Lexer_Tokens.Is_Value ("the");
    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);

    --  These redirectors are needed to resolve circular references in the instantiations.
    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);

    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 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 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);

    package Parser is new My_Rat.Parsers.Parse_Once (S);




    Lexed_Tokens : My_Rat.Lexer_Result := Scanner.Scan (Input);
    Result_Graph : My_Rat.Parser_Result;


begin


    --  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.Parse (Lexed_Tokens);


    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;


end Sentence;