summaryrefslogtreecommitdiff
path: root/example/sentence.adb
blob: 93379d7efd99b0525a12fb11f41b839f326ee880 (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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153


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




    --  Lexer grammar to group letters into words and get rid of whitespace

    function Sat_Alpha is new Lexers.Satisfy (Packrat.Utilities.Is_Letter);
    function Many_Alpha is new Lexers.Many (Sat_Alpha, 1);
    function Word is new Lexers.Stamp (Word, Many_Alpha);

    function Sat_Blank is new Lexers.Satisfy (Packrat.Utilities.Is_Whitespace);
    function Many_Blank is new Lexers.Many (Sat_Blank, 1);
    function Whitespace is new Lexers.Discard (Whitespace, Many_Blank);

    package Scanner is new Lexers.Scan_Once ((Word'Access, Whitespace'Access));




    --  Parser grammar from page 2 of
    --  Parser Combinators for Ambiguous Left-Recursive Grammars
    --  (Richard A. Frost, Rahmatullah Hafiz, Paul Callaghan, 2008)

    --  s ::= np vp | s pp
    --  np ::= noun | det noun | np pp
    --  pp ::= prep np
    --  vp ::= verb np
    --  det ::= "a" | "the"
    --  noun ::= "i" | "man" | "park" | "bat"
    --  verb ::= "saw"
    --  prep ::= "in" | "with"

    function Is_In is new Lexer_Tokens.Is_Value ("in");
    function Is_With is new Lexer_Tokens.Is_Value ("with");
    function Sat_In is new Parsers.Satisfy (Is_In);
    function Sat_With is new Parsers.Satisfy (Is_With);
    function Prep_Choice is new Parsers.Choice_2 (Sat_In, Sat_With);
    function Prep is new Parsers.Stamp (Prep, Prep_Choice);

    function Is_Saw is new Lexer_Tokens.Is_Value ("saw");
    function Sat_Saw is new Parsers.Satisfy (Is_Saw);
    function Verb is new Parsers.Stamp (Verb, Sat_Saw);

    function Is_I is new Lexer_Tokens.Is_Value ("i");
    function Is_Man is new Lexer_Tokens.Is_Value ("man");
    function Is_Park is new Lexer_Tokens.Is_Value ("park");
    function Is_Bat is new Lexer_Tokens.Is_Value ("bat");
    function Sat_I is new Parsers.Satisfy (Is_I);
    function Sat_Man is new Parsers.Satisfy (Is_Man);
    function Sat_Park is new Parsers.Satisfy (Is_Park);
    function Sat_Bat is new Parsers.Satisfy (Is_Bat);
    function Noun_Choice is new Parsers.Choice
        ((Sat_I'Access, Sat_Man'Access, Sat_Park'Access, Sat_Bat'Access));
    function Noun is new Parsers.Stamp (Noun, Noun_Choice);

    function Is_A is new Lexer_Tokens.Is_Value ("a");
    function Is_The is new Lexer_Tokens.Is_Value ("the");
    function Sat_A is new Parsers.Satisfy (Is_A);
    function Sat_The is new Parsers.Satisfy (Is_The);
    function Det_Choice is new Parsers.Choice_2 (Sat_A, Sat_The);
    function Det is new Parsers.Stamp (Det, Det_Choice);

    --  These redirectors are needed to resolve circular references in the instantiations.
    package NP_Redir is new Parsers.Redirect;
    package S_Redir is new Parsers.Redirect;

    function VP_Seq is new Parsers.Sequence_2 (Verb, NP_Redir.Call);
    function VP is new Parsers.Stamp (VP, VP_Seq);

    function PP_Seq is new Parsers.Sequence_2 (Prep, NP_Redir.Call);
    function PP is new Parsers.Stamp (PP, PP_Seq);

    function NP_Seq_1 is new Parsers.Sequence_2 (Det, Noun);
    function NP_Seq_2 is new Parsers.Sequence_2 (NP_Redir.Call, PP);
    function NP_Choice is new Parsers.Choice
        ((Noun'Access, NP_Seq_1'Access, NP_Seq_2'Access));
    function NP is new Parsers.Stamp (NP, NP_Choice);

    function S_Seq_1 is new Parsers.Sequence_2 (NP, VP);
    function S_Seq_2 is new Parsers.Sequence_2 (S_Redir.Call, PP);
    function S_Choice is new Parsers.Choice_2 (S_Seq_1, S_Seq_2);
    function S is new Parsers.Stamp (S, S_Choice);

    package Parser is new Parsers.Parse_Once (S);




    Lexed_Tokens : Lexer_Result := Scanner.Scan (Input);
    Result_Graph : 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 (Lexer_Tokens.Debug_String (T));
    end loop;
    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 Sentence;