shrub/jets/e/jam.c

/* j/5/jam.c
**
*/
#include "all.h"

/* functions
*/

  static u3_noun
  _jam_pair(u3_noun x, u3_noun d, u3_noun e)
  {
    u3_noun r, p_d, q_d, r_d;
    u3x_trel(d, &p_d, &q_d, &r_d);
    {
      u3_noun y = u3qa_add(x, p_d);
      u3_noun p_e, q_e, r_e;

      u3x_trel(e, &p_e, &q_e, &r_e);
      {
        u3_noun z = u3qa_add(p_d, p_e);

        r = u3nt(u3qa_add(2, z), u3k(q_e), 0);

        u3z(z);
      }
      u3z(y);
    }
    u3z(x);
    u3z(d);
    u3z(e);
    return r;
  }

  static u3_noun
  _jam_flat(u3_atom a, u3_noun l)
  {
    u3_noun d = u3qe_mat(a);
    u3_noun x = u3qa_add(1, u3h(d));
    u3_noun y = u3nt
      (u3k(x), u3nc(u3nc(x, u3qc_lsh(0, 1, u3t(d))), u3k(l)), 0);

    u3z(d);
    u3z(l);

    return y;
  }

  static u3_noun
  _jam_ptr(u3_atom u_c, u3_noun l)
  {
    u3_noun d = u3qe_mat(u_c);
    u3_atom x = u3qc_lsh(0, 2, u3t(d));
    u3_atom y = u3qa_add(2, u3h(d));
    u3_noun z = u3nt
      (u3k(y), u3nc(u3nc(y, u3qc_mix(3, x)), u3k(l)), 0);

    u3z(d);
    u3z(x);
    u3z(l);

    return z;
  }

  #define JAM_NONE 0
  #define JAM_HEAD 1
  #define JAM_TAIL 2

  typedef struct {
    c3_y    sat_y;
    u3_noun nun;
    u3_noun len;
    u3_noun lis;
    u3_noun hed;
  } jamframe;

  static inline jamframe*
  _jam_push(c3_ys mov, c3_ys off)
  {
    u3R->cap_p += mov;
    return u3to(jamframe, u3R->cap_p + off);
  }

  static inline jamframe*
  _jam_pop(c3_ys mov, c3_ys off)
  {
    u3R->cap_p -= mov;
    return u3to(jamframe, u3R->cap_p + off);
  }

  static u3_noun
  _jam_cap(u3_atom a)
  {
    u3p(u3h_root) har_p = u3h_new();
    c3_o          nor_o = u3a_is_north(u3R);
    c3_y          wis_y = c3_wiseof(jamframe);
    c3_ys         mov   = ( c3y == nor_o ? -wis_y : wis_y );
    c3_ys         off   = ( c3y == nor_o ? 0 : -wis_y );
    jamframe*     fam   = _jam_push(mov, off);

    fam->sat_y = JAM_NONE;
    fam->nun   = a;
    fam->len   = 0;
    fam->lis   = u3_nul;

    u3_noun q, r = u3_none;
    c3_w    dep_w;

    for ( dep_w = 1; dep_w > 0; ) {
      switch ( fam->sat_y ) {
        case JAM_NONE: {
          u3_noun nun = fam->nun;
          u3_noun len = fam->len;
          u3_noun lis = fam->lis;
          u3_weak got = u3h_get(har_p, nun);

          if ( u3_none == got ) {
            u3h_put(har_p, nun, u3k(len));
            if ( c3n == u3du(nun) ) {
              r   = _jam_flat(nun, lis);
              fam = _jam_pop(mov, off);
              --dep_w;
              u3z(len);
            }
            else {
              fam->sat_y  = JAM_HEAD;
              fam         = _jam_push(mov, off);
              fam->sat_y  = JAM_NONE;
              fam->nun    = u3h(nun);
              fam->len    = u3qa_add(2, len);
              fam->lis    = u3nc(u3nc(2, 1), lis);
              ++dep_w;
            }
          }
          else {
            if ( c3y == u3ud(nun) && (u3r_met(0, nun) <= u3r_met(0, got)) ) {
              r = _jam_flat(nun, lis);
            }
            else {
              r = _jam_ptr(got, lis);
            }
            fam = _jam_pop(mov, off);
            --dep_w;
            u3z(len);
          }
          break;
        }
        case JAM_HEAD: {
          u3_noun p_r, q_r, r_r;
          u3x_trel(r, &p_r, &q_r, &r_r);
          u3_noun nun = fam->nun;
          fam->sat_y  = JAM_TAIL;
          fam->hed    = r;
          u3_noun z   = u3qa_add(2, fam->len);
          fam         = _jam_push(mov, off);
          fam->sat_y  = JAM_NONE;
          fam->nun    = u3t(nun);
          fam->len    = u3qa_add(z, p_r);
          fam->lis    = u3k(q_r);
          u3z(z);
          ++dep_w;
          break;
        }
        case JAM_TAIL: {
          u3_noun len = fam->len;
          r   = _jam_pair(u3qa_add(2, len), fam->hed, r);
          fam = _jam_pop(mov, off);
          --dep_w;
          u3z(len);
          break;
        }
        default:
          c3_assert(0);
          return u3_none;
      }
    }

    q = u3qb_flop(u3h(u3t(r)));
    u3z(r);
    r = u3qc_can(0, q);
    u3z(q);
    u3h_free(har_p);
    return r;
  }

  u3_noun
  u3qe_jam(u3_atom a)
  {
    return _jam_cap(a);
  }
  u3_noun
  u3we_jam(u3_noun cor)
  {
    u3_noun a;

    if ( (u3_none == (a = u3r_at(u3x_sam, cor))) ) {
      return u3m_bail(c3__fail);
    } else {
      return u3qe_jam(a);
    }
  }
  u3_atom
  u3ke_jam(u3_noun a)
  {
    u3_atom b = u3qe_jam(a);

    u3z(a);
    return b;
  }