Beispiel #1
0
/* _mill_m_cast()::
*/
u4_loaf
_mill_m_cast(u4_milr m, 
             u4_gene fes,
             u4_gene rum, 
             u4_mold tip)
{
  u4_lane lane = m->lane;
  u4_mold maf  = _mill_play(m, fes, tip);
  u4_loaf kib  = _mill_make(m, rum, tip);

#if 0
  if ( !u4_n_zero(m->rux) ) {
    u4_burp(m->lane, "cast: m: kib", _mill_dump(m, u4_ch(kib)));
    u4_burp(m->lane, "cast: m: maf", _mill_dump(m, maf));
  }
#endif

  if ( _mill_nest(m, u4_ch(kib), maf) ) {
    return u4_k_cell(lane, maf, u4_ct(kib));
  }
  else {
    // u4_burp(lane, "cast: maf", _mill_dump(m, maf));
    // u4_burp(lane, "cast: kib", _mill_dump(m, u4_ch(kib)));
    // return _mill_fail(m, "cast failure - not every kib is a maf");

    return _mill_fail(m, "cast failure");
  }
}
Beispiel #2
0
/* _lump_pick()::
*/
static u4_gene
_lump_pick(u4_milr m,
           u4_noun bec)
{
  u4_lane lane = m->lane;

  if ( u4_n_zero(bec) ) {
    return _mill_fail(m, "pick: empty");
  }
  else {
    u4_form hem = u4_ch(bec);

    return u4_k_trel
      (lane,
       u4_atom_trop,
       u4_k_trel
        (lane, 
         u4_atom_cast,
         u4_k_cell(lane, u4_atom_crad, u4_noun_0),
         _mill_lump(m, hem)),
       u4_k_trel
        (lane,
         u4_atom_gril,
         u4_k_cell(lane, u4_k_cell(lane, u4_atom_frag, u4_noun_2), u4_noun_0),
         _lump_pick_in(m, bec)));
  }
}
Beispiel #3
0
/* _mill_b_like()::
*/
u4_nock
_mill_b_like(u4_milr m, 
             u4_rope rid,
             u4_gene bul, 
             u4_mold tip)
{
  u4_loaf fod  = _mill_look(m, rid, tip);
  u4_mold gan  = _mill_play(m, bul, tip);
  u4_axis axe;

  if ( !u4_b_p(u4_ct(fod), u4_noun_0, &axe) ) {
    return _mill_fail(m, "fat like");
  }
  else {
    return _mill_fish(m, axe, gan);
  }
}
Beispiel #4
0
/* _gate_pick()::
*/
static u4_gene
_gate_pick(u4_milr m,
           u4_noun bec)
{
  u4_lane lane = m->lane;

  if ( u4_n_zero(bec) ) {
    return _mill_fail(m, "pick: empty");
  }
  else {
    u4_form hem = u4_ch(bec);

    return u4_k_qual
      (lane,
       u4_atom_trop,
       _gate_arg(m, hem),
       u4_atom_lome,
       u4_k_trel
        (lane,
         u4_atom_gril,
         u4_k_cell(lane, u4_k_cell(lane, u4_atom_frag, u4_noun_4), u4_noun_0),
         _gate_pick_in(m, bec)));
  }
}
Beispiel #5
0
/* _mill_repo(): replay load.
*/
u4_type
_mill_repo(u4_milr m,
           u4_type tip,
           u4_gene gen)
{
  u4_lane lane = m->lane;
  u4_noun fad = u4_k_cell(lane, tip, gen);
  u4_noun fan;
  u4_type pol;

  if ( u4_bag_in(fad, m->fan) ) {
    // printf("inference recursion\n");
    // abort();

    return _mill_fail(m, "repo: inference recursion");
  }

  fan = m->fan;
  m->fan = u4_bag_add(lane, fad, m->fan);
  pol = _mill_play(m, gen, tip);
  m->fan = fan;

  return pol;
}
Beispiel #6
0
/* _mill_hunt(): rope to tape.
*/
u4_tape
_mill_hunt(u4_milr m,
           u4_rope dap,
           u4_type fim,
           u4_axis *axe,
           u4_type *buv)
{
  u4_lane lane = m->lane;

  if ( u4_n_zero(dap) ) {
    if ( buv ) {
      *buv = fim;
    }
    return u4_noun_0;
  }
  else {
    u4_knot i_dap = u4_ch(dap);
    u4_rope t_dap = u4_ct(dap);
    u4_axis mar;
    u4_tick tik;
    u4_term cox;

    if ( _is_frag(i_dap, &mar) ) {
      u4_type gey = _mill_peek(m, mar, u4_noun_0, fim);

      *axe = u4_op_peg(lane, *axe, mar);

      return u4_k_cell
        (lane, u4_k_cell(lane, u4_atom_axis, mar),
               _mill_hunt(m, t_dap, gey, axe, buv));
    }
    else if ( _is_lect(i_dap, &tik, &cox) ) {
      u4_loaf zib = _mill_find(m, cox, u4_noun_0, fim);

      if ( u4_n_zero(zib) ) {
        u4_burp(lane, "mark", u4_prep_textual(lane, cox));
        u4_burp(lane, "type", _mill_dump(m, fim));

        return _mill_fail(m, "look: no port");
      }
      else {
        u4_type gey = u4_ch(zib);
   
        if ( !u4_b_p(u4_ct(zib), u4_noun_0, &mar) ) {
          return _mill_fail(m, "heavy rope");
        }
        else {
          u4_rope guz;

          guz = u4_n_zero(tik)
            ? t_dap
            : u4_k_cell
              (lane, u4_k_trel(lane, u4_atom_lect, u4_op_dec(lane, tik), cox),
                     t_dap);

          *axe = u4_op_peg(lane, *axe, mar);

          if ( u4_n_eq(u4_noun_1, mar) ) {
            return u4_k_cell
              (lane, u4_k_cell(lane, u4_atom_term, cox),
                     _mill_hunt(m, guz, gey, axe, buv));
          }
          else {
            return u4_k_trel
              (lane, u4_k_cell(lane, u4_atom_axis, mar),
                     u4_k_cell(lane, u4_atom_term, cox),
                     _mill_hunt(m, guz, gey, axe, buv));
          }
        }
      }
    }
    else return u4_trip;
  }
}
Beispiel #7
0
/* _safe_loop(): check type, inside memoization.
*/
static u4_t
_safe_loop(u4_milr m,
           u4_bag  gil,
           u4_type naf,
           u4_gene dug)
{
  u4_lane lane = m->lane;

  /* Recursion control.
  */
  {
    u4_noun mel = u4_k_cell(lane, naf, dug);

    if ( u4_bag_in(mel, gil) ) {
      /* Conservative search.
      */
      return 1;
    }
    else {
      gil = u4_bag_add(lane, mel, gil);
    }
  }

  /* Core semantics.
  */
  {
    u4_noun p_dug, q_dug, r_dug;

    if ( u4_b_fork(dug, &p_dug, &q_dug) ) {
      return _mill_safe_in(m, gil, naf, p_dug) && 
             _mill_safe_in(m, gil, naf, q_dug);
    }

    else if ( u4_b_pq(dug, u4_atom_bend, &p_dug, &q_dug) ) {
      return _mill_suss(m, gil, naf, p_dug, q_dug);
    }

    else if ( u4_b_pq(dug, u4_atom_cast, &p_dug, &q_dug) ) {
      if ( !_mill_safe_in(m, gil, naf, p_dug) || 
           !_mill_safe_in(m, gil, naf, q_dug) )
      {
        return 0;
      }
      else {
        u4_type lup = _mill_play(m, naf, p_dug);
        u4_type tog = _mill_play(m, naf, q_dug);

        if ( !_mill_cong(m, lup, tog) ) {
          // u4_burp(lane, "cast: lup", _mill_dump(m, lup));
          // u4_burp(lane, "cast: tog", _mill_dump(m, tog));

          _mill_fail(m, "cast infraction");
          return 0;
        }
        return 1;
      }
    }
  
    else if ( u4_b_pq(dug, u4_atom_coat, &p_dug, &q_dug) ) {
      return _mill_safe_in(m, gil, naf, q_dug);
    }

    else if ( u4_b_p(dug, u4_atom_dbug, &p_dug) ) {
      u4_t gaf;

      m->rux = u4_op_inc(lane, m->rux);
      gaf = _mill_safe_in(m, gil, naf, p_dug);
      m->rux = u4_op_dec(lane, m->rux);

      return gaf;
    }

    else if ( u4_b_pqr(dug, u4_atom_if, &p_dug, &q_dug, &r_dug) ) {
      if ( !_mill_safe_in(m, gil, naf, p_dug) ) {
        return 0;
      }
      else {
        u4_type lag = _mill_play(m, naf, p_dug);

        if ( !_mill_cong(m, _flag(lane), lag) ) {
          return _mill_fail(m, "if abuse");
        }
        else {
          u4_loaf ruf = _mill_hunt(m, naf, p_dug);
          u4_type sec = u4_ch(ruf);
          u4_form nak = u4_ct(ruf);
    
          if ( u4_n_eq(u4_noun_1, u4_ch(nak)) ) {
            if ( u4_n_eq(u4_noun_0, u4_ct(nak)) ) {
              return _mill_safe_in(m, gil, naf, q_dug);
            } else {
              return _mill_safe_in(m, gil, naf, r_dug);
            }
          }
          else {
            return _mill_safe_in(m, gil, _mill_both(m, sec, naf), q_dug) && 
                   _mill_safe_in(m, gil, naf, r_dug);
          }
        }
      }
    }
  
    else if ( u4_b_pq(dug, u4_atom_like, &p_dug, &q_dug) ) {
      if ( !_mill_safe_in(m, gil, naf, p_dug) || 
           !_mill_safe_in(m, gil, naf, q_dug) )
      {
        return 0;
      }
      else {
#if 0
        u4_type fez = _mill_play(m, naf, p_dug);
        u4_type gar = _mill_play(m, naf, q_dug);

        if ( !_mill_cong(m, fez, gar) && !_mill_orth(m, fez, gar) ) {
          _mill_fail(m, "like confusion");
          return 0;
        }
#endif
        return 1;
      }
    }

    else if ( u4_b_p(dug, u4_atom_limb, &p_dug) ) {
      return 1;
    }

    else if ( u4_b_pq(dug, u4_atom_link, &p_dug, &q_dug)) {
      if ( !_mill_safe_in(m, gil, naf, p_dug) ) {
        return 0;
      }
      else return _mill_safe_in(m, gil, _mill_play(m, naf, p_dug), q_dug);
    }

    else if ( u4_b_p(dug, u4_atom_load, &p_dug) ) {
      u4_type roz = u4_k_trel(lane, u4_atom_cone, naf, p_dug);

      return _main_load(m, gil, roz, p_dug);
    }
  
    else if (u4_b_pq(dug, u4_atom_look, &p_dug, &q_dug) ) {
      return _mill_peek(m, gil, naf, p_dug, q_dug);
    }

    else if ( u4_b_pq(dug, u4_atom_raw, &p_dug, &q_dug) ) {
      if ( !_mill_safe_in(m, gil, naf, q_dug) ) {
        return 0;
      }
      else {
        if ( u4_n_eq(u4_noun_3, p_dug) || u4_n_eq(u4_noun_4, p_dug) ) {
          return 1;
        }
        else if ( u4_n_eq(u4_noun_5, p_dug) ) {
          u4_type poz = _mill_play(m, naf, q_dug);

          if ( !_mill_cong(m, u4_atom_atom, poz) ) {
            return _mill_fail(m, "raw bump");
          }
          else return 1;
        }
        else if ( u4_n_eq(u4_noun_6, p_dug) ) {
          u4_type lem = u4_k_trel
            (lane, u4_atom_pair, u4_atom_blur, u4_atom_blur);
          u4_type poz = _mill_play(m, naf, q_dug);

          if ( !_mill_cong(m, lem, poz) ) {
            return _mill_fail(m, "raw same");
          }
          else return 1;
        }
        else return u4_trip;
      }
    }
  
    else if ( u4_b_p(dug, u4_atom_rock, &p_dug) ) {
      return 1;
    }

    else if ( u4_b_pq(dug, u4_atom_site, &p_dug, &q_dug) ) {
      u4_noun fob = m->zud;
      u4_t    gaf;

      m->zud = p_dug;
      gaf = _mill_safe_in(m, gil, naf, q_dug);
      m->zud = fob;

      return gaf;
    }

    else if ( u4_b_pq(dug, u4_atom_spot, &p_dug, &q_dug) ) {
      u4_noun fob = m->nix;
      u4_t    gaf;

      m->nix = p_dug;
      gaf = _mill_safe_in(m, gil, naf, q_dug);
      m->nix = fob;

      return gaf;
    }
  
    else if ( u4_b_pqr(dug, u4_atom_sure, &p_dug, &q_dug, &r_dug) ) {
      if ( !_mill_safe_in(m, gil, naf, p_dug) || 
           !_mill_safe_in(m, gil, naf, q_dug) )
      {
        return 0;
      }
      else {
        u4_type lop = _mill_play(m, naf, p_dug);
        u4_type huq = _mill_play(m, naf, q_dug);

        if ( !_mill_cong(m, huq, lop) ) {
          return _mill_fail(m, "sure violation");
        }
        else {
          return _mill_safe_in(m, gil, naf, r_dug);
        }
      }
    }
  
    else {
      return _mill_safe_in(m, gil, naf, _mill_open(m, dug));
    }
  }
}
Beispiel #8
0
/* _look_knot(): read a step on a rope.
*/
u4_loaf
_look_knot(u4_milr m,
           u4_knot vor,
           u4_mold typ)
{
  u4_lane lane = m->lane;
  u4_tick tik;
  u4_term cox;
  u4_axis axe;
  u4_loaf fod;

  if ( _is_port(vor, &tik, &cox) ) {
    fod = _mill_find(m, cox, u4_noun_0, typ);

    if ( u4_n_zero(fod) ) {
      u4_burp(lane, "mold", _mill_dump(m, typ));
      u4_burp(lane, "mark", u4_prep_textual(lane, cox));

      return _mill_fail(m, "look: not found");
    }
    else if ( u4_n_zero(tik) ) {
      return fod;
    }
    else {
      u4_mold lem = u4_ch(fod);
      u4_nock vil = u4_ct(fod);
      u4_noun p_vil;
      u4_mold ger;

      vor = u4_k_trel(lane, u4_atom_port, u4_op_dec(lane, tik), cox);

      if ( u4_b_p(vil, u4_noun_0, &axe) ) {
        ger = lem;
      }
      else if ( u4_b_pq(vil, u4_noun_3, &p_vil, 0) &&
                u4_b_p(p_vil, u4_noun_0, &axe) &&
                u4_b_pq(lem, u4_atom_hold, &ger, 0) )
      {
        axe = u4_op_peg(lane, axe, u4_noun_2);
        vil = u4_k_cell(lane, u4_noun_0, axe);
        ger = _mill_peek(m, u4_noun_2, u4_noun_0, ger);
      }
      else return u4_trip;

      fod = _look_knot(m, vor, ger);

      if ( u4_n_zero(fod) ) {
        u4_burp(lane, "mold", _mill_dump(m, typ));
        u4_burp(lane, "mark", u4_prep_textual(lane, cox));

        return _mill_fail(m, "look: no grip");
      }
      else {
        return u4_k_cell
          (lane, u4_ch(fod), _mill_comp(m, vil, u4_ct(fod)));
      }
    }
  }
  else if ( _is_frag(vor, &axe) ) {
    return u4_k_trel
      (lane, _mill_peek(m, axe, u4_noun_0, typ), 
             u4_noun_0, 
             axe);
  }
  else return u4_trip;
}