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-2015 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 "Bif_OPER2_RANK.hh"
22 #include "Common.hh"
23 #include "DerivedFunction.hh"
24 #include "Executable.hh"
25 #include "IndexExpr.hh"
26 #include "LvalCell.hh"
27 #include "PointerCell.hh"
28 #include "Prefix.hh"
29 #include "StateIndicator.hh"
30 #include "Symbol.hh"
31 #include "UserFunction.hh"
32 #include "ValueHistory.hh"
33 #include "Workspace.hh"
34
35 uint64_t Prefix::instance_counter = 0;
36
37 //-----------------------------------------------------------------------------
Prefix(StateIndicator & _si,const Token_string & _body)38 Prefix::Prefix(StateIndicator & _si, const Token_string & _body)
39 : instance(++instance_counter),
40 si(_si),
41 put(0),
42 saved_lookahead(Token(TOK_VOID), Function_PC_invalid),
43 body(_body),
44 PC(Function_PC_0),
45 assign_state(ASS_none),
46 lookahead_high(Function_PC_invalid),
47 action(RA_FIXME)
48 {
49 }
50 //-----------------------------------------------------------------------------
51 void
clean_up()52 Prefix::clean_up()
53 {
54 loop(s, size())
55 {
56 Token tok = at(s).tok;
57 if (tok.get_Class() == TC_VALUE)
58 {
59 tok.extract_apl_val(LOC);
60 }
61 else if (tok.get_ValueType() == TV_INDEX)
62 {
63 tok.get_index_val().extract_all();
64 }
65 }
66
67 put = 0;
68 }
69 //-----------------------------------------------------------------------------
70 void
syntax_error(const char * loc)71 Prefix::syntax_error(const char * loc)
72 {
73 // move the PC back to the beginning of the failed statement
74 //
75 while (PC > 0)
76 {
77 --PC;
78 if (body[PC].get_Class() == TC_END)
79 {
80 ++PC;
81 break;
82 }
83 }
84
85 // clear values in FIFO
86 //
87 loop (s, size())
88 {
89 Token & tok = at(s).tok;
90 if (tok.get_Class() == TC_VALUE)
91 {
92 Value_P val = tok.get_apl_val();
93 }
94 }
95
96 // see if error was caused by a function not returning a value.
97 // in that case we throw a value error instead of a syntax error.
98 //
99 loop (s, size())
100 {
101 if (at(s).tok.get_Class() == TC_VOID)
102 throw_apl_error(E_VALUE_ERROR, loc);
103 }
104
105 throw_apl_error(get_assign_state() == ASS_none ? E_SYNTAX_ERROR
106 : E_LEFT_SYNTAX_ERROR, loc);
107 }
108 //-----------------------------------------------------------------------------
109 bool
uses_function(const UserFunction * ufun) const110 Prefix::uses_function(const UserFunction * ufun) const
111 {
112 loop (s, size())
113 {
114 const Token & tok = at(s).tok;
115 if (tok.get_ValueType() == TV_FUN &&
116 tok.get_function() == ufun) return true;
117 }
118
119 if (saved_lookahead.tok.get_ValueType() == TV_FUN &&
120 saved_lookahead.tok.get_function() == ufun) return true;
121
122 return false;
123 }
124 //-----------------------------------------------------------------------------
125 bool
is_value_parenthesis(int pc) const126 Prefix::is_value_parenthesis(int pc) const
127 {
128 // we have ) XXX with XXX on the stack and need to know if the evaluation
129 // of (... ) will be a value as in e.g. (1 + 1) or a function as in (+/).
130 //
131 Assert1(body[pc].get_Class() == TC_R_PARENT);
132
133 ++pc;
134 if (pc >= int(body.size())) return true; // syntax error
135
136 TokenClass next = body[pc].get_Class();
137
138 if (next == TC_R_BRACK) // skip [ ... ]
139 {
140 const int offset = body[pc].get_int_val2();
141 pc += offset;
142 Assert1(body[pc].get_Class() == TC_L_BRACK); // opening [
143 if (pc >= Function_PC(body.size())) return true; // syntax error
144 next = body[pc].get_Class();
145 }
146
147 if (next == TC_SYMBOL) // resolve symbol if necessary
148 {
149 const Symbol * sym = body[pc].get_sym_ptr();
150 const NameClass nc = sym->get_nc();
151
152 if (nc == NC_FUNCTION) return false;
153 if (nc == NC_OPERATOR) return false;
154 return true;
155 }
156
157 if (next == TC_OPER1) return false;
158 if (next == TC_OPER2) return false;
159 if (next == TC_FUN12) return false;
160
161 if (next == TC_L_PARENT) // )) XXX
162 {
163 ++pc;
164 if (!is_value_parenthesis(pc)) return false; // (fun)) XXX
165 const int offset = body[pc].get_int_val2();
166 pc += offset;
167 if (pc >= Function_PC(body.size())) return true; // syntax error
168 next = body[pc].get_Class();
169 Assert1(next == TC_L_PARENT); // opening (
170 ++pc;
171 if (pc >= Function_PC(body.size())) return true; // syntax error
172
173 // (val)) XXX
174 // ^
175 // pc
176 //
177 // result is a value unless (val) is the right function operand
178 // of a dyadic operator
179 //
180 next = body[pc].get_Class();
181 if (next == TC_OPER2) return false;
182 if (next == TC_SYMBOL) // resolve symbol if necessary
183 {
184 const Symbol * sym = body[pc].get_sym_ptr();
185 const Function * fun = sym->get_function();
186 return ! (fun && fun->is_operator() &&
187 fun->get_oper_valence() == 2);
188 }
189 return true;
190 }
191
192 // dyadic operator with numeric function argument, for example: ⍤ 0
193 //
194 if (next == TC_VALUE &&
195 pc < Function_PC(body.size() - 1) &&
196 body[pc+1].get_Class() == TC_OPER2) return false;
197
198 return true;
199 }
200 //-----------------------------------------------------------------------------
201 bool
is_fun_or_oper(int pc) const202 Prefix::is_fun_or_oper(int pc) const
203 {
204 // this function is called when / ⌿ \ or ⍀ shall be resolved. pc points
205 // to the token left of / ⌿ \ or ⍀.
206 //
207 TokenTag tag_LO = body[pc].get_tag();
208
209 if (tag_LO == TOK_R_BRACK)
210 {
211 // e.g. fun[...]/ or value[...]/ Skip over [...]
212 //
213 pc += body[pc].get_int_val2();
214 Assert1(body[pc++].get_Class() == TC_L_BRACK); // opening [
215 tag_LO = body[pc].get_tag();
216 }
217
218 if (tag_LO == TOK_R_PARENT) return !is_value_parenthesis(pc);
219 if (body[pc].get_Class() == TC_OPER2) return false; // make / a function
220
221 if ((tag_LO & TV_MASK) == TV_FUN) return true;
222
223 if (tag_LO == TOK_SYMBOL)
224 {
225 Symbol * sym = body[pc].get_sym_ptr();
226 if (sym == 0) return false;
227 return sym->get_function() != 0;
228 }
229
230 return false; // not a function or operator
231 }
232 //-----------------------------------------------------------------------------
233 bool
is_value_bracket() const234 Prefix::is_value_bracket() const
235 {
236 Assert1(body[PC - 1].get_Class() == TC_R_BRACK);
237 const int offset = body[PC - 1].get_int_val2();
238 Assert1(body[PC + offset - 1].get_Class() == TC_L_BRACK); // opening [
239
240 const Token & tok1 = body[PC + offset];
241 if (tok1.get_Class() == TC_VALUE) return true;
242 if (tok1.get_Class() != TC_SYMBOL) return false;
243
244 Symbol * sym = tok1.get_sym_ptr();
245 const bool left_sym = get_assign_state() == ASS_arrow_seen;
246 return sym->resolve_class(left_sym) == TC_VALUE;
247 }
248 //-----------------------------------------------------------------------------
249 int
vector_ass_count() const250 Prefix::vector_ass_count() const
251 {
252 int count = 0;
253
254 for (Function_PC pc = PC; pc < Function_PC(body.size()); ++pc)
255 {
256 if (body[pc].get_tag() != TOK_LSYMB2) break;
257 ++count;
258 }
259
260 return count;
261 }
262 //-----------------------------------------------------------------------------
263 void
print_stack(ostream & out,const char * loc) const264 Prefix::print_stack(ostream & out, const char * loc) const
265 {
266 const int si_depth = si.get_level();
267
268 out << "fifo[si=" << si_depth << " len=" << size()
269 << " PC=" << PC << "] is now :";
270
271 loop(s, size())
272 {
273 const TokenClass tc = at(s).tok.get_Class();
274 out << " " << Token::class_name(tc);
275 }
276
277 out << " at " << loc << endl;
278 }
279 //-----------------------------------------------------------------------------
280 int
show_owners(const char * prefix,ostream & out,const Value & value) const281 Prefix::show_owners(const char * prefix, ostream & out,
282 const Value & value) const
283 {
284 int count = 0;
285
286 loop (s, size())
287 {
288 const Token & tok = at(s).tok;
289 if (tok.get_ValueType() != TV_VAL) continue;
290
291 if (Value::is_or_contains(tok.get_apl_val().get(), value))
292 {
293 out << prefix << " Fifo [" << s << "]" << endl;
294 ++count;
295 }
296
297 }
298
299 return count;
300 }
301 //-----------------------------------------------------------------------------
302 Function_PC
get_range_high() const303 Prefix::get_range_high() const
304 {
305 // if the stack is empty then return the last address (if any) or otherwise
306 // the address of the next token.
307 //
308 if (size() == 0) // stack is empty
309 {
310 if (lookahead_high == Function_PC_invalid) return PC;
311 return lookahead_high;
312 }
313
314 // stack non-empty: return address of highest item or the last address
315 //
316 Function_PC high = lookahead_high;
317 if (high == Function_PC_invalid) high = at(0).pc;
318
319 if (best && best->misc) --high;
320 return high;
321 }
322 //-----------------------------------------------------------------------------
323 Function_PC
get_range_low() const324 Prefix::get_range_low() const
325 {
326 // if the stack is not empty then return the PC of the lowest element
327 //
328 if (size() > 0) return at(size() - 1).pc;
329
330
331 // the stack is empty. Return the last address (if any) or otherwise
332 // the address of the next token.
333 //
334 if (lookahead_high == Function_PC_invalid) return PC; // no last address
335 return lookahead_high;
336 }
337 //-----------------------------------------------------------------------------
338 bool
value_expected()339 Prefix::value_expected()
340 {
341 // return true iff the current saved_lookahead token (which has been tested
342 // to be a TC_INDEX token) is the index of a value and false it it is
343 // a function axis
344
345 // if it contains semicolons then get_ValueType() is TV_INDEX and
346 // it MUST be a value.
347 //
348 if (saved_lookahead.tok.get_ValueType() == TV_INDEX) return true;
349
350 for (int pc = PC; pc < int(body.size());)
351 {
352 const Token & tok = body[pc++];
353 switch(tok.get_Class())
354 {
355 case TC_R_BRACK: // skip over [...] (func axis or value index)
356 //
357 pc += tok.get_int_val2();
358 continue;
359
360 case TC_END: return false; // syntax error
361
362 case TC_FUN0: return true; // niladic function is a value
363 case TC_FUN12: return false; // function
364
365 case TC_SYMBOL:
366 {
367 const Symbol * sym = tok.get_sym_ptr();
368 const NameClass nc = sym->get_nc();
369
370 if (nc == NC_FUNCTION) return false;
371 if (nc == NC_OPERATOR) return false;
372 return true; // value
373 }
374
375 case TC_RETURN: return false; // syntax error
376 case TC_VALUE: return true;
377
378 default: continue;
379 }
380 }
381
382 // this is a syntax error.
383 //
384 return false;
385 }
386 //-----------------------------------------------------------------------------
387 void
unmark_all_values() const388 Prefix::unmark_all_values() const
389 {
390 loop (s, size())
391 {
392 const Token & tok = at(s).tok;
393 if (tok.get_ValueType() != TV_VAL) continue;
394
395 Value_P value = tok.get_apl_val();
396 if (!!value) value->unmark();
397 }
398 }
399 //-----------------------------------------------------------------------------
400
401 // a hash table with all prefixes that can be reduced...
402 #define PH(name, idx, prio, misc, len, fun) \
403 { #name, idx, prio, misc, len, &Prefix::reduce_ ## fun, #fun },
404
405 #include "Prefix.def" // the hash table
406
407 Token
reduce_statements()408 Prefix::reduce_statements()
409 {
410 Log(LOG_prefix_parser)
411 {
412 CERR << endl << "changed to Prefix[si=" << si.get_level()
413 << "]) ============================================" << endl;
414 }
415
416 if (size() > 0) goto again;
417
418 grow:
419 // the current stack does not contain a valid phrase.
420 // Push one more token onto the stack and continue
421 //
422 {
423 if (saved_lookahead.tok.get_tag() != TOK_VOID)
424 {
425 // there is a MISC token from a MISC phrase. Use it.
426 //
427 push(saved_lookahead);
428 saved_lookahead.tok.clear(LOC);
429 goto again; // success
430 }
431
432 // if END was reached, then there are no more token in current-statement
433 //
434 if (size() > 0 && at0().get_Class() == TC_END)
435 {
436 Log(LOG_prefix_parser) print_stack(CERR, LOC);
437
438 // provide help on some common cases...
439 //
440 for (int j = 1; j < (size() - 1); ++j)
441 {
442 if ( (at(j).tok.get_Class() == TC_ASSIGN) &&
443 (at(j + 1).tok.get_Class() == TC_VALUE))
444 {
445 if (at(j - 1).tok.get_Class() == TC_FUN0 ||
446 at(j - 1).tok.get_Class() == TC_FUN12)
447 {
448 MORE_ERROR() <<
449 "Cannot assign a value to a function";
450 }
451 else if (at(j - 1).tok.get_Class() == TC_OPER1 ||
452 at(j - 1).tok.get_Class() == TC_OPER1)
453 {
454 MORE_ERROR() <<
455 "Cannot assign a value to an operator";
456 }
457 }
458 }
459 syntax_error(LOC); // no more token
460 }
461
462 Token_loc tl = lookahead();
463 Log(LOG_prefix_parser)
464 {
465 CERR << " [si=" << si.get_level() << " PC=" << (PC - 1)
466 << "] Read token[" << size()
467 << "] (←" << get_assign_state() << "←) " << tl.tok << " "
468 << Token::class_name(tl.tok.get_Class()) << endl;
469 }
470
471 lookahead_high = tl.pc;
472 TokenClass tcl = tl.tok.get_Class();
473
474 if (tcl == TC_SYMBOL) // resolve symbol if necessary
475 {
476 // reset the PC back to the previous token, so that a failed
477 // resolve() (aka VALUE ERROR) will re-fetch the token
478 //
479 // But not if symbol is ⎕LC because that would make the first
480 // element of ⎕LC too low!
481 //
482 if (tl.tok.get_tag() != TOK_Quad_LC) --PC;
483
484 Symbol * sym = tl.tok.get_sym_ptr();
485 if (tl.tok.get_tag() == TOK_LSYMB2)
486 {
487 // this is the last token C of a vector assignment
488 // (A B ... C)←. We return C and let the caller do the rest
489 //
490 sym->resolve(tl.tok, true);
491 Log(LOG_prefix_parser)
492 CERR << "TOK_LSYMB2 " << sym->get_name()
493 << "resolved to " << tl.tok << endl;
494 }
495 else
496 {
497 const bool left_sym = get_assign_state() == ASS_arrow_seen;
498 bool resolved = false;
499 if (size() > 0 && at(0).tok.get_Class() == TC_INDEX &&
500 tl.tok.get_tag() == TOK_SYMBOL) // user defined variable
501 {
502 // indexed reference, e.g. A[N]. Calling sym->resolve()
503 // would copy the entire variable and then index it, which
504 // is inefficient if the variable is big. We rather call
505 // Symbol::get_value() directly in order to avoid that
506 //
507 Value_P val = sym->get_value();
508 if (!!val && !left_sym)
509 {
510 Token tok(TOK_APL_VALUE1, val);
511 tl.tok.move_1(tok, LOC);
512 resolved = true;
513 }
514 }
515 if (!resolved) sym->resolve(tl.tok, left_sym);
516
517 if (left_sym) set_assign_state(ASS_var_seen);
518 Log(LOG_prefix_parser)
519 {
520 if (left_sym) CERR << "TOK_LSYMB ";
521 else CERR << "TOK_SYMBOL ";
522 CERR << "resolved to " << tl.tok << endl;
523 }
524 }
525 PC = lookahead_high + 1; // resolve() succeeded: restore PC
526
527 Log(LOG_prefix_parser)
528 {
529 CERR << " resolved symbol " << sym->get_name()
530 << " to " << tl.tok.get_Class() << endl;
531 }
532
533 if (tl.tok.get_tag() == TOK_SI_PUSHED)
534 {
535 // Quad_Quad::resolve() calls ⍎ which returns TOK_SI_PUSHED.
536 //
537 push(tl);
538 return Token(TOK_SI_PUSHED);
539 }
540 }
541 else if (tcl == TC_ASSIGN) // resolve symbol if necessary
542 {
543 if (get_assign_state() != ASS_none) syntax_error(LOC);
544 set_assign_state(ASS_arrow_seen);
545 }
546
547 push(tl);
548 }
549
550 again:
551 Log(LOG_prefix_parser) print_stack(CERR, LOC);
552
553 // search prefixes in phrase table...
554 //
555 {
556 const int hash_0 = at0().get_Class();
557
558 if (size() >= 3)
559 {
560 const int hash_01 = hash_0 | at1().get_Class() << 5;
561 const int hash_012 = hash_01 | at2().get_Class() << 10;
562
563 if (size() >= 4)
564 {
565 const int hash_0123 = hash_012 | at3().get_Class() << 15;
566 best = hash_table + hash_0123 % PHRASE_MODU;
567 if (best->phrase_hash == hash_0123) goto found_prefix;
568 }
569
570 best = hash_table + hash_012 % PHRASE_MODU;
571 if (best->phrase_hash == hash_012) goto found_prefix;
572
573 best = hash_table + hash_01 % PHRASE_MODU;
574 if (best->phrase_hash == hash_01) goto found_prefix;
575
576 best = hash_table + hash_0 % PHRASE_MODU;
577 if (best->phrase_hash != hash_0) goto grow; // no matching phrase
578 }
579 else // 0 < size() < 3
580 {
581 if (size() >= 2)
582 {
583 const int hash_01 = hash_0 | at1().get_Class() << 5;
584 best = hash_table + hash_01 % PHRASE_MODU;
585 if (best->phrase_hash == hash_01) goto found_prefix;
586 }
587
588 best = hash_table + hash_0 % PHRASE_MODU;
589 if (best->phrase_hash != hash_0) goto grow;
590 }
591 }
592
593 found_prefix:
594
595 // found a reducible prefix. See if the next token class binds stronger
596 // than best->prio
597 //
598 {
599 TokenClass next = TC_INVALID;
600 if (PC < Function_PC(body.size()))
601 {
602 const Token & tok = body[PC];
603
604 next = tok.get_Class();
605 if (next == TC_SYMBOL)
606 {
607 Symbol * sym = tok.get_sym_ptr();
608 const bool left_sym = get_assign_state() == ASS_arrow_seen;
609 next = sym->resolve_class(left_sym);
610 }
611 }
612
613 if (best->misc && (at0().get_Class() == TC_R_BRACK))
614 {
615 // the next symbol is a ] and the matching phrase is a MISC
616 // phrase (monadic call of a possibly dyadic function).
617 // The ] could belong to:
618 //
619 // 1. an indexed value, e.g. A[X] or
620 // 2. a function with an axis, e.g. +[2]
621 //
622 // These cases lead to different reductions:
623 //
624 // 1. A[X] × B should evalate × dyadically, while
625 // 2. +[1] × B should evalate × monadically,
626 //
627 // We solve this by computing the indexed value first
628 //
629 if (is_value_bracket()) // case 1.
630 {
631 // we call reduce_RBRA____, which pushes a partial index list
632 // onto the stack. The following token are processed until the
633 // entire indexed value A[ ... ] is computed
634 prefix_len = 1;
635 reduce_RBRA___();
636 goto grow;
637 }
638 }
639
640 // Q(next) Q(at0())
641
642 // we could reduce, but we could also shift. Compute more, which is true
643 // if we should shift.
644 //
645 const bool shift = dont_reduce(next);
646 if (shift)
647 {
648 Log(LOG_prefix_parser) CERR
649 << " phrase #" << (best - hash_table)
650 << ": " << best->phrase_name
651 << " matches, but prio " << best->prio
652 << " is too small to call " << best->reduce_name
653 << "()" << endl;
654 goto grow;
655 }
656 }
657
658 Log(LOG_prefix_parser) CERR
659 << " phrase #" << (best - hash_table)
660 << ": " << best->phrase_name
661 << " matches, prio " << best->prio
662 << ", calling reduce_" << best->reduce_name
663 << "()" << endl;
664
665 action = RA_FIXME;
666 prefix_len = best->phrase_len;
667 if (best->misc) // MISC phrase: save X and remove it
668 {
669 Assert(saved_lookahead.tok.get_tag() == TOK_VOID);
670 saved_lookahead.copy(pop(), LOC);
671 --prefix_len;
672 }
673
674 const uint64_t inst = instance;
675 (this->*best->reduce_fun)();
676
677 if (inst != Workspace::SI_top()->get_prefix().instance)
678 {
679 // the reduce_fun() above has changed the )SI stack. As a consequence
680 // the 'this' pointer is no longer valid and we must not access members
681 // of this Prefix instance.
682 //
683 return Token(TOK_SI_PUSHED);
684 }
685
686 Log(LOG_prefix_parser)
687 CERR << " reduce_" << best->reduce_name << "() returned: ";
688
689 // handle action (with decreasing likelihood)
690 //
691 if (action == RA_CONTINUE)
692 {
693 Log(LOG_prefix_parser) CERR << "RA_CONTINUE" << endl;
694 goto again;
695 }
696
697 if (action == RA_PUSH_NEXT)
698 {
699 Log(LOG_prefix_parser) CERR << "RA_PUSH_NEXT" << endl;
700 goto grow;
701 }
702
703 if (action == RA_SI_PUSHED)
704 {
705 Log(LOG_prefix_parser) CERR << "RA_SI_PUSHED" << endl;
706 return Token(TOK_SI_PUSHED);
707 }
708
709 if (action == RA_RETURN)
710 {
711 Log(LOG_prefix_parser) CERR << "RA_RETURN" << endl;
712 return pop().tok;
713 }
714
715 if (action == RA_FIXME)
716 {
717 Log(LOG_prefix_parser) CERR << "RA_FIXME" << endl;
718 FIXME;
719 }
720
721 FIXME;
722 }
723 //-----------------------------------------------------------------------------
724 bool
dont_reduce(TokenClass next) const725 Prefix::dont_reduce(TokenClass next) const
726 {
727 if (at0().get_Class() == TC_VALUE)
728 {
729 if (next == TC_OPER2) // DOP B
730 {
731 return true;
732 }
733 else if (next == TC_VALUE) // A B
734 {
735 return best->prio < BS_VAL_VAL;
736 }
737 else if (next == TC_R_PARENT) // ) B
738 {
739 if (is_value_parenthesis(PC)) // e.g. (X+Y) B
740 {
741 return best->prio < BS_VAL_VAL;
742 }
743 else // e.g. (+/) B
744 {
745 return false;
746 }
747 }
748 }
749 else if (at0().get_Class() == TC_FUN12)
750 {
751 if (next == TC_OPER2)
752 {
753 return true;
754 }
755 }
756
757 return false;
758 }
759 //-----------------------------------------------------------------------------
760 bool
replace_AB(Value_P old_value,Value_P new_value)761 Prefix::replace_AB(Value_P old_value, Value_P new_value)
762 {
763 Assert(!!old_value);
764 Assert(!!new_value);
765
766 loop(s, size())
767 {
768 Token & tok = at(s).tok;
769 if (tok.get_Class() != TC_VALUE) continue;
770 if (tok.get_apl_val() == old_value) // found
771 {
772 new (&tok) Token(tok.get_tag(), new_value);
773 return true;
774 }
775 }
776 return false;
777 }
778 //-----------------------------------------------------------------------------
locate_L()779 Token * Prefix::locate_L()
780 {
781 // expect at least A f B (so we have at0(), at1() and at2()
782
783 if (prefix_len < 3) return 0;
784
785 if (at1().get_Class() != TC_FUN12 &&
786 at1().get_Class() != TC_OPER1 &&
787 at1().get_Class() != TC_OPER2) return 0;
788
789 if (at0().get_Class() == TC_VALUE) return &at0();
790 return 0;
791 }
792 //-----------------------------------------------------------------------------
793 Value_P *
locate_X()794 Prefix::locate_X()
795 {
796 // expect at least B X (so we have at0() and at1() and at2()
797
798 if (prefix_len < 2) return 0;
799
800 // either at0() (for monadic f X B) or at1() (for dyadic A f X B) must
801 // be a function or operator
802 //
803 for (int x = put - 1; x >= put - prefix_len; --x)
804 {
805 if (content[x].tok.get_ValueType() == TV_FUN)
806 {
807 Function * fun = content[x].tok.get_function();
808 if (fun)
809 {
810 Value_P * X = fun->locate_X();
811 if (X) return X; // only for derived function
812 }
813 }
814 else if (content[x].tok.get_Class() == TC_INDEX) // maybe found X ?
815 {
816 return content[x].tok.get_apl_valp();
817 }
818 }
819
820 return 0;
821 }
822 //-----------------------------------------------------------------------------
locate_R()823 Token * Prefix::locate_R()
824 {
825 // expect at least f B (so we have at0(), at1() and at2()
826
827 if (prefix_len < 2) return 0;
828
829 // either at0() (for monadic f B) or at1() (for dyadic A f B) must
830 // be a function or operator
831 //
832 if (at0().get_Class() != TC_FUN12 &&
833 at0().get_Class() != TC_OPER1 &&
834 at0().get_Class() != TC_OPER2 &&
835 at1().get_Class() != TC_FUN12 &&
836 at1().get_Class() != TC_OPER1 &&
837 at1().get_Class() != TC_OPER2) return 0;
838
839 Token * ret = &content[put - prefix_len].tok;
840 if (ret->get_Class() == TC_VALUE) return ret;
841 return 0;
842 }
843 //-----------------------------------------------------------------------------
844 void
print(ostream & out,int indent) const845 Prefix::print(ostream & out, int indent) const
846 {
847 loop(i, indent) out << " ";
848 out << "Token: ";
849 loop(s, size()) out << " " << at(s).tok;
850 out << endl;
851 }
852 //=============================================================================
853 //
854 // phrase reduce functions...
855 //
856 //-----------------------------------------------------------------------------
857 void
reduce____()858 Prefix::reduce____()
859 {
860 // this function is a placeholder for invalid phrases and should never be
861 // called.
862 //
863 FIXME;
864 }
865 //-----------------------------------------------------------------------------
866 void
reduce_LPAR_B_RPAR_()867 Prefix::reduce_LPAR_B_RPAR_()
868 {
869 Assert1(prefix_len == 3);
870
871 Token result = at1(); // B or F
872 if (result.get_tag() == TOK_APL_VALUE3) result.ChangeTag(TOK_APL_VALUE1);
873
874 pop_args_push_result(result);
875 set_action(result);
876 }
877 //-----------------------------------------------------------------------------
878 void
reduce_LPAR_F_C_RPAR()879 Prefix::reduce_LPAR_F_C_RPAR()
880 {
881 Assert1(prefix_len == 4);
882
883 // C should be an axis and not a [;;] index
884 //
885 if (at2().get_ValueType() != TV_VAL) SYNTAX_ERROR;
886 if (!at2().get_apl_val()) SYNTAX_ERROR;
887
888 // at: 0 1 2 3
889 // before: ( F C )
890 // after: F C
891 //
892 at3().move_1(at2(), LOC);
893 at2().move_1(at1(), LOC);
894 pop_and_discard(); // pop old RPAR
895 pop_and_discard(); // pop old C
896 action = RA_CONTINUE;
897 }
898 //-----------------------------------------------------------------------------
899 void
reduce_N___()900 Prefix::reduce_N___()
901 {
902 Assert1(prefix_len == 1);
903
904 Token result = at0().get_function()->eval_();
905 if (result.get_tag() == TOK_ERROR)
906 {
907 Token_loc tl(result, get_range_low());
908 push(tl);
909 action = RA_RETURN;
910 return;
911 }
912
913 pop_args_push_result(result);
914 set_action(result);
915 }
916 //-----------------------------------------------------------------------------
917 void
reduce_MISC_F_B_()918 Prefix::reduce_MISC_F_B_()
919 {
920 Assert1(prefix_len == 2);
921
922 if (saved_lookahead.tok.get_Class() == TC_INDEX)
923 {
924 if (value_expected())
925 {
926 // push [...] and read one more token
927 //
928 push(saved_lookahead);
929 saved_lookahead.tok.clear(LOC);
930 action = RA_PUSH_NEXT;
931 return;
932 }
933 }
934
935 Token result = at0().get_function()->eval_B(at1().get_apl_val());
936 if (result.get_Class() == TC_SI_LEAVE)
937 {
938 if (result.get_tag() == TOK_SI_PUSHED) goto done;
939
940 /* NOTE: the tags TOK_QUAD_ES_COM, TOK_QUAD_ES_ESC, TOK_QUAD_ES_BRA,
941 and TOK_QUAD_ES_ERR below can only occur if:
942
943 1. ⎕EA resp. ⎕EB is called; each is implemented as macro
944 Z__A_Quad_EA_B resp. Z__A_Quad_EB_B.
945
946 2. The macro calls ⎕ES 100 ¯1...¯4, which brings us here.
947
948 Token result is the return token of Quad_ES::eval_AB() or
949 Quad_ES::eval_B() and contains the right argument B (as set in
950 the macro).
951
952 We must check that ⎕ES 100 was not called directly, but only via
953 ⎕EA or ⎕EB.
954 */
955
956 if (result.get_tag() == TOK_QUAD_ES_COM)
957 {
958 // make sure that ⎕ES was called from a macro (implies parent)
959 //
960 if (Workspace::SI_top()->function_name()[0] != UNI_MUE)
961 DOMAIN_ERROR;
962
963 Workspace::pop_SI(LOC); // discard ⎕EA/⎕EB context
964
965 const Cell & QES_arg2 = result.get_apl_val()->get_ravel(2);
966 Token & si_pushed = Workspace::SI_top()->get_prefix().at0();
967 Assert(si_pushed.get_tag() == TOK_SI_PUSHED);
968 if (QES_arg2.is_pointer_cell())
969 {
970 Value_P val = QES_arg2.get_pointer_value();
971 new (&si_pushed) Token(TOK_APL_VALUE2, val);
972 }
973 else
974 {
975 Value_P scalar(LOC);
976 scalar->next_ravel()->init(QES_arg2, scalar.getref(),LOC);
977 scalar->check_value(LOC);
978 new (&si_pushed) Token(TOK_APL_VALUE2, scalar);
979 }
980 return;
981 }
982
983 if (result.get_tag() == TOK_QUAD_ES_ESC)
984 {
985 // make sure that ⎕ES was called from a macro (implies parent)
986 //
987 if (Workspace::SI_top()->function_name()[0] != UNI_MUE)
988 DOMAIN_ERROR;
989
990 Workspace::pop_SI(LOC); // discard the ⎕EA/⎕EB context
991
992 Token & si_pushed = Workspace::SI_top()->get_prefix().at0();
993 Assert(si_pushed.get_tag() == TOK_SI_PUSHED);
994 new (&si_pushed) Token(TOK_ESCAPE);
995 return;
996 }
997
998 if (result.get_tag() == TOK_QUAD_ES_BRA)
999 {
1000 // make sure that ⎕ES was called from a macro (implies parent)
1001 //
1002 if (Workspace::SI_top()->function_name()[0] != UNI_MUE)
1003 DOMAIN_ERROR;
1004
1005 Workspace::pop_SI(LOC); // discard the ⎕EA/⎕EB context
1006
1007 const Cell & QES_arg2 = result.get_apl_val()->get_ravel(2);
1008 const APL_Integer line = QES_arg2.get_int_value();
1009
1010 Token & si_pushed = Workspace::SI_top()->get_prefix().at0();
1011 Assert(si_pushed.get_tag() == TOK_SI_PUSHED);
1012
1013 Workspace::SI_top()->jump(IntScalar(line, LOC));
1014 return;
1015 }
1016
1017 if (result.get_tag() == TOK_QUAD_ES_ERR)
1018 {
1019 // this case can only occur with ⎕EA, but not with ⎕EB.
1020
1021 // make sure that ⎕ES was called from a macro (implies parent)
1022 //
1023 if (Workspace::SI_top()->function_name()[0] != UNI_MUE)
1024 DOMAIN_ERROR;
1025
1026 Workspace::pop_SI(LOC); // discard the ⎕EA/⎕EB context
1027 StateIndicator * top = Workspace::SI_top();
1028
1029 Token & si_pushed = top->get_prefix().at0();
1030 Assert(si_pushed.get_tag() == TOK_SI_PUSHED);
1031
1032 const Cell * QES_arg = &result.get_apl_val()->get_ravel(0);
1033 UCS_string statement_A( QES_arg[2].get_pointer_value().getref());
1034 const APL_Integer major = QES_arg[3].get_int_value();
1035 const APL_Integer minor = QES_arg[4].get_int_value();
1036 const ErrorCode ec = ErrorCode(major << 16 | minor);
1037
1038 Token result_A = Bif_F1_EXECUTE::execute_statement(statement_A);
1039 if (result_A.get_Class() == TC_VALUE) // ⍎ literal
1040 {
1041 Workspace::SI_top()->get_prefix().at0().move_1(result_A, LOC);
1042 return;
1043 }
1044 new (&StateIndicator::get_error(top)) Error(ec, LOC);
1045 return;
1046 }
1047
1048 // at this point a normal monadic function (i.e. other than ⎕EA/⎕EB)
1049 // has returned an error
1050 //
1051 if (result.get_tag() == TOK_ERROR)
1052 {
1053 Token_loc tl(result, get_range_low());
1054 push(tl);
1055 action = RA_RETURN;
1056 return;
1057 }
1058
1059 // not reached
1060 Q1(result.get_tag())
1061 FIXME;
1062 }
1063
1064 done:
1065 pop_args_push_result(result);
1066 set_action(result);
1067 }
1068 //-----------------------------------------------------------------------------
1069 void
reduce_MISC_F_C_B()1070 Prefix::reduce_MISC_F_C_B()
1071 {
1072 Assert1(prefix_len == 3);
1073
1074 if (saved_lookahead.tok.get_Class() == TC_INDEX)
1075 {
1076 if (value_expected())
1077 {
1078 // push [...] and read one more token
1079 //
1080 push(saved_lookahead);
1081 saved_lookahead.tok.clear(LOC);
1082 action = RA_PUSH_NEXT;
1083 return;
1084 }
1085 }
1086
1087 if (at1().get_ValueType() != TV_VAL) // [i1;i2...] instead of [axis]
1088 {
1089 IndexExpr * idx = &at1().get_index_val();
1090 Log(LOG_delete) CERR << "delete " << voidP(idx) << " at " LOC << endl;
1091 delete idx;
1092 at1().clear(LOC);
1093 SYNTAX_ERROR;
1094 }
1095 if (!at1().get_apl_val()) SYNTAX_ERROR;
1096
1097 if (at0().get_tag() == TOK_Quad_FIO &&
1098 saved_lookahead.tok.get_Class() == TC_FUN12)
1099 {
1100 DerivedFunction * derived =
1101 Workspace::SI_top()->fun_oper_cache.get(LOC);
1102 new (derived) DerivedFunction(saved_lookahead.tok,
1103 at0().get_function(),
1104 at1().get_apl_val(), LOC);
1105 saved_lookahead.tok.clear(LOC);
1106 prefix_len = 2; // only f ⎕FIO
1107 pop_args_push_result(Token(TOK_FUN2, derived));
1108 action = RA_CONTINUE;
1109 return;
1110 }
1111
1112 Token result = at0().get_function()->eval_XB(at1().get_apl_val(),
1113 at2().get_apl_val());
1114 if (result.get_tag() == TOK_ERROR)
1115 {
1116 Token_loc tl(result, get_range_low());
1117 push(tl);
1118 action = RA_RETURN;
1119 return;
1120 }
1121
1122 pop_args_push_result(result);
1123 set_action(result);
1124 }
1125 //-----------------------------------------------------------------------------
1126 void
reduce_A_F_B_()1127 Prefix::reduce_A_F_B_()
1128 {
1129 Assert1(prefix_len == 3);
1130
1131 Token result = at1().get_function()->eval_AB(at0().get_apl_val(),
1132 at2().get_apl_val());
1133 if (result.get_tag() == TOK_ERROR)
1134 {
1135 Token_loc tl(result, get_range_low());
1136 push(tl);
1137 action = RA_RETURN;
1138 return;
1139 }
1140
1141 pop_args_push_result(result);
1142 set_action(result);
1143 }
1144 //-----------------------------------------------------------------------------
1145 void
reduce_A_M_B_()1146 Prefix::reduce_A_M_B_()
1147 {
1148 const TokenTag tag = at1().get_tag();
1149 if (tag == TOK_OPER1_REDUCE || tag == TOK_OPER1_SCAN ||
1150 tag == TOK_OPER1_REDUCE1 || tag == TOK_OPER1_SCAN1)
1151 return reduce_A_F_B_();
1152
1153 syntax_error(LOC);
1154 }
1155 //-----------------------------------------------------------------------------
1156 void
reduce_A_F_C_B()1157 Prefix::reduce_A_F_C_B()
1158 {
1159 Assert1(prefix_len == 4);
1160
1161 if (at2().get_ValueType() != TV_VAL) SYNTAX_ERROR;
1162 if (!at2().get_apl_val()) SYNTAX_ERROR;
1163
1164 Token result = at1().get_function()->eval_AXB(at0().get_apl_val(),
1165 at2().get_apl_val(),
1166 at3().get_apl_val());
1167 if (result.get_tag() == TOK_ERROR)
1168 {
1169 Token_loc tl(result, get_range_low());
1170 push(tl);
1171 action = RA_RETURN;
1172 return;
1173 }
1174
1175 pop_args_push_result(result);
1176 set_action(result);
1177 }
1178 //-----------------------------------------------------------------------------
1179 void
reduce_A_M_C_B()1180 Prefix::reduce_A_M_C_B()
1181 {
1182 const TokenTag tag = at1().get_tag();
1183 if (tag == TOK_OPER1_REDUCE || tag == TOK_OPER1_SCAN ||
1184 tag == TOK_OPER1_REDUCE1 || tag == TOK_OPER1_SCAN1)
1185 return reduce_A_F_C_B();
1186
1187 syntax_error(LOC);
1188 }
1189 //-----------------------------------------------------------------------------
1190 void
reduce_F_M__()1191 Prefix::reduce_F_M__()
1192 {
1193 Assert1(prefix_len == 2);
1194
1195 DerivedFunction * derived =
1196 Workspace::SI_top()->fun_oper_cache.get(LOC);
1197 new (derived) DerivedFunction(at0(), at1().get_function(), LOC);
1198
1199 pop_args_push_result(Token(TOK_FUN2, derived));
1200 action = RA_CONTINUE;
1201 }
1202 //-----------------------------------------------------------------------------
1203 void
reduce_M_M__()1204 Prefix::reduce_M_M__()
1205 {
1206 if (is_fun_or_oper(PC))
1207 {
1208 action = RA_PUSH_NEXT;
1209 return;
1210 }
1211
1212 const TokenTag tag = at0().get_tag();
1213 if (tag == TOK_OPER1_REDUCE || tag == TOK_OPER1_SCAN ||
1214 tag == TOK_OPER1_REDUCE1 || tag == TOK_OPER1_SCAN1)
1215 return reduce_F_M__();
1216
1217 syntax_error(LOC);
1218 }
1219 //-----------------------------------------------------------------------------
1220 void
reduce_F_M_C_()1221 Prefix::reduce_F_M_C_()
1222 {
1223 Assert1(prefix_len == 3);
1224
1225 if (at2().get_tag() != TOK_AXES) // e.g. F[;2] instead of F[2]
1226 {
1227 // the user has provided a TOK_INDEX where TOK_AXES was expected
1228 MORE_ERROR() << "illegal ; in axis";
1229 AXIS_ERROR;
1230 }
1231
1232 DerivedFunction * derived =
1233 Workspace::SI_top()->fun_oper_cache.get(LOC);
1234 new (derived) DerivedFunction(at0(),
1235 at1().get_function(),
1236 at2().get_axes(), LOC);
1237
1238 pop_args_push_result(Token(TOK_FUN2, derived));
1239 action = RA_CONTINUE;
1240 }
1241 //-----------------------------------------------------------------------------
1242 void
reduce_M_M_C_()1243 Prefix::reduce_M_M_C_()
1244 {
1245 if (is_fun_or_oper(PC))
1246 {
1247 action = RA_PUSH_NEXT;
1248 return;
1249 }
1250
1251 const TokenTag tag = at0().get_tag();
1252 if (tag == TOK_OPER1_REDUCE || tag == TOK_OPER1_SCAN ||
1253 tag == TOK_OPER1_REDUCE1 || tag == TOK_OPER1_SCAN1)
1254 return reduce_F_M_C_();
1255
1256 syntax_error(LOC);
1257 }
1258 //-----------------------------------------------------------------------------
1259 void
reduce_F_C_M_()1260 Prefix::reduce_F_C_M_()
1261 {
1262 Assert1(prefix_len == 3);
1263
1264 if (at1().get_tag() != TOK_AXES) // e.g. F[;2] instead of F[2]
1265 {
1266 // the user has provided a TOK_INDEX where TOK_AXES was expected
1267 MORE_ERROR() << "illegal ; in axis";
1268 AXIS_ERROR;
1269 }
1270
1271 DerivedFunction * F_C =
1272 Workspace::SI_top()->fun_oper_cache.get(LOC);
1273 new (F_C) DerivedFunction(at0().get_function(),
1274 at1().get_axes(), LOC);
1275
1276 Token tok_F_C(TOK_FUN2, F_C);
1277 DerivedFunction * derived =
1278 Workspace::SI_top()->fun_oper_cache.get(LOC);
1279 new (derived) DerivedFunction(tok_F_C, at2().get_function(), LOC);
1280
1281 pop_args_push_result(Token(TOK_FUN2, derived));
1282 action = RA_CONTINUE;
1283 }
1284 //-----------------------------------------------------------------------------
1285 void
reduce_M_C_M_()1286 Prefix::reduce_M_C_M_()
1287 {
1288 if (is_fun_or_oper(PC))
1289 {
1290 action = RA_PUSH_NEXT;
1291 return;
1292 }
1293
1294 const TokenTag tag = at0().get_tag();
1295 if (tag == TOK_OPER1_REDUCE || tag == TOK_OPER1_SCAN ||
1296 tag == TOK_OPER1_REDUCE1 || tag == TOK_OPER1_SCAN1)
1297 return reduce_F_C_M_();
1298
1299 syntax_error(LOC);
1300 }
1301 //-----------------------------------------------------------------------------
1302 void
reduce_F_C_M_C()1303 Prefix::reduce_F_C_M_C()
1304 {
1305 Assert1(prefix_len == 4);
1306
1307 if (at1().get_tag() != TOK_AXES) // e.g. F[;2] instead of F[2]
1308 {
1309 // the user has provided a TOK_INDEX where TOK_AXES was expected
1310 MORE_ERROR() << "illegal ; in axis";
1311 AXIS_ERROR;
1312 }
1313
1314 if (at3().get_tag() != TOK_AXES) // e.g. M[;2] instead of M[2]
1315 {
1316 // the user has provided a TOK_INDEX where TOK_AXES was expected
1317 MORE_ERROR() << "illegal ; in axis";
1318 AXIS_ERROR;
1319 }
1320
1321 DerivedFunction * F_C =
1322 Workspace::SI_top()->fun_oper_cache.get(LOC);
1323 new (F_C) DerivedFunction(at0().get_function(),
1324 at1().get_axes(), LOC);
1325
1326 Token tok_F_C(TOK_FUN2, F_C);
1327 DerivedFunction * derived =
1328 Workspace::SI_top()->fun_oper_cache.get(LOC);
1329 new (derived) DerivedFunction(tok_F_C, at2().get_function(),
1330 at3().get_axes(), LOC);
1331
1332 pop_args_push_result(Token(TOK_FUN2, derived));
1333 action = RA_CONTINUE;
1334 }
1335 //-----------------------------------------------------------------------------
1336 void
reduce_M_C_M_C()1337 Prefix::reduce_M_C_M_C()
1338 {
1339 if (is_fun_or_oper(PC))
1340 {
1341 action = RA_PUSH_NEXT;
1342 return;
1343 }
1344
1345 const TokenTag tag = at0().get_tag();
1346 if (tag == TOK_OPER1_REDUCE || tag == TOK_OPER1_SCAN ||
1347 tag == TOK_OPER1_REDUCE1 || tag == TOK_OPER1_SCAN1)
1348 return reduce_F_C_M_C();
1349
1350 syntax_error(LOC);
1351 }
1352 //-----------------------------------------------------------------------------
1353 void
reduce_F_D_B_()1354 Prefix::reduce_F_D_B_()
1355 {
1356 // same as G2, except for ⍤
1357 //
1358 if (at1().get_function()->get_Id() != ID_OPER2_RANK)
1359 {
1360 reduce_F_D_G_();
1361 return;
1362 }
1363
1364 // we have f ⍤ y_B with y_B glued beforehand. Unglue it.
1365 //
1366 Value_P y123;
1367 Value_P B;
1368 Bif_OPER2_RANK::split_y123_B(at2().get_apl_val(), y123, B);
1369 Token new_y123(TOK_APL_VALUE1, y123);
1370
1371 DerivedFunction * derived = Workspace::SI_top()->fun_oper_cache.get(LOC);
1372 new (derived) DerivedFunction(at0(), at1().get_function(), new_y123, LOC);
1373
1374 Token result = Token(TOK_FUN2, derived);
1375
1376 if (!B) // only y123, no B (e.g. (f ⍤[X] 1 2 3)
1377 {
1378 pop_args_push_result(result);
1379 }
1380 else // a new B split off from the original B
1381 {
1382 // save locations of ⍤ and B
1383 //
1384 Function_PC pc_D = at(1).pc;
1385 Function_PC pc_B = at(2).pc;
1386
1387 pop_and_discard(); // pop F
1388 pop_and_discard(); // pop C
1389 pop_and_discard(); // pop B (old)
1390
1391 Token new_B(TOK_APL_VALUE1, B);
1392 Token_loc tl_B(new_B, pc_B);
1393 Token_loc tl_derived(result, pc_D);
1394 push(tl_B);
1395 push(tl_derived);
1396 }
1397
1398 action = RA_CONTINUE;
1399 }
1400 //-----------------------------------------------------------------------------
1401 void
reduce_F_D_G_()1402 Prefix::reduce_F_D_G_()
1403 {
1404 DerivedFunction * derived =
1405 Workspace::SI_top()->fun_oper_cache.get(LOC);
1406 new (derived) DerivedFunction(at0(), at1().get_function(), at2(), LOC);
1407
1408 pop_args_push_result(Token(TOK_FUN2, derived));
1409 action = RA_CONTINUE;
1410 }
1411 //-----------------------------------------------------------------------------
1412 void
reduce_F_D_M_()1413 Prefix::reduce_F_D_M_()
1414 {
1415 const TokenTag tag = at2().get_tag();
1416 if (tag == TOK_OPER1_REDUCE || tag == TOK_OPER1_SCAN ||
1417 tag == TOK_OPER1_REDUCE1 || tag == TOK_OPER1_SCAN1)
1418 return reduce_F_D_G_();
1419
1420 syntax_error(LOC);
1421 }
1422 //-----------------------------------------------------------------------------
1423 void
reduce_M_D_G_()1424 Prefix::reduce_M_D_G_()
1425 {
1426 const TokenTag tag = at0().get_tag();
1427 if (tag == TOK_OPER1_REDUCE || tag == TOK_OPER1_SCAN ||
1428 tag == TOK_OPER1_REDUCE1 || tag == TOK_OPER1_SCAN1)
1429 return reduce_F_D_G_();
1430
1431 syntax_error(LOC);
1432 }
1433 //-----------------------------------------------------------------------------
1434 void
reduce_M_D_M_()1435 Prefix::reduce_M_D_M_()
1436 {
1437 const TokenTag tag0 = at0().get_tag();
1438 const TokenTag tag2 = at2().get_tag();
1439 if ((tag0 == TOK_OPER1_REDUCE || tag0 == TOK_OPER1_SCAN ||
1440 tag0 == TOK_OPER1_REDUCE1 || tag0 == TOK_OPER1_SCAN1) &&
1441 (tag2 == TOK_OPER1_REDUCE || tag2 == TOK_OPER1_SCAN ||
1442 tag2 == TOK_OPER1_REDUCE1 || tag2 == TOK_OPER1_SCAN1))
1443 return reduce_F_D_G_();
1444
1445 syntax_error(LOC);
1446 }
1447 //-----------------------------------------------------------------------------
1448 void
reduce_F_D_C_B()1449 Prefix::reduce_F_D_C_B()
1450 {
1451 // reduce, except if another dyadic operator is coming. In that case
1452 // F belongs to the other operator and we simply continue.
1453 //
1454 if (PC < Function_PC(body.size()))
1455 {
1456 const Token & tok = body[PC];
1457 TokenClass next = tok.get_Class();
1458 if (next == TC_SYMBOL)
1459 {
1460 Symbol * sym = tok.get_sym_ptr();
1461 const bool left_sym = get_assign_state() == ASS_arrow_seen;
1462 next = sym->resolve_class(left_sym);
1463 }
1464
1465 if (next == TC_OPER2)
1466 {
1467 action = RA_PUSH_NEXT;
1468 return;
1469 }
1470 }
1471 // we have f ⍤ [X] y_B with y_B glued beforehand. Unglue it.
1472 //
1473 Value_P y123;
1474 Value_P B;
1475 Bif_OPER2_RANK::split_y123_B(at3().get_apl_val(), y123, B);
1476 Token new_y123(TOK_APL_VALUE1, y123);
1477
1478 if (at2().get_tag() != TOK_AXES) // e.g. D[;2] instead of D[;2]
1479 {
1480 // the user has provided a TOK_INDEX where TOK_AXES was expected
1481 MORE_ERROR() << "illegal ; in axis";
1482 AXIS_ERROR;
1483 }
1484
1485 Value_P v_idx = at2().get_axes();
1486 DerivedFunction * derived = Workspace::SI_top()->fun_oper_cache.get(LOC);
1487 new (derived) DerivedFunction(at0(), at1().get_function(),
1488 v_idx, new_y123, LOC);
1489
1490 Token result = Token(TOK_FUN2, derived);
1491
1492 if (!B) // only y123, no B (e.g. (f ⍤[X] 1 2 3)
1493 {
1494 pop_args_push_result(result);
1495 }
1496 else // a new B split off from the original B
1497 {
1498 // save locations of ⍤ and B
1499 //
1500 Function_PC pc_D = at(1).pc;
1501 Function_PC pc_B = at(3).pc;
1502
1503 pop_and_discard(); // pop F
1504 pop_and_discard(); // pop D
1505 pop_and_discard(); // pop C
1506 pop_and_discard(); // pop B (old)
1507
1508 Token new_B(TOK_APL_VALUE1, B);
1509 Token_loc tl_B(new_B, pc_B);
1510 Token_loc tl_derived(result, pc_D);
1511 push(tl_B);
1512 push(tl_derived);
1513 }
1514
1515 action = RA_CONTINUE;
1516 }
1517 //-----------------------------------------------------------------------------
1518 void
reduce_A_C__()1519 Prefix::reduce_A_C__()
1520 {
1521 Value_P A = at0().get_apl_val();
1522 Value_P Z;
1523
1524 if (at1().get_tag() == TOK_AXES)
1525 {
1526 Z = A->index(at1().get_apl_val());
1527 }
1528 else
1529 {
1530 IndexExpr * idx = &at1().get_index_val();
1531 try
1532 {
1533 Z = A->index(*idx);
1534 Log(LOG_delete)
1535 CERR << "delete " << voidP(idx) << " at " LOC << endl;
1536 delete idx;
1537 }
1538 catch (Error err)
1539 {
1540 Token result = Token(TOK_ERROR, err.get_error_code());
1541 Log(LOG_delete) CERR << "delete " << voidP(idx)
1542 << " at " LOC << endl;
1543 delete idx;
1544 pop_args_push_result(result);
1545 set_action(result);
1546 return;
1547 }
1548 }
1549
1550 Token result = Token(TOK_APL_VALUE1, Z);
1551 pop_args_push_result(result);
1552
1553 set_action(result);
1554 }
1555 //-----------------------------------------------------------------------------
1556 void
reduce_V_C__()1557 Prefix::reduce_V_C__()
1558 {
1559 Symbol * V = at0().get_sym_ptr();
1560 Token tok = V->resolve_lv(LOC);
1561 at0().move_1(tok, LOC);
1562 set_assign_state(ASS_var_seen);
1563 action = RA_CONTINUE;
1564 }
1565 //-----------------------------------------------------------------------------
1566 void
reduce_V_C_ASS_B()1567 Prefix::reduce_V_C_ASS_B()
1568 {
1569 Symbol * V = at0().get_sym_ptr();
1570 Value_P B = at3().get_apl_val();
1571
1572 if (at1().get_tag() == TOK_AXES) // [] or [x]
1573 {
1574 Value_P v_idx = at1().get_axes();
1575
1576 try
1577 {
1578 V->assign_indexed(v_idx, B);
1579 }
1580 catch (Error err)
1581 {
1582 Token result = Token(TOK_ERROR, err.get_error_code());
1583 at1().clear(LOC);
1584 at3().clear(LOC);
1585 pop_args_push_result(result);
1586 set_assign_state(ASS_none);
1587 set_action(result);
1588 return;
1589 }
1590 }
1591 else // [a;...]
1592 {
1593 IndexExpr * idx = &at1().get_index_val();
1594 try
1595 {
1596 V->assign_indexed(*idx, B);
1597 Log(LOG_delete) CERR << "delete " << voidP(idx)
1598 << " at " LOC << endl;
1599 delete idx;
1600 }
1601 catch (Error err)
1602 {
1603 Token result = Token(TOK_ERROR, err.get_error_code());
1604 at1().clear(LOC);
1605 at3().clear(LOC);
1606 Log(LOG_delete) CERR << "delete " << voidP(idx)
1607 << " at " LOC << endl;
1608 delete idx;
1609 pop_args_push_result(result);
1610 set_assign_state(ASS_none);
1611 set_action(result);
1612 return;
1613 }
1614 }
1615
1616 Token result = Token(TOK_APL_VALUE2, B);
1617 pop_args_push_result(result);
1618 set_assign_state(ASS_none);
1619 set_action(result);
1620 }
1621 //-----------------------------------------------------------------------------
1622 void
reduce_F_V__()1623 Prefix::reduce_F_V__()
1624 {
1625 // turn V into a (left-) value
1626 //
1627 Symbol * V = at1().get_sym_ptr();
1628 Token tok = V->resolve_lv(LOC);
1629 at1().move_1(tok, LOC);
1630 set_assign_state(ASS_var_seen);
1631 action = RA_CONTINUE;
1632 }
1633 //-----------------------------------------------------------------------------
1634 void
reduce_A_ASS_B_()1635 Prefix::reduce_A_ASS_B_()
1636 {
1637 Value_P A = at0().get_apl_val();
1638 Value_P B = at2().get_apl_val();
1639
1640 A->assign_cellrefs(B);
1641
1642 Token result = Token(TOK_APL_VALUE2, B);
1643 pop_args_push_result(result);
1644
1645 set_assign_state(ASS_none);
1646 action = RA_CONTINUE;
1647 }
1648 //-----------------------------------------------------------------------------
1649 void
reduce_V_ASS_B_()1650 Prefix::reduce_V_ASS_B_()
1651 {
1652 Value_P B = at2().get_apl_val();
1653
1654 Assert1(B->get_owner_count() >= 2); // owners are at least B and at2()
1655 const bool clone = B->get_owner_count() != 2 || at1().get_tag() != TOK_ASSIGN1;
1656 Symbol * V = at0().get_sym_ptr();
1657 pop_and_discard(); // V
1658 pop_and_discard(); // ←
1659
1660 at0().ChangeTag(TOK_APL_VALUE2); // change value to committed value
1661
1662 set_assign_state(ASS_none);
1663 action = RA_CONTINUE;
1664
1665 V->assign(B, clone, LOC);
1666 }
1667 //-----------------------------------------------------------------------------
1668 void
reduce_V_ASS_F_()1669 Prefix::reduce_V_ASS_F_()
1670 {
1671 // named lambda: V ← { ... }
1672 //
1673 Function * F = at2().get_function();
1674 if (!F->is_lambda()) SYNTAX_ERROR;
1675
1676 Symbol * V = at0().get_sym_ptr();
1677 if (V->assign_named_lambda(F, LOC)) DEFN_ERROR;
1678
1679 Value_P Z(V->get_name(), LOC);
1680 Token result = Token(TOK_APL_VALUE2, Z);
1681 pop_args_push_result(result);
1682
1683 set_assign_state(ASS_none);
1684 action = RA_CONTINUE;
1685 }
1686 //-----------------------------------------------------------------------------
1687 void
reduce_RBRA___()1688 Prefix::reduce_RBRA___()
1689 {
1690 Assert1(prefix_len == 1);
1691
1692 // start partial index list. Parse the index as right so that, for example,
1693 // A[IDX}←B resolves IDX properly. assign_state is restored when the
1694 // index is complete.
1695 //
1696 IndexExpr * idx = new IndexExpr(get_assign_state(), LOC);
1697 Log(LOG_delete)
1698 CERR << "new " << voidP(idx) << " at " LOC << endl;
1699
1700 new (&at0()) Token(TOK_PINDEX, *idx);
1701 set_assign_state(ASS_none);
1702 action = RA_CONTINUE;
1703 }
1704 //-----------------------------------------------------------------------------
1705 void
reduce_LBRA_I__()1706 Prefix::reduce_LBRA_I__()
1707 {
1708 // [ I or ; I (elided index)
1709 //
1710 Assert1(prefix_len == 2);
1711
1712 IndexExpr & idx = at1().get_index_val();
1713 const bool last_index = (at0().get_tag() == TOK_L_BRACK);
1714
1715 if (idx.value_count() == 0 && last_index) // special case: [ ]
1716 {
1717 assign_state = idx.get_assign_state();
1718 Token result = Token(TOK_INDEX, idx);
1719 pop_args_push_result(result);
1720 action = RA_CONTINUE;
1721 Log(LOG_delete) CERR << "delete " << voidP(&idx)
1722 << " at " LOC << endl;
1723 delete &idx;
1724 return;
1725 }
1726
1727 // add elided index to partial index list
1728 //
1729 Token result = at1();
1730 result.get_index_val().add(Value_P());
1731
1732 if (last_index) // [ seen
1733 {
1734 assign_state = idx.get_assign_state();
1735
1736 if (idx.is_axis()) result.move_2(Token(TOK_AXES, idx.values[0]), LOC);
1737 else result.move_2(Token(TOK_INDEX, idx), LOC);
1738 }
1739 else
1740 {
1741 set_assign_state(ASS_none);
1742 }
1743
1744 pop_args_push_result(result);
1745 action = RA_CONTINUE;
1746 }
1747 //-----------------------------------------------------------------------------
1748 void
reduce_LBRA_B_I_()1749 Prefix::reduce_LBRA_B_I_()
1750 {
1751 Assert1(prefix_len == 3);
1752
1753 // [ B I or ; B I (normal index)
1754 //
1755 Token I = at2();
1756 I.get_index_val().add(at1().get_apl_val());
1757
1758 const bool last_index = (at0().get_tag() == TOK_L_BRACK); // ; vs. [
1759
1760 if (last_index) // [ seen
1761 {
1762 IndexExpr & idx = I.get_index_val();
1763 assign_state = idx.get_assign_state();
1764
1765 if (idx.is_axis())
1766 {
1767 Value_P X = idx.extract_value(0);
1768 Assert1(!!X);
1769 I.move_2(Token(TOK_AXES, X), LOC);
1770 Log(LOG_delete)
1771 CERR << "delete " << voidP(&idx) << " at " LOC << endl;
1772 delete &idx;
1773 }
1774 else
1775 {
1776 I.move_2(Token(TOK_INDEX, idx), LOC);
1777 }
1778 }
1779 else
1780 {
1781 set_assign_state(ASS_none);
1782 }
1783
1784 pop_args_push_result(I);
1785 action = RA_CONTINUE;
1786 }
1787 //-----------------------------------------------------------------------------
1788 void
reduce_A_B__()1789 Prefix::reduce_A_B__()
1790 {
1791 Assert1(prefix_len == 2);
1792
1793 Token result;
1794 Value::glue(result, at0(), at1(), LOC);
1795 pop_args_push_result(result);
1796
1797 set_action(result);
1798 }
1799 //-----------------------------------------------------------------------------
1800 void
reduce_V_RPAR_ASS_B()1801 Prefix::reduce_V_RPAR_ASS_B()
1802 {
1803 Assert1(prefix_len == 4);
1804
1805 const int count = vector_ass_count();
1806
1807 // vector assignment also matches selective specification, but count
1808 // distinguishes them, e.g.
1809 //
1810 // (T U V) ← value count = 2 vector assignment
1811 // (U V) ← value count = 1 vector assignment
1812 // (2 ↑ V) ← value count = 0 selective specification
1813 //
1814 if (count < 1)
1815 {
1816 // selective specification. Convert variable V into a (left-) value
1817 //
1818 Symbol * V = at0().get_sym_ptr();
1819 Token result = V->resolve_lv(LOC);
1820 set_assign_state(ASS_var_seen);
1821 at0().move_1(result, LOC);
1822 action = RA_CONTINUE;
1823 return;
1824 }
1825
1826 // vector assignment.
1827 //
1828 std::vector<Symbol *> symbols;
1829 symbols.push_back(at0().get_sym_ptr());
1830 loop(c, count)
1831 {
1832 Token_loc tl = lookahead();
1833 Assert1(tl.tok.get_tag() == TOK_LSYMB2); // by vector_ass_count()
1834 Symbol * V = tl.tok.get_sym_ptr();
1835 Assert(V);
1836 symbols.push_back(V);
1837 }
1838
1839 Value_P B = at3().get_apl_val();
1840 Symbol::vector_assignment(symbols, B);
1841
1842 set_assign_state(ASS_none);
1843
1844 // clean up stack
1845 //
1846 Token result(TOK_APL_VALUE2, at3().get_apl_val());
1847 pop_args_push_result(result);
1848 Token_loc tl = lookahead();
1849 if (tl.tok.get_Class() != TC_L_PARENT) syntax_error(LOC);
1850
1851 action = RA_CONTINUE;
1852 }
1853 //-----------------------------------------------------------------------------
1854 void
reduce_END_VOID__()1855 Prefix::reduce_END_VOID__()
1856 {
1857 Assert1(prefix_len == 2);
1858
1859 if (size() != 2) syntax_error(LOC);
1860
1861 const bool end_of_line = at0().get_tag() == TOK_ENDL;
1862 const bool trace = (at0().get_int_val() & 1) != 0;
1863
1864 pop_and_discard(); // pop END
1865 pop_and_discard(); // pop VOID
1866
1867 Token Void(TOK_VOID);
1868 si.statement_result(Void, trace);
1869 action = RA_PUSH_NEXT;
1870 if (attention_is_raised() && end_of_line)
1871 {
1872 const bool int_raised = interrupt_is_raised();
1873 clear_attention_raised(LOC);
1874 clear_interrupt_raised(LOC);
1875 if (int_raised) INTERRUPT
1876 else ATTENTION
1877 }
1878 }
1879 //-----------------------------------------------------------------------------
1880 void
reduce_END_B__()1881 Prefix::reduce_END_B__()
1882 {
1883 Assert1(prefix_len == 2);
1884
1885 if (size() != 2) syntax_error(LOC);
1886
1887 const bool end_of_line = at0().get_tag() == TOK_ENDL;
1888 const bool trace = (at0().get_int_val() & 1) != 0;
1889
1890 pop_and_discard(); // pop END
1891 Token B = pop().tok; // pop B
1892 si.fun_oper_cache.reset();
1893 si.statement_result(B, trace);
1894
1895 action = RA_PUSH_NEXT;
1896 if (attention_is_raised() && end_of_line)
1897 {
1898 const bool int_raised = interrupt_is_raised();
1899 clear_attention_raised(LOC);
1900 clear_interrupt_raised(LOC);
1901 if (int_raised) INTERRUPT
1902 else ATTENTION
1903 }
1904 }
1905 //-----------------------------------------------------------------------------
1906 void
reduce_END_GOTO_B_()1907 Prefix::reduce_END_GOTO_B_()
1908 {
1909 Assert1(prefix_len == 3);
1910
1911 if (size() != 3) syntax_error(LOC);
1912
1913 si.fun_oper_cache.reset();
1914
1915 // at0() is either TOK_END or TOK_ENDL.
1916 //
1917 const bool end_of_line = at0().get_tag() == TOK_ENDL;
1918 const bool trace = at0().get_Class() == TC_END &&
1919 (at0().get_int_val() & 1) != 0;
1920
1921 Value_P line = at2().get_apl_val();
1922 if (trace && line->element_count() > 0)
1923 {
1924 const int64_t line_num = line->get_line_number();
1925 Token bra(TOK_BRANCH, line_num);
1926 si.statement_result(bra, true);
1927 }
1928
1929 const Token result = si.jump(line);
1930
1931 if (result.get_tag() == TOK_BRANCH) // branch back into a function
1932 {
1933 Log(LOG_prefix_parser)
1934 {
1935 CERR << "Leaving context after " << result << endl;
1936 }
1937
1938 pop_args_push_result(result);
1939 action = RA_RETURN;
1940 return;
1941 }
1942
1943 // StateIndicator::jump may have called set_PC() which resets the prefix.
1944 // we do not call pop_args_push_result(result) (which would fail due
1945 // to the now incorrect prefix_len), but discard the entire statement.
1946 //
1947 reset(LOC);
1948
1949 if (result.get_tag() == TOK_NOBRANCH) // branch not taken, e.g. →⍬
1950 {
1951 Token bra(TOK_NOBRANCH);
1952 si.statement_result(bra, trace);
1953
1954 action = RA_PUSH_NEXT;
1955 if (attention_is_raised() && end_of_line)
1956 {
1957 const bool int_raised = interrupt_is_raised();
1958 clear_attention_raised(LOC);
1959 clear_interrupt_raised(LOC);
1960 if (int_raised) INTERRUPT
1961 else ATTENTION
1962 }
1963
1964 return;
1965 }
1966
1967 if (result.get_tag() == TOK_VOID) // branch taken, e.g. →N
1968 {
1969 action = RA_PUSH_NEXT;
1970 if (attention_is_raised() && end_of_line)
1971 {
1972 const bool int_raised = interrupt_is_raised();
1973 clear_attention_raised(LOC);
1974 clear_interrupt_raised(LOC);
1975 if (int_raised) INTERRUPT
1976 else ATTENTION
1977 }
1978
1979 return;
1980 }
1981
1982 // branch within function
1983 //
1984 const Function_PC new_pc = si.get_PC();
1985 Log(LOG_prefix_parser)
1986 {
1987 CERR << "Staying in context after →PC(" << new_pc << ")" << endl;
1988 print_stack(CERR, LOC);
1989 }
1990
1991 Assert1(size() == 0);
1992 action = RA_PUSH_NEXT;
1993 if (attention_is_raised() && end_of_line)
1994 {
1995 const bool int_raised = interrupt_is_raised();
1996 clear_attention_raised(LOC);
1997 clear_interrupt_raised(LOC);
1998 if (int_raised) INTERRUPT
1999 else ATTENTION
2000 }
2001 }
2002 //-----------------------------------------------------------------------------
2003 void
reduce_END_GOTO__()2004 Prefix::reduce_END_GOTO__()
2005 {
2006 Assert1(prefix_len == 2);
2007
2008 if (size() != 2) syntax_error(LOC);
2009
2010 si.fun_oper_cache.reset();
2011
2012 const bool trace = at0().get_Class() == TC_END &&
2013 (at0().get_int_val() & 1) != 0;
2014 if (trace)
2015 {
2016 Token esc(TOK_ESCAPE);
2017 si.statement_result(esc, true);
2018 }
2019
2020 // the statement is → which could mean TOK_ESCAPE (normal →) or
2021 // TOK_STOP_LINE from S∆←line
2022 //
2023 if (at1().get_tag() == TOK_STOP_LINE) // S∆ line
2024 {
2025 const UserFunction * ufun = si.get_executable()->get_ufun();
2026 if (ufun && ufun->get_exec_properties()[2])
2027 {
2028 // the function ignores attention (aka. weak interrupt)
2029 //
2030 pop_and_discard(); // pop END
2031 pop_and_discard(); // pop GOTO
2032 action = RA_CONTINUE;
2033 return;
2034 }
2035
2036 COUT << si.function_name() << "[" << si.get_line() << "]" << endl;
2037 Token result(TOK_ERROR, E_STOP_LINE);
2038 pop_args_push_result(result);
2039 action = RA_RETURN;
2040 }
2041 else
2042 {
2043 Token result(TOK_ESCAPE);
2044 pop_args_push_result(result);
2045 action = RA_RETURN;
2046 }
2047 }
2048 //-----------------------------------------------------------------------------
2049 void
reduce_RETC_VOID__()2050 Prefix::reduce_RETC_VOID__()
2051 {
2052 Assert1(prefix_len == 2);
2053
2054 Token result = Token(TOK_VOID);
2055 pop_args_push_result(result);
2056 action = RA_RETURN;
2057 }
2058 //-----------------------------------------------------------------------------
2059 void
reduce_RETC___()2060 Prefix::reduce_RETC___()
2061 {
2062 Assert1(prefix_len == 1);
2063
2064 if (size() != 1) syntax_error(LOC);
2065
2066 // end of context reached. There are 4 cases:
2067 //
2068 // TOK_RETURN_STATS: end of ◊ context
2069 // TOK_RETURN_EXEC: end of ⍎ context with no result (e.g. ⍎'')
2070 // TOK_RETURN_VOID: end of ∇ (no result)
2071 // TOK_RETURN_SYMBOL: end of ∇ (result in Z)
2072 //
2073 // case TOK_RETURN_EXEC (end of ⍎ context) is handled in reduce_RETC_B___()
2074 //
2075 switch(at0().get_tag())
2076 {
2077 case TOK_RETURN_EXEC: // immediate execution context
2078 Log(LOG_prefix_parser)
2079 CERR << "- end of ⍎ context (no result)" << endl;
2080 at0().clear(LOC);
2081 action = RA_RETURN;
2082 return;
2083
2084 case TOK_RETURN_STATS: // immediate execution context
2085 Log(LOG_prefix_parser)
2086 CERR << "- end of ◊ context" << endl;
2087 at0().clear(LOC);
2088 action = RA_RETURN;
2089 return;
2090
2091 case TOK_RETURN_VOID: // user-defined function not returning a value
2092 Log(LOG_prefix_parser)
2093 CERR << "- end of ∇ context (function has no result)" << endl;
2094
2095 {
2096 const UserFunction * ufun = si.get_executable()->get_ufun();
2097 if (ufun) { /* do nothing, needed for -Wall */ }
2098 Assert1(ufun);
2099 at0().clear(LOC);
2100 }
2101 action = RA_RETURN;
2102 return;
2103
2104 case TOK_RETURN_SYMBOL: // user-defined function returning a value
2105 {
2106 const UserFunction * ufun = si.get_executable()->get_ufun();
2107 Assert1(ufun);
2108 Symbol * ufun_Z = ufun->get_sym_Z();
2109 Value_P Z;
2110 if (ufun_Z) Z = ufun_Z->get_value();
2111 if (!!Z)
2112 {
2113 Log(LOG_prefix_parser)
2114 CERR << "- end of ∇ context (function result is: "
2115 << *Z << ")" << endl;
2116 new (&at0()) Token(TOK_APL_VALUE1, Z);
2117 }
2118 else
2119 {
2120 Log(LOG_prefix_parser)
2121 CERR << "- end of ∇ context (MISSING function result)."
2122 << endl;
2123 at0().clear(LOC);
2124 }
2125 }
2126 action = RA_RETURN;
2127 return;
2128
2129 default: break;
2130 }
2131
2132 // not reached
2133 //
2134 Q1(at0().get_tag()) FIXME;
2135 }
2136 //-----------------------------------------------------------------------------
2137 // Note: reduce_RETC_B___ happens only for context ⍎,
2138 // since contexts ◊ and ∇ use reduce_END_B___ instead.
2139 //
2140 void
reduce_RETC_B__()2141 Prefix::reduce_RETC_B__()
2142 {
2143 Assert1(prefix_len == 2);
2144
2145 if (size() != 2)
2146 {
2147 syntax_error(LOC);
2148 }
2149
2150 Log(LOG_prefix_parser)
2151 CERR << "- end of ⍎ context.";
2152
2153 Token B = at1();
2154 pop_args_push_result(B);
2155
2156 action = RA_RETURN;
2157 }
2158 //-----------------------------------------------------------------------------
2159 // Note: reduce_RETC_GOTO_B__ happens only for context ⍎,
2160 // since contexts ◊ and ∇ use reduce_END_GOTO_B__ instead.
2161 //
2162 void
reduce_RETC_GOTO_B_()2163 Prefix::reduce_RETC_GOTO_B_()
2164 {
2165 if (size() != 3) syntax_error(LOC);
2166
2167 reduce_END_GOTO_B_();
2168
2169 if (action == RA_PUSH_NEXT)
2170 {
2171 // reduce_END_GOTO_B_() has detected a non-taken branch (e.g. →'')
2172 // and wants to continue with the next statement.
2173 // We are in ⍎ mode, so there is no next statement and we
2174 // RA_RETURN a TOK_VOID instead of RA_PUSH_NEXT.
2175 //
2176 Token tok(TOK_VOID);
2177 Token_loc tl(tok, Function_PC_0);
2178 push(tl);
2179 }
2180
2181 action = RA_RETURN;
2182 }
2183 //-----------------------------------------------------------------------------
2184 // Note: reduce_RETC_ESC___ happens only for context ⍎,
2185 // since contexts ◊ and ∇ use reduce_END_ESC___ instead.
2186 //
2187 void
reduce_RETC_GOTO__()2188 Prefix::reduce_RETC_GOTO__()
2189 {
2190 if (size() != 2) syntax_error(LOC);
2191
2192 reduce_END_GOTO__();
2193 }
2194 //-----------------------------------------------------------------------------
2195
2196