parser-refinement.c
1 //! @file parser-refinement.c
2 //! @author J. Marcel van der Veer
3 //!
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
8 //!
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! Refinement preprocessor.
25
26 #include "a68g.h"
27 #include "a68g-parser.h"
28
29 // This code implements a small refinement preprocessor for A68G.
30 //
31 // At the University of Nijmegen a preprocessor much like this one was used
32 // as a front-end to FLACC in elementary computer science courses.
33 // See:
34 //
35 // C.H.A. Koster et al.,
36 // Systematisch programmeren in Algol 68, Deel I en II.
37
38 //! @brief Whether refinement terminator.
39
40 BOOL_T is_refinement_terminator (NODE_T * p)
41 {
42 if (IS (p, POINT_SYMBOL)) {
43 if (IN_PRELUDE (NEXT (p))) {
44 return A68_TRUE;
45 } else {
46 return whether (p, POINT_SYMBOL, IDENTIFIER, COLON_SYMBOL, STOP);
47 }
48 } else {
49 return A68_FALSE;
50 }
51 }
52
53 //! @brief Get refinement definitions in the internal source.
54
55 void get_refinements (void)
56 {
57 NODE_T *p = TOP_NODE (&A68_JOB);
58 TOP_REFINEMENT (&A68_JOB) = NO_REFINEMENT;
59 // First look where the prelude ends.
60 while (p != NO_NODE && IN_PRELUDE (p)) {
61 FORWARD (p);
62 }
63 // Determine whether the program contains refinements at all.
64 while (p != NO_NODE && !IN_PRELUDE (p) && !is_refinement_terminator (p)) {
65 FORWARD (p);
66 }
67 if (p == NO_NODE || IN_PRELUDE (p)) {
68 return;
69 }
70 // Apparently this is code with refinements.
71 FORWARD (p);
72 if (p == NO_NODE || IN_PRELUDE (p)) {
73 // Ok, we accept a program with no refinements as well.
74 return;
75 }
76 while (p != NO_NODE && !IN_PRELUDE (p) && whether (p, IDENTIFIER, COLON_SYMBOL, STOP)) {
77 REFINEMENT_T *new_one = (REFINEMENT_T *) get_fixed_heap_space ((size_t) SIZE_ALIGNED (REFINEMENT_T)), *x;
78 BOOL_T exists;
79 NEXT (new_one) = NO_REFINEMENT;
80 NAME (new_one) = NSYMBOL (p);
81 APPLICATIONS (new_one) = 0;
82 LINE_DEFINED (new_one) = LINE (INFO (p));
83 LINE_APPLIED (new_one) = NO_LINE;
84 NODE_DEFINED (new_one) = p;
85 BEGIN (new_one) = END (new_one) = NO_NODE;
86 p = NEXT_NEXT (p);
87 if (p == NO_NODE) {
88 diagnostic (A68_SYNTAX_ERROR, NO_NODE, ERROR_REFINEMENT_EMPTY);
89 return;
90 } else {
91 BEGIN (new_one) = p;
92 }
93 while (p != NO_NODE && ATTRIBUTE (p) != POINT_SYMBOL) {
94 END (new_one) = p;
95 FORWARD (p);
96 }
97 if (p == NO_NODE) {
98 diagnostic (A68_SYNTAX_ERROR, NO_NODE, ERROR_SYNTAX_EXPECTED, POINT_SYMBOL);
99 return;
100 } else {
101 FORWARD (p);
102 }
103 // Do we already have one by this name.
104 x = TOP_REFINEMENT (&A68_JOB);
105 exists = A68_FALSE;
106 while (x != NO_REFINEMENT && !exists) {
107 if (NAME (x) == NAME (new_one)) {
108 diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (new_one), ERROR_REFINEMENT_DEFINED);
109 exists = A68_TRUE;
110 }
111 FORWARD (x);
112 }
113 // Straight insertion in chain.
114 if (!exists) {
115 NEXT (new_one) = TOP_REFINEMENT (&A68_JOB);
116 TOP_REFINEMENT (&A68_JOB) = new_one;
117 }
118 }
119 if (p != NO_NODE && !IN_PRELUDE (p)) {
120 diagnostic (A68_SYNTAX_ERROR, p, ERROR_REFINEMENT_INVALID);
121 }
122 }
123
124 //! @brief Put refinement applications in the internal source.
125
126 void put_refinements (void)
127 {
128 REFINEMENT_T *x;
129 NODE_T *p, *point;
130 // If there are no refinements, there's little to do.
131 if (TOP_REFINEMENT (&A68_JOB) == NO_REFINEMENT) {
132 return;
133 }
134 // Initialisation.
135 x = TOP_REFINEMENT (&A68_JOB);
136 while (x != NO_REFINEMENT) {
137 APPLICATIONS (x) = 0;
138 FORWARD (x);
139 }
140 // Before we introduce infinite loops, find where closing-prelude starts.
141 p = TOP_NODE (&A68_JOB);
142 while (p != NO_NODE && IN_PRELUDE (p)) {
143 FORWARD (p);
144 }
145 while (p != NO_NODE && !IN_PRELUDE (p)) {
146 FORWARD (p);
147 }
148 ABEND (p == NO_NODE, ERROR_INTERNAL_CONSISTENCY, __func__);
149 point = p;
150 // We need to substitute until the first point.
151 p = TOP_NODE (&A68_JOB);
152 while (p != NO_NODE && ATTRIBUTE (p) != POINT_SYMBOL) {
153 if (IS (p, IDENTIFIER)) {
154 // See if we can find its definition.
155 REFINEMENT_T *y = NO_REFINEMENT;
156 x = TOP_REFINEMENT (&A68_JOB);
157 while (x != NO_REFINEMENT && y == NO_REFINEMENT) {
158 if (NAME (x) == NSYMBOL (p)) {
159 y = x;
160 } else {
161 FORWARD (x);
162 }
163 }
164 if (y != NO_REFINEMENT) {
165 // We found its definition.
166 APPLICATIONS (y)++;
167 if (APPLICATIONS (y) > 1) {
168 diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (y), ERROR_REFINEMENT_APPLIED);
169 FORWARD (p);
170 } else {
171 // Tie the definition in the tree.
172 LINE_APPLIED (y) = LINE (INFO (p));
173 if (PREVIOUS (p) != NO_NODE) {
174 NEXT (PREVIOUS (p)) = BEGIN (y);
175 }
176 if (BEGIN (y) != NO_NODE) {
177 PREVIOUS (BEGIN (y)) = PREVIOUS (p);
178 }
179 if (NEXT (p) != NO_NODE) {
180 PREVIOUS (NEXT (p)) = END (y);
181 }
182 if (END (y) != NO_NODE) {
183 NEXT (END (y)) = NEXT (p);
184 }
185 p = BEGIN (y); // So we can substitute the refinements within
186 }
187 } else {
188 FORWARD (p);
189 }
190 } else {
191 FORWARD (p);
192 }
193 }
194 // After the point we ignore it all until the prelude.
195 if (p != NO_NODE && IS (p, POINT_SYMBOL)) {
196 if (PREVIOUS (p) != NO_NODE) {
197 NEXT (PREVIOUS (p)) = point;
198 }
199 if (PREVIOUS (point) != NO_NODE) {
200 PREVIOUS (point) = PREVIOUS (p);
201 }
202 } else {
203 diagnostic (A68_SYNTAX_ERROR, p, ERROR_SYNTAX_EXPECTED, POINT_SYMBOL);
204 }
205 // Has the programmer done it well?.
206 if (ERROR_COUNT (&A68_JOB) == 0) {
207 x = TOP_REFINEMENT (&A68_JOB);
208 while (x != NO_REFINEMENT) {
209 if (APPLICATIONS (x) == 0) {
210 diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (x), ERROR_REFINEMENT_NOT_APPLIED);
211 }
212 FORWARD (x);
213 }
214 }
215 }
