/* _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");
}
}
/* _mill_p_cast()::
*/
u4_mold
_mill_p_cast(u4_milr m,
u4_gene fes,
u4_gene rum,
u4_mold tip)
{
u4_mold maf = _mill_play(m, fes, tip);
return maf;
}
/* _mill_hunt(): analyze branch test.
**
** Produce (p.type q.form). p is the gain on yes. q is the test.
*/
u4_noun
_mill_hunt(u4_milr m,
u4_type met,
u4_gene nif)
{
u4_lane lane = m->lane;
u4_noun p_nif, q_nif;
if ( u4_b_pq(nif, u4_atom_like, &p_nif, &q_nif) ) {
u4_axis gam = _mill_hook(m, met, p_nif);
u4_type lef = _mill_play(m, met, q_nif);
u4_form maz = _mill_diff(m, gam, lef, met);
if ( u4_n_eq(u4_noun_1, u4_ch(maz)) ) {
return u4_k_cell(lane, u4_atom_blur, maz);
}
else {
u4_type sar = _mill_flap(m, gam, lef);
return u4_k_cell(lane, sar, maz);
}
}
else if ( u4_b_pq(nif, u4_atom_and, &p_nif, &q_nif) ) {
u4_loaf fot = _mill_hunt(m, met, p_nif);
u4_type lep = u4_ch(fot);
u4_form pid = u4_ct(fot);
u4_type rew = _mill_both(m, lep, met);
u4_loaf dof = _mill_hunt(m, rew, q_nif);
u4_type sud = u4_ch(dof);
u4_form ves = u4_ct(dof);
return u4_k_cell(lane, _mill_both(m, lep, sud),
_mill_and(m, pid, ves));
}
else if ( u4_b_pq(nif, u4_atom_or, &p_nif, &q_nif) ) {
u4_noun miv = _mill_hunt(m, met, p_nif);
u4_noun pas = _mill_hunt(m, met, q_nif);
return u4_k_cell(lane, _mill_eith(m, u4_ch(miv), u4_ch(pas)),
_mill_or(m, u4_ct(miv), u4_ct(pas)));
}
else {
u4_noun vob = _mill_open(m, nif);
if ( u4_n_eq(vob, nif) ) {
return u4_k_cell(lane, u4_atom_blur, _mill_make(m, met, nif));
}
else return _mill_hunt(m, met, vob);
}
}
/* _mill_p_quiz()::
*/
u4_mold
_mill_p_quiz(u4_milr m,
u4_gene tes,
u4_gene bif,
u4_gene hob,
u4_mold tip)
{
u4_loaf ruf = _mill_test(m, tes, tip);
u4_nock fal = u4_ct(ruf);
if ( u4_n_eq(u4_noun_1, u4_ch(fal)) ) {
if ( u4_n_eq(u4_noun_0, u4_ct(fal)) ) {
return _mill_play(m, bif, u4_ch(ruf));
} else {
return _mill_play(m, hob, tip);
}
}
else {
u4_mold tuv = _mill_play(m, bif, u4_ch(ruf));
u4_mold miz = _mill_play(m, hob, tip);
return _mill_eith(m, tuv, miz);
}
}
/* _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);
}
}
/* _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;
}
/* _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));
}
}
}
