/*
    This file is part of GNU APL, a free implementation of the
    ISO/IEC Standard 13751, "Programming Language APL, Extended"

    Copyright © 2008-2025  Dr. Jürgen Sauermann

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

/** @file
*/

#include "Bif_OPER2_RANK.hh"
#include "Bif_OPER2_POWER.hh"
#include "Common.hh"
#include "DerivedFunction.hh"
#include "Executable.hh"
#include "IndexExpr.hh"
#include "LvalCell.hh"
#include "PointerCell.hh"
#include "Prefix.hh"
#include "StateIndicator.hh"
#include "Symbol.hh"
#include "UserFunction.hh"
#include "ValueHistory.hh"
#include "Workspace.hh"

/// prefix search mode (hash table vs. search tree
// #define PREFIX_HASH

uint64_t Prefix::instance_counter = 0;

//----------------------------------------------------------------------------
Prefix::Prefix(StateIndicator & _si, const Token_string & _body)
   : instance(++instance_counter),
     si(_si),
     put(0),
     saved_MISC(Token(TOK_VOID), Function_PC_invalid),
     body(_body),
     PC(Function_PC_0),
     assign_state(ASS_none),
     action(RA_FIXME)
{
}
//----------------------------------------------------------------------------
void
Prefix::clean_up()
{
   loop(s, ssize())
      {
        Token & tok = at(s).get_token();
        if (tok.get_Class() == TC_VALUE)
           {
             tok.release_apl_val(LOC);
           }
        else if (tok.get_ValueType() == TV_INDEX)
           {
             tok.get_index_val().~IndexExpr();
           }
      }

   put = 0;
}
//----------------------------------------------------------------------------
void
Prefix::syntax_error(const char * loc)
{
   // move the PC back to the beginning of the failed statement
   //
   while (PC > 0)
      {
        --PC;
        if (body[PC].get_Class() == TC_END)
           {
             ++PC;
             break;
           }
      }

   // clear values in FIFO
   //
   loop (s, ssize())
      {
        Token & tok = at(s).get_token();
        if (tok.get_Class() == TC_VALUE)
           {
             Value_P val = tok.get_apl_val();
          }
        else if (tok.get_Class() == TC_FUN2)
          {
            cFunction_P fun = tok.get_function();
            if (fun && fun->is_derived())
               {
                 Function * fp = const_cast<Function *>(fun);
                 reinterpret_cast<DerivedFunction *>(fp)->destroy_derived(LOC);
               }
          }
      }

   // see if error was caused by a function not returning a value.
   // In that case we throw a value error instead of a syntax error.
   //
   loop (s, ssize())
      {
        if (at(s).get_Class() == TC_VOID)
           {
             MORE_ERROR() << "No assignment to result variable Z"
                             " in e.g. ∇Z←... ?";
             throw_apl_error(E_VALUE_ERROR, loc);
           }
      }

   throw_apl_error(get_assign_state() == ASS_none ? E_SYNTAX_ERROR
                                                  : E_LEFT_SYNTAX_ERROR, loc);
}
//----------------------------------------------------------------------------
bool
Prefix::uses_function(const UserFunction * ufun) const
{
   loop (s, ssize())
      {
        const Token & tok = at(s).get_token();
        if (tok.get_ValueType() == TV_FUN &&
            tok.get_function() == ufun)   return true;
      }

   if (saved_MISC.get_ValueType() == TV_FUN &&
       saved_MISC.get_function() == ufun)   return true;

   return false;
}
//----------------------------------------------------------------------------
bool
Prefix::has_quad_LRX() const
{
   /* examples:

       at0 at1 at2 at3  prefix_len
        ÷   R           2            in MISC  ÷ R      has ⎕R
        L   ÷   R       3            in    L  ÷ R      has ⎕L and ⎕R
        L   ÷  [X]  R   4            in    L  ÷ [X] R  has ⎕L and ⎕X and ⎕R
        B  [X]                       in  5 6 [2]
    */

   switch(ssize())
      {
        case 0:  return false;
        case 1:  return false;
        case 2:  if (at1().get_Class() == TC_INDEX)   return true;   // B[X]
                 // fall through
        default: return content[0].get_Class() == TC_VALUE;
      }
}
//----------------------------------------------------------------------------
bool
Prefix::is_value_parenthesis(int pc) const
{
   // we have ) XXX with XXX on the stack and need to know if the evaluation
   // of (... ) will be a value as in e.g. (1 + 1) or a function as in (+/).
   //
   Assert1(body[pc].get_Class() == TC_R_PARENT);

   ++pc;
   if (pc >= int(body.ssize()))   return true;   // syntax error

TokenClass next = body[pc].get_Class();

   if (next == TC_R_BRACK)   // skip [ ... ]
      {
        const int offset = body[pc].get_int_val2();
        pc += offset;
        Assert1(body[pc].get_Class() == TC_L_BRACK);   // opening [
        if (pc >= Function_PC(body.ssize()))   return true;   // syntax error
        next = body[pc].get_Class();
      }

   if (next == TC_SYMBOL)   // resolve symbol if necessary
      {
        const Symbol * sym = body[pc].get_sym_ptr();
        const NameClass nc = sym->get_NC();

        if (nc == NC_FUNCTION)   return false;
        if (nc == NC_OPERATOR)   return false;
        return true;
      }

   if (next == TC_OPER1)   return false;
   if (next == TC_OPER2)   return false;
   if (next == TC_FUN12)   return false;

   if (next == TC_L_PARENT)   // )) XXX
      {
        ++pc;
        if (!is_value_parenthesis(pc))   return false;   // (fun)) XXX
        const int offset = body[pc].get_int_val2();
        pc += offset;
        if (pc >= Function_PC(body.ssize()))   return true;   // syntax error
        next = body[pc].get_Class();
        Assert1(next == TC_L_PARENT);   // opening (
        ++pc;
        if (pc >= Function_PC(body.ssize()))   return true;   // syntax error

        //   (val)) XXX
        //  ^
        //  pc
        //
        // result is a value unless (val) is the right function operand
        // of a dyadic operator
        //
        next = body[pc].get_Class();
        if (next == TC_OPER2)   return false;
        if (next == TC_SYMBOL)   // resolve symbol if necessary
           {
             const Symbol * sym = body[pc].get_sym_ptr();
             const Function * fun = sym->get_function();
             return ! (fun && fun->is_operator() &&
                       fun->get_oper_valence() == 2);
           }
        return true;
      }

   // dyadic operator with numeric function argument, for example:  ⍤ 0
   //
   if (next == TC_VALUE                  &&
       pc < Function_PC(body.ssize() - 1) &&
       body[pc+1].get_Class() == TC_OPER2)   return false;

   return true;
}
//----------------------------------------------------------------------------
bool
Prefix::is_value_bracket() const
{
   Assert1(body[PC - 1].get_Class() == TC_R_BRACK);
const int offset = body[PC - 1].get_int_val2();
   Assert1(body[PC + offset - 1].get_Class() == TC_L_BRACK);   // opening [

const Token & tok1 = body[PC + offset];
   if (tok1.get_Class() == TC_VALUE)    return true;
   if (tok1.get_Class() != TC_SYMBOL)   return false;

Symbol * sym = tok1.get_sym_ptr();
const bool is_left_sym = get_assign_state() == ASS_arrow_seen;
   return sym->resolve_class(is_left_sym) == TC_VALUE;
}
//----------------------------------------------------------------------------
void
Prefix::collect_symbols(vector<Symbol *> & symbols)
{
   // TOKEN ... TOKEN VAR ) ←   (reversed)
   //             ↑
   //             PC
   //
   // return the TOK_LSYMB2 symbols left of \b PC.
   //
   while (PC < Function_PC(body.ssize()))
       {
         const Token & tok = body[PC];
         if (tok.get_ValueType() != TV_SYM)   break;

         ++PC;
         Symbol * sym_var = tok.get_sym_ptr();
         Assert(sym_var);
         if (!sym_var->can_be_assigned())   break;   // not a variable
         symbols.push_back(sym_var);
       }
}
//----------------------------------------------------------------------------
void
Prefix::print_stack(ostream & out, const char * loc) const
{
const int si_depth = si.get_level();

   out << "fifo[si=" << si_depth << " len=" << ssize()
       << " PC=" << PC << "] is now :";

   loop(s, ssize())
      {
        const TokenTag tag = at(s).get_tag();
        out << " " << Token::class_name(tag);
      }

   out << "  at " << loc << endl;
}
//----------------------------------------------------------------------------
int
Prefix::show_owners(const char * prefix, ostream & out,
                          const Value & value) const
{
int count = 0;

   loop (s, ssize())
      {
        const Token & tok = at(s).get_token();
        if (tok.get_ValueType() != TV_VAL)      continue;

        if (Value::is_or_contains(tok.get_apl_val().get(), &value))
           {
             out << prefix << " Fifo [" << s << "]" << endl;
             ++count;
           }

      }

   return count;
}
//----------------------------------------------------------------------------
ostream &
Prefix::print_token_value(ostream & out, const Token & tok)
{
const TokenClass tc = tok.get_Class();
   if (tc == TC_SYMBOL)
      {
        out << "SYMBOL(";
        const Symbol * sym = tok.get_sym_ptr();
        out << sym->get_name();
        return out << ")";
      }

   if (tc == TC_VALUE)
      {
        const TokenTag tag = tok.get_tag();
        if      (tag == TOK_APL_VALUE1)   out << "VALUE1(";
        else if (tag == TOK_APL_VALUE2)   out << "VALUE2(";
        else if (tag == TOK_APL_VALUE3)   out << "VALUE3(";
        else if (tag == TOK_APL_VALUE4)   out << "VALUE4(";
        else                              out << "VALUE?(";

        Value_P value = tok.get_apl_val();
        if (+value)   value->print_brief(out);
        else          out << "0";
        return out << ")";
      }

   if (tc == TC_END)
      {
        const TokenTag tag = tok.get_tag();
        if (tag == TOK_END)       return out << "◊";
        if (tag == TOK_ENDL)      return out << "ENDL";
        if (tag == TOK_IF_THEN)   return out << "→→";
        if (tag == TOK_IF_ELSE)   return out << "←→";
        if (tag == TOK_IF_END)    return out << "←←";
      }

   return out << (Token::class_name(tok.get_tag()) + 3);
}
//----------------------------------------------------------------------------
ostream &
Prefix::print_patterns(ostream & out, int which)
{
const bool on_stack = which & 1;
const bool ahead    = which & 2;
const bool reverse  = which & 4;   // print ahead in APL order

   if (on_stack)   // print token on the stack
      {
        int Nval = 0;
        loop (s, ssize())
             {
               const Token & tok = at(s).get_token();
               if (tok.get_Class() == TC_VALUE)   ++Nval;
             }
        const char * AB[4]  = { "A", "B",  "-", "-" };
        const char * ARB[4] = { "A", "RO", "B", "-" };
        const char * FG[4]  = { "F", "G",  "-", "-" };
        const char ** V = AB;
        const char ** F = FG;

        if      (Nval <= 1)   V = AB + 1;
        else if (Nval >  2)   V = ARB;

        int sepa = 0;
        out << "«";
        loop (s, ssize())
             {
               if (sepa++)   out << " ";

               const Token & tok = at(s).get_token();
               switch(const TokenClass tc = tok.get_Class())
                  {
                    case TC_ASSIGN:    out << "←";          break;
                    case TC_R_ARROW:   out << "→";          break;
                    case TC_L_BRACK:   out << "[";          break;
                    case TC_R_BRACK:   out << "]";          break;
                    case TC_END:       out << "END";        break;
                    case TC_FUN0:      out << "N";          break;
                    case TC_FUN12:     out << *F++;         break;
                    case TC_INDEX:     out << "C";          break;
                    case TC_OPER1:     out << "M";          break;
                    case TC_OPER2:     out << "D";          break;
                    case TC_L_PARENT:  out << "(";          break;
                    case TC_R_PARENT:  out << ")";          break;
                    case TC_RETURN:    out << "RET";        break;
                    case TC_SYMBOL:    out << "SYM";        break;
                    case TC_VALUE:     out << *V++;         break;
                    case TC_VOID:      out << "VOID";       break;
                    case TC_SI_CHANGE: out << "SI_CHANGE";  break;
                    default:           out << "-TC_" << int(tc);
                  }
             }
        out << "»";
      }

   if (on_stack && ahead)   out << " ";   // both

   if (ahead)   // print token ahead
      {
        int sepa = 0;
        if (reverse)
           {
             size_t end_of_statement = body.size() - 1;
             for (size_t pc = PC; pc < body.size(); ++pc)
                 {
                   if (body[pc].get_Class() == TC_END)
                      {
                        end_of_statement = pc;
                        break;
                      }
                 }

             for (int pc = end_of_statement - 1; pc >= PC; --pc)
                 {
                   if (sepa++)   out << " ";
                   const TokenTag tag = body[pc].get_tag();
                   out << Token::short_class_name(tag);
                 }

             if (end_of_statement != body.size() - 1)
                {
                  if (sepa++)   out << " ";
                  out << "END";
                }
           }
        else
           {
             for (size_t pc = PC; pc < body.size(); ++pc)
                 {
                   if (sepa++)   out << " ";
                   const TokenTag tag = body[pc].get_tag();
                   out << Token::short_class_name(tag);
                   if ((tag & TC_MASK) == TC_END)   break;   // end of statement
                 }
           }
      }
   return out;
}
//----------------------------------------------------------------------------
bool
Prefix::value_expected() const
{
   /* on entry: saved_MISC.get_Class() == TC_INDEX token.
                body[PC] is the token left of saved_MISC.

      return true if the token left of saved_MISC must be a value (so
      that saved_MISC is the index of a value) or false if the token
      left of saved_MISC must be a function or operator (so that
      saved_MISC is the axis of a  function or operator).

       See also: "Additional Requirement" at the bottom of page 48 in the
       ISO standard.
    */
   Assert1(saved_MISC.get_Class() == TC_INDEX);
   Assert1(saved_MISC.get_PC() == (PC - 1));

   // function axes cannot contain semicolons. Therefore, if saved_MISC
   // contains semicolons then its get_ValueType() is TV_INDEX and
   // saved_MISC  MUST be the index of a value. The converse is not
   // true: a get_ValueType() of TC_VALUE only indicates the lack of semicolons,
   // which is valid for both functions and values.
   //
   if (saved_MISC.get_ValueType() == TV_INDEX)   return true;   // value

   // look ahead further until value index vs. function axis can be decided.
   //
   for (ShapeItem pc = PC; pc < body.ssize();)
      {
        const Token & tok = body[pc++];
        switch(tok.get_Class())
           {
               case TC_R_BRACK:   // skip over [...] (func axis or value index)
                    //
                    pc += tok.get_int_val2();
                    continue;

               case TC_END:     return false;   // ◊ [] : syntax error

               case TC_FUN0:    return true;   // niladic function is a value
               case TC_FUN12:   return false;  // function

               case TC_SYMBOL:
                    {
                      const Symbol * sym = tok.get_sym_ptr();
                      const NameClass nc = sym->get_NC();

                      if (nc == NC_FUNCTION)   return false;
                      if (nc == NC_OPERATOR)   return false;
                      return true;   // value
                    }

               case TC_RETURN:  return false;   // syntax error
               case TC_VALUE:   return true;

               default: continue;
           }
      }

   // this is a syntax error.
   //
   return false;
}
//----------------------------------------------------------------------------
void
Prefix::unmark_all_values() const
{
   loop (s, ssize())
      {
        const Token & tok = at(s).get_token();
        if (tok.get_ValueType() != TV_VAL)      continue;

        Value_P value = tok.get_apl_val();
        if (+value)   value->unmark();
      }
}
//----------------------------------------------------------------------------
inline bool
Prefix::push_Symbol(Token_loc & tl)
{
   if (tl.get_tag() == TOK_LSYMB2)
      {
        // tl.tok is the last token C of a vector assignment (A B ... C)←.
        // Return C and let reduce_V_RPAR_ASS_B() do the rest
        //
        const Symbol * symbol = tl.get_token().get_sym_ptr();
        symbol->resolve_left(tl.get_token(), PC);

        LOG_prefix_parser && CERR << "TOK_LSYMB2 " << symbol->get_name() <<
                "resolved to " << tl.get_token() << " at " << LOC  << endl;
        push(tl);
        return false;
      }

Symbol * const symbol = tl.get_token().get_sym_ptr();
   if (PC < body.ssize() && body[PC].get_tag() == TOK_OPER2_INNER)
      {
        /* The APL code is .SYM which could be:
 
           1. a normal inner product f.SYM, or
           2. a value member VAL.SYM

           We check the name class of symbol to decide.
         */
        const NameClass nc = symbol->get_NC();
        if (nc != NC_FUNCTION && nc != NC_OPERATOR)   // case 2: 
           {
             push(tl);
             return false;   // )SI not pushed
           }
      }

   if (get_assign_state() == ASS_arrow_seen)
      {
        // symbol is the first symbol left of ← (in APL order).
        // allow assignment only to variables or undefined names.
        //
        // There is a common, but hard to understand pitfall: a label with
        // the same name exists. We should then provide some more info.
        //
        const NameClass nc = symbol->get_NC();
        if (!(nc & NC_left))   // error
           {
             const char * sym_nc = "???";
             switch(nc)
                {
                   case NC_LABEL:      sym_nc = "label";              break;
                   case NC_OPERATOR:   sym_nc = "defined operator";   break;
                   case NC_FUNCTION:   sym_nc = "defined function";   break;
                   case NC_SYSTEM_FUN: sym_nc = "system function";    break;
                   default: FIXME;
                }

             MORE_ERROR() << "Assignment to symbol " << symbol->get_name()
                  << " which (currently) is a " << sym_nc;
             syntax_error(LOC);
           }

        symbol->resolve_left(tl.get_token(), PC);
        set_assign_state(ASS_var_seen);
        push(tl);
        return false;
      }

   if (ssize()                       &&          // at0() is valid,
       at0().get_Class() == TC_INDEX &&          // at0() is [...;... ], and
       tl.get_tag() == TOK_SYMBOL)   // user defined variable
      {
        // indexed reference, e.g. A[N]. Calling symbol->resolve()
        // would copy the entire variable A and then index it, which
        // is inefficient if the variable is big. We rather call
        // Symbol::get_var_value() directly in order to avoid that
        //
        Value_P value = symbol->get_var_value();
        if (+value)
           {
             Token tok(TOK_APL_VALUE1, value);
             tl.get_token().move_from(tok, LOC);
           }
       else
          {
            symbol->resolve_right(tl.get_token(), PC);
           }
      }
   else
      {
        symbol->resolve_right(tl.get_token(), PC);
      }

   Log(LOG_prefix_parser)
      {
        CERR << "TOK_SYMBOL resolved to " << tl.get_token()
             << " at " << LOC  << endl
             << "   resolved symbol " << symbol->get_name()
             << " to " << tl.get_Class() << endl;
      }

   // Quad_Quad::resolve() calls ⍎ which may return TOK_SI_PUSHED.
   //
   push(tl);
   return tl.get_tag() == TOK_SI_PUSHED;   // )SI not pushed
}
//----------------------------------------------------------------------------
void
Prefix::push_END_error()
{
   Log(LOG_prefix_parser)   print_stack(CERR, LOC);

   // provide help on some common cases...
   //
   for (int j = 1; j < ssize() - 1; ++j)
       {
         if ( (at(j)    .get_Class() == TC_ASSIGN) &&
              (at(j + 1).get_Class() == TC_VALUE))
            {
              const TokenClass left = at(j - 1).get_Class();
              if (is_function_class(left))
                 {
                    MORE_ERROR() <<
                    "Cannot assign a value to a function";
                 }
              else if (is_operator_class(left))
                 {
                    MORE_ERROR() <<
                    "Cannot assign a value to an operator";
                 }
            }
       }

   Log(LOG_prefix_parser)   print_stack(CERR, LOC);

UCS_string & more = MORE_ERROR();
   more << "At the left end of statement: invalid phrase remaining:";

   // print token, but no more than 4
   //
   enum { MAX_j = 4 };   // limit for the number of tokens displayed
   loop(j, MAX_j)
       {
         const bool rightmost = (j == ssize() - 1);   // end of phrase
         const Token & tok = at(j).get_token();
         more << " ";
         if (tok.is_function())   // token is a function
            {
              const Function * fun = tok.get_function();
              more << fun->get_name();
              if (rightmost)   // rightmost token of the stack is a function
                 {
                   if (MAX_j < ssize())   more << "...";

                   // frequent error: missing right argument of a non-niladic
                   // function.
                   more << "\nMissing mandatory right argument of function "
                        << fun->get_name() << "?";
                   VALENCE_ERROR;
                 }
            }
         else
            {
              const UCS_string name = at(j).get_token().tag_name();
              if (name.starts_with("TOK_"))   more << UCS_string(name, 4);
              else
                 more << name;
              if (rightmost && MAX_j < ssize())   more << "...";
            }

         if (rightmost)   break;
       }

   syntax_error(LOC);   // no more token
}
//----------------------------------------------------------------------------
inline bool
Prefix::push_next_token()
{
   if (has_MISC())   // valid lookahead token
      {
        // there is a stored MISC token from a MISC phrase. Symbol resolution
        // was already performed, so we can push it now and are done.
        //
        push(saved_MISC);
        saved_MISC.get_token().clear(LOC);   // saved_MISC ← TOK_VOID
        return false;
      }

again:

const Function_PC old_PC = PC++;
const Token & tok = body[old_PC];
const TokenClass tcl = tok.get_Class();
   Log(LOG_prefix_parser)
      {
        CERR << "    [si=" << si.get_level() << " PC=" << (PC - 1)
             << "] Read token[" << ssize()
             << "] (←" << get_assign_state() << "←) " << tok << " "
             << Token::class_name(tok.get_tag()) << endl;
      }

   saved_MISC.set_PC(old_PC);   // expand the PC range of the stack

   if (tok.get_tag() == TOK_GOTO_PC)   // →N
      {
        PC = Function_PC(tok.get_int_val());
        Assert1(ssize() == 0);
        goto again;
      }

   if (tcl == TC_SYMBOL)          // resolve symbol if necessary
      {
        Token_loc tloc(tok, old_PC);
        return push_Symbol(tloc);   // true iff )SI pushed
      }

   if (tcl == TC_ASSIGN)     // update assign_state (from right to left)
      {
        if (get_assign_state() != ASS_none)   syntax_error(LOC);
        set_assign_state(ASS_arrow_seen);
      }

const Token_loc tloc(tok, old_PC);
   push(tloc);
   return false;   // )SI not pushed
}
//----------------------------------------------------------------------------
Fun_signature
Prefix::get_current_signature()
{
   // this function is called after some eval_XXX() was invoked and
   // computes the signature XXX from the current stack.
   //
const Prefix & prefix = Workspace::SI_top()->get_prefix();
const int prefix_len = prefix.prefix_len;

int ret = SIG_NONE;
   Assert(prefix_len > 1);   // at least FUN B
   if (prefix.Class_at(prefix_len - 1) == TC_VALUE)   ret |= SIG_B;
   if (prefix.Class_at(0) == TC_VALUE)                ret |= SIG_A;
   loop(p, prefix_len)
       {
         switch(prefix.Class_at(p))
            {
              case TC_FUN12: ret |= SIG_FUN;   break;
              case TC_OPER1: ret |= SIG_LO;    break;
              case TC_OPER2: ret |= SIG_OP2;   break;
              case TC_INDEX: ret |= SIG_X;     break;
              default:       ;
            }
       }

   return Fun_signature(ret);
}
//----------------------------------------------------------------------------
#ifdef PREFIX_HASH
inline void
Prefix::find_best_phrase()
{
const int s_max = ssize() < 4 ? ssize() : 4;
const int s_max_1 = s_max - 1;
unsigned int hash[4] = { at0().get_Class() };

   /* compute s_max_1 hash values from the token classes, starting at at(0).
      That is:

      hash[0] =                                    TC₀
      hash[1] =                         TC₀ << 5 | TC₁
      hash[3] = TC₀ <<             10 | TC₁ << 5 | TC₂
      hash[4] = TC₀ << 15 | TC₁ << 10 | TC₂ << 5 | TC₃
    */
   for (int s = 0; s < s_max_1;)
       {
         const int prev = s++;
         hash[s] = hash[prev] | Class_at(s) << 5*s;
       }

   // match hashes in hash_table, from longest to shortest phrases
   //
   rev_loop(s, s_max)
       {
         const unsigned int hash_s = hash[s];
         best_phrase = hash_table + hash_s % PHRASE_MODU;
         if (best_phrase->phrase_hash == hash_s)   return;   // found
       }

   best_phrase = 0;   // not found
}
#endif

#ifdef PREFIX_TREE
inline void
Prefix::find_best_phrase()
{
   best_phrase = 0;   // assume nothing found

// CERR << "\nfind_best_phrase(): size=" << size() << endl;
// print_stack(CERR, LOC);

int idx = 0;
   loop(s, size())
       {
// CERR << "s=" << s << " idx=" << HEX2(idx) << endl;

         const TokenClass tc = at(s).get_Class();
// CERR << " TokenClass tc=" << HEX2(tc) << " aka. "
//      << Token::class_name(tc) << endl;

         idx = hash_table[idx].sub_nodes[tc];
         const Phrase & phrase = hash_table[idx];
// CERR << " phrase now #" << HEX2(idx) << ": " << phrase.phrase_name << endl;
// CERR << " reduce name: " << phrase.reduce_name << endl;

         {
// CERR << "  ├── best_phrase before=" << voidP(best_phrase) << endl;
         if (phrase.reduce_fun)   best_phrase = &phrase;
// CERR << "  └── best_phrase after=" << voidP(best_phrase) << endl;
         }

// if (idx)   CERR << "  now idx=" << HEX2(idx) << " : "
//                 << hash_table[idx].reduce_name << endl;
// else       CERR << "  no child" << endl;
         if (idx == 0)
            {
// CERR << "end of tree" << endl;
              return;
            }
       }
// CERR << "end of prefix" << endl;
}
#endif
//----------------------------------------------------------------------------

// one entry of a hash table for all prefixes that can be reduced.
// Used in Prefix.def
//
# define reduce_none 0

#ifdef PREFIX_HASH
# define PH(name, suffix, idx, prio, misc, len)                         \
   { #name, #suffix, &Prefix::reduce_ ## suffix, idx, prio, misc, len }
#endif   // PREFIX_HASH

#ifdef PREFIX_TREE

# define PH(name, suffix, idx, prio, misc, len,                               \
           t0,t1,t2,t3,t4,t5,t6,t7,t8,t9,tA,tB,tC,tD,tE,tF,tG,tH)             \
  { #name, #suffix, &Prefix::reduce_ ## suffix, idx, prio, misc, len,         \
    { 0x##t0, 0x##t1, 0x##t2, 0x##t3, 0x##t4, 0x##t5, 0x##t6, 0x##t7, 0x##t8, \
      0x##t9, 0x##tA, 0x##tB, 0x##tC, 0x##tD, 0x##tE, 0x##tF, 0x##tG, 0x##tH }}

// dito, but without reduce function.
#define P0(name, suffix, idx, prio, misc, len,                          \
           t0,t1,t2,t3,t4,t5,t6,t7,t8,t9,tA,tB,tC,tD,tE,tF,tG,tH)       \
   { #name, #suffix, 0, idx, prio, misc, len,                           \
    { 0x##t0, 0x##t1, 0x##t2, 0x##t3, 0x##t4, 0x##t5, 0x##t6, 0x##t7, 0x##t8, \
      0x##t9, 0x##tA, 0x##tB, 0x##tC, 0x##tD, 0x##tE, 0x##tF, 0x##tG, 0x##tH }}
#endif   // PREFIX_TREE

const Prefix::Phrase Prefix::hash_table[] =
{
// the entire hash table or tree with all prefixes that can be reduced...
#include "Prefix.def"   // the hash table
};

Token
Prefix::reduce_statements()
{
   Log(LOG_Reduce_XXX)
      {
       loop(s, si.get_depth())   CERR << "    ";   // indent
        CERR << "Reduce Statement (in APL order): ";
        print_patterns(CERR, 6) << endl;
      }

   Log(LOG_prefix_parser)
      {
        CERR << endl << "changed to Prefix[si=" << si.get_level()
             << "]) ============================================" << endl;
      }

   if (ssize())   goto again;

   // the main loop of an LALR(1) parser...
   //
grow:    // aka. SHIFT
   // the current stack does not contain a valid phrase.
   // Push one more token onto the stack and continue
   //
   Log(LOG_Shift_XXX)
      {
        loop(s, si.get_depth() + 1)   CERR << "    ";   // indent
        CERR << "PC=" << PC << " Shift[" << ssize() << "]: ";
        print_token_value(CERR, body[PC]) << " into ";
        print_patterns(CERR, 1);
      }

   if (push_next_token())
      {
        Log(LOG_Shift_XXX)   CERR << "pushed )SI.";
        return Token(TOK_SI_PUSHED);
      }

   Log(LOG_Shift_XXX)
      {
        while (Output::get_column() < 50)   CERR << " ";
        CERR << " yields: ";
        print_patterns(CERR, 3) << endl;
      }

again:   // aka. REDUCE
   Log(LOG_prefix_parser)   print_stack(CERR, LOC);

   // search longest prefixes in phrase table...
   //
   find_best_phrase();                  // set best_phrase
   if (best_phrase == 0)   goto grow;   // no best_phrase

   /* found a reducible prefix. See if the next token class binds stronger
      than best_phrase->prio.

      If best_phrase->prio ≥ BS_ANY_BRA then we reduce immediately,
      since ALWAYS [ ] has the strongest binding.
    */
   if (best_phrase->prio < BS_ANY_BRA && check_next_binding())   goto grow;

   Log(LOG_prefix_parser)
      {
        CERR << "   phrase #" <<  (best_phrase - hash_table)
             << ": " << best_phrase->phrase_name
             << " matches, prio " << best_phrase->prio
             << ", calling reduce_" << best_phrase->reduce_name
             << "()" << endl;
      }

   prefix_len = best_phrase->phrase_len;
   Log(LOG_Reduce_XXX)
      {
        loop(s, si.get_depth() + 1)   CERR << "    ";   // indent
        CERR << "Match[" << prefix_len << "]: calling: reduce_"
             << best_phrase->reduce_name << "()" << endl;
      }

   action = RA_FIXME;   // to detect missing 'action = ' in a reduce_XXX()
   if (best_phrase->misc)   // MISC phrase: save X and remove it
      {
        Assert(!has_MISC());
        saved_MISC.copy(pop(), LOC);
        --prefix_len;
      }

   /*
      detect if the reduce_fun() changes the Prefix instance. Only checking
      for e.g. changes in Workspace::SI_top() does not suffice because a
      different Prefix instance could be located at the same address.
    */
const uint64_t inst = instance;
   (this->*best_phrase->reduce_fun)();

   Log(LOG_Reduce_XXX)
      {
        while (Output::get_column() < 50)   CERR << " ";
        CERR << " yields: ";
        print_patterns(CERR, 3) << endl;
      }

   if (inst != Workspace::SI_top()->get_prefix().instance)
      {
        // the reduce_fun() above has changed the )SI stack. As a consequence
        // the 'this' pointer is no longer valid and we must not access members
        // of this Prefix instance.
        //
        return Token(TOK_SI_PUSHED);
      }

   Log(LOG_prefix_parser)
      CERR << "   reduce_" << best_phrase->reduce_name << "() returned: ";

   // handle action
   //
   switch(action)
      {
        case RA_CONTINUE:
             LOG_prefix_parser && CERR << "RA_CONTINUE" << endl;

             // the reduce_fun() has modified this Prefix (in most cases with
             // pop_args_push_result()).
             // Repeat the pattern matching without fetching a new token.
             //
             goto again;

        case RA_PUSH_NEXT:
             LOG_prefix_parser && CERR << "RA_PUSH_NEXT" << endl;

             // the reduce_fun() has decided to SHIFT. Fetch one more token.
             //
             goto grow;

        case RA_SI_PUSHED:
             LOG_prefix_parser && CERR << "RA_SI_PUSHED" << endl;

             // the reduce_fun() has pushed the )SI stack.
             // Continue execution in the new )SI item.
             //
             return Token(TOK_SI_PUSHED);

        case RA_RETURN:
             LOG_prefix_parser && CERR << "RA_RETURN" << endl;

             // the reduce_fun() has decided to leave this Prefix.
             // The result of this Prefix is e.g. the TOK_VOID or TOK_BRANCH
             // that was returned by StateIndicator::jump(). pop() the
             // result from this Prefix and return it to the calling Prefix.
             //
             return pop().get_token();

        case RA_FIXME:
             LOG_prefix_parser && CERR << "RA_FIXME" << endl;

             // not expected to happen.
             //
             FIXME;
      }

   FIXME;
}
//----------------------------------------------------------------------------
inline bool
Prefix::check_next_binding()
{
TokenClass next = TC_INVALID;   // assume no bext
    if (PC < Function_PC(body.ssize()))
       {
         const Token & tok = body[PC];
         next = tok.get_Class();
         if (next == TC_SYMBOL)
            {
              const Symbol * symbol = tok.get_sym_ptr();
              const bool is_left_sym = get_assign_state() == ASS_arrow_seen;
              next = symbol->resolve_class(is_left_sym);
            }
       }

    if (best_phrase->misc && (at0().get_Class() == TC_R_BRACK))
       {
         // the next symbol is a ] and the matching phrase is a MISC
         // phrase (monadic call of a possibly dyadic function).
         // The ] could belong to:
         //
         // 1. an indexed value,        e.g. A[X] or
         // 2. a function with an axis, e.g. +[2]
         //
         // These cases lead to different reductions:
         //
         // 1.  A[X] × B   should evalate × dyadically, while
         // 2.  +[1] × B   should evalate × monadically,
         //
         // We solve this by computing the indexed value first
         //
         if (is_value_bracket())   // case 1.
            {
              // we call reduce_RBRA____, which pushes a partial index list
              // onto the stack. The following token are processed until the
              // entire indexed value A[ ... ] is computed
              prefix_len = 1;
              reduce_RBRA___();
              return true;   // do bind
            }
       }

//   Q1(next) Q1(at0())

   // shift/reduce conflict. See what to do.
   // if we should shift.
   //
   if (do_shift(next))   // i.e. shift
      {
        Log(LOG_prefix_parser)  CERR
             << "   phrase #" << (best_phrase - hash_table)
             << ": " << best_phrase->phrase_name
             << " matches, but prio " << best_phrase->prio
             << " is too small to call " << best_phrase->reduce_name
             << "()" << endl;
        return true;   // do bind
      }

   return false;    // don't bind
}
//----------------------------------------------------------------------------
bool
Prefix::do_shift(TokenClass next) const
{
   /* resolve a shift/reduce conflict.

       at0() ist the (in APL order) current token
       at1() ist the (in APL order) token right of the current token
       next is the class of the token left of at0()
    */
   switch(at0().get_Class())
      {
        case TC_VALUE:
             if (next == TC_OPER2)           // DOP B
                {
                  return true;
                }
             else if (next == TC_VALUE)      // A B
                {
                  return best_phrase->prio < BS_VAL_VAL;
                }
             else if (next == TC_R_PARENT)   // ) B
                {
                  if (is_value_parenthesis(PC))     // e.g. (X+Y) B
                     {
                       return best_phrase->prio < BS_VAL_VAL;
                     }
                   else                      // e.g. (+/) B
                     {
                       return false;
                     }
                }
             return false;   // TC_VALUE

        case TC_FUN12:
             if (next == TC_OPER2)
                {
                  return true;
                }
             return false;   // TC_FUN12

        case TC_SYMBOL:
             if (next == TC_OPER2)
                {
                  return true;
                }
             return false;   // TC_SYMBOL

        default: return false;
      }
}
//----------------------------------------------------------------------------
Value_P *
Prefix::locate_L(UCS_string & function) const
{
   /*  ⎕L requires at least A f B (so we have at0(), at1() and at2(). However,
       the user could fail on a monadic function (with size() = 2) and then
       query ⎕L. For example:

       at0 at1 at2  size()
        ÷   0       2            in × ÷ 0   (hence no ⎕L)
        2   ÷   0   3            in 2 ÷ 0   (⎕L is 2)
    */

   if (ssize() && at0().get_ValueType() == TV_FUN)
      {
        // e.g. DOMAIN ERROR in × ÷ 0. ssize() is 2 and at0() is ÷
        function = at0().get_function()->get_name();
        return 0;
      }

   if (ssize() > 1 && at1().get_ValueType() == TV_FUN)
      {
        function = at1().get_function()->get_name();
      }
   else if (ssize() == 2 && at1().get_Class() == TC_INDEX)   // B[X]
      {
        function = UCS_ASCII_string("[]");
        return at0().get_apl_valp();
      }

   if (ssize() < 3)   return 0;

   if (at0().get_Class() == TC_VALUE)   return at0().get_apl_valp();
   return 0;
}
//----------------------------------------------------------------------------
Value_P *
Prefix::locate_R(UCS_string & function) const
{
   // ⎕R requires at least f B (so we have at0() and at1()

   if (ssize() < 2)   return 0;

   if (ssize() == 2 && at1().get_Class() == TC_INDEX)   // B[X]
      {
        function = UCS_ASCII_string("[]");   // valid function
        return 0;                      // but no ⎕R.
      }

   // either at0() (for monadic f B) or at1() (for dyadic A f B) must
   // be a function or operator
   //
   if (at0().get_ValueType() != TV_FUN &&
       at1().get_ValueType() != TV_FUN)   return 0;

const Token & ret = content[ssize() - prefix_len].get_token();
   if (ret.get_Class() == TC_VALUE)   return ret.get_apl_valp();
   return 0;
}
//----------------------------------------------------------------------------
Value_P *
Prefix::locate_X(UCS_string & function) const
{
   // ⎕X requires at least X B (so we have at0() and at1()

   if (ssize() < 2)   return 0;

   // either at0() (for monadic f X B) or at1() (for dyadic A f X B) must
   // be a function or operator
   //
   rev_loop(x, ssize())
       {
         if (content[x].get_ValueType() == TV_FUN)
            {
              if (cFunction_P fun = content[x].get_function())
                 {
                   function = fun->get_name();
                   // locate_X() always returns 0 for non-derived functions
                   // because we can't allow ⎕X to modify the function body.
                   if (Value_P * X = fun->locate_X())   return  X;
                 }
            }
         else if (content[x].get_Class() == TC_INDEX)   // maybe found X ?
            {
              return content[x].get_token().get_apl_valp();
            }
       }

   return 0;
}
//----------------------------------------------------------------------------
void
Prefix::print(ostream & out, int indent) const
{
   loop(i, indent)   out << "    ";
   out << "Token: ";
   loop(s, ssize())   out << " " << at(s).get_token();
   out << endl;
}
//----------------------------------------------------------------------------
void
Prefix::adjust_right_caret(Function_PC2 & range,
                           const Token_string & failed_statement)
                           
{
   // called after a SYNTAX ERROR. The right caret may be too far right
   // (in APL order). Try to narrow the range.
   //
   // range.low is the right (in APL order) end of the statement,
   // range.high is the left (in APL order) end of the statement,
   //
   for (Function_PC pc = range.low; (pc + 1) < range.high; ++pc)
       {
         // find an obviously impossible pattern 
         //
         const Token & T0 = failed_statement[pc];
         const TokenTag tag0 =  T0.get_tag();
         const TokenClass tc0 = T0.get_Class();

         const Token & T1 = failed_statement[pc + 1];
         const TokenTag tag1 =  T1.get_tag();
         const TokenClass tc1 = T1.get_Class();

         const bool right_end = pc == 0             ||
                                tc0  == TC_R_BRACK  ||
                                tc0  == TC_R_PARENT ||
                                tag0 == TOK_SEMICOL;
          const bool nomadic1 = needs_B(tc1);

          if (right_end && nomadic1)
             {
               // nomadic function without B, e.g. + )
               //
               const UCS_string name = T1.get_function()->get_name();
               MORE_ERROR() << name << " B: Nomadic function " << name
                            << " without right argument B.";
               range.low = pc;
               range.high = pc + 1;
               return;
             }

         if (is_operator_class(tc0))
            {
              const UCS_string name = T0.get_function()->get_name();
              if (tc1 == TC_L_BRACK   ||
                  tc1  == TC_L_PARENT ||
                  tag1 == TOK_SEMICOL)
                 {
                   // operator f OP without f, e.g. ( ⍣
                   //
                   MORE_ERROR() << "f " << name << " Operator: " << name
                                << " without left argument f.";
                   range.low = pc;
                   range.high = pc + 1;
                   return;
                 }

              if (tc1 == TC_VALUE && tag0 == TOK_OPER2_POWER)
                 {
                   // operator f OP with value f, e.g. 4 ⍣
                   //
                   MORE_ERROR() << "f " << name << ": Operator " << name
                                << " with left value f.";
                   range.low = pc;
                   range.high = pc + 1;
                   return;
                 }
             }
       }
}
//----------------------------------------------------------------------------
DerivedFunction *
Prefix::get_fun_oper_slot(const char * loc) const
{
   return si.get_fun_oper_slot(LOC);
}
//----------------------------------------------------------------------------
void
Prefix::set_action(const Token & result)
{
   switch(result.get_Class())
      {
        case TC_VALUE:
        case TC_VOID:
        case TC_END:
        case TC_FUN2:
             set_action(RA_CONTINUE);
             return;

        case TC_RETURN:
             // result was one of TOK_RETURN_EXEC, TOK_RETURN_STATS,
             // TOK_RETURN_VOID, or TOK_RETURN_SYMBOL.
             // The current context is complete and may or may not
             // have produced a value.
             //
             set_action(RA_RETURN);
             return;

        case TC_SI_CHANGE:
             //
             // result was TOK_SI_PUSHED or TOK_ERROR
             if (result.get_tag() == TOK_ERROR)   set_action(RA_RETURN);
             else                                 set_action(RA_SI_PUSHED);
             return;

        default: CERR << "CLASS = " << result.get_Class()
                      << " at " << LOC << endl;
                 FIXME;
      }
}
//=======================================================================
//
// e reduce functions...
//
//----------------------------------------------------------------------------
void
Prefix::reduce____()
{
   // this function is a placeholder for invalid phrases and should never be
   // called.
   //
   print_stack(CERR, LOC);
   FIXME;
}
//----------------------------------------------------------------------------
void
Prefix::reduce_LPAR_B_RPAR_()
{
   Assert1(prefix_len == 3);

   // B is a Function or a Value. Make Values have tag TOK_APL_VALUE1
   //
   if (at1().get_Class() == TC_VALUE && at1().get_tag() != TOK_APL_VALUE1)
      {
        const Token result(TOK_APL_VALUE1, at1().get_apl_val());
        pop_args_push_result(result);
      }
   else
      {
        const Token & result = at1(); 
        pop_args_push_result(result);
      }

   set_action(RA_CONTINUE);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_LPAR_F_C_RPAR()
{
   Assert1(prefix_len == 4);

   // C should be an axis and not a [;;] index
   //
   if (at2().get_ValueType() != TV_VAL)   SYNTAX_ERROR;
   if (!at2().get_apl_val())              SYNTAX_ERROR;

   //     at: 0 1 2 3
   // before: ( F C )
   // after:  F C
   //
   at3().move_from(at2(), LOC);   // move C left
   at2().move_from(at1(), LOC);   // move F left
   pop_and_discard();          // discard old C
   pop_and_discard();          // discard old RPAR
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_N___()
{
   Assert1(prefix_len == 1);

const Token result = at0().get_function()->eval_();
   if (push_error(result))   return;

   pop_args_push_result(result);
   set_action(RA_CONTINUE);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_MISC_F_B_()
{
   Assert1(prefix_len == 2);

   if (saved_MISC.get_Class() == TC_INDEX)
      {
        // resolve a potential SHIFT/REDUCE conflict. If [] belongs to
        // an indexed left value A[...] then we must not reduce with
        // monadic F, but shift [] for the dyadyc F to reduce A[] F B
        // later on..
        //
        if (value_expected())   // then SHIFT
           {
             // push [...] and read one more token
             //
             push(saved_MISC);
             clear_MISC(LOC);
             set_action(RA_PUSH_NEXT);   // aka. SHIFT
             return;
           }

        // fall through (REDUCE)
      }

const Token result = at0().get_function()->eval_B(at1().get_apl_val());
   if (result.get_Class() != TC_SI_CHANGE)   // the normal case
      {
        pop_args_push_result(result);
        set_action(result);
        return;
      }
   
    /* the executing of monadic at0().get_function() resulted in a
       change of the current )SI entry. This change could have been in
       in two directions:

       1. a new )SI entry was pushed. This is the most common case
          after a defined function was called. In this case the current
          parser is abandoned until the new )SI entry returns.

       2. ⎕ES (Event Simulate) has simulated an event (with one of
              the ⎕EC results like:
       2a.    0 - Error,
       2b.    1 - non-committed value,
       2c.    2 - committed value,
       2d.    3 - missing value (function w/o a result),
       2e.    4 - branch to function line, or
       2f.    5 - escape from function.

          Normally ⎕ES has pop'ed the )SI stack, so this parser does
          not exist anymore (and we must not use its member.
          in particular si
     */
   if (result.get_tag() == TOK_SI_PUSHED)   // case 1.
      {
        pop_args_push_result(result);
        set_action(result);
        return;
      }

   /* NOTE: the tags TOK_QUAD_ES_COM, TOK_QUAD_ES_ESC, TOK_QUAD_ES_BRA,
            and TOK_QUAD_ES_ERR below can only occur if:

       1. ⎕EA resp. ⎕EB is called; each is implemented as macro
          Z__A_Quad_EA_B resp. Z__A_Quad_EB_B.

       2. The macro calls ⎕ES 100 ¯1...¯4, which brings us here.

       Token result is the return token of Quad_ES::eval_AB() or
       Quad_ES::eval_B() and contains the right argument B (as set in
       the macro).

       We must check that ⎕ES 100 was not called directly, but only via
       ⎕EA or ⎕EB.
    */

   switch(result.get_tag())
       {
         default: break;
         case TOK_QUAD_ES_COM:   handle_QUAD_ES_COM(result);   return;
         case TOK_QUAD_ES_ESC:   handle_QUAD_ES_ESC();         return;
         case TOK_QUAD_ES_BRA:   handle_QUAD_ES_BRA(result);   return;
         case TOK_QUAD_ES_ERR:   handle_QUAD_ES_ERR(result);   return;
      }

   // at this point a normal monadic function (i.e. other than ⎕EA/⎕EB)
   // has returned an error
   //
   if (push_error(result))   return;

   // not reached
   //
   Q1(result.get_tag())
   FIXME;
}
//----------------------------------------------------------------------------
void
Prefix::handle_QUAD_ES_COM(const Token & result)
{
   // make sure that ⎕ES was called from a macro (which implies
   // that it has a parent).
   //
   if (Workspace::SI_top()->function_name()[0] != UNI_MUE)   DOMAIN_ERROR;

   Workspace::pop_SI(LOC);   // discard ⎕EA/⎕EB context

const Cell & QES_arg2 = result.get_apl_val()->get_cravel(2);
Token & si_pushed = Workspace::SI_top()->get_prefix().at0();
   Assert(si_pushed.get_tag() == TOK_SI_PUSHED);
   if (QES_arg2.is_pointer_cell())
      {
        Value_P val = QES_arg2.get_pointer_value();
        new (&si_pushed)  Token(TOK_APL_VALUE2, val);
      }
   else
      {
        Value_P scalar(LOC);
        scalar->next_ravel_Cell(QES_arg2);
        scalar->check_value(LOC);
        new (&si_pushed)  Token(TOK_APL_VALUE2, scalar);
      }
}
//----------------------------------------------------------------------------
void
Prefix::handle_QUAD_ES_ESC()
{
   // make sure that ⎕ES was called from a macro (implies parent)
   //
   if (Workspace::SI_top()->function_name()[0] != UNI_MUE)   DOMAIN_ERROR;

   Workspace::pop_SI(LOC);   // discard the ⎕EA/⎕EB context

Token & si_pushed = Workspace::SI_top()->get_prefix().at0();
   Assert(si_pushed.get_tag() == TOK_SI_PUSHED);
   new (&si_pushed)  Token(TOK_ESCAPE);
}
//----------------------------------------------------------------------------
void
Prefix::handle_QUAD_ES_BRA(const Token & result)
{
   // make sure that ⎕ES was called from a macro (implies parent)
   //
   if (Workspace::SI_top()->function_name()[0] != UNI_MUE)   DOMAIN_ERROR;

   Workspace::pop_SI(LOC);   // discard the ⎕EA/⎕EB context

const Cell & QES_arg2 = result.get_apl_val()->get_cravel(2);
const APL_Integer line = QES_arg2.get_int_value();

Token & si_pushed = Workspace::SI_top()->get_prefix().at0();
   Assert(si_pushed.get_tag() == TOK_SI_PUSHED);

Value_P v_line = IntScalar(line, LOC);
   Workspace::SI_top()->jump(v_line.get());
}
//----------------------------------------------------------------------------
void
Prefix::handle_QUAD_ES_ERR(const Token & result)
{
   // this case can only occur with ⎕EA, but not with ⎕EB.

   // make sure that ⎕ES was called from a macro (implies parent)
   //
   if (Workspace::SI_top()->function_name()[0] != UNI_MUE)   DOMAIN_ERROR;

   Workspace::pop_SI(LOC);   // discard the ⎕EA/⎕EB context
StateIndicator * top = Workspace::SI_top();

Token & si_pushed = top->get_prefix().at0();
   Assert(si_pushed.get_tag() == TOK_SI_PUSHED);

const Cell * QES_arg = &result.get_apl_val()->get_cfirst();
UCS_string statement_A(  *QES_arg[2].get_pointer_value());
const APL_Integer major = QES_arg[3].get_int_value();
const APL_Integer minor = QES_arg[4].get_int_value();
const ErrorCode ec      = ErrorCode(major << 16 | minor);

Token result_A = Bif_F1_EXECUTE::execute_statement(statement_A);
   if (result_A.get_Class() == TC_VALUE)   // ⍎ literal
      {
        Workspace::SI_top()->get_prefix().at0().move_from(result_A, LOC);
        return;
      }
   new (&StateIndicator::get_error(top)) Error(ec, LOC);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_MISC_F_C_B()
{
   Assert1(prefix_len == 3);   // F C B

cMonOP  M = at0().get_function();
Value_P C = at1().get_function_axis();
Value_P B = at2().get_apl_val();

   if (saved_MISC.get_Class() == TC_INDEX)
      {
        if (value_expected())
           {
             // push [...] and read one more token
             //
             push(saved_MISC);
             clear_MISC(LOC);
             set_action(RA_PUSH_NEXT);   // aka. SHIFT
             return;
           }
      }

   // ⎕FIO and ⌹ are primarily functions, but have subfunctions that are
   // operators. If saved_MISC is a function, then M was possibly called
   // as an operator and we derive it here if the subfunction was anindeed
   // an operator.
   //
   if (saved_MISC.get_Class() == TC_FUN12)
      {
        // C may have more than one item, so we should call get_sole_integer()
        // only after having checked that M is ⎕FIO The subfunction which is
        // an operator is ⎕FIO[49] aka. ⎕FIO,read_text
        //
        const TokenTag tag_M = at0().get_tag();
        if (tag_M == TOK_Quad_FIO && C->get_sole_integer() == 49)
           {
             Token & LO = saved_MISC.get_token();
             DerivedFunction * derived = get_fun_oper_slot(LOC);
             new (derived)  Derived_LO_M_X(LO, M, C, LOC);
             clear_MISC(LOC);

             const Function_PC pc_M = at(0).get_PC();   // PC of M
             pop_and_discard();   // pop M
             pop_and_discard();   // pop C
                                  // but leave B
             Token tok_Derived(TOK_FUN2, derived);
             Token_loc tl_Derived(tok_Derived, pc_M);
             push(tl_Derived);
             prefix_len = 2;   // only f ⎕FIO resp. f ⌹
             set_action(RA_CONTINUE);   // match again (w/o SHIFT)
             return;
           }
      }

const Token Z = M->eval_XB(C, B);
   if (push_error(Z))   return;

   pop_args_push_result(Z);
   set_action(Z);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_F_B_()
{
   Assert1(prefix_len == 3);

const Token result = at1().get_function()->eval_AB(at0().get_apl_val(),
                                                   at2().get_apl_val());
   if (push_error(result))   return;

   pop_args_push_result(result);
   set_action(result);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_M_B_()
{
   if (at1().is_SLASH_or_BACKSLASH())   return reduce_A_F_B_();
   syntax_error(LOC);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_F_C_B()
{
   Assert1(prefix_len == 4);   // A F C B

Value_P     A = at0().get_apl_val();
cFunction_P F = at1().get_function();
Value_P     C = at2().get_function_axis();
Value_P     B = at3().get_apl_val();

const Token Z = F->eval_AXB(A, C, B);

   // result could be a value or an error
   //
   if (push_error(Z))   return;   // if result was an error

   // result was a value
   //
   pop_args_push_result(Z);
   set_action(Z);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_M_C_B()
{
   if (at1().is_SLASH_or_BACKSLASH())   return reduce_A_F_C_B();
   syntax_error(LOC);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_F_M__()
{
   Assert1(prefix_len == 2);

Token & LO_F = at0();
cMonOP     M = at1().get_function();

DerivedFunction * derived = get_fun_oper_slot(LOC);
   new (derived) Derived_LO_M(LO_F, M, LOC);

   pop_args_push_result(Token(TOK_FUN2, derived));
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
inline bool
Prefix::MM_is_FM(Function_PC pc)
{
   /*
      dis-ambiguate / ⌿ \ or ⍀.

      return true if M M shall actually be F M in reduce_M_M__().
      PC was alredy incremented and points to the token left of M M:

       On entry;
                             ┌─────────────────── PC
                             │      ┌──────────── PC-1   i.e. M1
                             │      │        ┌─── PC-2   i.e. M2
       ┌────────┬───   ───┬──────┬──────┬──────────┬───
       │ TC_END │   ...   │ NEXT │ /⌿\⍀ | TC_OPER1 │  (B...)
       └────────┴───   ───┴──────┴──────┴──────────┴───

       NOTE: if M1 is an operator then its left argument must either be a
             value or a function. Therefore the token in metaclass MISC,
             i.e. ← → ; [ END or ( implies that M1 shall be a function F
             (which, unless M1 / ⌿ \ or ⍀) will rise a syntax error in
             reduce_F_M__().
    */
   for (;;)
       {
         const Token & NEXT = body[pc];
         switch(const TokenClass tc_NEXT = NEXT.get_Class())
            {
                                    // Examples:    ┌─────── NEXT
                                    //              │ ┌───── M1 is / ⌿ \ or ⍀
                                    //              │ │ ┌─── M2 any operator
                                    //              │ │ │
              case TC_ASSIGN:       //            Q ← / ⍨ 1 2 3         (MISC)
              case TC_R_ARROW:      //              → / ⍨ 1 2 3         (MISC)
              case TC_L_BRACK:      //              [ / ⍨ 1 2 3         (MISC)
                                    //              ; / ⍨ 1 2 3         (MISC)
              case TC_L_PARENT:     //              ( / ⍨ 1 2 3         (MISC)
              case TC_END:          //              ◊ / ⍨ 1 2 3         (MISC)
              case TC_FUN0:         //            FOO / ¨ ⊂ 'abc
              case TC_OPER2:        //            FOO / ¨ ⊂ 'abc
              case TC_RETURN:       //                / ⍨ 1 2 3
              case TC_VALUE:        // (1 0 1)(0 1 1) / ¨ ⊂ 'abc
                   return true;     // M1 is F       │ │ │
                                    //               │ │ │
              case TC_FUN12:        //               + / ¨ (1 2)(3 4)(5 6)
              case TC_OPER1:        // M1 is M       / / ¨ (1 2)(3 4)(5 6)
                   return false;    // MM is operator

              case TC_SYMBOL:
                   return NEXT.get_sym_ptr()->M_is_F();

              // most likely an indexed value
              case TC_INDEX:
                   return true;   // MM is function

              case TC_R_BRACK:   // skip over [ ... ]
                   pc = Function_PC(int(pc) + body[pc].get_int_val2());
                   continue;

              case TC_R_PARENT:
                   pc = Function_PC(pc + 1);
                   continue;

              default: CERR << "NEXT: " << tc_NEXT << endl;
                       TODO;
            }
       }
}
//----------------------------------------------------------------------------
void
Prefix::reduce_M_M__()
{
   if (at0().is_SLASH_or_BACKSLASH() && MM_is_FM(PC))
      {
        reduce_F_M__();
      }
   else   // the normal case: the left M is an operator. SHIFT
      {
        set_action(RA_PUSH_NEXT);
      }
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_M__()
{
   Assert1(prefix_len == 2);

Token & LO_A = at0();
cMonOP     M = at1().get_function();

DerivedFunction * derived = get_fun_oper_slot(LOC);
   new (derived) Derived_LO_M(LO_A, M, LOC);

   pop_args_push_result(Token(TOK_FUN1, derived));
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_F_M_C_()
{
   Assert1(prefix_len == 3);

Token & LO_F = at0();
cMonOP     M = at1().get_function();
Value_P C      = at2().get_function_axis();

DerivedFunction * derived = get_fun_oper_slot(LOC);
   new (derived) Derived_LO_M_X(LO_F, M, C, LOC);

   pop_args_push_result(Token(TOK_FUN2, derived));
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_F_C_M_()
{
   Assert1(prefix_len == 3);

cFunction_P LO_F = at0().get_function();
Value_P        C = at1().get_function_axis();
cMonOP         M = at2().get_function();

DerivedFunction * derived_F_C = get_fun_oper_slot(LOC);
   new (derived_F_C) Derived_F_X(LO_F, C, LOC);

Token tok_F_C(TOK_FUN2, derived_F_C);
DerivedFunction * derived = get_fun_oper_slot(LOC);
   new (derived) Derived_LO_M(tok_F_C, M, LOC);

   pop_args_push_result(Token(TOK_FUN2, derived));
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_F_C_M_C()
{
   Assert1(prefix_len == 4);

cFunction_P F  = at0().get_function();
Value_P     FX = at1().get_axes();
cMonOP      M  = at2().get_function();
Value_P     MX = at3().get_function_axis();

DerivedFunction * derived_F_C = get_fun_oper_slot(LOC);
   new (derived_F_C) Derived_F_X(F, FX, LOC);

Token tok_F_C(TOK_FUN2, derived_F_C);
DerivedFunction * derived = get_fun_oper_slot(LOC);
   new (derived) Derived_LO_M_X(tok_F_C, M, MX, LOC);

   pop_args_push_result(Token(TOK_FUN2, derived));
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_F_D_B_()
{
Token &  LO_F = at0();
cDyaOP   D    = at1().get_function();
Value_P  RO_B = at2().get_apl_val();

   // same as F D G, except for D = ⍤ or ⍣
   //
const Id id_D = D->get_Id();
   if (id_D != ID_OPER2_RANK && id_D != ID_OPER2_POWER)
      {
         reduce_F_D_G_();
         return;
      }

   /* At this point we have:
 
      f ⍤ RO with RO←(y B) that were stranded together in Parser.cc, or else
      f ⍣ RO with RO←(N B) that were stranded together in Parser.cc.

      Unstrand RO into y resp. N and (maybe) B. NOTE that in this context
      B is y resp. N of the strand RO and not the real right argument B of
      (f ⍤ RO) B resp. (f ⍣ RO) B.
     
      There may or may not be a left A on the way. Since f can be nomadic
      we do not know if a left argument A for f⍤ is coming and we have to
      create a derived function instead of calling >eval_ALRB() or eval_LRB()
      of ⍤ directly.
    */
Value_P value_B;   // the original B (before stranding RO and B).
DerivedFunction * derived = get_fun_oper_slot(LOC);
   {
     Value_P value_RO;   // j123 (for ⍤) or N (for ⍣)
     if (id_D == ID_OPER2_RANK)
        Bif_OPER2_RANK::unstrand_RO_B(RO_B, value_RO, value_B);
     else
        Bif_OPER2_POWER::unstrand_RO_B(RO_B, value_RO, value_B);

     Token tok_RO(TOK_APL_VALUE1, value_RO);
     new (derived) Derived_LO_D_RO(LO_F, D, tok_RO, LOC);
   }

   /* for unstrand_RO_B() there are 2 main cases:
 
      case 1: y and B were stranded into y_B, for example: f ⍤ y B.
              In this case unstrand_RO_B() returns y and a valid B

      case 2: y and B were not stranded into y_B, for example: (f ⍤ y) B or
              f ⍤ y SYM In this case unstrand_RO_B() returns only y and no
              valid B. The right argument B is waiting on the stack (at
              at3() for f⍤B, or at at4() for (f⍤B), or at a5() for ((f⍤B)),
              and so on.
    */
const Token dD(TOK_FUN2, derived);

   if (+value_B)   // case 1 (valid B)
      {
        // save locations of ⍤ and B
        //
        const Function_PC pc_D = at(1).get_PC();
        const Function_PC pc_B = at(2).get_PC();

        pop_and_discard();   // pop LO_F
        pop_and_discard();   // pop D
        pop_and_discard();   // pop y_B

        Token B(TOK_APL_VALUE1, value_B);
        Token_loc tloc_B(B, pc_B);
        Token_loc tloc_dD(dD, pc_D);
        push(tloc_B);    // was y_B
        push(tloc_dD);   // was D
      }
   else    // case 2: only y123, but no B (e.g. (f ⍤ 1 2 3) B
      {
        pop_args_push_result(dD);
      }

   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_D_V__()
{
   /* This is the end of an A.B.C...V chain.

      at0() is the final member V, and
      at1() is the '.' (aka. D) before V.

      Collect the members (and discard the '.' preceeding them)
      until no more '.' token are found.

      Prefix::reduce_D_V__() is called from two places:

      case 1. from reduce_statements() with prefix D V and (therefore
               prefix_len == 2), or else

      case 2. from reduce_D_V_ASS_B() and therefore prefix_len == 4.

      case 1 is called via best_phrase->reduce_fun)() with best_phrase D V.

      The processing of member variables is somewhat lengthy and almost the
      same for member reference and for member assignment. We therefore
      handle both cases here (i.e. in reduce_D_V__()) instead of replicating
      almost the same code in in reduce_D_V_ASS_B().
    */

const bool member_assign = prefix_len == 4;   // assume member reference
   if (prefix_len == 2)      // case 1: member reference
      {
        Assert(get_assign_state() != ASS_var_seen);
      }
   else if (member_assign)   // case 2: member assignment
      {
        Assert(get_assign_state() == ASS_var_seen);   // by reduce_D_V_ASS_B
      }
   else                      // something unexected
      {
        Assert(0 && "Bad prefix length in Prefix::reduce_D_V__()");
        return;
      }

   /*
      construct members which is a vector of member names in reverse order.

      For e.g. A.B.C.D ← 42 members would be { "D", "C", "B", "A" }

      The prefix parser has so far seen Token '.' 'D' or '.' 'D' '←' 42 and
      we now collect 'C' '.' 'B' '.' 'A' in the while() loop below.

      The top-level variable A may or may not already exist and is created
      if not and if this is a member assignment.

      ⎕CR.subfun and ⎕FIO.subfun are a special case in the while() loop below.
      They parse like a member variable access A.subfun but are not since
      A is not a variable but a function. If this special case is detected
      then e.g. ⎕CR.subfun is replaced with ⎕CR[fun] where fun is the function
      number corresponding for the subfunction name subfun. Dito for ⎕FIO.
    */
vector<const UCS_string *>members;
Symbol * top_sym = 0;
   members.push_back(at1().get_sym_ptr()->get_name_ptr());
   while (PC < body.ssize() - 1)   // at least 2 more token
         {
           if (body[PC].get_Class() == TC_SYMBOL)   // the normal case
              {
                Symbol * symbol = body[PC].get_sym_ptr();
                members.push_back(symbol->get_name_ptr());
               if (body[PC + 1].get_tag() == TOK_OPER2_INNER)
                  {
                    PC = Function_PC(PC + 2);
                  }
               else
                  {
                    top_sym = symbol;
                    PC = Function_PC(PC + 1);
                    break;
                  }
              }
           else   // body[PC] is not a symbol: the special ⎕CR/⎕FIO case
              {
                // this case is normally optimized away in
                // Parser::replace_static_patterns, but may slip through
                // for non-static patterns.
                //
                if (members.size() == 1                  &&
                    body[PC].get_Class() == TC_FUN12     &&
                    body[PC].get_function()->has_subfuns())
                   {
                     /* at this point we have ⎕CR.subfun B or ⎕FIO.subfun B.
                        The sub-function subfun of ⎕FIO is members[0].
                        subfun may or may not be a valid sub-function name
                        and we raise SYNTAX ERROR if not.

                        If the sub-function name is valid (i.e. axis != -1
                        below) then we replace e.g. ⎕FIO.subfun with the
                        corresponding axis function ⎕FIO[axis];
                      */
                     cFunction_P fun = body[PC].get_function();
                     const sAxis axis = fun->subfun_to_axis(*members[0]);
                     if (axis == -1)   // no sub0function with that name
                        {
                          MORE_ERROR() << "'" << *members[0]
                             << "' is not a sub-function of "
                             << fun->get_name() << ".\nTry " << fun->get_name()
                             << " '' for a list of valid sub-function names.";
                          syntax_error(LOC);
                        }

                     pop_args_push_result(Token(TOK_AXIS,
                                                IntScalar(axis, LOC)));
                     set_action(RA_CONTINUE);   // match again (w/o SHIFT)
                     return;
                   }

                 MORE_ERROR() << "member access: missing variable name";
                 syntax_error(LOC);
              }
         }

Value_P top_val = top_sym->get_var_value();
   if (!top_val)   // top_sym is not a variable (-name). Maybe create one.
      {
        if (member_assign)
           {
             // VAR.member ← value.
             //
             // The user assigns a value to the member of a structured
             // variable that does not yet exist. We do the same as for
             // VAR←value for not existing APL variables, i.e. we create
             // t automatically.
             //
             top_val = EmptyStruct(LOC);
             top_sym->assign(top_val, false, LOC);
             set_assign_state(ASS_none);
           }
        else   // member reference
           {
             // reference of the member a not existing variable. Like
             // referencing a normal variable we raise a VALUE ERROR but
             // give the user some more info.
             //
             UCS_string & more = MORE_ERROR()
                    << "member access: missing top-level variable "
                    << top_sym->get_name() << " for member ";
             more.append_members(members, 0);
             more << " not found";
             VALUE_ERROR;   // bail out
           }
      }

   // at this point the structured variable exist, either beforehand or
   // created above

   if (member_assign)   // (direct) member assignment e.g. A.B.C←V
      {
        Value * member_owner = 0;
        Cell * member_cell = top_val->get_member(members, member_owner, true);
        Assert(member_owner);

        if (member_cell->is_member_anchor())
           {
             UCS_string & more = MORE_ERROR() <<
                          "member access: cannot override non-leaf member ";
             more.append_members(members, 0);
             more << "\n      )ERASE or ⎕EX that member first.";
             DOMAIN_ERROR;
           }

        member_cell->release(LOC);   // let it free

        Value_P B = at3().get_apl_val();
        if (B->is_simple_scalar())
           {
             member_cell->init(B->get_cfirst(), *member_owner, LOC);
           }
        else
           {
             new (member_cell)   PointerCell(B.get(), *member_owner);
           }
        pop_args_push_result(Token(TOK_APL_VALUE2, B));
      }
   else                 // member reference (or selective specification)
      {
        const Cell * member_cell = top_val->get_existing_member(members);
        Assert(member_cell);

        if (member_cell->is_member_anchor() &&
            get_assign_state() == ASS_arrow_seen)
           {
             UCS_string & more = MORE_ERROR() <<
                          "member access: cannot use non-leaf member ";
             more.append_members(members, 0);
             more << " in selective specification.\n"
                     "      )ERASE or ⎕EX that member first.";
             DOMAIN_ERROR;
           }
        else if (member_cell->is_pointer_cell())
            {
              if (get_assign_state() == ASS_arrow_seen)   // selective spec.
                 {
                   set_assign_state(ASS_none);
                   Value_P cell_refs = member_cell->get_pointer_value()
                                                 ->get_cellrefs(LOC);
                   pop_args_push_result(Token(TOK_APL_VALUE2, cell_refs));
                 }
              else
                 {
                   Value_P Z(CLONE_P(member_cell->get_pointer_value(), LOC),
                                     LOC);
                   pop_args_push_result(Token(TOK_APL_VALUE1, Z));
                 }
            }
        else
           {
             Value_P Z(LOC);
             Z->next_ravel_Cell(*member_cell);
             Z->check_value(LOC);
             pop_args_push_result(Token(TOK_APL_VALUE1, Z));
           }
      }

   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_F_D_G_()
{
   // bind F and G to D.
   //
Token &     LO_F = at0();
cFunction_P D    = at1().get_function();
Token &     RO_G = at2();

DerivedFunction * derived = get_fun_oper_slot(LOC);
   new (derived) Derived_LO_D_RO(LO_F, D, RO_G, LOC);

   pop_args_push_result(Token(TOK_FUN2, derived));
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_F_D_C_B()
{
Token & LO_F = at0();
cDyaOP     D = at1().get_function();
Value_P  X_C = at2().get_function_axis();
Value_P RO_B = at3().get_apl_val();

const Function_PC pc_D = at(1).get_PC();

   // reduce, unless if another dyadic operator is coming. In that case
   // F is the right operand of the other operator (and not the left operand
   // of D and we simply continue (because right operand binds stronger than
   // left operand).
   //
   if (PC < Function_PC(body.ssize()))   // more token ahead
      {
        const Token & tok = body[PC];
        TokenClass next =  tok.get_Class();
        if (next == TC_SYMBOL)
           {
             Symbol * sym = tok.get_sym_ptr();
             const bool is_left_sym = get_assign_state() == ASS_arrow_seen;
             next = sym->resolve_class(is_left_sym);
           }

        if (next == TC_OPER2)
           {
             set_action(RA_PUSH_NEXT);   // aka. SHIFT
             return;
           }
      }

   if (D != &Bif_OPER2_RANK::fun)   // the normal case
      {
        DerivedFunction * derived = get_fun_oper_slot(LOC);
        new (derived) Derived_LO_D_RO(LO_F, D, at2(), LOC);
        pop_and_discard();   // pop LO_F
        pop_and_discard();   // pop D
        pop_and_discard();   // pop C
        Token tok_derived(TOK_FUN2, derived);
        Token_loc tloc_D(tok_derived, pc_D);
        push(tloc_D);
        set_action(RA_CONTINUE);   // match again (w/o SHIFT)
        return;
      }

   /* At this point we have the special case: (A) f ⍤[X] y_B
      with y_B stranded together in Parser.cc.  Unstrand y_B into y
      and (maybe) B. NOTE that B is y (and not the real B).
     
      There may or may not be a left A on the way. Since f can be nomadic
      we do not know if a left argument A for f⍤ is coming and we have to
      create a derived function instead of calling >eval_ALRB() or eval_LRB()
      of ⍤ directly.

      Note that X_C is the axes for LO_F (for the final disclose of the
      NARS variant of ⍤ with axes.
    */
Value_P value_B;   // the original B (before stranding j and B).
DerivedFunction * derived = get_fun_oper_slot(LOC);
   {
     Value_P y123;
     Bif_OPER2_RANK::unstrand_RO_B(RO_B, y123, value_B);
     Token T_y123_orig_RO(TOK_APL_VALUE1, y123);

     new (derived) Derived_LO_D_X_RO(LO_F, D, X_C, T_y123_orig_RO, LOC);
   }

   /* for unstrand_RO_B() there are 2 main cases:
 
      case 1: y and B were stranded into y_B, for example: f ⍤ y B.
              In this case unstrand_RO_B() returns y and a valid B

      case 2: y and B were not stranded into y_B, for example: (f ⍤ y) B or
              f ⍤ y SYM In this case unstrand_RO_B() returns only y and no
              valid B. The right argument B is waiting on the stack (at
              at4() for f⍤B, or at at5() for (f⍤B), or at a6() for ((f⍤B)),
              and so on.
    */
const Token tok_derived(TOK_FUN2, derived);

   if (+value_B)   // case 1 (valid B)
      {
        const Function_PC pc_B = at(3).get_PC();

        pop_and_discard();   // pop LO_F
        pop_and_discard();   // pop D
        pop_and_discard();   // pop C
        pop_and_discard();   // pop y_B

        Token B(TOK_APL_VALUE1, value_B);
        Token_loc tloc_B(B, pc_B);
        Token_loc tloc_dD(tok_derived, pc_D);
        push(tloc_B);    // was y_B
        push(tloc_dD);   // was D
      }
   else    // case 2: only y123, but no B (e.g. (f ⍤[X] 1 2 3) B
      {
        // replace F, D, C, and B with derived. Note that B is RO and not
        // the real B for derived.
        //
        pop_args_push_result(tok_derived);
      }

   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_C__()
{
Value_P A = at0().get_apl_val();
Value_P Z;

   if (at1().get_tag() == TOK_AXIS)   // [] or [IX]
      {
        Z = A->index(at1().get_apl_val().get());
      }
   else                               // [I1; I2...]
      {
        const IndexExpr * idx =  &at1().get_index_val();
        try
           {
             Z = A->index(*idx);
             Log(LOG_delete)
                CERR << "delete " << voidP(idx) << " at " LOC << endl;
             delete idx;
           }
        catch (Error err)
           {
             const Token result(TOK_ERROR, err.get_error_code());
             Log(LOG_delete)   CERR << "delete " << voidP(idx)
                                    << " at " LOC << endl;
             delete idx;
             pop_args_push_result(result);
             set_action(result);
             return;
           }
      }

const Token result(TOK_APL_VALUE1, Z);
   pop_args_push_result(result);

   set_action(result);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_V_C__()
{
Symbol * V = at0().get_sym_ptr();
Token tok = V->resolve_lv(LOC);   // not Token & !
   at0().move_from(tok, LOC);
   set_assign_state(ASS_var_seen);
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_V_C_ASS_B()
{
Symbol * V = at0().get_sym_ptr();
Value_P B = at3().get_apl_val();

   if (at1().get_tag() == TOK_AXIS)   // [] or [x]
      {
        const Value * v_idx = at1().get_axes().get();

        try
           {
             V->assign_indexed(v_idx, B);
           }
        catch (Error err)
           {
             const Token result(TOK_ERROR, err.get_error_code());
             at1().clear(LOC);
             at3().clear(LOC);
             pop_args_push_result(result);
             set_assign_state(ASS_none);
             set_action(result);
             return;
           }
      }
   else                               // [a;...]
      {
        const IndexExpr * idx = &at1().get_index_val();
        try
           {
             V->assign_indexed(*idx, B);
             Log(LOG_delete)   CERR << "delete " << voidP(idx)
                                    << " at " LOC << endl;
             delete idx;
           }
        catch (Error err)
           {
             const Token result(TOK_ERROR, err.get_error_code());
             at1().clear(LOC);
             at3().clear(LOC);
             Log(LOG_delete)   CERR << "delete " << voidP(idx)
                                    << " at " LOC << endl;
             delete idx;
             pop_args_push_result(result);
             set_assign_state(ASS_none);
             set_action(result);
             return;
           }
      }

const Token result(TOK_APL_VALUE2, B);
   pop_args_push_result(result);
   set_assign_state(ASS_none);
   set_action(result);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_F_V__()
{
   // turn V into a (left-) value
   //
Symbol * V = at1().get_sym_ptr();
Token tok = V->resolve_lv(LOC);   // not Token & !
   at1().move_from(tok, LOC);
   set_assign_state(ASS_var_seen);
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_ASS_B_()
{
Value_P A = at0().get_apl_val();
Value_P B = at2().get_apl_val();

   A->assign_cellrefs(B);

const Token result(TOK_APL_VALUE2, B);
   pop_args_push_result(result);

   set_assign_state(ASS_none);
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_D_V_ASS_B()
{
  set_assign_state(ASS_var_seen);
  reduce_D_V__();
  set_assign_state(ASS_none);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_V_ASS_B_()
{
Value_P B = at2().get_apl_val();

   Assert1(B->get_owner_count() >= 2);   // owners are at least B and at2()
const bool clone = B->get_owner_count() != 2 || at1().get_tag() != TOK_ASSIGN1;
Symbol * V = at0().get_sym_ptr();
   pop_and_discard();   // V
   pop_and_discard();   // ←

   at0().ChangeTag(TOK_APL_VALUE2);   // change value to committed value

   set_assign_state(ASS_none);
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)

   V->assign(B, clone, LOC);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_V_ASS_F_()
{
   // named lambda: V ← { ... }
   //
cFunction_P F = at2().get_function();
   if (!F->is_lambda())   SYNTAX_ERROR;

Symbol * V = at0().get_sym_ptr();
   if (V->assign_named_lambda(F, LOC))   DEFN_ERROR;

Value_P Z(V->get_name(), LOC);
const Token result(TOK_APL_VALUE2, Z);
   pop_args_push_result(result);

   set_assign_state(ASS_none);
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_RBRA___()
{
   Assert1(prefix_len == 1);

   // start partial index list. Parse the index as right so that, for example,
   // A[IDX}←B resolves IDX properly. assign_state is restored when the
   // index is complete.
   //
IndexExpr * idx = new IndexExpr(get_assign_state(), LOC);
   Log(LOG_delete)
      CERR << "new    " << voidP(idx) << " at " LOC << endl;

   new (&at0()) Token(TOK_PINDEX, *idx);
   set_assign_state(ASS_none);
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_LBRA_I__()
{
   // either [ I (true index) or else ; I (elided index). I is a (partial)
   // index and LBRA is the left) end of it. The result is either a scalar
   // axis aka. TOK_AXIS() or a non-scalar index aka. TOK_INDEX().
   //
   Assert1(prefix_len == 2);

IndexExpr & idx = at1().get_index_val();
const bool last_index = (at0().get_tag() == TOK_L_BRACK);

   if (idx.get_rank() == 0 && last_index)   // special case: [ ]
      {
        assign_state = idx.get_assign_state();
        const Token result(TOK_INDEX, idx);
        pop_args_push_result(result);
        set_action(RA_CONTINUE);   // match again (w/o SHIFT)
        Log(LOG_delete)   CERR << "delete " << voidP(&idx)
                               << " at " LOC << endl;
        delete &idx;
        return;
      }

   // add elided index to partial index list
   //
Token result = at1();
   result.get_index_val().add_index(Value_P());

   if (last_index)   // [ seen
      {
        assign_state = idx.get_assign_state();

        if (idx.is_axis())
           {
             Token tok_axis(TOK_AXIS, idx.values[0]);
             result.move_from(tok_axis, LOC);
           }
        else
           {
               Token tok_index(TOK_INDEX, idx);
               result.move_from(tok_index, LOC);
           }
      }
   else
      {
        set_assign_state(ASS_none);
      }

   pop_args_push_result(result);
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_LBRA_B_I_()
{
   Assert1(prefix_len == 3);

   // [ B I or ; B I   (normal index)
   //
Token I = at2();
   I.get_index_val().add_index(at1().get_apl_val());

const bool last_index = (at0().get_tag() == TOK_L_BRACK);   // ; vs. [

   if (last_index)   // [ seen
      {
        IndexExpr & idx = I.get_index_val();
        assign_state = idx.get_assign_state();

        if (idx.is_axis())   // [] or [ axis ]
           {
             Value_P X = idx.extract_axis();
             Assert1(+X);   // not [ ]
             Token tok_axis(TOK_AXIS, X);
             I.move_from(tok_axis, LOC);
             Log(LOG_delete)
                CERR << "delete " << voidP(&idx) << " at " LOC << endl;
             delete &idx;
           }
        else
           {
             Token tok_index(TOK_INDEX, idx);
             I.move_from(tok_index, LOC);
           }
      }
   else
      {
         set_assign_state(ASS_none);
      }

   pop_args_push_result(I);
   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_B__()
{
   Assert1(prefix_len == 2);

   /* vector notation. Glue A and B together, unless A is the right operand
      of a dyadic operator.

      Right operand is the only case where vector notation binds weaker
      (since bracket (i.e. B[...]) and specification left (i.e. ←A) ido
      obviously not apply here.

       The only cases where A is a right operand are:

    */
const int pc_A = at(0).get_PC();
   if (body[pc_A + 1].get_Class() == TC_OPER2)   // case 1.
      {
        /* case 1:

                  ┌────────── PC_A + 1
                  │   ┌────── PC_A
                  │   │ ┌──── PC_A - 1
         ... LO OPER2 A B ...   and
         */
        set_action(RA_PUSH_NEXT);
        return;
      }

   if (body[pc_A + 1].get_Class() == TC_R_PARENT)   // maybe case 2.
      {
        /* case 2:

                    ┌───────────────── PC_A + 3 + n   (with n = 0 if single ')')
                    │    ┌──────────── PC_A + 2 + n   (with n = 0 if single ')')
                    │    │ ┌────────── PC_A + 1
                    │    │ │ ┌──────── PC_A
                    │    │ │ │ ┌────── PC_A - 1
         ... ( LO OPER2 RO ) A B) ...
         */
        // normally there is only one ), but there could be more.
        //
        int pc_RPAR = pc_A + 1;   // rightmost RPAR
        while (body[pc_RPAR + 1].get_Class() == TC_R_PARENT)   ++pc_RPAR;
        if (body[pc_RPAR + 2].get_Class() == TC_OPER2)   // definitively case 2
           {
             set_action(RA_PUSH_NEXT);
             return;
           }
      }

Value_P Z = Value::glue(at0(), at1(), LOC);
const Token result(TOK_APL_VALUE3, Z);
   pop_args_push_result(result);

   set_action(RA_CONTINUE);
}
//----------------------------------------------------------------------------
/// pattern V ) ← B.
void
Prefix::reduce_V_RPAR_ASS_B()
{
   Assert1(prefix_len == 4);

   /* This pattern, i.e. V ) ← B, is the trailing tokens of one of 2 cases:

      1. selective specification:   (... FUN V) ← B
      2. vector assignment;         (C D ... V) ← B
    */

vector<Symbol *> symbols;
   symbols.reserve(10);
   symbols.push_back(at0().get_sym_ptr());   // i.e. the last symbol V
   collect_symbols(symbols);   // of the remaining symbols C D ...

   if (symbols.size() == 1)   // case 1: selective specification
      {
        // count == 0 normally indicates a selective specification. However,
        // an incorrect vector assignment such as (A 1 C) ← would also lead
        // to count == 0 (because Parser.cc would set is_vector_spec to
        // false around line 820 in Parser.cc). We fix this case here.
        //
        const TokenClass tc = body[PC].get_Class();
        if (!((1 << tc) & TCG_FUN12_OPER12))   // tc is neither fun nor oper
           {
             // this case is rather rare, so we can afford a little time
             // to verify that we have at least one function in the supposed
             // selective specification
             bool selective_spec = false;
             for (int pc = PC + 1;;)
                 {
                   const TokenClass tc1 = body[pc++].get_Class();
                   if ((1 << tc1) & TCG_FUN12_OPER12)
                      {
                        selective_spec = true;
                        break;
                      }
                   else if (tc1 == TC_L_PARENT)   // most likely end of (...)←
                      {
                        break;   // so selective_spec remains false
                      }
                 }

             // at this point the token left of V ) ← B should form a
             // selective specification. Complain if not.
             //
             if (!selective_spec)
                {
                  MORE_ERROR() <<
                  "Malformed selective specification or vector specification";
                  LEFT_SYNTAX_ERROR;
                }
           }
      }

   // at this point the pattern could still be a selective specification
   // or a vector assignment. However, the count (i.e. symbol.size())
   // computed above shall distinguishes them. For example:
   //
   // case 1: (T U V) ← value        count = 2      vector assignment
   // case 2:   (U V) ← value        count = 1      vector assignment
   // case 3: (2 ↑ V) ← value        count = 0      selective specification
   //
   if (symbols.size() < 2)   // single variable V
      {
        // definitively case 3. (selective specification).
        // Replace variable V by its (left-) value and repeat matching
        //
        Symbol * V = at0().get_sym_ptr();
        Assert1(V);
        Token result = V->resolve_lv(LOC);
        set_assign_state(ASS_var_seen);
        at0().move_from(result, LOC);

        // at this point variable name V was resolved to the (left-) value
        // of V. Repeat matching with the updated phrase.
        //
        set_action(RA_CONTINUE);   // match again (w/o SHIFT)
        return;
      }

   // cases 1. or 2. (vector assugnment)
   //
Value_P B = at3().get_apl_val();
   Symbol::vector_assignment(symbols, B);

   set_assign_state(ASS_none);

   // clean up stack
   //
const Token result(TOK_APL_VALUE2, at3().get_apl_val());
   pop_args_push_result(result);
   if (PC >= body.ssize() ||
       body[PC++].get_Class() != TC_L_PARENT)   syntax_error(LOC);

   set_action(RA_CONTINUE);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::handle_ELSE(const Token & maybe_else, int num)
{
   // the int value of TOK_IF_ELSE is the PC of the end of the ELSE clause.
   //
   if (maybe_else.get_tag() != TOK_IF_ELSE)   return;   // not ←→

const Function_PC PC_from = PC = Function_PC(maybe_else.get_int_val());
   while (body[PC].get_tag() == TOK_IF_END)   ++PC;   // nested else
   if (body[PC].get_tag() == TOK_IF_ELSE)   // another ELSE clause
      PC = Function_PC(body[PC].get_int_val());
   Log(LOG_IfElse)
      {
        CERR << "END of THEN (" << num << ") reached, PC is now: " << PC
             << "(" << PC_from << ")" << endl;
      }
}
//----------------------------------------------------------------------------
void
Prefix::reduce_END___()
{
   /*
      this phrase occurs only if none of the other reduce_END_XXX phrases
      has matched. This happens rarely if either:

      1. the entire statement was empty (and then ssize() == 1).
         However, empty statements are normaly optimized away (in
         Executable::parse_body_line() around line 277) so that this does
         not happen under normal conditions, but conditionals may become
         an exception in the future. Currently empty conditional clauses
         are rejected at parse time in Executable::parse_body_line() around
         line 193, but this may change.

         or otherwise:

      2. an invalid phrase. In this case there are tokens other than B,
         VOID, or GOTO phrases on the stack and the end of statment is
         reacehd. This is a SYNTAX ERROR and we can throw it here rather
         than shifting the END token and failing then.

         will trigger a SYNTAX ERROR because END X will not match.
    */

   if (ssize() > 1)   push_END_error();   // case 2

   handle_ELSE(at0(), 1);

   // case 1 (empty statement)
   put = 0;
   set_action(RA_PUSH_NEXT);   // match again (w/o SHIFT)
}
//----------------------------------------------------------------------------
void
Prefix::reduce_END_VOID__()
{
   Assert1(prefix_len == 2);

   if (ssize() != 2)   syntax_error(LOC);

const bool end_of_line = at0().get_tag() == TOK_ENDL;
const bool trace = end_of_line && (at0().get_int_val() & 1);

   handle_ELSE(at0(), 3);

   put = 0;             // pop END and VOID

Token Void(TOK_VOID);
   si.statement_result(Void, trace);
   set_action(RA_PUSH_NEXT);   // aka. SHIFT
   if (InterruptContext::attention_is_raised() && end_of_line)
      {
        const bool int_raised = InterruptContext::interrupt_is_raised();
        InterruptContext::clear_attention_raised(LOC);
        InterruptContext::clear_interrupt_raised(LOC);
        if (int_raised)   INTERRUPT
        else              ATTENTION
      }
}
//----------------------------------------------------------------------------
void
Prefix::reduce_END_B__()
{
   Assert1(prefix_len == 2);

   if (ssize() != 2)
      {
        UCS_string & more = MORE_ERROR();
        more << "non-empty stack at end of statement:";
        loop(s, ssize())
           {
             const TokenTag tag = at(s).get_tag();
             more << " " << Token::class_name(tag);
           }
        syntax_error(LOC);
      }

const Token END = pop().get_token();   // pop END
const bool end_of_line = END.get_tag() == TOK_ENDL;
const bool trace = end_of_line && (END.get_int_val() & 1);

Token B = pop().get_token();   // pop B

   if (END.get_tag() == TOK_IF_THEN)   // end of condition B
      {
        // B is the Boolean condition of an if/else conditional.
        // END is the token after the condition (PC of the IF clause).
        //
        // If COND is 1 then continue, else jump to the else clause
        const bool cond = B.get_apl_val()->get_sole_bool();
        if (!cond)   PC = Function_PC(END.get_int_val());   // else clause

        Log(LOG_IfElse)
           {
             if (cond)   CERR << "IF(1) : Proceeding with THEN clause";
             else        CERR << "IF(0) : Jump to ELSE/ENDIF clause";
             CERR << " PC is now: " << PC << endl;
           }

         set_action(RA_PUSH_NEXT);
         return;
      }

   // true end of statement. This may be:
   //
   // TOK_IF_ELSE: the end of a THEN clause:         adjust the PC
   // TOK_IF_END:  the end of (or no) ELSE clause:   no op
   // TOK_END(L):  normal end of statement or line:  no op
   //
   if (END.get_tag() == TOK_IF_END)   // ←←
      {
        Log(LOG_IfElse)   CERR << 
            "ENDIF reached, PC is now: " << PC << endl;
        while (body[PC].get_tag() == TOK_IF_END)   ++PC;
        if (body[PC].get_tag() == TOK_IF_ELSE)
           PC = Function_PC(body[PC].get_int_val());
        Log(LOG_IfElse)   CERR << 
            "ENDIF reached, fixed PC is now: " << PC << endl;
      }
   else
      {
        handle_ELSE(END, 2);   // maybe ←→
      }

   si.fun_oper_cache.reset();
   si.statement_result(B, trace);

   set_action(RA_PUSH_NEXT);   // aka. SHIFT
   if (InterruptContext::attention_is_raised() && end_of_line)
      {
        const bool int_raised = InterruptContext::interrupt_is_raised();
        InterruptContext::clear_attention_raised(LOC);
        InterruptContext::clear_interrupt_raised(LOC);
        if (int_raised)   INTERRUPT
        else              ATTENTION
      }
}
//----------------------------------------------------------------------------
void
Prefix::reduce_A_GOTO_B_()
{
   // dyadic LABEL → CONDITION.

   Assert1(prefix_len == 3);

   // we want this to be fast, therefore we don't check the shape but
   // rather use ↑A and ↑B,
   //
const Cell & A0 = at0().get_apl_val()->get_cfirst();   // the jump offset
const Cell & B0 = at2().get_apl_val()->get_cfirst();   // the condition

   if (!A0.is_near_int())
      {
        MORE_ERROR() << "A → B: bad (non-Integer) ↑A ";
        DOMAIN_ERROR;
      }

   if (!B0.is_near_int())
      {
        MORE_ERROR() << "A → B: bad (non-Integer) ↑B ";
        DOMAIN_ERROR;
      }

   if (B0.get_near_int() == 0)  // the branch is not taken
      {
        const Token result(TOK_APL_VALUE2, Idx0(LOC));
        pop_args_push_result(result);
        set_action(RA_CONTINUE);   // match again (w/o SHIFT)
        return;
      }

const APL_Integer jump_offset = A0.get_near_int();

   if (const UserFunction * ufun = si.get_executable()->get_exec_ufun())
      {
        // A → B in a ∇-context (lambda or ∇-function)
     
        // PC was already incremented and now points to the next token
        // after the branch. In order to compute the proper line number,
        // we have to use the PC BEFORE the branch.
        //
        const int function_line = ufun->get_line(PC - prefix_len) + jump_offset;
        si.jump_to_line(Function_Line(function_line));   // changes the PC
        branch_within_function(true);   // check ^C and set_action(RA_PUSH_NEXT)
        reset(LOC);                     // abort the current statement

        // branch_within_function() MAY have set the PC to the end of the
        // function (token ENDL). However, that skips the return of the
        // ∇-result. Fix it.
        //
        if (PC >= body.ssize())           // PC at or past end of function
           {
             Assert(body[PC-1].get_tag() == TOK_ENDL);
             Assert(body[PC].get_Class() == TC_RETURN);
             PC = Function_PC(body.ssize() -1);
           }
      }
   else         // ⍎ or ◊ context
      {
        // A → B in ⍎ or ◊ context. Unlike ∇-contexts, the line number is
        // always 0 and →0 does NOT return and non-zero jump_offsets are
        // not permitted.
        //
        if (jump_offset)   // function_line is 0 in ⍎ or ◊ contexts
           {
             MORE_ERROR() << "A → B with non-zero A is only permitted "
                             "inside a defined function";
             DOMAIN_ERROR;
           }

        // jump to same line (but outside a defined function)
        //
        goto_PC(Function_PC_0);   // calls reset(), so don't pop_args() !
        set_action(RA_PUSH_NEXT);   // aka. SHIFT
      }
}
//----------------------------------------------------------------------------
void
Prefix::reduce_END_GOTO_B_()
{
   // monadic →LABEL. Preserves the at0() token and reduces only GOTO_B.

   Assert1(prefix_len == 3);

   si.fun_oper_cache.reset();

   // at0() is either TOK_ENDL (end of line), or one of TOK_END, TOK_FUN12,
   //       or TOK_OPER1
   //
const bool end_of_line = at0().get_tag() == TOK_ENDL;
const bool trace = end_of_line && (at0().get_int_val() & 1);

const Value * line = at2().get_apl_val().get();

   // produce ⎕TRACE output if enabled and branch is not empty
   //
   if (trace && line->element_count() > 0)
      {
        const ShapeItem line_num = line->get_line_number();
        Token bra(TOK_BRANCH, line_num);
        si.statement_result(bra, true);   // display trace line
      }

const Token result = si.jump(line);   // may change the PC

   if (result.get_tag() == TOK_BRANCH)   // branch back into a function
      {
        Log(LOG_prefix_parser)
           {
             CERR << "Leaving context after " << result << endl;
           }

        pop_args_push_result(result);
        set_action(RA_RETURN);            // return from context;
        return;
      }

   if (result.get_tag() == TOK_NOBRANCH)   // branch not taken, e.g. →⍬
      {
        handle_ELSE(at0(), 4);
        reset(LOC);
        set_action(RA_PUSH_NEXT);   // again with modified stack
        return;
      }

   reset(LOC);   // branch taken: terminate current statement

   /* NOTE: the →N cases with N≤0 or N≥↑⍴⎕CR 'FUNCTION' are handled in 
      UserFunction::pc_for_line(). pc_for_line() sets the PC to the end
      of the function (which then returns):

      StateIndicator::jump()   above
      └── StateIndicator::jump_to_line()
          └── UserFunction::pc_for_line()
    */
   Assert(result.get_tag() == TOK_VOID);   // branch taken, i.e. →N in ∇-context
   branch_within_function(end_of_line);    // does set_action(RA_PUSH_NEXT)
}
//----------------------------------------------------------------------------
void
Prefix::check_interrupt_or_attention(bool end_of_line)
{
   if (InterruptContext::attention_is_raised() && end_of_line)
      {
        const bool int_raised = InterruptContext::interrupt_is_raised();
        InterruptContext::clear_attention_raised(LOC);
        InterruptContext::clear_interrupt_raised(LOC);
        if (int_raised)   INTERRUPT
        else              ATTENTION
      }
}
//----------------------------------------------------------------------------
void
Prefix::reduce_END_GOTO__()   // Escape ( → )
{
   /*
       Normally:

       1a. reduce_END_GOTO__ happens for APL → aka. ESC
       1b. tokens TOK_BRANCH and TOK_NOBRANCH are local result token
           returned by si.jump(line) in reduce_END_GOTO_B_(), where
           si.jump() also modifies the PC.

       In UserFunction::optimize_labels() we optimize
       the statements →N (with literal integer N) and →LABEL into a single
       token TOK_GOTO_PC whose integer value is the new PC, and:

       2a. a value type of TV_INT of the GOTO token indicates that this
           optimization was performed
       2b. the int value is the new PC
       2c. a PC of -1 means: return from the function
    */
    if (at1().get_tag() == TOK_GOTO_PC)   // optimized →N
       {
         reset(LOC);
         const Function_PC new_PC = Function_PC(at1().get_int_val());
         if (new_PC == Function_PC_done)   // →0 etc.
            {
              PC = Function_PC(body.ssize() - 1);   // RETURN_XXX
              const Token result(TOK_VOID);
              pop_args_push_result(result);
              set_action(RA_CONTINUE);      // return from defined function
            }
         else                             // normal →N
            {
              PC = new_PC;
              set_action(RA_PUSH_NEXT);
            }
         return;
       }

   Assert1(prefix_len == 2);

   if (ssize() != 2)   syntax_error(LOC);

   si.fun_oper_cache.reset();

const bool trace = at0().get_Class() == TC_END && (at0().get_int_val() & 1);
   if (trace)
      {
        Token esc(TOK_ESCAPE);
        si.statement_result(esc, true);
      }

   // the statement is → which could mean TOK_ESCAPE (normal →) or
   //  TOK_STOP_LINE from S∆←line
   //
   if (at1().get_tag() == TOK_STOP_LINE)   // S∆ line
      {
        const UserFunction * ufun = si.get_executable()->get_exec_ufun();
        if (ufun && ufun->get_exec_properties()[2])
           {
              // the function ignores attention (aka. weak interrupt)
              //
              handle_ELSE(at0(), 5);
              pop_and_discard();   // pop END
              pop_and_discard();   // pop GOTO
              set_action(RA_CONTINUE);   // match again (w/o SHIFT)
              return;
           }

        COUT << si.function_name() << "[" << si.get_line() << "]" << endl;
        const Token result(TOK_ERROR, E_STOP_LINE);
        pop_args_push_result(result);
        set_action(RA_RETURN);            // return from context;
      }
   else
      {
        const Token result(TOK_ESCAPE);
        pop_args_push_result(result);
        set_action(RA_RETURN);            // return from context;
      }
}
//----------------------------------------------------------------------------
void
Prefix::reduce_RETC_VOID__()
{
   // e.g.      ⎕FX 'qio' '⎕IO' ◊ ⍎'qio'
   //
   // execute of a defined function without result. Im[pssible for lambdas
   // since they always have a result λ←.

   Assert1(prefix_len == 2);

   // action is RA_RETURN, therefore the entire si.fun_oper_cache will be
   // discarded and no reset() of it is required.

const Token result(TOK_VOID);   // function result is VOID
   pop_args_push_result(result);
   set_action(RA_RETURN);            // return from context;
}
//----------------------------------------------------------------------------
void
Prefix::reduce_RETC___()
{
   Assert1(prefix_len == 1);

   if (ssize() != 1)   syntax_error(LOC);

   // action is RA_RETURN, therefore the entire si.fun_oper_cache will be
   // discarded and no reset() of it is required.

   // end of context reached. There are 4 cases:
   //
   // TOK_RETURN_STATS:  end of ◊ context
   // TOK_RETURN_EXEC:   end of ⍎ context with no result (e.g. ⍎'')
   // TOK_RETURN_VOID:   end of ∇ (no result)
   // TOK_RETURN_SYMBOL: end of ∇ (result in Z)
   //
   // case TOK_RETURN_EXEC (end of ⍎ context) is handled in reduce_RETC_A___()
   //
   switch(at0().get_tag())
      {
        case TOK_RETURN_EXEC:   // immediate execution context
             Log(LOG_prefix_parser)
                CERR << "- end of ⍎ context (no result)" << endl;
             at0().clear(LOC);
             set_action(RA_RETURN);            // return from context;
             return;

        case TOK_RETURN_STATS:   // immediate execution context
             Log(LOG_prefix_parser)
                CERR << "- end of ◊ context" << endl;
             at0().clear(LOC);
             set_action(RA_RETURN);            // return from context;
             return;

        case TOK_RETURN_VOID:   // user-defined function not returning a value
             Log(LOG_prefix_parser)
                CERR << "- end of ∇ context (function has no result)" << endl;

             {
               const UserFunction * ufun = si.get_executable()->get_exec_ufun();
               if (ufun)   { /* do nothing, needed for -Wall */ }
               Assert1(ufun);
               at0().clear(LOC);
             }
             set_action(RA_RETURN);            // return from context;
             return;

        case TOK_RETURN_SYMBOL:   // user-defined function returning a value
             {
               const UserFunction * ufun = si.get_executable()->get_exec_ufun();
               Assert1(ufun);
               Symbol * ufun_Z = ufun->get_sym_Z();
               Value_P Z;
               if (ufun_Z)   Z = ufun_Z->get_var_value();
               if (!Z)
                  {
                    Log(LOG_prefix_parser)
                       CERR << "- end of ∇ context (MISSING function result)."
                            << endl;
                    at0().clear(LOC);
                  }
               else
                  {
                    Log(LOG_prefix_parser)
                       CERR << "- end of ∇ context (function result is: "
                            << *Z << ")" << endl;
                    new (&at0()) Token(TOK_APL_VALUE1, Z);
                  }
             }
             set_action(RA_RETURN);            // return from context;
             return;

        default: break;
      }

   // not reached
   //
   Q1(at0().get_tag())   FIXME;
}
//----------------------------------------------------------------------------
// Note: reduce_RETC_A___ happens only for context ⍎,
//       since contexts ◊ and ∇ use reduce_END_B___ instead.
//
void
Prefix::reduce_RETC_A__()
{
   Assert1(prefix_len == 2);

   if (ssize() != 2)   // there extra tokens
      {
        syntax_error(LOC);
      }

   // action is RA_RETURN, therefore the entire si.fun_oper_cache will be
   // discarded and no reset() of it is required.

   Log(LOG_prefix_parser)   CERR << "- end of ⍎ context.";

Token B = at1();
   pop_args_push_result(B);

   set_action(RA_RETURN);            // return from context;
}
//----------------------------------------------------------------------------
// Note: reduce_RETC_A_GOTO_B happens only for context ⍎, since
//       the contexts ◊ and ∇ use reduce_END_GOTO_B__ instead.
//
void
Prefix::reduce_RETC_A_GOTO_B()
{
   Assert1(prefix_len == 4);
   syntax_error(LOC);
}
//----------------------------------------------------------------------------
void
Prefix::reduce_RETC_GOTO_B_()
{
   // Note: reduce_RETC_GOTO_B__ can only happen for context ⍎, since
   //       the contexts ◊ and ∇ use reduce_END_GOTO_B__ instead.

   if (ssize() != 3)   syntax_error(LOC);

   // monadic →LABEL.

   Assert1(prefix_len == 3);

   si.fun_oper_cache.reset();

   // at0() is either TOK_ENDL (end of line), or one of TOK_END, TOK_FUN12,
   //       or TOK_OPER1
   //
const bool end_of_line = at0().get_tag() == TOK_ENDL;
const bool trace = end_of_line && (at0().get_int_val() & 1);

const Value * line = at2().get_apl_val().get();

   // produce ⎕TRACE output if enabled and branch is not empty
   //
   if (trace && line->element_count() > 0)
      {
        const ShapeItem line_num = line->get_line_number();
        Token bra(TOK_BRANCH, line_num);
        si.statement_result(bra, true);   // display trace line
      }

const Token result = si.jump(line);   // may change the PC

   if (result.get_tag() == TOK_BRANCH)   // branch back into a function
      {
        Log(LOG_prefix_parser)
           {
             CERR << "Leaving context after " << result << endl;
           }

        pop_args_push_result(result);
        set_action(RA_RETURN);            // return from context;
        return;
      }

   if (result.get_tag() == TOK_NOBRANCH)   // branch not taken, e.g. →⍬
      {
        // unlike reduce_END_GOTO_B (which can simply reset(LOC) and then
        //  RA_CONTINUE with the next token), we need a TOK_VOID token that
        //  will be returned to the caller of the current ⍎ context.
        //
        const Token result(TOK_VOID);   // function result is VOID
        pop_args_push_result(result);
        set_action(RA_RETURN);   // again with modified stack
        return;
      }

   reset(LOC);   // branch taken: terminate current statement

   /* NOTE: the →N cases with N≤0 or N≥↑⍴⎕CR 'FUNCTION' are handled in 
      UserFunction::pc_for_line(). pc_for_line() sets the PC to the end
      of the function (which then returns):

      StateIndicator::jump()   above
      └── StateIndicator::jump_to_line()
          └── UserFunction::pc_for_line()
    */
   Assert(result.get_tag() == TOK_VOID);   // branch taken, i.e. →N in ∇-context
   branch_within_function(end_of_line);    // does set_action(RA_PUSH_NEXT)

   set_action(RA_RETURN);            // return from context;
}
//----------------------------------------------------------------------------
void
Prefix::reduce_RETC_GOTO__()
{
   // Note: reduce_RETC_ESC___ can only happen for context ⍎, since
   //       contexts ◊ and ∇ use reduce_END_ESC___ instead

   if (ssize() != 2)   syntax_error(LOC);

   reduce_END_GOTO__();
}
//----------------------------------------------------------------------------

