shrub/f/dash.c

/* f/dash.c
**
** This file is in the public domain.
*/
#include "all.h"

/* _ds_mate(): u2_yes iff `xip` binds to `cor`.
*/
static u2_bean
_ds_mate(u2_noun xip,                                             //  retain
         u2_noun cor)                                             //  retain
{
  u2_noun dac, bat, pet;

  u2_as_trel(xip, &dac, &bat, &pet);

  //  Very important for performance that we mate top-down.
  //  Reason: duplicates are much more common in shallower
  //  batteries, and duplicate comparison is always slow.
  //
  if ( u2_nul != pet ) {
    u2_noun axe = u2_h(pet);
    u2_noun led = u2_t(pet);
    u2_noun ruc = u2_frag(axe, cor);
 
    if ( (u2_none == ruc) || (u2_no == _ds_mate(led, ruc)) ) {
      return u2_no;
    }
  } 

  return u2_sing(bat, u2_h(cor));
}

/* _ds_scan(): linear search for matching chip.
*/
static u2_noun                                                    //  discover
_ds_scan(u2_noun pug,                                             //  retain
         u2_noun cor)                                             //  retain
{
  while ( u2_nul != pug ) {
    u2_noun i_pug = u2_h(pug);

    if ( u2_yes == _ds_mate(i_pug, cor) ) {
      return i_pug;
    }
    pug = u2_t(pug);
  }
  return u2_none;
}

/* u2_ds_find(): find chip by core, or none.
*/
u2_weak                                                           //  senior
u2_ds_find(u2_wire wir_r,
           u2_noun cor)                                           //  retain
{
  if ( u2_no == u2_dust(cor) ) {
    return u2_none;
  } else {
    u2_rail bas_r = u2_wire_bas_r(wir_r);
    u2_noun pug = u2_cs_find(bas_r, u2_wire_des_r(wir_r), 0, u2_h(cor));
    u2_noun out;

    if ( u2_none == pug ) {
      out = u2_none;
    }
    else out = _ds_scan(pug, cor);

    if ( (u2_none == out) && (u2_none != pug) ) {
      fprintf(stderr, "half match\r\n");
    }
    return out;
  }
}

/* _ds_good_cop()::
*/
static u2_bean
_ds_good_cop(u2_noun cop)
{
  c3_w i_w = 0;

  while ( i_w < 4 ) {
    if ( u2_yes == u2_stud(cop) ) {
      return u2_yes;
    } 
    if ( u2_no == u2_stud(u2_h(cop)) ) {
      return u2_no;
    }
    cop = u2_t(cop);
    i_w++;
  }
  return u2_no;
}

/* _ds_good_bud()::
*/
static u2_bean
_ds_good_bud(u2_noun bud)
{
  u2_noun p_bud, q_bud;

  if ( _0 == bud ) {
    return u2_yes;
  }
  else if ( (u2_no == u2_as_cell(bud, &p_bud, &q_bud)) ) {
    return u2_no;
  }
  if ( (u2_nock_bone == p_bud) && (_0 == q_bud) ) {
    return u2_yes;
  }
  if ( (u2_nock_frag == p_bud) && (u2_yes == u2_stud(q_bud)) ) {
    return u2_yes;
  }
  if ( u2_nock_hint == p_bud ) {
    return u2_yes == u2_dust(u2_t(bud)) ? _ds_good_bud(u2_t(u2_t(bud))) : u2_no;
  }
  else return u2_no;
}

/* _ds_good_pic()::
*/
static u2_bean
_ds_good_pic(u2_noun pic)
{
  if ( u2_nul == pic ) {
    return u2_yes;
  } else {
    u2_noun i_pic, t_pic;
    u2_noun pi_pic, qi_pic;

    if ( (u2_no == u2_as_cell(pic, &i_pic, &t_pic)) ||
         (u2_no == u2_as_cell(i_pic, &pi_pic, &qi_pic)) ||
         (u2_no == u2_stud(pi_pic)) )
    {
      return u2_no;
    }
    else return u2_yes;
  }
}

/* _ds_chip(): fabricate chip from clue and core.
*/
static u2_weak                                                    //  senior
_ds_chip(u2_wire wir_r,
         u2_noun clu,                                             //  retain
         u2_noun cor)                                             //  retain
{
  u2_rail bas_r = u2_wire_bas_r(wir_r);
  u2_noun bud_clu, cop_clu, pic_clu;

  if ( (u2_no == u2_as_trel(clu, &bud_clu, &cop_clu, &pic_clu)) ||
       (u2_no == _ds_good_bud(bud_clu)) ||
       (u2_no == _ds_good_cop(cop_clu)) ||
       (u2_no == _ds_good_pic(pic_clu)) )
  {
    return u2_none;
  }
  else {
    u2_noun dac, bat, pet;
 
    /* disc: dac
    */
    {
      if ( u2_none == (dac = u2_rx(bas_r, u2_t(clu))) ) {
        u2_ho_warn_here();
        return u2_none;
      }
    }
#if 1
    /* battery: bat
    */
    {
      if ( u2_none == (bat = u2_rx(bas_r, u2_h(cor))) ) {
        u2_ho_warn_here();
        u2_rz(bas_r, dac); return u2_none;
      }
    }
#endif
#if 0
    /* bat: battery
    */
    {
      // Important to reuse existing battery even if it does not match
      // the whole chip - since battery is a comparison key, we don't
      // want duplicates, which compare slowly.
      //
      if ( u2_nul == pug ) {
        bat = u2_rx(bas_r, u2_h(cor));
      }
      else {
        u2_noun i_pug = u2_h(pug);
        bat = u2_rx(bas_r, u2_h(u2_t(i_pug)));
      }

      if ( u2_none == bat ) {
        u2_ho_warn_here();
        u2_rz(bas_r, dac); return u2_none;
      }
    }
#endif
    /* trunk: pet
    */
    {
      if ( _0 == bud_clu ) {
        pet = u2_nul;
      } 
      else {
        while ( _10 == u2_h(bud_clu) ) {
          bud_clu = u2_t(u2_t(bud_clu));
        }

        if ( _1 == u2_h(bud_clu) ) {
          pet = u2_nul;
        }
        else {
          u2_atom axe = u2_t(bud_clu);
          u2_noun ruc = u2_frag(axe, cor);
          u2_noun led;

          if ( u2_none == ruc ) {
            // u2_err(wir_r, "clu", clu);
            u2_ho_warn_here();
            u2_rz(bas_r, dac); u2_rz(bas_r, bat); return u2_none;
          } else {
            if ( u2_none == (led = u2_ds_find(wir_r, ruc)) ) {
              // u2_err(wir_r, "clu", clu);
              u2_ho_warn_here();
              c3_assert(0);
              u2_rz(bas_r, dac); u2_rz(bas_r, bat); return u2_none;
            }
            pet = u2_rc(bas_r, u2_rx(bas_r, axe), u2_rx(bas_r, led));
          }
        }
      }
    }
    return u2_rt(bas_r, dac, bat, pet);
  }
}

/* u2_ds_mine(): 
**
**   Register and/or save core.
*/
u2_noun                                                           //  transfer
u2_ds_mine(u2_wire wir_r,
           u2_noun clu,                                           //  retain
           u2_noun cor)                                           //  transfer
{
  u2_noun bas_r = u2_wire_bas_r(wir_r);

  if ( u2_no == u2_dust(cor) ) {
    return cor;
  } else {
    u2_noun pay = u2_t(cor);
    u2_noun bat = u2_h(cor);
    u2_noun pug = u2_cs_find(bas_r, u2_wire_des_r(wir_r), 0, bat);
    u2_noun xip, bat_xip;
    u2_noun gop;

    if ( u2_none == pug ) {
      pug = u2_nul;
    }
    if ( u2_none == (xip = _ds_scan(pug, cor)) ) {
      gop = u2_rc(bas_r, (xip = _ds_chip(wir_r, clu, cor)), u2_rx(bas_r, pug));

      if ( u2_none == gop ) {
        return cor;
      } else {
        bat_xip = u2_h(u2_t(xip));

#if 0
        {  
          c3_c* xip_c = u2_ho_cstring(xip);

          fprintf(stderr, "!%s - lent %d\r\n", xip_c, u2_ckb_lent(gop));
          free(xip_c);
        }
#endif
        gop = u2_cs_save(bas_r, u2_wire_des_r(wir_r), 0, bat_xip, gop);
        {
          u2_noun poo = u2_cs_find(bas_r, u2_wire_des_r(wir_r), 0, bat_xip);
         
          {
            _ds_scan(poo, cor);
          }
        }
        u2_rz(bas_r, gop);

      }
    }
    else {
      bat_xip = u2_h(u2_t(xip));
    }

    if ( bat_xip != bat ) {
      u2_noun cyr = u2_rc(wir_r, bat_xip, u2_rx(wir_r, pay));

      if ( u2_none == cyr ) {
        return cor;
      }
      else {
        u2_rz(wir_r, cor);
        return cyr;
      }
    }
    else return cor;
  }
}

/* _ds_leap(): formula from name and chip.
*/
static u2_weak                                                    //  senior
_ds_leap(u2_wire     wir_r,
         u2_noun     xip,                                         //  retain
         const c3_c* tam_c)                                       //  retain
{
  u2_noun dac = u2_h(xip);
  u2_noun pic = u2_t(dac);

  while ( u2_nul != pic ) {
    u2_noun i_pic = u2_h(pic);
    u2_noun t_pic = u2_t(pic);

    if ( u2_yes == u2_sing_c(tam_c, u2_h(i_pic)) ) {
      return u2_t(i_pic);
    }
    else pic = t_pic;
  }
  return u2_none;
}

/* u2_ds_look():
**
**   Produce hook formula from core, or u2_none.
*/
u2_weak                                                           //  produce
u2_ds_look(u2_wire     wir_r,
           u2_noun     cor,                                       //  retain
           const c3_c* tam_c)                                     //  retain
{
  u2_noun xip = u2_ds_find(wir_r, cor);

  if ( u2_none == xip ) {
    return u2_none;
  } 
  else {
    c3_l axe_l = _1;

    while ( 1 ) {
      u2_noun fol = _ds_leap(wir_r, xip, tam_c);

      if ( u2_none == fol ) {
        u2_noun pet = u2_t(u2_t(xip));

        if ( _0 == pet ) {
          // printf("no joy - %s\n", tam_c);
          return u2_none;
        }
        else {
          u2_axis pax = u2_h(pet);

          c3_assert(u2_fly_is_cat(pax));
          c3_assert((u2_ax_dep(axe_l) + u2_ax_dep(pax)) <= 30);

          axe_l = u2_ax_peg(axe_l, pax);
          xip = u2_t(pet);
          continue;
        }
      }
      else {
        if ( _1 != axe_l ) {
          return u2_rt(wir_r, u2_nock_flac,
                              u2_rc(wir_r, u2_nock_frag, axe_l),
                              fol);
        }
        else return fol;
      }
    }
  }
}

/* u2_ds_fire():
**
**   Fire formula from core.
*/
u2_weak                                                           //  produce
u2_ds_fire(u2_wire     wir_r,
           u2_noun     cor,                                       //  retain
           const c3_c* tam_c)                                     //  retain
{
  u2_noun fol = u2_ds_look(wir_r, cor, tam_c);

  if ( u2_none == fol ) {
    return u2_none;
  }
  else {
    u2_noun pro = u2_nk_nock(wir_r, u2_rx(wir_r, cor), fol);

    u2_rz(wir_r, fol);
    return pro;
  }
}