## replace-unlimited-precision-int-ops-in-nextcode.pkg
# Compiled by:
# src/lib/compiler/core.sublib# Expand out any remaining occurrences
# of test_inf, trunc_inf, extend_inf,
# and copy_inf.
#
# These primops carry a second argument
# which is a function that performs the
# operation for 32 bit precision.
### "John von Neumann was the only
### student I was ever afraid of."
###
### -- George Pólya,
stipulate
package ncf = nextcode_form; # nextcode_form is from src/lib/compiler/back/top/nextcode/nextcode-form.pkg package tmp = highcode_codetemp; # highcode_codetemp is from src/lib/compiler/back/top/highcode/highcode-codetemp.pkgherein
package replace_unlimited_precision_int_ops_in_nextcode
: (weak)
api {
replace_unlimited_precision_int_ops_in_nextcode
:
{ function: ncf::Function,
mk_kvar: Void -> tmp::Codetemp, # Make new fate var.
mk_i32var: Void -> tmp::Codetemp # Make new one_word_int var.
}
->
ncf::Function;
}
{
fun replace_unlimited_precision_int_ops_in_nextcode
{
function,
mk_kvar,
mk_i32var
}
=
do_function function
where
fun do_function (fk, f, vl, tl, e)
=
(fk, f, vl, tl, cexp e)
also
fun cexp (ncf::DEFINE_RECORD { kind, fields, to_temp, next })
=> ncf::DEFINE_RECORD { kind, fields, to_temp, next => cexp next };
#
cexp (ncf::GET_FIELD_I { i, record, to_temp, type, next })
=> ncf::GET_FIELD_I { i, record, to_temp, type, next => cexp next };
#
cexp (ncf::GET_ADDRESS_OF_FIELD_I { i, record, to_temp, next })
=> ncf::GET_ADDRESS_OF_FIELD_I { i, record, to_temp, next => cexp next };
cexp (ncf::TAIL_CALL funargs) => ncf::TAIL_CALL funargs;
cexp (ncf::DEFINE_FUNS { funs, next }) => ncf::DEFINE_FUNS { funs => map do_function funs, next => cexp next };
cexp (ncf::JUMPTABLE { i, xvar, nexts }) => ncf::JUMPTABLE { i, xvar, nexts => map cexp nexts };
#
cexp (ncf::IF_THEN_ELSE { op, args, xvar, then_next, else_next })
=>
ncf::IF_THEN_ELSE { op, args, xvar, then_next => cexp then_next,
else_next => cexp else_next
};
cexp (ncf::STORE_TO_RAM { op, args, next }) => ncf::STORE_TO_RAM { op, args, next => cexp next };
cexp (ncf::FETCH_FROM_RAM { op, args, to_temp, type, next }) => ncf::FETCH_FROM_RAM { op, args, to_temp, type, next => cexp next };
cexp (ncf::PURE { op => ncf::p::COPY_TO_INTEGER 32,
args => [x, fn],
to_temp,
type,
next
}
)
=>
{ k = mk_kvar ();
#
next = cexp next;
ncf::DEFINE_FUNS { funs => [(ncf::FATE_FN, k, [to_temp], [type], next)],
#
next => ncf::TAIL_CALL { fn,
args => [ncf::CODETEMP k, x, ncf::INT 0]
}
};
};
cexp (ncf::PURE { op => ncf::p::STRETCH_TO_INTEGER 32,
args => [x, fn],
to_temp,
type,
next
}
)
=>
{ k = mk_kvar ();
next = cexp next;
ncf::DEFINE_FUNS { funs => [(ncf::FATE_FN, k, [to_temp], [type], next)],
#
next => ncf::TAIL_CALL { fn, args => [ncf::CODETEMP k, x, ncf::INT 1] }
};
};
cexp ( ncf::ARITH { op => ncf::p::SHRINK_INTEGER 32, args => [x, fn], to_temp, type, next }
| ncf::PURE { op => ncf::p::CHOP_INTEGER 32, args => [x, fn], to_temp, type, next }
)
=>
{ k = mk_kvar ();
next = cexp next;
ncf::DEFINE_FUNS { funs => [(ncf::FATE_FN, k, [to_temp], [type], next)],
next => ncf::TAIL_CALL { fn, args => [ncf::CODETEMP k, x] }
};
};
cexp (ncf::ARITH { op => ncf::p::SHRINK_INTEGER i,
args => [x, fn],
to_temp,
type,
next
}
)
=>
{ k = mk_kvar ();
v' = mk_i32var ();
next = cexp next;
ncf::DEFINE_FUNS
{
funs =>
[ ( ncf::FATE_FN,
k,
[v'],
[ncf::typ::INT1],
ncf::ARITH
{ op => ncf::p::SHRINK_INT (32, i),
args => [ncf::CODETEMP v'],
to_temp,
type,
next
}
)
],
next => ncf::TAIL_CALL { fn, args => [ncf::CODETEMP k, x] }
};
};
cexp (ncf::ARITH { op, args, to_temp, type, next })
=> ncf::ARITH { op, args, to_temp, type, next => cexp next };
cexp (ncf::PURE { op => ncf::p::CHOP_INTEGER i,
args => [x, fn],
to_temp,
type,
next
}
)
=>
{ k = mk_kvar ();
v' = mk_i32var ();
next = cexp next;
ncf::DEFINE_FUNS
{
funs =>
[ ( ncf::FATE_FN,
k,
[v'],
[ncf::typ::INT1],
ncf::PURE
{ op => ncf::p::CHOP (32, i),
args => [ncf::CODETEMP v'],
to_temp,
type,
next
}
)
],
#
next => ncf::TAIL_CALL { fn, args => [ncf::CODETEMP k, x] }
};
};
cexp (ncf::PURE { op => ncf::p::COPY_TO_INTEGER i,
args => [x, fn],
to_temp,
type,
next
}
)
=>
{ k = mk_kvar ();
v' = mk_i32var ();
next = cexp next;
ncf::DEFINE_FUNS
{
funs => [ (ncf::FATE_FN, k, [to_temp], [type], next) ],
#
next =>
ncf::PURE
{ op => ncf::p::COPY (i, 32),
args => [x],
to_temp => v',
type => ncf::typ::INT1,
next => ncf::TAIL_CALL { fn, args => [ncf::CODETEMP k, ncf::CODETEMP v', ncf::INT 0] }
}
};
};
cexp (ncf::PURE { op => ncf::p::STRETCH_TO_INTEGER i,
args => [x, fn],
to_temp,
type,
next
}
)
=>
{ k = mk_kvar ();
v' = mk_i32var ();
next = cexp next;
ncf::DEFINE_FUNS
{
funs => [(ncf::FATE_FN, k, [to_temp], [type], next)],
#
next => ncf::PURE
{ op => ncf::p::STRETCH (i, 32),
args => [x],
to_temp => v',
type => ncf::typ::INT1,
next => ncf::TAIL_CALL { fn,
args => [ncf::CODETEMP k, ncf::CODETEMP v', ncf::INT 1]
}
}
};
};
cexp (ncf::PURE { op, args, to_temp, type, next })
=> ncf::PURE { op, args, to_temp, type, next => cexp next };
cexp (ncf::RAW_C_CALL { kind, cfun_name, cfun_type, args, to_ttemps, next })
=> ncf::RAW_C_CALL { kind, cfun_name, cfun_type, args, to_ttemps, next => cexp next };
end;
end;
};
end;