## treecode-fold-g.pkg
#
# "basic functionality for implementing various forms of
# aggregation function over the [treecode] sumtypes."
#
# -- http://www.cs.nyu.edu/leunga/MLRISC/Doc/html/mltree-util.html
# Compiled by:
# src/lib/compiler/back/low/lib/treecode.lib### "I find television very educating.
### Every time somebody turns on the set,
### I go into the other room and read a book."
###
### -- Groucho Marx
generic package treecode_fold_g (
# ===============
#
package tcf: Treecode_Form; # Treecode_Form is from src/lib/compiler/back/low/treecode/treecode-form.api # Extension mechanism:
#
sext: tcf::Fold_Fns(Y) -> ( tcf::Sext, Y) -> Y;
rext: tcf::Fold_Fns(Y) -> (tcf::Int_Bitsize, tcf::Rext, Y) -> Y;
fext: tcf::Fold_Fns(Y) -> (tcf::Float_Bitsize, tcf::Fext, Y) -> Y;
ccext: tcf::Fold_Fns(Y) -> (tcf::Int_Bitsize, tcf::Ccext, Y) -> Y;
)
: (weak) Treecode_Fold # Treecode_Fold is from src/lib/compiler/back/low/treecode/treecode-fold.api{
# Export to client packages:
#
package tcf = tcf; # "tcf" == "treecode_form".
fun fold
{ int_expression => do_int_expression,
float_expression => do_float_expression,
flag_expression => do_flag_expression,
void_expression => do_void_expression
}
=
{ fun void_expression (s, x)
=
do_void_expression (s, x)
where
x = case s
#
tcf::LOAD_INT_REGISTER (type, dst, e) => int_expression (e, x);
tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (dst, e) => flag_expression (e, x);
tcf::LOAD_FLOAT_REGISTER (fty, dst, e) => float_expression (e, x);
tcf::MOVE_INT_REGISTERS _ => x;
tcf::MOVE_FLOAT_REGISTERS _ => x;
tcf::GOTO (e, cf) => int_expression (e, x);
tcf::IF_GOTO (cc, l) => flag_expression (cc, x);
tcf::CALL { funct, defs, uses, ... } => lowhalfs (uses, lowhalfs (defs, int_expression (funct, x)));
tcf::RET _ => x;
tcf::FLOW_TO (s, _) => void_expression (s, x);
tcf::IF (cc, yes, no) => void_expression (no, void_expression (yes, flag_expression (cc, x)));
tcf::STORE_INT (type, ea, d, r) => int_expression (d, int_expression (ea, x));
tcf::STORE_FLOAT (fty, ea, d, r) => float_expression (d, int_expression (ea, x));
tcf::REGION (s, ctrl) => void_expression (s, x);
tcf::SEQ s => void_expressions (s, x);
tcf::DEFINE _ => x;
tcf::NOTE (s, an) => void_expression (s, x);
tcf::EXT s => sext { void_expression, int_expression, float_expression, flag_expression } (s, x);
tcf::PHI _ => x;
tcf::ASSIGN(_, a, b) => int_expression (b, int_expression (a, x));
tcf::SOURCE => x;
tcf::SINK => x;
tcf::RTL _ => x;
tcf::LIVE ls => lowhalfs (ls, x);
tcf::DEAD ks => lowhalfs (ks, x);
esac;
end
also
fun void_expressions (ss, x)
=
fold_backward void_expression x ss
also
fun int_expression (e, x)
=
do_int_expression (e, x)
where
x = case e
#
tcf::CODETEMP_INFO _ => x;
tcf::LITERAL _ => x;
tcf::LABEL _ => x;
tcf::LABEL_EXPRESSION _ => x;
tcf::LATE_CONSTANT _ => x;
tcf::NEG (type, a) => int_expression (a, x);
tcf::ADD (type, a, b) => rexp2 (a, b, x);
tcf::SUB (type, a, b) => rexp2 (a, b, x);
tcf::MULS (type, a, b) => rexp2 (a, b, x);
tcf::DIVS (m, type, a, b) => rexp2 (a, b, x);
tcf::REMS (m, type, a, b) => rexp2 (a, b, x);
tcf::MULU (type, a, b) => rexp2 (a, b, x);
tcf::DIVU (type, a, b) => rexp2 (a, b, x);
tcf::REMU (type, a, b) => rexp2 (a, b, x);
tcf::NEG_OR_TRAP (type, a) => int_expression (a, x);
tcf::ADD_OR_TRAP (type, a, b) => rexp2 (a, b, x);
tcf::SUB_OR_TRAP (type, a, b) => rexp2 (a, b, x);
tcf::MULS_OR_TRAP (type, a, b) => rexp2 (a, b, x);
tcf::DIVS_OR_TRAP (m, type, a, b) => rexp2 (a, b, x);
tcf::BITWISE_AND (type, a, b) => rexp2 (a, b, x);
tcf::BITWISE_OR (type, a, b) => rexp2 (a, b, x);
tcf::BITWISE_XOR (type, a, b) => rexp2 (a, b, x);
tcf::BITWISE_EQV (type, a, b) => rexp2 (a, b, x);
tcf::BITWISE_NOT (type, a) => int_expression (a, x);
tcf::RIGHT_SHIFT (type, a, b) => rexp2 (a, b, x);
tcf::RIGHT_SHIFT_U (type, a, b) => rexp2 (a, b, x);
tcf::LEFT_SHIFT (type, a, b) => rexp2 (a, b, x);
tcf::SIGN_EXTEND (t, t', e) => int_expression (e, x);
tcf::ZERO_EXTEND (t, t', e) => int_expression (e, x);
tcf::FLOAT_TO_INT (type, mode, fty, e) => float_expression (e, x);
tcf::CONDITIONAL_LOAD (type, cc, yes, no) => int_expression (no, int_expression (yes, flag_expression (cc, x)));
tcf::LOAD (type, ea, r) => int_expression (ea, x);
tcf::PRED (e, ctrl) => int_expression (e, x);
tcf::LET (s, e) => int_expression (e, void_expression (s, x));
tcf::REXT (t, e) => rext { void_expression, int_expression, float_expression, flag_expression } (t, e, x);
tcf::RNOTE (e, an) => int_expression (e, x);
tcf::OP (type, op, es) => rexps (es, x);
tcf::ARG _ => x;
tcf::PARAM _ => x;
tcf::BITSLICE(_, _, e) => int_expression (e, x);
tcf::ATATAT(type, k, e) => int_expression (e, x);
tcf::QQQ => x;
esac;
end
also
fun rexp2 (a, b, x)
=
int_expression (b, int_expression (a, x))
also
fun rexps (es, x)
=
fold_backward int_expression x es
also
fun float_expression (e, x)
=
do_float_expression (e, x)
where
x = case e
#
tcf::CODETEMP_INFO_FLOAT _ => x;
tcf::FLOAD (fty, e, r) => int_expression (e, x);
#
tcf::FADD (fty, a, b) => fexp2 (a, b, x);
tcf::FSUB (fty, a, b) => fexp2 (a, b, x);
tcf::FMUL (fty, a, b) => fexp2 (a, b, x);
tcf::FDIV (fty, a, b) => fexp2 (a, b, x);
#
tcf::FABS (fty, e) => float_expression (e, x);
tcf::FNEG (fty, e) => float_expression (e, x);
tcf::FSQRT (fty, e) => float_expression (e, x);
#
tcf::COPY_FLOAT_SIGN (fty, a, b) => fexp2 (a, b, x);
tcf::FCONDITIONAL_LOAD (fty, c, a, b) => fexp2 (a, b, flag_expression (c, x));
#
tcf::INT_TO_FLOAT (fty, type, e) => int_expression (e, x);
tcf::FLOAT_TO_FLOAT (fty, fty', e) => float_expression (e, x);
#
tcf::FPRED (e, ctrl) => float_expression (e, x);
tcf::FEXT (t, e) => fext { void_expression, int_expression, float_expression, flag_expression } (t, e, x);
tcf::FNOTE (e, an) => float_expression (e, x);
esac;
end
also
fun fexp2 (a, b, x)
=
float_expression (b, float_expression (a, x))
also
fun fexps (es, x)
=
fold_backward float_expression x es
also
fun flag_expression (e, x)
=
do_flag_expression (e, x)
where
x = case e
#
tcf::CC _ => x;
tcf::FCC _ => x;
tcf::TRUE => x;
tcf::FALSE => x;
#
tcf::NOT e => flag_expression (e, x);
#
tcf::AND (a, b) => flag_expression2 (a, b, x);
tcf::OR (a, b) => flag_expression2 (a, b, x);
tcf::XOR (a, b) => flag_expression2 (a, b, x);
tcf::EQV (a, b) => flag_expression2 (a, b, x);
#
tcf::CMP (type, cond, a, b) => rexp2 (a, b, x);
tcf::FCMP (type, fcond, a, b) => fexp2 (a, b, x);
#
tcf::CCNOTE (e, an) => flag_expression (e, x);
tcf::CCEXT (t, e) => ccext { void_expression, int_expression, float_expression, flag_expression } (t, e, x);
esac;
end
also
fun flag_expression2 (a, b, x)
=
flag_expression (b, flag_expression (a, x))
also
fun lowhalfs (m, x)
=
fold_backward lowhalf x m
also
fun lowhalf (m, x)
=
case m
#
tcf::FLAG_EXPRESSION e => flag_expression (e, x);
tcf::INT_EXPRESSION e => int_expression (e, x);
tcf::FLOAT_EXPRESSION e => float_expression (e, x);
esac;
{ int_expression,
float_expression,
flag_expression,
void_expression
};
};
}; # treecode_fold_g