## treecode-rewrite-g.pkg
#
# "a generic term rewriting engine which is useful for
# performing various transformations on [Treecode] terms."
#
# -- http://www.cs.nyu.edu/leunga/MLRISC/Doc/html/mltree-util.html
# Compiled by:
# src/lib/compiler/back/low/lib/treecode.lib### "How lowly is the poor man!
### A mill (for him) (is) the edge of the oven;
### His ripped garment will not be mended;
### What he has lost will not be sought for!"
###
### -- Sumerian saying
# Compiled by:
# src/lib/compiler/back/low/lib/treecode.lib# This generic is invoked (only) in:
#
# src/lib/compiler/back/low/treecode/treecode-simplifier-g.pkg# src/lib/compiler/back/low/tools/arch/adl-rtl.pkg#
generic package treecode_rewrite_g (
# ==================
#
package tcf: Treecode_Form; # Treecode_Form is from src/lib/compiler/back/low/treecode/treecode-form.api # Tree-walk extensions:
#
sext: tcf::Rewrite_Fns -> tcf::Sext -> tcf::Sext; # "s" for "statement"
rext: tcf::Rewrite_Fns -> tcf::Rext -> tcf::Rext; # "r" for "int"
fext: tcf::Rewrite_Fns -> tcf::Fext -> tcf::Fext; # "f" for "float"
ccext: tcf::Rewrite_Fns -> tcf::Ccext -> tcf::Ccext; # "cc" for "condition code" -- zero/parity/overflow/... flag stuff.
)
: (weak) Treecode_Rewrite # Treecode_Rewrite is from src/lib/compiler/back/low/treecode/treecode-rewrite.api{
# Export to client packages:
#
package tcf = tcf;
Rewriters
=
{ void_expression: tcf::Void_Expression -> tcf::Void_Expression, # void-valued expressions ("statements") are used for their side-effects.
int_expression: tcf::Int_Expression -> tcf::Int_Expression,
float_expression: tcf::Float_Expression -> tcf::Float_Expression,
flag_expression: tcf::Flag_Expression -> tcf::Flag_Expression # flag expressions handle zero/parity/overflow/... flag stuff.
};
fun rewrite
{ int_expression => do_int_expression,
float_expression => do_float_expression,
flag_expression => do_flag_expression,
void_expression => do_void_expression
}
=
{ fun void_expression s
=
do_void_expression void_expression s
where
s = case s
tcf::LOAD_INT_REGISTER (type, dst, e) => tcf::LOAD_INT_REGISTER (type, dst, int_expression e);
tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (dst, e) => tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (dst, flag_expression e);
tcf::LOAD_FLOAT_REGISTER (fty, dst, e) => tcf::LOAD_FLOAT_REGISTER (fty, dst, float_expression e);
tcf::MOVE_INT_REGISTERS _ => s;
tcf::MOVE_FLOAT_REGISTERS _ => s;
tcf::GOTO (e, cf) => tcf::GOTO (int_expression e, cf);
tcf::IF_GOTO (cc, l) => tcf::IF_GOTO (flag_expression cc, l);
tcf::CALL { funct, targets, defs, uses, region, pops } =>
tcf::CALL { funct=>int_expression funct, targets,
defs=>lowhalfs defs, uses=>lowhalfs uses,
region, pops };
tcf::FLOW_TO (s, controlflow) => tcf::FLOW_TO (void_expression s, controlflow);
tcf::RET _ => s;
tcf::IF (cc, yes, no) => tcf::IF (flag_expression cc, void_expression yes, void_expression no);
tcf::STORE_INT (type, ea, d, r) => tcf::STORE_INT (type, int_expression ea, int_expression d, r);
tcf::STORE_FLOAT (fty, ea, d, r) => tcf::STORE_FLOAT (fty, int_expression ea, float_expression d, r);
tcf::REGION (s, ctrl) => tcf::REGION (void_expression s, ctrl);
tcf::SEQ s => tcf::SEQ (void_expressions s);
tcf::DEFINE _ => s;
tcf::NOTE (s, an) => tcf::NOTE (void_expression s, an);
tcf::EXT s =>
tcf::EXT (sext { int_expression, float_expression, flag_expression, void_expression } s);
tcf::PHI _ => s;
tcf::SOURCE => s;
tcf::SINK => s;
tcf::RTL _ => s;
tcf::ASSIGN (type, x, y) => tcf::ASSIGN (type, int_expression x, int_expression y);
tcf::LIVE ls => tcf::LIVE (lowhalfs ls);
tcf::DEAD ks => tcf::DEAD (lowhalfs ks);
esac;
end
also
fun void_expressions ss
=
map void_expression ss
also
fun int_expression e
=
do_int_expression int_expression e
where
e = case e
#
tcf::CODETEMP_INFO _ => e;
tcf::LITERAL _ => e;
tcf::LABEL _ => e;
tcf::LABEL_EXPRESSION _ => e;
tcf::LATE_CONSTANT _ => e;
#
tcf::NEG (type, x ) => tcf::NEG (type, int_expression x);
tcf::ADD (type, x, y) => tcf::ADD (type, int_expression x, int_expression y);
tcf::SUB (type, x, y) => tcf::SUB (type, int_expression x, int_expression y);
tcf::MULS (type, x, y) => tcf::MULS (type, int_expression x, int_expression y);
#
tcf::DIVS (m, type, x, y) => tcf::DIVS (m, type, int_expression x, int_expression y);
tcf::REMS (m, type, x, y) => tcf::REMS (m, type, int_expression x, int_expression y);
#
tcf::MULU (type, x, y) => tcf::MULU (type, int_expression x, int_expression y);
tcf::DIVU (type, x, y) => tcf::DIVU (type, int_expression x, int_expression y);
tcf::REMU (type, x, y) => tcf::REMU (type, int_expression x, int_expression y);
tcf::NEG_OR_TRAP (type, x ) => tcf::NEG_OR_TRAP (type, int_expression x);
tcf::ADD_OR_TRAP (type, x, y) => tcf::ADD_OR_TRAP (type, int_expression x, int_expression y);
tcf::SUB_OR_TRAP (type, x, y) => tcf::SUB_OR_TRAP (type, int_expression x, int_expression y);
tcf::MULS_OR_TRAP (type, x, y) => tcf::MULS_OR_TRAP (type, int_expression x, int_expression y);
#
tcf::DIVS_OR_TRAP (m, type, x, y) => tcf::DIVS_OR_TRAP (m, type, int_expression x, int_expression y);
#
tcf::BITWISE_AND (type, x, y) => tcf::BITWISE_AND (type, int_expression x, int_expression y);
tcf::BITWISE_OR (type, x, y) => tcf::BITWISE_OR (type, int_expression x, int_expression y);
tcf::BITWISE_XOR (type, x, y) => tcf::BITWISE_XOR (type, int_expression x, int_expression y);
tcf::BITWISE_EQV (type, x, y) => tcf::BITWISE_EQV (type, int_expression x, int_expression y);
tcf::BITWISE_NOT (type, x) => tcf::BITWISE_NOT (type, int_expression x);
#
tcf::RIGHT_SHIFT (type, x, y) => tcf::RIGHT_SHIFT (type, int_expression x, int_expression y);
tcf::RIGHT_SHIFT_U (type, x, y) => tcf::RIGHT_SHIFT_U (type, int_expression x, int_expression y);
tcf::LEFT_SHIFT (type, x, y) => tcf::LEFT_SHIFT (type, int_expression x, int_expression y);
tcf::SIGN_EXTEND (t, t', e) => tcf::SIGN_EXTEND (t, t', int_expression e);
tcf::ZERO_EXTEND (t, t', e) => tcf::ZERO_EXTEND (t, t', int_expression e);
tcf::FLOAT_TO_INT (type, mode, fty, e) => tcf::FLOAT_TO_INT (type, mode, fty, float_expression e);
tcf::CONDITIONAL_LOAD (type, cc, yes, no) => tcf::CONDITIONAL_LOAD (type, flag_expression cc, int_expression yes, int_expression no);
tcf::LOAD (type, ea, r) => tcf::LOAD (type, int_expression ea, r);
tcf::PRED (e, ctrl) => tcf::PRED (int_expression e, ctrl);
tcf::LET (s, e) => tcf::LET (void_expression s, int_expression e);
tcf::REXT (type, e) => tcf::REXT (type, rext { int_expression, float_expression, flag_expression, void_expression } e);
tcf::RNOTE (e, an) => tcf::RNOTE (int_expression e, an);
tcf::ATATAT(type, k, e) => tcf::ATATAT(type, k, int_expression e);
tcf::ARG _ => e;
tcf::PARAM _ => e;
tcf::BITSLICE (type, sl, e) => tcf::BITSLICE (type, sl, int_expression e);
tcf::QQQ => tcf::QQQ;
tcf::OP (type, op, es) => tcf::OP (type, op, rexps es);
esac;
end
also
fun rexps es
=
map int_expression es
also
fun float_expression e
=
do_float_expression float_expression e
where
e = case e
#
tcf::CODETEMP_INFO_FLOAT _ => e;
tcf::FLOAD (fty, e, r) => tcf::FLOAD (fty, int_expression e, r);
#
tcf::FADD (fty, x, y) => tcf::FADD (fty, float_expression x, float_expression y);
tcf::FSUB (fty, x, y) => tcf::FSUB (fty, float_expression x, float_expression y);
tcf::FMUL (fty, x, y) => tcf::FMUL (fty, float_expression x, float_expression y);
tcf::FDIV (fty, x, y) => tcf::FDIV (fty, float_expression x, float_expression y);
#
tcf::FABS (fty, x) => tcf::FABS (fty, float_expression x);
tcf::FNEG (fty, x) => tcf::FNEG (fty, float_expression x);
tcf::FSQRT (fty, x) => tcf::FSQRT (fty, float_expression x);
#
tcf::COPY_FLOAT_SIGN (fty, x, y) => tcf::COPY_FLOAT_SIGN (fty, float_expression x, float_expression y);
tcf::FCONDITIONAL_LOAD (fty, c, x, y) => tcf::FCONDITIONAL_LOAD (fty, flag_expression c, float_expression x, float_expression y);
tcf::INT_TO_FLOAT (fty, type, e) => tcf::INT_TO_FLOAT (fty, type, int_expression e);
tcf::FLOAT_TO_FLOAT (fty, fty', e) => tcf::FLOAT_TO_FLOAT (fty, fty', float_expression e);
tcf::FPRED (e, ctrl) => tcf::FPRED (float_expression e, ctrl);
tcf::FEXT (fty, e) => tcf::FEXT (fty, fext { int_expression, float_expression, flag_expression, void_expression } e);
tcf::FNOTE (e, an) => tcf::FNOTE (float_expression e, an);
esac;
end
also
fun fexps es
=
map float_expression es
also
fun flag_expression e
=
do_flag_expression flag_expression e
where
e = case e
#
tcf::CC _ => e;
tcf::FCC _ => e;
tcf::TRUE => e;
tcf::FALSE => e;
tcf::NOT e => tcf::NOT (flag_expression e);
#
tcf::AND (x, y) => tcf::AND (flag_expression x, flag_expression y);
tcf::OR (x, y) => tcf::OR (flag_expression x, flag_expression y);
tcf::XOR (x, y) => tcf::XOR (flag_expression x, flag_expression y);
tcf::EQV (x, y) => tcf::EQV (flag_expression x, flag_expression y);
#
tcf::CMP (type, cond, x, y) => tcf::CMP (type, cond, int_expression x, int_expression y);
tcf::FCMP (type, fcond, x, y) => tcf::FCMP (type, fcond, float_expression x, float_expression y);
#
tcf::CCNOTE (e, an) => tcf::CCNOTE (flag_expression e, an);
#
tcf::CCEXT (type, e)
=>
tcf::CCEXT (type, ccext { int_expression, float_expression, flag_expression, void_expression } e);
esac;
end
also
fun lowhalfs m
=
map lowhalf m
also
fun lowhalf m
=
m
where
m = case m
#
tcf::FLOAT_EXPRESSION e => tcf::FLOAT_EXPRESSION (float_expression e);
tcf::FLAG_EXPRESSION e => tcf::FLAG_EXPRESSION (flag_expression e);
tcf::INT_EXPRESSION e => tcf::INT_EXPRESSION (int_expression e);
esac;
end;
{ int_expression,
float_expression,
flag_expression,
void_expression
};
};
};