AAda Compiler Token Position

17
Jan
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
package body aada_compiler_token_position is
 
-- page sizes functions
procedure set_page_size(page_sizes: in out page_sizes_type;
                        page_width: in position_type;
                        page_height: in position_type;
                        horizontal_tab: in position_type;
                        vertical_tab: in position_type) is
begin
  -- verify that the positions are within sensible ranges
  if page_width < minimum_page_width
  or else page_height < minimum_page_height
  or else horizontal_tab < minimum_tab_size
  or else horizontal_tab >= page_width / 2
  or else vertical_tab < minimum_tab_size
  or else vertical_tab >= page_height / 2
  then
    raise page_size_limits_error;
  end if;
 
  -- save acceptable sizes
  page_sizes.page_width := page_width;
  page_sizes.page_height := page_height;
  page_sizes.horizontal_tab := horizontal_tab;
  page_sizes.vertical_tab := vertical_tab;
end set_page_size;
 
function get_size(page_sizes: in page_sizes_type;
                  parameter: in page_sizes_field := horizontal_tab)
                                               return position_type is
begin
  case parameter is
  when page_width =>
    return page_sizes.page_width;
  when page_height =>
    return page_sizes.page_height;
  when horizontal_tab =>
    return page_sizes.horizontal_tab;
  when vertical_tab =>
    return page_sizes.vertical_tab;
  end case;
end get_size;
 
 
-- position functions
procedure initialize_position(position: out token_position_type;
                              filename: in aada_vstrings.vstring) is
begin
  position.filename := filename;
  position.character := 1;
  position.line_character := 1;
  position.line := 1;
  position.page_line := 1;
  position.page := 1;
end initialize_position;
 
procedure next_page(page_sizes: in out page_sizes_type;
                    position: in out token_position_type) is
begin
  position.page := position_type'succ(position.page);
 
  -- we're at the top of the next page
  position.page_line := 1;
 
  -- we also reset the character position to the left
  -- (this is not automatically correct though.)
  position.character := 1;
  position.line_character := 1;
end next_page;
 
procedure next_line(page_sizes: in out page_sizes_type;
                    position: in out token_position_type;
                    count: in position_type := 1) is
begin
  position.line := position.line + count;
  position.page_line := position.page_line + count;
  if count > 1 then
    -- make it a multiple of count
    position.line := position.line - position.line rem count;
    position.page_line := position.page_line - position.page_line rem count;
  end if;
  if position.page_line >= page_sizes.page_height then
    next_page(page_sizes, position);
  else
    -- since we accept LF and CR LF and CR as an end of
    -- line, we have to force the character position back
    -- to 1 in all cases (next_page() already does it so
    -- to avoid doing it twice we do it in the else part)
    position.character := 1;
    position.line_character := 1;
  end if;
end next_line;
 
procedure next_character(page_sizes: in out page_sizes_type;
                         position: in out token_position_type;
                         count: in position_type := 1) is
  character_position: position_type;
begin
  position.character := position.character + count;
  position.line_character := position.line_character + count;
  if count > 1 then
    -- make it a multiple of count
    position.character := position.character - position.character rem count;
    position.line_character := position.line_character
                                        - position.line_character rem count;
  end if;
  -- auto-New_Line?
  -- (this is primarily for output)
  if position.line_character > page_sizes.page_width then
    -- in this case we want to save the character position
    -- since tha auto new line does not affect them
    character_position := position.character;
    next_line(page_sizes, position);
    position.character := character_position;
  end if;
end next_character;
 
function get_position_filename(position: in token_position_type)
                                          return aada_vstrings.vstring is
begin
  return position.filename;
end get_position_filename;
 
function get_position(position: in token_position_type;
                      parameter: in token_position_field := line)
                                          return position_type is
begin
  case parameter is
  when character =>
    return position.character;
  when line_character =>
    return position.line_character;
  when line =>
    return position.line;
  when page_line =>
    return position.page_line;
  when page =>
    return position.page;
  end case;
end get_position;
 
 
end aada_compiler_token_position;
 
-- vim: ts=2 sw=2 et syntax=ada
Project aada v1.0-338 (Project id #3)
Process Done (Last compiled on 2012/01/13 01:21:26)
Description Alexis Ada Compiler written in Ada (my first attempt was in C++ which is not correct for an Ada compiler.)
Syndicate content