Ejemplo n.º 1
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ INI(_NIL_TYPE_)
 { _EXP_TYPE_ dct, exp, nbr, tab, val;
   _UNS_TYPE_ ctr, siz;
   _stk_claim_();
   _stk_pop_EXP_(val);
   _stk_pop_EXP_(nbr);
   _stk_pop_EXP_(exp);
   _stk_peek_EXP_(tab);
   siz = _ag_get_TAB_SIZ_(tab);
   ctr = _ag_get_NBU_(nbr);
   _ag_set_TAB_EXP_(tab, ctr, val);
   if (ctr < siz)
     { nbr = _ag_succ_NBR_(nbr);
       _stk_push_EXP_(exp);
       _stk_push_EXP_(nbr);
       _stk_push_EXP_(exp);
       _stk_push_CNT_(EXP); }
   else
     { _stk_zap_EXP_();
       _stk_peek_EXP_(dct);
       _ag_set_DCT_VAL_(dct, tab);
       _ag_set_DCT_DCT_(dct, _DCT_);
       _DCT_ = dct;
       _stk_poke_EXP_(tab);
       _stk_zap_CNT_(); }}
Ejemplo n.º 2
0
static _NIL_TYPE_ exit_loop(_NIL_TYPE_)
 { SES_TAB[SES_IDX].res = _PICO_DONE_;
   SES_TAB[SES_IDX].dct = _DCT_;
   SES_TAB[SES_IDX].esc = _ESC_;
   _stk_zap_EXP_();
   _stk_zap_CNT_();
   longjmp(SES_TAB[SES_IDX].exi, 1); }
Ejemplo n.º 3
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ ATV(_NIL_TYPE_)
 { _EXP_TYPE_ act, arg, dct, exp, nbr, tab, val;
   _CNT_TYPE_ cnt;
   _UNS_TYPE_ ctr, siz;
   _stk_claim_();
   _stk_pop_EXP_(val);
   _stk_pop_EXP_(nbr);
   _stk_pop_EXP_(tab);
   _stk_peek_EXP_(arg);
   siz = _ag_get_TAB_SIZ_(arg);
   ctr = _ag_get_NBU_(nbr);
   _ag_set_TAB_EXP_(tab, ctr, val);
   if (ctr < siz)
     { act = _ag_get_TAB_EXP_(arg, ctr+1);
       _stk_push_EXP_(tab);
       nbr = _ag_succ_NBR_(nbr);
       _stk_push_EXP_(nbr);
       _stk_push_EXP_(act);
       _stk_push_CNT_(EXP); }
   else
     { _stk_zap_EXP_();
       _stk_pop_EXP_(dct);
       _ag_set_DCT_VAL_(dct, tab);
       _stk_zap_CNT_();
       _stk_peek_CNT_(cnt);
       if (cnt != RET)
         { _stk_peek_EXP_(exp);
           _stk_poke_EXP_(_DCT_);
           _stk_push_EXP_(exp);
           _stk_push_CNT_(RET); }
       _stk_push_CNT_(EXP);
       _DCT_ = dct; }}
Ejemplo n.º 4
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ RET(_NIL_TYPE_)
 { _EXP_TYPE_ val;
   _stk_pop_EXP_(val);
   _stk_peek_EXP_(_DCT_);
   _stk_poke_EXP_(val);
   _stk_zap_CNT_();
   _ESCAPE_; }
Ejemplo n.º 5
0
/*--------------------------------------------------------------------------*/
static _NIL_TYPE_ LARG(_NIL_TYPE_)
 { _EXP_TYPE_ dct, exp, val, ltab;
   _TAG_TYPE_ tag;
   _stk_claim_();
   _stk_pop_EXP_(val);
   tag = _ag_get_TAG_(val);
   if (tag == _VOI_TAG_)
     { _stk_pop_EXP_(exp);
       ltab = _ag_make_LTAB_();
       _stk_peek_EXP_(dct);
       _ag_set_DCT_VAL_(dct, ltab);
       _ag_set_DCT_DCT_(dct, _DCT_);
       _DCT_ = dct;
       _ag_set_LTAB_CONCR_(ltab, _EMPTY_);
       _ag_set_LTAB_LZEXP_(ltab, exp);
       _ag_set_LTAB_DCT_(ltab, _DCT_);
       _stk_poke_EXP_(ltab);
       _stk_zap_CNT_(); }
   else if (tag == _TAB_TAG_)
     { ltab = _ag_make_LTAB_();
       _stk_peek_EXP_(exp);
       _stk_poke_EXP_(ltab);
       _stk_push_EXP_(exp);
       _stk_push_EXP_(val);
       _stk_push_EXP_(_ONE_);
       exp = _ag_get_TAB_EXP_(val, 1);
       _stk_push_EXP_(exp);
       _stk_poke_CNT_(INIC);
       _stk_push_CNT_(EXP); }
   else
     _error_(_IAG_ERROR_); }
Ejemplo n.º 6
0
/*----------------------------------------------------------------------------*/
static _NIL_TYPE_ INIC(_NIL_TYPE_)
 { _EXP_TYPE_ dct, exp, nbr, ltab, concreteTab, val;
   _UNS_TYPE_ ctr, siz;
   _stk_pop_EXP_(val);
   _stk_pop_EXP_(nbr);
   _stk_peek_EXP_(concreteTab);
   siz = _ag_get_TAB_SIZ_(concreteTab);
   ctr = _ag_get_NBU_(nbr);
   _ag_set_TAB_EXP_(concreteTab, ctr, val);
   if (ctr < siz)
     { nbr = _ag_succ_NBR_(nbr);
       ctr = _ag_get_NBU_(nbr);
       _stk_push_EXP_(nbr);
       exp = _ag_get_TAB_EXP_(concreteTab, ctr);
       _stk_push_EXP_(exp);
       _stk_push_CNT_(EXP); }
   else
     { _stk_zap_EXP_();
       _stk_pop_EXP_(exp);
       _stk_pop_EXP_(ltab);
       _stk_peek_EXP_(dct);
       _ag_set_DCT_VAL_(dct, ltab);
       _ag_set_DCT_DCT_(dct, _DCT_);
       _DCT_ = dct;
       _ag_set_LTAB_CONCR_(ltab, concreteTab);
       _ag_set_LTAB_LZEXP_(ltab, exp);
       _ag_set_LTAB_DCT_(ltab, _DCT_);
       _stk_poke_EXP_(ltab);
       _stk_zap_CNT_(); }}
Ejemplo n.º 7
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ IDX(_NIL_TYPE_)
 { _EXP_TYPE_ dct, exp, nbr, tab;
   _TAG_TYPE_ tag;
   _UNS_TYPE_ siz;
   _stk_claim_();
   _stk_pop_EXP_(nbr);
   tag = _ag_get_TAG_(nbr);
   if (tag == _NBR_TAG_)
     { siz = _ag_get_NBU_(nbr);
       if (siz == 0)
         { _stk_zap_EXP_();
           _stk_peek_EXP_(dct);
           _ag_set_DCT_VAL_(dct, _EMPTY_);
           _ag_set_DCT_DCT_(dct, _DCT_);
           _DCT_ = dct;
           _stk_poke_EXP_(_EMPTY_);
           _stk_zap_CNT_(); }
       else if (siz > 0)
         { _mem_claim_SIZ_(siz);
           tab = _ag_make_TAB_(siz);
           _stk_peek_EXP_(exp);
           _stk_poke_EXP_(tab);
           _stk_push_EXP_(exp);
           _stk_push_EXP_(_ONE_);
           _stk_push_EXP_(exp);
           _stk_poke_CNT_(INI);
           _stk_push_CNT_(EXP); }
       else
         _error_(_SIZ_ERROR_);}
   else
     _error_(_SIZ_ERROR_); }
Ejemplo n.º 8
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ CHG(_NIL_TYPE_)
 { _EXP_TYPE_ dct, val;
   _stk_pop_EXP_(val);
   _stk_peek_EXP_(dct);
   _ag_set_DCT_VAL_(dct, val);
   _stk_poke_EXP_(val);
   _stk_zap_CNT_(); }
Ejemplo n.º 9
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ VAR(_NIL_TYPE_)
 { _EXP_TYPE_ dct, nam, val, var;
   _stk_peek_EXP_(var);
   nam = _ag_get_VAR_NAM_(var);
   _dct_locate_(nam, dct, _DCT_);
   val = _ag_get_DCT_VAL_(dct);
   _stk_poke_EXP_(val);
   _stk_zap_CNT_(); }
Ejemplo n.º 10
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ SET(_NIL_TYPE_)
 { _EXP_TYPE_ arg, dct, exp, fun, idx, inv, nam, set, tab, ltab;
   _TAG_TYPE_ tag;
   _stk_claim_();
   _mem_claim_();
   _stk_peek_EXP_(set);
   inv = _ag_get_SET_INV_(set);
   exp = _ag_get_SET_EXP_(set);
   tag = _ag_get_TAG_(inv);
   switch (tag)
    { case _VAR_TAG_:
        nam = _ag_get_VAR_NAM_(inv);
        _dct_locate_(nam, dct, _DCT_);
        _stk_poke_EXP_(dct);
        _stk_push_EXP_(exp);
        _stk_poke_CNT_(CHG);
        _stk_push_CNT_(EXP);
        break;
      case _APL_TAG_:
        fun = _ag_make_FUN_();
        inv = _ag_get_SET_INV_(set);
        nam = _ag_get_APL_NAM_(inv);
        arg = _ag_get_APL_ARG_(inv);
        _dct_locate_(nam, dct, _DCT_);
        _ag_set_DCT_VAL_(dct, fun);
        _ag_set_FUN_NAM_(fun, nam);
        _ag_set_FUN_ARG_(fun, arg);
        _ag_set_FUN_EXP_(fun, exp);
        _ag_set_FUN_DCT_(fun, _DCT_);
        _stk_poke_EXP_(fun);
        _stk_zap_CNT_();
        break;
      case _TBL_TAG_:
        nam = _ag_get_TBL_NAM_(inv);
        idx = _ag_get_TBL_IDX_(inv);
        _dct_locate_(nam, dct, _DCT_);
        tab = _ag_get_DCT_VAL_(dct);
        _stk_poke_EXP_(tab);
        _stk_push_EXP_(idx);
        _stk_push_EXP_(exp);
        _stk_poke_CNT_(RPL);
        _stk_push_CNT_(SWP);
        _stk_push_CNT_(EXP);
        break;
      case _LTBL_TAG_:
        nam = _ag_get_TBL_NAM_(inv);
        arg = _ag_get_TBL_IDX_(inv);
        _dct_locate_(nam, dct, _DCT_);
        ltab = _ag_get_DCT_VAL_(dct);
        _stk_poke_EXP_(ltab);
        _stk_push_EXP_(exp);
        _stk_push_EXP_(arg);
        _stk_poke_CNT_(LRPL);
        _stk_push_CNT_(EXP);
      break;
      default:
       _error_(_AGR_ERROR_); }}
Ejemplo n.º 11
0
/*-------------------------------------------------------------------------*/
static _NIL_TYPE_ DEF(_NIL_TYPE_)
 { _EXP_TYPE_ arg, dct, def, exp, fun, idx, inv, nam;
   _TAG_TYPE_ tag;
   _stk_claim_();
   _mem_claim_();
   dct = _ag_make_DCT_();
   _stk_peek_EXP_(def);
   inv = _ag_get_DEF_INV_(def);
   exp = _ag_get_DEF_EXP_(def);
   tag = _ag_get_TAG_(inv);
   switch (tag)
    { case _VAR_TAG_:
        nam = _ag_get_VAR_NAM_(inv);
        _ag_set_DCT_NAM_(dct, nam);
        _stk_poke_EXP_(dct);
        _stk_push_EXP_(exp);
        _stk_poke_CNT_(ASS);
        _stk_push_CNT_(EXP);
        break;
      case _APL_TAG_:
        fun = _ag_make_FUN_();
        nam = _ag_get_APL_NAM_(inv);
        arg = _ag_get_APL_ARG_(inv);
        _ag_set_DCT_NAM_(dct, nam);
        _ag_set_DCT_VAL_(dct, fun);
        _ag_set_DCT_DCT_(dct, _DCT_);
        _DCT_ = dct;
        _ag_set_FUN_NAM_(fun, nam);
        _ag_set_FUN_ARG_(fun, arg);
        _ag_set_FUN_EXP_(fun, exp);
        _ag_set_FUN_DCT_(fun, dct);
        _stk_poke_EXP_(fun);
        _stk_zap_CNT_();
        break;
      case _TBL_TAG_:
        nam = _ag_get_TBL_NAM_(inv);
        idx = _ag_get_TBL_IDX_(inv);
        _ag_set_DCT_NAM_(dct, nam);
        _stk_poke_EXP_(dct);
        _stk_push_EXP_(exp);
        _stk_push_EXP_(idx);
        _stk_poke_CNT_(IDX);
        _stk_push_CNT_(EXP);
        break;
      case _LTBL_TAG_:   // Added Lazy Tabulation
        nam = _ag_get_LTBL_NAM_(inv);
        arg = _ag_get_LTBL_ARG_(inv);
        _ag_set_DCT_NAM_(dct, nam);
        _stk_poke_EXP_(dct);
        _stk_push_EXP_(exp);
        _stk_push_EXP_(arg);
        _stk_poke_CNT_(LARG);
        _stk_push_CNT_(EXP);
        break;
      default:
        _error_(_AGR_ERROR_); }}
Ejemplo n.º 12
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ BND(_NIL_TYPE_)
 { _EXP_TYPE_ act, arg, dct, exp, fun, frm, nam, nbr, par, val, xdc;
   _CNT_TYPE_ cnt;
   _TAG_TYPE_ tag;
   _UNS_TYPE_ ctr, siz;
   _stk_claim_();
   _mem_claim_();
   _stk_pop_EXP_(val);
   _stk_pop_EXP_(dct);
   _ag_set_DCT_VAL_(dct, val);
   _stk_pop_EXP_(nbr);
   _stk_pop_EXP_(arg);
   siz = _ag_get_TAB_SIZ_(arg);
   ctr = _ag_get_NBU_(nbr);
   if (ctr == siz)
     { _stk_zap_EXP_();
       _stk_zap_CNT_();
       _stk_peek_CNT_(cnt);
       if (cnt != RET)
         { _stk_peek_EXP_(exp);
           _stk_poke_EXP_(_DCT_);
           _stk_push_EXP_(exp);
           _stk_push_CNT_(RET); }
       _stk_push_CNT_(EXP);
       _DCT_ = dct; }
   else
     { _stk_peek_EXP_(par);
       frm = _ag_get_TAB_EXP_(par, ++ctr);
       act = _ag_get_TAB_EXP_(arg, ctr);
       tag = _ag_get_TAG_(frm);
       _stk_push_EXP_(arg);
       nbr = _ag_succ_NBR_(nbr);
       _stk_push_EXP_(nbr);
       xdc = _ag_make_DCT_();
       _stk_push_EXP_(xdc);
       _ag_set_DCT_DCT_(xdc, dct);
       switch (tag)
        { case _VAR_TAG_:
            nam = _ag_get_VAR_NAM_(frm);
            _ag_set_DCT_NAM_(xdc, nam);
            _stk_push_EXP_(act);
            _stk_push_CNT_(EXP);
            break;
          case _APL_TAG_:
            fun = _ag_make_FUN_();
            nam = _ag_get_APL_NAM_(frm);
            arg = _ag_get_APL_ARG_(frm);
            _ag_set_DCT_NAM_(xdc, nam);
            _ag_set_FUN_NAM_(fun, nam);
            _ag_set_FUN_ARG_(fun, arg);
            _ag_set_FUN_EXP_(fun, act);
            _ag_set_FUN_DCT_(fun, _DCT_);
            _stk_push_EXP_(fun);
             break;
          default:
            _error_(_IPM_ERROR_); }}}
Ejemplo n.º 13
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ ATL(_NIL_TYPE_)
 { _EXP_TYPE_ val, nbr, concreteTab;
   _UNS_TYPE_ pos;
   _mem_claim_();
   _stk_pop_EXP_(val);
   _stk_pop_EXP_(nbr);
   _stk_pop_EXP_(concreteTab);
   _stk_peek_EXP_(_DCT_);
   
   pos = _ag_get_NBU_(nbr);
   _ag_set_TAB_EXP_(concreteTab, pos, val);
   _stk_poke_EXP_(val);
   _stk_zap_CNT_(); 
   }
Ejemplo n.º 14
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ ATA(_NIL_TYPE_)
 { _EXP_TYPE_ act, apl, arg, dct, exp, fun, nam, nbr, par, tab;
   _CNT_TYPE_ cnt;
   _UNS_TYPE_ ctr, siz;
   _mem_claim_();
   fun = _ag_make_FUN_();
   _stk_pop_EXP_(apl);
   _stk_pop_EXP_(nbr);
   _stk_pop_EXP_(tab);
   _stk_pop_EXP_(arg);
   _stk_peek_EXP_(dct);
   siz = _ag_get_TAB_SIZ_(arg);
   ctr = _ag_get_NBU_(nbr);
   act = _ag_get_TAB_EXP_(arg, ctr);
   nam = _ag_get_APL_NAM_(apl);
   par = _ag_get_APL_ARG_(apl);
   _ag_set_FUN_NAM_(fun, nam);
   _ag_set_FUN_ARG_(fun, par);
   _ag_set_FUN_EXP_(fun, act);
   _ag_set_FUN_DCT_(fun, _DCT_);
   _ag_set_TAB_EXP_(tab, ctr, fun);
   if (ctr < siz)
     { _stk_push_EXP_(arg);
       _stk_push_EXP_(tab);
       nbr = _ag_succ_NBR_(nbr);
       _stk_push_EXP_(nbr);
       _stk_push_EXP_(apl); }
   else
     { _ag_set_DCT_VAL_(dct, tab);
       _stk_zap_EXP_();
       _stk_zap_CNT_();
       _stk_peek_CNT_(cnt);
       if (cnt != RET)
         { _stk_peek_EXP_(exp);
           _stk_poke_EXP_(_DCT_);
           _stk_push_EXP_(exp);
           _stk_push_CNT_(RET); }
       _stk_push_CNT_(EXP);
       _DCT_ = dct; }}
Ejemplo n.º 15
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ RPL(_NIL_TYPE_)
 { _EXP_TYPE_ nbr, tab, val;
   _UNS_TYPE_ ctr, siz;
   _TAG_TYPE_ tag;
   _stk_pop_EXP_(nbr);
   _stk_pop_EXP_(val);
   _stk_peek_EXP_(tab);
   tag = _ag_get_TAG_(tab);
   if (TAB_tab[tag])
     { siz = _ag_get_TAB_SIZ_(tab);
       tag = _ag_get_TAG_(nbr);
       if (tag == _NBR_TAG_)
         { ctr = _ag_get_NBU_(nbr);
           if ((ctr > 0) && (ctr <= siz))
             { _ag_set_TAB_EXP_(tab, ctr, val);
               _stk_zap_CNT_(); }
           else
             _error_(_RNG_ERROR_); }
       else
         _error_(_IIX_ERROR_); }
   else
     _error_(_NAT_ERROR_); }
Ejemplo n.º 16
0
/*------------------------------------------------------------------------*/
_NIL_TYPE_ _eval_CAL_(_NIL_TYPE_)
 { _EXP_TYPE_ act, arg, dct, exp, frm, fun, nam, par, tab, xdc, xfu;
   _CNT_TYPE_ cnt;
   _TAG_TYPE_ tag, xtg;
   _UNS_TYPE_ siz, xsz;
   _stk_claim_();
   _stk_peek_EXP_(arg);
   tag = _ag_get_TAG_(arg);
   if (tag != _TAB_TAG_)
     { _stk_zap_EXP_();
       _stk_peek_EXP_(fun);
       _error_msg_(_NAT_ERROR_, _ag_get_FUN_NAM_(fun)); }
   siz = _ag_get_TAB_SIZ_(arg);
   _mem_claim_SIZ_(siz);
   _stk_pop_EXP_(arg);
   if (siz == 0)
     { _stk_peek_EXP_(fun);
       par = _ag_get_FUN_ARG_(fun);
       tag = _ag_get_TAG_(par);
       switch (tag)
         { case _VAR_TAG_:
           case _APL_TAG_:
             dct = _ag_make_DCT_();
             par = _ag_get_FUN_ARG_(fun);
             nam = _ag_get_VAR_NAM_(par);
             _ag_set_DCT_NAM_(dct, nam);
             _ag_set_DCT_VAL_(dct, _EMPTY_);
             xdc = _ag_get_FUN_DCT_(fun);
             _ag_set_DCT_DCT_(dct, xdc);
             break;
           case _TAB_TAG_:
             xsz = _ag_get_TAB_SIZ_(par);
             if (xsz == 0)
               dct = _ag_get_FUN_DCT_(fun);
             else
               _error_msg_(_NMA_ERROR_, _ag_get_FUN_NAM_(fun));
             break;
           default:
             _error_msg_(_IPM_ERROR_, _ag_get_FUN_NAM_(fun)); }
       exp = _ag_get_FUN_EXP_(fun);
       _stk_zap_CNT_();
       _stk_peek_CNT_(cnt);
       if (cnt != RET)
         { _stk_poke_EXP_(_DCT_);
           _stk_push_EXP_(exp);
           _stk_push_CNT_(RET); }
       else
         _stk_poke_EXP_(exp);
       _stk_push_CNT_(EXP);
       _DCT_ = dct; }
   else
     { dct = _ag_make_DCT_();
       _stk_peek_EXP_(fun);
       par = _ag_get_FUN_ARG_(fun);
       exp = _ag_get_FUN_EXP_(fun);
       xdc = _ag_get_FUN_DCT_(fun);
       tag = _ag_get_TAG_(par);
       switch (tag)
         { case _VAR_TAG_:
             nam = _ag_get_VAR_NAM_(par);
             _ag_set_DCT_NAM_(dct, nam);
             _ag_set_DCT_DCT_(dct, xdc);
             _stk_poke_EXP_(exp);
             _stk_push_EXP_(dct);
             _stk_push_EXP_(arg);
             tab = _ag_make_TAB_(siz);
             act = _ag_get_TAB_EXP_(arg, 1);
             _stk_push_EXP_(tab);
             _stk_push_EXP_(_ONE_);
             _stk_push_EXP_(act);
             _stk_poke_CNT_(ATV);
             _stk_push_CNT_(EXP);
             break;
           case _APL_TAG_:
             nam = _ag_get_APL_NAM_(par);
             _ag_set_DCT_NAM_(dct, nam);
             _ag_set_DCT_DCT_(dct, xdc);
             _stk_poke_EXP_(exp);
             _stk_push_EXP_(dct);
             _stk_push_EXP_(arg);
             tab = _ag_make_TAB_(siz);
             _stk_push_EXP_(tab);
             _stk_push_EXP_(_ONE_);
             _stk_push_EXP_(par);
             _stk_poke_CNT_(ATA);
             break;
           case _TAB_TAG_:
             xsz = _ag_get_TAB_SIZ_(par);
             if (siz != xsz)
               _error_msg_(_NMA_ERROR_, _ag_get_FUN_NAM_(fun));
             frm = _ag_get_TAB_EXP_(par, 1);
             xtg = _ag_get_TAG_(frm);
             switch (xtg)
              { case _VAR_TAG_:
                  act = _ag_get_TAB_EXP_(arg, 1);
                  _stk_poke_EXP_(exp);
                  _stk_push_EXP_(par);
                  _stk_push_EXP_(arg);
                  _stk_push_EXP_(_ONE_);
                  nam = _ag_get_VAR_NAM_(frm);
                  _ag_set_DCT_NAM_(dct, nam);
                  _ag_set_DCT_DCT_(dct, xdc);
                  _stk_push_EXP_(dct);
                  _stk_push_EXP_(act);
                  _stk_poke_CNT_(BND);
                  _stk_push_CNT_(EXP);
                  break;
                case _APL_TAG_:
                  xfu = _ag_make_FUN_();
                  par = _ag_get_FUN_ARG_(fun);
                  exp = _ag_get_FUN_EXP_(fun);
                  xdc = _ag_get_FUN_DCT_(fun);
                  act = _ag_get_TAB_EXP_(arg, 1);
                  frm = _ag_get_TAB_EXP_(par, 1);
                  _stk_poke_EXP_(exp);
                  _stk_push_EXP_(par);
                  _stk_push_EXP_(arg);
                  _stk_push_EXP_(_ONE_);
                  nam = _ag_get_APL_NAM_(frm);
                  arg = _ag_get_APL_ARG_(frm);
                  _ag_set_DCT_NAM_(dct, nam);
                  _ag_set_DCT_DCT_(dct, xdc);
                  _stk_push_EXP_(dct);
                  _ag_set_FUN_NAM_(xfu, nam);
                  _ag_set_FUN_ARG_(xfu, arg);
                  _ag_set_FUN_EXP_(xfu, act);
                  _ag_set_FUN_DCT_(xfu, _DCT_);
                  _stk_push_EXP_(xfu);
                  _stk_poke_CNT_(BND);
                   break;
                default:
                  _error_msg_(_IPM_ERROR_, _ag_get_FUN_NAM_(fun)); }
             break;
           default:
             _error_msg_(_IPM_ERROR_, _ag_get_FUN_NAM_(fun)); }}}
Ejemplo n.º 17
0
/*------------------------------------------------------------------------*/
static _NIL_TYPE_ SLF(_NIL_TYPE_)
 { _stk_zap_CNT_(); }
Ejemplo n.º 18
0
/*-------------------------------------------------------------------------*/
static _NIL_TYPE_ LRPL(_NIL_TYPE_)
 { _EXP_TYPE_ dct, arg, xdc, exp, nbr, tab, ltab, newtab, i;
   _UNS_TYPE_ ctr, siz, pos;
   _STR_TYPE_ iname;
   _TAG_TYPE_ tag;
   _stk_pop_EXP_(arg);
   _stk_pop_EXP_(exp);
   _stk_peek_EXP_(ltab);
   tag = _ag_get_TAG_(arg);
   if (tag == _VOI_TAG_)                                    // Assign the new lazy expression
     { _ag_set_LTAB_LZEXP_(ltab, exp);
       _ag_set_LTAB_DCT_(ltab, _DCT_);
       _stk_zap_CNT_(); }
   else if (TAB_tab[tag] && (_ag_get_TAB_SIZ_(arg) == 1))   // Assign new member of concrete part
     { tab = _ag_get_LTAB_CONCR_(ltab);
       siz = _ag_get_TAB_SIZ_(tab);
       nbr = _ag_get_TAB_EXP_(arg, 1);
       tag = _ag_get_TAG_(nbr);
       if (tag == _NBR_TAG_)
         { xdc = _ag_get_LTAB_DCT_(ltab);
           pos = _ag_get_NBU_(nbr);
  
           iname = "i";
           _mem_claim_STR_(iname);
           i = _env_make_NAM_(iname);
           dct = _ag_make_DCT_();
           _ag_set_DCT_NAM_(dct, i);
           _ag_set_DCT_VAL_(dct, nbr);
           _ag_set_DCT_DCT_(dct, xdc);
           _stk_poke_EXP_(_DCT_);
           _DCT_ = dct;
           _stk_push_EXP_(exp);
           _stk_push_EXP_(tab);
           if ((pos > 0) && (pos <= 1073741824))            // greatest positive number represented with 31 bits, greater are negative
             { if (pos > siz) 
                 { ctr = _ag_get_NBU_(nbr);                 // make the counter equal to pos
                   _mem_claim_SIZ_(ctr);                    // create a new concrete table
                   newtab = _ag_make_TAB_(ctr);
                   _ag_set_LTAB_CONCR_(ltab, newtab);
                   exp = _ag_make_LAZY_();                  // fill the new concrete table
                   while (ctr > siz) {                      // first fill with <lazy> members
                      _ag_set_TAB_EXP_(newtab, ctr, exp);
                      ctr--; }
                   while (ctr > 0) {                        // now copy the concrete part
                      exp = _ag_get_TAB_EXP_(tab, ctr);
                      _ag_set_TAB_EXP_(newtab, ctr, exp);
                      ctr--; }
                   _stk_poke_EXP_(newtab);
                 }
               _stk_pop_EXP_(tab);
               _stk_peek_EXP_(exp);
               _stk_poke_EXP_(tab);
               _stk_push_EXP_(nbr);
               _stk_push_EXP_(exp);
               _stk_poke_CNT_(ATL);
               _stk_push_CNT_(EXP);
             }
           else
            _error_(_RNG_ERROR_); }
       else
        _error_(_IIX_ERROR_); }
   else
     _error_(_IAG_ERROR_); }