AAda Compiler Node Package

28
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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
package body aada_compiler_node_package is
 
procedure init(node: in out compiler_node;
               token: in aada_compiler_token_package.compiler_token_type) is
begin
  node.token := token;
end init;
 
-- note that the children remains!
procedure unlink(node: in out compiler_node_access) is
begin
  if node.previous /= null then
    node.previous.next := node.next;
  elsif node.parent /= null then
    node.parent.child(node.index) := node.next;
  end if;
  if node.next /= null then
    node.next.previous := node.previous;
  end if;
  node.parent := null;
  node.next := null;
  node.previous := null;
end unlink;
 
procedure parent(node: in out compiler_node_access;
                 parent: in out compiler_node_access;
                 child_index: in compiler_node_index := 1) is
  l: compiler_node_access;
begin
  node := first(node);
 
  -- attach to the new parent if not null
  if parent /= null and then node.parent /= parent then
    if parent.child(child_index) /= null then
      -- we're not the first... attach at the end of the existing children
      l := last(parent.child(child_index));
      l.next := node;
      node.previous := l;
    else
      -- we're the first
      parent.child(child_index) := node;
    end if;
    -- avoid the detach (see loop below)
    node.parent := parent;
  end if;
 
  -- now reparent all the siblings in this list
  while node /= null
  loop
    -- detach from the old parent if any
    if node.parent /= null and then node.parent /= parent then
      node.parent.child(node.index) := null;
    end if;
 
    node.parent := parent;
    node.index := child_index;
 
    -- loop through all the siblings
    node := node.next;
  end loop;
end parent;
 
function parent(node: in compiler_node_access) return compiler_node_access is
begin
  return node.parent;
end parent;
 
function child(node: in compiler_node_access;
               child_index: in compiler_node_index := 1)
                                            return compiler_node_access is
begin
  return node.child(child_index);
end child;
 
procedure next(node: in out compiler_node_access;
               next: in out compiler_node_access) is
  f: compiler_node_access;
  l: compiler_node_access;
begin
  f := first(next);
  l := last(next);
 
  l.next := node.next;
  f.previous := node;
  node.next := f;
  if l.next /= null then
    l.next.previous := l;
  end if;
 
  -- reparent our new children
  parent(node, node.parent, node.index);
end next;
 
function next(node: in compiler_node_access) return compiler_node_access is
begin
  return node.next;
end next;
 
function last(node: in compiler_node_access) return compiler_node_access is
  n: compiler_node_access := node;
begin
  if n /= null then
    while n.next /= null
    loop
      n := n.next;
    end loop;
  end if;
  return n;
end last;
 
procedure previous(node: in out compiler_node_access;
                   previous: in out compiler_node_access) is
  f: compiler_node_access;
  l: compiler_node_access;
begin
  f := first(previous);
  l := last(previous);
 
  l.next := node;
  f.previous := node.previous;
  node.previous := l;
  if f.previous /= null then
    f.previous.next := f;
  end if;
 
  -- reparent our new children
  parent(node, node.parent, node.index);
end previous;
 
function previous(node: in compiler_node_access)
                                        return compiler_node_access is
begin
  return node.previous;
end previous;
 
function first(node: in compiler_node_access) return compiler_node_access is
  n: compiler_node_access := node;
begin
  if n /= null then
    while n.previous /= null
    loop
      n := n.previous;
    end loop;
  end if;
  return n;
end first;
 
procedure create_node(node_handle: in out compiler_node_handle;
                      token: in aada_compiler_token_package.compiler_token_type;
                      children: in compiler_node_index := 0) is
begin
  node_handle.node := new compiler_node(children);
  init(node_handle.node.all, token);
end create_node;
 
procedure init(node_handle: compiler_node_handle;
               token: in aada_compiler_token_package.compiler_token_type) is
begin
  init(node_handle.node.all, token);
end init;
 
procedure parent(node_handle: in out compiler_node_handle;
                 parent_handle: in out compiler_node_handle;
                 child_index: in compiler_node_index := 1) is
begin
  parent(node_handle.node, parent_handle.node, child_index);
end parent;
 
procedure next(node_handle: in out compiler_node_handle;
               next_handle: in out compiler_node_handle) is
begin
  next(node_handle.node, next_handle.node);
end next;
 
end aada_compiler_node_package;
 
-- 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