1 /*
2 This file is part of GNU APL, a free implementation of the
3 ISO/IEC Standard 13751, "Programming Language APL, Extended"
4
5 Copyright (C) 2008-2016 Dr. Jürgen Sauermann
6
7 This program is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>.
19 */
20
21 #include <stdio.h>
22 #include <string.h>
23 #include <fcntl.h>
24 #include <unistd.h>
25 #include <sys/stat.h>
26 #include <sys/mman.h>
27 #include <errno.h>
28
29 #include "Backtrace.hh"
30 #include "Error.hh"
31 #include "Output.hh"
32 #include "Parser.hh"
33 #include "StateIndicator.hh"
34 #include "Symbol.hh"
35 #include "UserFunction_header.hh"
36 #include "Value.hh"
37 #include "Workspace.hh"
38
39 //=============================================================================
40 /// a user-define function signature and its properties
41 const struct _header_pattern
42 {
43 Fun_signature signature; ///< a bitmap for header items
44 int sc100_tc; ///< symbols * 100 + tokens (excl local vars)
45 TokenTag tags[11]; ///< tags of the header token (excl local vars)
46 } header_patterns[] = ///< all valid function headers
47 {
48 /// function result
49 #define __Z TOK_LSYMB, TOK_ASSIGN1
50
51 /// lambda result (λ)
52 #define __z TOK_LAMBDA, TOK_ASSIGN1
53
54 /// left function argument
55 #define __A TOK_SYMBOL
56
57 /// left lambda argument
58 #define __a TOK_ALPHA
59
60 /// left lambda operator argument
61 #define __au TOK_ALPHA_U
62
63 /// a niladic function
64 #define __F0 TOK_SYMBOL
65
66 /// a monadic function
67 #define __F1 TOK_SYMBOL
68
69 /// a dyadic function
70 #define __F2 TOK_SYMBOL
71
72 /// a monadic operator
73 #define __OP1 TOK_L_PARENT, TOK_SYMBOL, TOK_SYMBOL, TOK_R_PARENT
74
75 /// a monadic operator in lambda
76 #define __op1 TOK_L_PARENT, TOK_ALPHA_U, TOK_SYMBOL, TOK_R_PARENT
77
78 /// a dyadic operator
79 #define __OP2 TOK_L_PARENT, TOK_SYMBOL, TOK_SYMBOL, TOK_SYMBOL, TOK_R_PARENT
80
81 /// a dyadic operator in lambda
82 #define __op2 TOK_L_PARENT, TOK_ALPHA_U, TOK_SYMBOL, TOK_OMEGA_U, TOK_R_PARENT
83
84 /// an axis
85 #define __x TOK_L_BRACK, TOK_CHI, TOK_R_BRACK
86
87 /// an axis
88 #define __X TOK_L_BRACK, TOK_SYMBOL, TOK_R_BRACK
89
90 /// right function argument
91 #define __B TOK_SYMBOL
92
93 /// right lambda argument
94 #define __b TOK_OMEGA
95
96 /// left lambda operator argument
97 #define __ou TOK_OMEGA_U
98
99 // niladic
100 //
101 { SIG_F0 , 101, { __F0, } },
102
103 { SIG_Z_F0 , 203, { __Z, __F0, } },
104
105 // monadic
106 //
107 { SIG_F1_B , 202, { __F1, __B, } },
108 { SIG_F1_X_B , 305, { __F1, __X, __B, } },
109 { SIG_LO_OP1_B , 305, { __OP1, __B, } },
110 { SIG_LO_OP1_X_B , 408, { __OP1, __X, __B, } },
111 { SIG_LO_OP2_RO_B , 406, { __OP2, __B, } },
112
113 { SIG_Z_F1_B , 304, { __Z, __F1, __B, } },
114 { SIG_Z_F1_X_B , 407, { __Z, __F1, __X, __B, } },
115 { SIG_Z_LO_OP1_B , 407, { __Z, __OP1, __B, } },
116 { SIG_Z_LO_OP1_X_B , 510, { __Z, __OP1, __X, __B, } },
117 { SIG_Z_LO_OP2_RO_B , 508, { __Z, __OP2, __B, } },
118
119 { SIG_Z_F1_B , 304, { __z, __F1, __b, } },
120 { SIG_Z_F1_X_B , 407, { __z, __F1, __x, __b, } },
121 { SIG_Z_LO_OP1_B , 407, { __z, __op1, __b, } },
122 { SIG_Z_LO_OP1_X_B , 510, { __z, __op1, __x, __b, } },
123 { SIG_Z_LO_OP2_RO_B , 508, { __z, __op2, __b, } },
124
125 // dyadic
126 //
127 { SIG_A_F2_B , 303, { __A, __F2, __B } },
128 { SIG_A_F2_X_B , 406, { __A, __F2, __X, __B } },
129 { SIG_A_LO_OP1_B , 406, { __A, __OP1, __B } },
130 { SIG_A_LO_OP1_X_B , 509, { __A, __OP1, __X, __B } },
131 { SIG_A_LO_OP2_RO_B , 507, { __A, __OP2, __B } },
132
133 { SIG_Z_A_F2_B , 405, { __Z, __A, __F2, __B } },
134 { SIG_Z_A_F2_X_B , 508, { __Z, __A, __F2, __X, __B } },
135 { SIG_Z_A_LO_OP1_B , 508, { __Z, __A, __OP1, __B } },
136 { SIG_Z_A_LO_OP1_X_B , 611, { __Z, __A, __OP1, __X, __B } },
137 { SIG_Z_A_LO_OP2_RO_B, 609, { __Z, __A, __OP2, __B } },
138
139 { SIG_Z_A_F2_B , 405, { __z, __a, __F2, __b } },
140 { SIG_Z_A_F2_X_B , 508, { __z, __a, __F2, __x, __b } },
141 { SIG_Z_A_LO_OP1_B , 508, { __z, __a, __op1, __b } },
142 { SIG_Z_A_LO_OP1_X_B , 611, { __z, __a, __op1, __x, __b } },
143 { SIG_Z_A_LO_OP2_RO_B, 609, { __z, __a, __op2, __b } },
144 };
145
146 /// the number of signatures
147 enum { PATTERN_COUNT = sizeof(header_patterns) / sizeof(*header_patterns) };
148
149 //-----------------------------------------------------------------------------
UserFunction_header(const UCS_string & text,bool macro)150 UserFunction_header::UserFunction_header(const UCS_string & text, bool macro)
151 : error(E_DEFN_ERROR), // assume bad headr
152 error_info("Bad header"),
153 sym_Z(0),
154 sym_A(0),
155 sym_LO(0),
156 sym_FUN(0),
157 sym_RO(0),
158 sym_X(0),
159 sym_B(0)
160 {
161 UCS_string header_line;
162
163 loop(t, text.size())
164 {
165 const Unicode uni = text[t];
166 if (uni == UNI_ASCII_CR) ; // ignore CR
167 else if (uni == UNI_ASCII_LF) break; // stop at LF
168 else header_line.append(uni);
169 }
170
171 if (header_line.size() == 0)
172 {
173 error_info = "Empty header line";
174 return;
175 }
176
177 Log(LOG_UserFunction__set_line)
178 {
179 CERR << "[0] " << header_line << endl;
180 // show_backtrace(__FILE__, __LINE__);
181 }
182
183 // add a semicolon as a guaranteed end marker.
184 // This avoids checks of the header token count
185 //
186 header_line.append(Unicode(';'));
187
188 Token_string tos;
189 {
190 const Parser parser(PM_FUNCTION, LOC, macro);
191 const ErrorCode err = parser.parse(header_line, tos);
192
193 if (err)
194 {
195 error = err;
196 error_info = "Parse error in header";
197 return;
198 }
199 }
200
201 // count symbols before first semicolon, allow one symbol too much.
202 //
203 size_t sym_count = 0;
204 size_t tos_idx = 0;
205 Symbol * symbols[12];
206 for (; tos_idx < 12; ++tos_idx)
207 {
208 if (tos_idx >= tos.size()) break;
209 if (tos[tos_idx].get_tag() == TOK_SEMICOL) break;
210 if (tos[tos_idx].get_Class() == TC_SYMBOL)
211 symbols[sym_count++] = tos[tos_idx].get_sym_ptr();
212 }
213
214 // find matching signature. If sym_count or tos_idx were too high above,
215 // then we will not find them in header_patterns and signal syntax error.
216 //
217 Fun_signature signature = SIG_NONE;
218 const int sc100_tc = sym_count * 100 + tos_idx;
219 loop(s, PATTERN_COUNT)
220 {
221 if (header_patterns[s].sc100_tc != sc100_tc) continue;
222 bool match = true;
223 loop(t, tos_idx)
224 {
225 if (tos[t].get_tag() != header_patterns[s].tags[t]) // mismatch
226 {
227 match = false;
228 break;
229 }
230 }
231
232 if (match)
233 {
234 signature = header_patterns[s].signature;
235 break; // found signature
236 }
237 }
238
239 if (signature == SIG_NONE)
240 {
241 error_info = "Bad header signature";
242 return;
243 }
244
245 // note: constructor has set all symbol pointers to 0!
246 // store symbol pointers according to signature.
247 {
248 size_t sidx = 0;
249 if (signature & SIG_Z) sym_Z = symbols[sidx++];
250 if (signature & SIG_A) sym_A = symbols[sidx++];
251 if (signature & SIG_LO) sym_LO = symbols[sidx++];
252 if (signature & SIG_FUN) sym_FUN = symbols[sidx++];
253 if (signature & SIG_RO) sym_RO = symbols[sidx++];
254 if (signature & SIG_X) sym_X = symbols[sidx++];
255 if (signature & SIG_B) sym_B = symbols[sidx++];
256
257 Assert1(sidx == sym_count); // otherwise header_patterns is faulty
258 Assert1(sym_FUN);
259
260 function_name = sym_FUN->get_name();
261 }
262
263 while (tos_idx < (tos.size() - 1))
264 {
265 if (tos[tos_idx++].get_tag() != TOK_SEMICOL)
266 {
267 error_info = "Semicolon expected in function header";
268 return;
269 }
270
271
272 if (tos_idx == tos.size())
273 {
274 error_info = "Trailing semicolon in function header";
275 return;
276 }
277
278 const TokenTag tag = tos[tos_idx].get_tag();
279 if (tag != TOK_SYMBOL && tag != TOK_Quad_CT
280 && tag != TOK_Quad_FC
281 && tag != TOK_Quad_IO
282 && tag != TOK_Quad_PP
283 && tag != TOK_Quad_PR
284 && tag != TOK_Quad_PW
285 && tag != TOK_Quad_RL)
286 {
287 CERR << "Offending token at " LOC " is: " << tos[tos_idx] << endl;
288 error_info = "Bad token in function header";
289 return;
290 }
291
292 local_vars.push_back(tos[tos_idx++].get_sym_ptr());
293 }
294
295 remove_duplicate_local_variables();
296
297 error_info = 0;
298 error = E_NO_ERROR;
299 }
300 //-----------------------------------------------------------------------------
UserFunction_header(Fun_signature sig,int lambda_num)301 UserFunction_header::UserFunction_header(Fun_signature sig, int lambda_num)
302 : error(E_DEFN_ERROR),
303 error_info("Bad header"),
304 sym_Z(0),
305 sym_A(0),
306 sym_LO(0),
307 sym_FUN(0),
308 sym_RO(0),
309 sym_X(0),
310 sym_B(0)
311 {
312 function_name.append(UNI_LAMBDA);
313 function_name.append_number(lambda_num);
314
315 // make sure that sig is valid
316 //
317 Fun_signature sig1 = Fun_signature(sig | SIG_FUN);
318 bool valid_signature = false;
319 loop(p, PATTERN_COUNT)
320 {
321 if (header_patterns[p].signature == sig1)
322 {
323 valid_signature = true;
324 break;
325 }
326 }
327
328 if (!valid_signature)
329 {
330 error_info = "Invalid signature";
331 return;
332 }
333
334 sym_Z = &Workspace::get_v_LAMBDA();
335 if (sig & SIG_A) sym_A = &Workspace::get_v_ALPHA();
336 if (sig & SIG_LO) sym_LO = &Workspace::get_v_ALPHA_U();
337 if (sig & SIG_RO) sym_RO = &Workspace::get_v_OMEGA_U();
338 if (sig & SIG_B) sym_B = &Workspace::get_v_OMEGA();
339 if (sig & SIG_X) sym_X = &Workspace::get_v_CHI();
340
341 error_info = 0;
342 error = E_NO_ERROR;
343 }
344 //-----------------------------------------------------------------------------
345 void
add_local_var(Symbol * sym)346 UserFunction_header::add_local_var(Symbol * sym)
347 {
348 local_vars.push_back(sym);
349 }
350 //-----------------------------------------------------------------------------
351 void
pop_local_vars() const352 UserFunction_header::pop_local_vars() const
353 {
354 loop(l, label_values.size()) label_values[l].sym->pop();
355
356 loop(l, local_vars.size()) local_vars[l]->pop();
357
358 if (sym_B) sym_B ->pop();
359 if (sym_X) sym_X ->pop();
360 if (sym_RO) sym_RO->pop();
361 if (sym_LO) sym_LO->pop();
362 if (sym_A) sym_A ->pop();
363 if (sym_Z) sym_Z ->pop();
364 }
365 //-----------------------------------------------------------------------------
366 void
print_local_vars(ostream & out) const367 UserFunction_header::print_local_vars(ostream & out) const
368 {
369 if (sym_Z) out << " " << *sym_Z;
370 if (sym_A) out << " " << *sym_A;
371 if (sym_LO) out << " " << *sym_LO;
372 if (sym_RO) out << " " << *sym_RO;
373 if (sym_B) out << " " << *sym_B;
374
375 loop(l, local_vars.size()) out << " " << *local_vars[l];
376 }
377 //-----------------------------------------------------------------------------
378 void
reverse_local_vars()379 UserFunction_header::reverse_local_vars()
380 {
381 const ShapeItem half = local_vars.size() / 2; // = rounded down!
382 loop(v, half)
383 {
384 Symbol * tmp = local_vars[v];
385 local_vars[v] = local_vars[local_vars.size() - v - 1];
386 local_vars[local_vars.size() - v - 1] = tmp;
387 }
388 }
389 //-----------------------------------------------------------------------------
390 void
remove_duplicate_local_variables()391 UserFunction_header::remove_duplicate_local_variables()
392 {
393 // remove local vars that are also labels, arguments or return values.
394 // This is to avoid pushing them twice
395 //
396 remove_duplicate_local_var(sym_Z, 0);
397 remove_duplicate_local_var(sym_A, 0);
398 remove_duplicate_local_var(sym_LO, 0);
399 remove_duplicate_local_var(sym_FUN, 0);
400 remove_duplicate_local_var(sym_RO, 0);
401 remove_duplicate_local_var(sym_X, 0);
402 remove_duplicate_local_var(sym_B, 0);
403
404 loop(l, label_values.size())
405 remove_duplicate_local_var(label_values[l].sym, 0);
406
407 loop(l, local_vars.size())
408 remove_duplicate_local_var(local_vars[l], l + 1);
409 }
410 //-----------------------------------------------------------------------------
411 void
remove_duplicate_local_var(const Symbol * sym,size_t pos)412 UserFunction_header::remove_duplicate_local_var(const Symbol * sym, size_t pos)
413 {
414 // remove sym from the vector of local variables. Only the local vars
415 // at pos or higher are being removed
416 //
417 if (sym == 0) return; // unused symbol
418
419 while (pos < local_vars.size())
420 {
421 if (sym == local_vars[pos])
422 {
423 local_vars[pos] = local_vars.back();
424 local_vars.pop_back();
425 continue;
426 }
427 ++pos;
428 }
429 }
430 //-----------------------------------------------------------------------------
431 UCS_string
lambda_header(Fun_signature sig,int lambda_num)432 UserFunction_header::lambda_header(Fun_signature sig, int lambda_num)
433 {
434 UCS_string u;
435
436 if (sig & SIG_Z) u.append_UTF8("λ←");
437 if (sig & SIG_A) u.append_UTF8("⍺ ");
438 if (sig & SIG_LORO) u.append_UTF8("(");
439 if (sig & SIG_LO) u.append_UTF8("⍶ ");
440 u.append_UTF8("λ");
441 u.append_number(lambda_num);
442 if (sig & SIG_RO) u.append_UTF8(" ⍹ ");
443 if (sig & SIG_LORO) u.append_UTF8(")");
444 if (sig & SIG_X) u.append_UTF8("[χ]");
445 if (sig & SIG_B) u.append_UTF8(" ⍵");
446
447 return u;
448 }
449 //-----------------------------------------------------------------------------
450 void
print_properties(ostream & out,int indent) const451 UserFunction_header::print_properties(ostream & out, int indent) const
452 {
453 UCS_string ind(indent, UNI_ASCII_SPACE);
454 if (is_operator()) out << "Operator " << function_name << endl;
455 else out << "Function " << function_name << endl;
456
457 if (sym_Z) out << ind << "Result: " << *sym_Z << endl;
458 if (sym_A) out << ind << "Left Argument: " << *sym_A << endl;
459 if (sym_LO) out << ind << "Left Op Arg: " << *sym_LO << endl;
460 if (sym_RO) out << ind << "Right Op Arg: " << *sym_RO << endl;
461 if (sym_B) out << ind << "Right Argument: " << *sym_B << endl;
462
463 if (local_vars.size())
464 {
465 out << ind << "Local Variables:";
466 loop(l, local_vars.size()) out << " " << *local_vars[l];
467 out << endl;
468 }
469
470 if (label_values.size())
471 {
472 out << ind << "Labels: ";
473 loop(l, label_values.size())
474 {
475 if (l) out << ",";
476 out << " " << *label_values[l].sym
477 << "=" << label_values[l].line;
478 }
479 out << endl;
480 }
481 }
482 //-----------------------------------------------------------------------------
483 void
eval_common()484 UserFunction_header::eval_common()
485 {
486 Log(LOG_UserFunction__enter_leave) CERR << "eval_common()" << endl;
487
488 // push local variables...
489 //
490 loop(l, local_vars.size()) local_vars[l]->push();
491
492 // push labels...
493 //
494 loop(l, label_values.size())
495 label_values[l].sym->push_label(label_values[l].line);
496 }
497 //-----------------------------------------------------------------------------
498