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
| -- The pragma instruction is quite special in that it may appear in
-- many different location. This package parses any pragma and then
-- checks for the validity of the location depending on the caller.
with aada_vstrings;
with aada_compiler_error_package;
with aada_compiler_parser_expression;
use aada_vstrings;
use aada_compiler_error_package;
package body aada_compiler_parser_pragma is
procedure parse_page(p: in out compiler_parser_type;
n: out compiler_node_handle) is
begin
null;
end parse_page;
procedure parse_page_info(p: in out compiler_parser_type;
n: out compiler_node_handle) is
begin
-- syntax: '(' [ <name> => ] <value>, { [ <name> => ] <value> } ')'
-- where <name> is one of: width, height, vertical_tab,
-- horizontal_tab
-- where <value> is an integer
null;
end parse_page_info;
procedure parse_pragma(p: in out compiler_parser_type;
t: in out compiler_token_type;
n: out compiler_node_handle) is
name: vstring;
token: ada_token;
l, r: compiler_node_handle;
begin
loop
-- this is not a pragma, exit
exit when get_token_token(t) /= token_pragma;
create_node(n, t, 2);
-- okay, we've got a pragma, parse it
next_token(p, t);
token := get_token_token(t);
-- a "normal" pragma (named using an identifier)
-- or the interface pragma (since Ada 95 "interface" is a reserved word)
-- are accepted
if token /= token_identifier and then token /= token_interface then
-- anything else is not valid for a pragma definition so first we
-- emit an error then we try to understand what the user was up to
error(p, expected_an_identifier_error, t,
"pragma must be followed by an identifier");
-- check for what appears next (i.e. '(' missing identifier, ';'
-- idem, etc.) but skip the "pragma" otherwise
else
-- save the name of the pragma in the node
create_node(l, t);
parent(l, n);
-- first parse the pragma parameters (expr_list)
next_token(p, t);
token := get_token_token(t);
if token /= token_open_parenthesis then
-- many pragmas are used without parameters so it is legal
-- but in this case you expect a semi-colon
if token /= token_semi_colon then
error(p, expected_an_identifier_error, t,
"open parenthesis or semi-colon was expected after"
& " a pragma name");
-- skip up to the next semi-colon
end if;
else
-- get the expression list, should end with ')'
aada_compiler_parser_expression.expr_list(p, t, r);
parent(r, n, 2);
token := get_token_token(t);
if token /= token_close_parenthesis then
error(p, expected_an_identifier_error, t,
"close parenthesis was expected at the end of a list of pragma"
& " parameters");
else
next_token(p, t);
token := get_token_token(t);
if token /= token_semi_colon then
error(p, expected_an_identifier_error, t,
"a pragma declaration is expected to end with a semi-colon"
& " (;) character");
end if;
end if;
end if;
name := get_token_uppercase(t);
if name = "PAGE" then
parse_page(p, l);
elsif name = "PAGE_INFO" then
parse_page_info(p, l);
else
-- we don't know anything about this pragma...
return;
end if;
end if;
end loop;
end parse_pragma;
end aada_compiler_parser_pragma;
-- vim: ts=2 sw=2 et syntax=ada |
