/* _mill_comp(): compose a pipe.
*/
u4_nock
_mill_comp(u4_milr m,
u4_nock mal,
u4_nock buz)
{
u4_lane lane = m->lane;
u4_noun p_mal, p_buz, q_buz, pp_buz, pq_buz;
if ( u4_b_p(mal, u4_noun_0, &p_mal) ) {
if ( u4_b_p(buz, u4_noun_0, &p_buz) ) {
if ( u4_n_zero(p_buz) ) {
return buz;
}
return u4_k_cell(lane, u4_noun_0, u4_op_peg(lane, p_mal, p_buz));
}
else if ( u4_b_pq(buz, u4_noun_3, &p_buz, &q_buz) &&
u4_b_p(p_buz, u4_noun_0, &pp_buz) &&
u4_b_p(q_buz, u4_noun_0, &pq_buz) )
{
return u4_k_trel
(lane, u4_noun_3,
u4_k_cell(lane, u4_noun_0, u4_op_peg(lane, p_mal, pp_buz)),
u4_k_cell(lane, u4_noun_0, u4_op_peg(lane, p_mal, pq_buz)));
}
}
else if ( u4_b_p(buz, u4_noun_0, &p_buz) ) {
if ( u4_n_eq(u4_noun_1, p_buz) ) {
return mal;
}
}
return u4_k_qual(lane, u4_noun_3, mal, u4_noun_1, buz);
}
/* comb:lily
*/
u4_tool
_lily_comb(u4_plow p,
u4_tool mal,
u4_tool buz)
{
u4_lane lan = p->lan;
u4_noun p_mal, q_mal, p_buz, q_buz, pp_buz, pq_buz;
if ( u4_b_p(mal, u4_nock_frag, &p_mal) ) {
if ( u4_b_p(buz, u4_nock_frag, &p_buz) ) {
if ( u4_n_zero(p_buz) ) {
return buz;
}
return u4_kc(lan, u4_nock_frag, u4_op_peg(lan, p_mal, p_buz));
}
else if ( u4_b_pq(buz, u4_nock_sail, &p_buz, &q_buz) &&
u4_b_p(p_buz, u4_nock_frag, &pp_buz) &&
u4_b_p(q_buz, u4_nock_frag, &pq_buz) )
{
return u4_kt
(lan, u4_nock_sail,
u4_kc(lan, u4_nock_frag, u4_op_peg(lan, p_mal, pp_buz)),
u4_kc(lan, u4_nock_frag, u4_op_peg(lan, p_mal, pq_buz)));
}
}
else if ( u4_b_fork(mal, &p_mal, &q_mal) ) {
if ( !u4_n_atom(q_mal) &&
u4_n_eq(u4_noun_0, u4_ch(q_mal)) &&
u4_n_eq(u4_noun_1, u4_ct(q_mal)) )
{
return u4_kt(lan, u4_nock_gant, p_mal, buz);
}
}
else if ( u4_b_p(buz, u4_nock_frag, &p_buz) ) {
if ( u4_n_eq(u4_axis_1, p_buz) ) {
return mal;
}
}
// return u4_kq(lan, u4_nock_sail, mal, u4_nock_bone, buz);
return u4_kt(lan, u4_nock_flac, mal, buz);
}
/* _gate_crib_in()::
*/
static u4_noun
_gate_crib_in(u4_milr m,
u4_axis axe,
u4_noun wix)
{
u4_lane lane = m->lane;
u4_noun i_wix = u4_ch(wix);
u4_noun t_wix = u4_ct(wix);
u4_mark pi_wix = u4_ch(i_wix);
u4_form qi_wix = u4_ct(i_wix);
if ( u4_n_zero(t_wix) ) {
return u4_k_cell
(lane, u4_k_trel
(lane, u4_atom_name,
pi_wix,
u4_k_trel
(lane, u4_atom_mang,
_mill_gate(m, qi_wix),
u4_k_cell(lane, u4_atom_frag, axe))),
u4_noun_0);
}
else {
u4_axis piq = u4_op_peg(lane, axe, u4_noun_2);
u4_axis guz = u4_op_peg(lane, axe, u4_noun_3);
return u4_k_cell
(lane, u4_k_trel
(lane, u4_atom_name,
pi_wix,
u4_k_trel
(lane, u4_atom_mang,
_mill_gate(m, qi_wix),
u4_k_cell(lane, u4_atom_frag, piq))),
_gate_crib_in(m, guz, t_wix));
}
}
/* _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;
}
}
/* _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;
}
