u4_log_at(u4_log log,
u4_atom n)
{
/* Applies only for a 32-bit system.
*/
if ( u4_a_bin(n, 5) > 1 ) {
return u4_bull;
}
else {
u4_xw xw_n = u4_a_wbail(n, u4_bail_trip);
while ( xw_n ) {
if ( u4_n_atom(log) ) {
return u4_bull;
}
else log = u4_ct(log);
xw_n--;
}
if ( u4_n_atom(log) ) {
return u4_bull;
}
else return u4_ch(log);
}
}
/* _bi_import(): import a noun from u4 to u3.
*/
static u3_rat
_bi_import(u3_l l,
u4_noun fob)
{
if ( u4_n_atom(fob) ) {
mpz_t mp_fob;
u4_a_gmp(fob, mp_fob);
return u3_ln_mp(l, mp_fob);
}
else {
return u3_ln_cell(l, _bi_import(l, u4_ch(fob)),
_bi_import(l, u4_ct(fob)));
}
}
/* _is_lect()::
*/
static u4_t
_is_lect(u4_knot sod,
u4_tick *tik,
u4_term *cox)
{
if ( u4_n_atom(sod) ) {
if ( tik ) *tik = u4_noun_0;
if ( cox ) *cox = sod;
return 1;
}
else if ( u4_b_pq(sod, u4_atom_lect, tik, cox) ) {
return 1;
}
else return 0;
}
/* _flay_main(): flay, with loop control.
*/
static u4_type
_flay_main(u4_milr m,
u4_bag hed,
u4_type naf)
{
u4_noun p_naf, q_naf;
if ( u4_n_atom(naf)
|| u4_b_p(naf, u4_atom_cube, 0)
|| u4_b_pq(naf, u4_atom_bone, &p_naf, &q_naf)
|| u4_b_pq(naf, u4_atom_cone, &p_naf, &q_naf)
|| u4_b_pq(naf, u4_atom_pair, &p_naf, &q_naf) )
{
return naf;
}
else if ( u4_b_pq(naf, u4_atom_fork, &p_naf, &q_naf) ) {
return _mill_eith(m, _flay_main(m, hed, p_naf),
_flay_main(m, hed, q_naf));
}
else if ( u4_b_pq(naf, u4_atom_fuse, &p_naf, &q_naf) ) {
return _mill_both(m, _flay_main(m, hed, p_naf),
_flay_main(m, hed, q_naf));
}
else if ( u4_b_pq(naf, u4_atom_post, &p_naf, &q_naf) ) {
if ( u4_bag_in(naf, hed) ) {
return naf;
}
else {
hed = u4_bag_add(m->lane, naf, hed);
{
u4_type tey = _mill_repo(m, p_naf, q_naf);
u4_type mal = _flay_main(m, hed, tey);
return (u4_n_eq(tey, mal) ? naf : mal);
}
}
}
else {
return _flay_main(m, hed, _mill_reap(m, naf));
}
}
u4_tack
_lark_nuke(u4_plow p,
u4_type sut,
u4_tack tac,
u4_rope rop,
u4_type feg)
{
u4_lane lan = p->lan;
if ( u4_n_zero(rop) ) {
return u4_k_cell(lan, u4_atom_leaf, feg);
}
else {
u4_cord i_rop = u4_ch(rop);
u4_rope t_rop = u4_ct(rop);
u4_noun pi_rop;
if ( u4_n_atom(i_rop) ) {
return _lark_nuke
(p, sut,
tac,
u4_k_cell(lan, u4_k_cell(lan, u4_atom_pane, rop), t_rop),
feg);
}
else if ( u4_b_p(i_rop, u4_atom_pane, &pi_rop) ) {
u4_plan lar = _iris_find(p, sut, u4_nul, u4_axis_1, pi_rop);
u4_axis p_lar = u4_ch(lar);
u4_unit q_lar = u4_ch(u4_ct(lar));
u4_type r_lar = u4_ct(u4_ct(lar));
return _lark_nuke_port
(p, sut, tac, t_rop, feg, pi_rop, p_lar, q_lar, r_lar);
}
else if ( u4_b_p(i_rop, u4_atom_frag, &pi_rop) ) {
u4_type gur = _iris_peek(p, sut, u4_nul, u4_axis_1, pi_rop);
return _lark_nuke_frag(p, sut, tac, t_rop, feg, pi_rop, gur);
}
else return u4_trip;
}
}
/* 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);
}
static u4_nopt
_put(u4_lane lane,
u4_twig twig,
u4_noun a,
u4_noun b,
u4_pt pt)
{
if ( pt == 0 ) {
return u4_k_safe(lane, a);
}
else {
pt -= 1;
{
if ( u4_n_atom(b) ) {
return u4_bull;
}
else {
u4_noun head = u4_ch(b);
u4_noun tail = u4_ct(b);
if ( 0 == u4_a_bit(twig, pt) ) {
u4_noun put_head = _put(lane, twig, a, head, pt);
if ( u4_bull == put_head ) {
return u4_bull;
}
else return u4_k_cell(lane, put_head, tail);
}
else {
u4_noun put_tail = _put(lane, twig, a, tail, pt);
if ( u4_bull == put_tail ) {
return u4_bull;
}
else return u4_k_cell(lane, head, put_tail);
}
}
}
}
}
/* _nock_pure_leak(): as u4_nock_pure(), leaking on (lane).
*/
static u4_noun
_nock_pure_leak(u4_lane lane,
u4_noun sub,
u4_noun form)
{
u4_noun form_2 = u4_chx(form);
u4_noun form_3 = u4_ctx(form);
if ( u4_n_cell(form_2) ) {
u4_noun pro_a = _nock_pure_leak(lane, sub, form_2);
u4_noun pro_b = _nock_pure_leak(lane, sub, form_3);
return u4_k_cell(lane, pro_a, pro_b);
}
else {
switch ( u4_a_wbail(form_2, u4_bail_exit) ) {
default: return u4_exit;
case 0: {
if ( u4_n_atom(form_3) ) {
u4_noun pro = u4_n_snip_(form_3, sub);
return (u4_bull == pro) ? u4_exit : u4_k_safe(lane, pro);
}
else return u4_bull;
}
case 1: {
return u4_k_safe(lane, form_3);
}
case 2: {
u4_noun form_6 = u4_chx(form_3);
u4_noun form_7 = u4_ctx(form_3);
{
u4_noun pro_a = _nock_pure_leak(lane, sub, form_6);
u4_noun pro_b = u4_n_eq(u4_noun_0, pro_a)
? _nock_pure_leak(lane, sub, u4_chx(form_7))
: u4_n_eq(u4_noun_1, pro_a)
? _nock_pure_leak(lane, sub, u4_ctx(form_7))
: u4_exit;
return pro_b;
}
}
case 3: {
u4_noun pro_a = _nock_pure_leak(lane, sub, form_3);
u4_noun pro_b = _nock_pure_leak(lane, u4_chx(pro_a), u4_ctx(pro_a));
return pro_b;
}
case 4: {
u4_noun pro_a = _nock_pure_leak(lane, sub, form_3);
u4_noun pro_b = u4_n_atom(pro_a) ? u4_noun_1 : u4_noun_0;
return pro_b;
}
case 5: {
u4_noun pro_a = _nock_pure_leak(lane, sub, form_3);
u4_noun pro_b = u4_n_cell(pro_a)
? u4_exit
: u4_op_inc(lane, pro_a);
return pro_b;
}
case 6: {
u4_noun pro_a = _nock_pure_leak(lane, sub, form_3);
u4_noun pro_b = u4_n_eq(u4_chx(pro_a), u4_ctx(pro_a))
? u4_noun_0
: u4_noun_1;
return pro_b;
}
}
}
}
/* _peek_main(): peek, with gil.
*/
u4_mold
_peek_main(u4_milr m,
u4_axis axe,
u4_bag gil,
u4_rail bar,
u4_mold tip)
{
u4_lane lane = m->lane;
u4_axis sud = u4_op_tip(axe);
u4_axis hec = u4_op_tap(lane, axe);
u4_noun p_tip, q_tip;
if ( u4_n_eq(u4_noun_1, axe) ) {
return tip;
}
else {
// %atom
//
if ( u4_n_eq(u4_atom_atom, tip) ) {
return u4_atom_blot;
}
// %blot
//
else if ( u4_n_eq(u4_atom_blot, tip) ) {
return u4_atom_blot;
}
// %blur
//
else if ( u4_n_eq(u4_atom_blur, tip) ) {
return u4_atom_blur;
}
// [%cell p=mold q=mold]
//
else if ( u4_b_pq(tip, u4_atom_cell, &p_tip, &q_tip) ) {
u4_mold gan;
if ( u4_n_eq(u4_noun_2, sud) ) {
gan = p_tip;
}
else gan = q_tip;
return _peek_main(m, hec, u4_noun_0, _mill_slip(m, sud, bar), gan);
}
// [%mono p=mold q={bush term mold}]
// [%poly p=mold q={bush term mold}]
//
else if ( u4_b_pq(tip, u4_atom_mono, &p_tip, &q_tip) ||
u4_b_pq(tip, u4_atom_poly, &p_tip, &q_tip) ) {
if ( u4_n_eq(u4_noun_2, sud) ) {
return _peek_main(m, hec, u4_noun_0, _mill_slip(m, sud, bar), p_tip);
}
else return u4_atom_blur;
}
// [%cube p=noun]
//
else if ( u4_b_p(tip, u4_atom_cube, &p_tip) ) {
if ( u4_n_atom(p_tip) ) {
return u4_atom_blot;
}
else return _peek_main(m, axe, gil, bar, _mill_reap(m, tip));
}
// [%face p=mark q=mold]
//
else if ( u4_b_pq(tip, u4_atom_face, &p_tip, &q_tip) ) {
return _peek_main(m, axe, gil, bar, q_tip);
}
// [%fork p=mold q=mold]
//
else if ( u4_b_pq(tip, u4_atom_fork, &p_tip, &q_tip) ) {
if ( _mill_cull(m, bar, p_tip) ) {
return _peek_main(m, axe, gil, bar, q_tip);
}
else if ( _mill_cull(m, bar, q_tip) ) {
return _peek_main(m, axe, gil, bar, p_tip);
}
else return _mill_eith
(m, _peek_main(m, axe, gil, bar, p_tip),
_peek_main(m, axe, gil, bar, q_tip));
}
// [%fuse p=mold q=mold]
//
else if ( u4_b_pq(tip, u4_atom_fuse, &p_tip, &q_tip) ) {
return _mill_both
(m, _peek_main(m, axe, gil, bar, p_tip),
_peek_main(m, axe, gil, u4_k_cell(lane, p_tip, bar), q_tip));
}
// [%hold p=mold q=gene]
//
else if ( u4_b_pq(tip, u4_atom_hold, &p_tip, &q_tip) ) {
if ( u4_bag_in(tip, gil) ) {
return u4_atom_blot;
}
else return _peek_main(m, axe, gil, bar, _mill_repo(m, p_tip, q_tip));
}
else return u4_trip;
}
}
