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-2024 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 // It is included for educational purposes only.
31 // At the University of Nijmegen a preprocessor much like this one
32 // was used as a front-end to FLACC in freshman programming courses.
33 //
34 // See:
35 // C.H.A. Koster et al.,
36 // Systematisch programmeren in Algol 68, Deel I en II.
37 // Kluwer, Deventer [1978, 1981]
38 //
39 // The superimposed 'refinement grammar' is trivial:
40 // refined-program-option:
41 // refined-algol-68-source-code;
42 // point-symbol;
43 // refinement-definition-sequence-option.
44 // refinement-definition:
45 // defining-identifier;
46 // colon-symbol;
47 // refined-Algol-68-source-code;
48 // point-symbol.
49 // refined-algol-68-source-code:
50 // # valid source code,
51 // with applied-refinements,
52 // without refinement-definitions #.
53 // applied-refinement:
54 // identifier.
55 //
56 // An applied-refinement is textually substituted for its definition.
57 // Note that refinement-definitions cannot be nested.
58 // Nested refinement-definitions would allow conflict with Algol 68 labels.
59 // The naive approach (no nesting) was chosen here to keep matters simple.
60 //
61 // Wirth had another approach to refinements in Pascal: procedures.
62 // That works for Algol 68 as well, of course.
63
64 //! @brief Whether refinement terminator.
65
66 BOOL_T is_refinement_terminator (NODE_T * p)
67 {
68 if (IS (p, POINT_SYMBOL)) {
69 if (IN_PRELUDE (NEXT (p))) {
70 return A68_TRUE;
71 } else {
72 return whether (p, POINT_SYMBOL, IDENTIFIER, COLON_SYMBOL, STOP);
73 }
74 } else {
75 return A68_FALSE;
76 }
77 }
78
79 //! @brief Get refinement definitions in the internal source.
80
81 void get_refinements (void)
82 {
83 TOP_REFINEMENT (&A68_JOB) = NO_REFINEMENT;
84 // First look where the prelude ends.
85 NODE_T *p = TOP_NODE (&A68_JOB);
86 while (p != NO_NODE && IN_PRELUDE (p)) {
87 FORWARD (p);
88 }
89 // Determine whether the program contains refinements at all.
90 while (p != NO_NODE && !IN_PRELUDE (p) && !is_refinement_terminator (p)) {
91 FORWARD (p);
92 }
93 if (p == NO_NODE || IN_PRELUDE (p)) {
94 return;
95 }
96 FORWARD (p);
97 if (p == NO_NODE || IN_PRELUDE (p)) {
98 // A program without refinements.
99 return;
100 }
101 // Apparently this is code with refinements.
102 while (p != NO_NODE && !IN_PRELUDE (p) && whether (p, IDENTIFIER, COLON_SYMBOL, STOP)) {
103 REFINEMENT_T *new_one = (REFINEMENT_T *) get_fixed_heap_space ((size_t) SIZE_ALIGNED (REFINEMENT_T));
104 NEXT (new_one) = NO_REFINEMENT;
105 NAME (new_one) = NSYMBOL (p);
106 APPLICATIONS (new_one) = 0;
107 LINE_DEFINED (new_one) = LINE (INFO (p));
108 LINE_APPLIED (new_one) = NO_LINE;
109 NODE_DEFINED (new_one) = p;
110 BEGIN (new_one) = END (new_one) = NO_NODE;
111 p = NEXT_NEXT (p);
112 if (p == NO_NODE) {
113 diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (new_one), ERROR_REFINEMENT_EMPTY);
114 return;
115 } else {
116 BEGIN (new_one) = p;
117 }
118 while (p != NO_NODE && ATTRIBUTE (p) != POINT_SYMBOL) {
119 END (new_one) = p;
120 FORWARD (p);
121 }
122 if (p == NO_NODE) {
123 diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (new_one), ERROR_REFINEMENT_INVALID);
124 return;
125 } else {
126 FORWARD (p);
127 }
128 // Do we already have one by this name.
129 REFINEMENT_T *x = TOP_REFINEMENT (&A68_JOB);
130 BOOL_T exists = A68_FALSE;
131 while (x != NO_REFINEMENT && !exists) {
132 if (NAME (x) == NAME (new_one)) {
133 diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (new_one), ERROR_REFINEMENT_DEFINED);
134 exists = A68_TRUE;
135 }
136 FORWARD (x);
137 }
138 // Straight insertion in chain.
139 if (!exists) {
140 NEXT (new_one) = TOP_REFINEMENT (&A68_JOB);
141 TOP_REFINEMENT (&A68_JOB) = new_one;
142 }
143 }
144 if (p != NO_NODE && !IN_PRELUDE (p)) {
145 diagnostic (A68_SYNTAX_ERROR, p, ERROR_REFINEMENT_INVALID);
146 }
147 }
148
149 //! @brief Put refinement applications in the internal source.
150
151 void put_refinements (void)
152 {
153 // If there are no refinements, there's little to do.
154 if (TOP_REFINEMENT (&A68_JOB) == NO_REFINEMENT) {
155 return;
156 }
157 // Initialisation.
158 REFINEMENT_T *x = TOP_REFINEMENT (&A68_JOB);
159 while (x != NO_REFINEMENT) {
160 APPLICATIONS (x) = 0;
161 FORWARD (x);
162 }
163 // Before we introduce infinite loops, find where closing-prelude starts.
164 NODE_T *p = TOP_NODE (&A68_JOB);
165 while (p != NO_NODE && IN_PRELUDE (p)) {
166 FORWARD (p);
167 }
168 while (p != NO_NODE && !IN_PRELUDE (p)) {
169 FORWARD (p);
170 }
171 ABEND (p == NO_NODE, ERROR_INTERNAL_CONSISTENCY, __func__);
172 NODE_T *point = p;
173 // We need to substitute until the first point.
174 p = TOP_NODE (&A68_JOB);
175 while (p != NO_NODE && ATTRIBUTE (p) != POINT_SYMBOL) {
176 if (IS (p, IDENTIFIER)) {
177 // See if we can find its definition.
178 REFINEMENT_T *y = NO_REFINEMENT;
179 x = TOP_REFINEMENT (&A68_JOB);
180 while (x != NO_REFINEMENT && y == NO_REFINEMENT) {
181 if (NAME (x) == NSYMBOL (p)) {
182 y = x;
183 } else {
184 FORWARD (x);
185 }
186 }
187 if (y != NO_REFINEMENT) {
188 // We found its definition.
189 APPLICATIONS (y)++;
190 if (APPLICATIONS (y) > 1) {
191 diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (y), ERROR_REFINEMENT_APPLIED);
192 FORWARD (p);
193 } else {
194 // Tie the definition in the tree.
195 LINE_APPLIED (y) = LINE (INFO (p));
196 if (PREVIOUS (p) != NO_NODE) {
197 NEXT (PREVIOUS (p)) = BEGIN (y);
198 }
199 if (BEGIN (y) != NO_NODE) {
200 PREVIOUS (BEGIN (y)) = PREVIOUS (p);
201 }
202 if (NEXT (p) != NO_NODE) {
203 PREVIOUS (NEXT (p)) = END (y);
204 }
205 if (END (y) != NO_NODE) {
206 NEXT (END (y)) = NEXT (p);
207 }
208 p = BEGIN (y); // So we can substitute the refinements within
209 }
210 } else {
211 FORWARD (p);
212 }
213 } else {
214 FORWARD (p);
215 }
216 }
217 // After the point we ignore it all until the prelude.
218 if (p != NO_NODE && IS (p, POINT_SYMBOL)) {
219 if (PREVIOUS (p) != NO_NODE) {
220 NEXT (PREVIOUS (p)) = point;
221 }
222 if (PREVIOUS (point) != NO_NODE) {
223 PREVIOUS (point) = PREVIOUS (p);
224 }
225 } else {
226 diagnostic (A68_SYNTAX_ERROR, p, ERROR_SYNTAX_EXPECTED, POINT_SYMBOL);
227 }
228 // Has the programmer done it well?.
229 if (ERROR_COUNT (&A68_JOB) == 0) {
230 x = TOP_REFINEMENT (&A68_JOB);
231 while (x != NO_REFINEMENT) {
232 if (APPLICATIONS (x) == 0) {
233 diagnostic (A68_SYNTAX_ERROR, NODE_DEFINED (x), ERROR_REFINEMENT_NOT_APPLIED);
234 }
235 FORWARD (x);
236 }
237 }
238 }
