Commit 5bf5b0ce authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

Fuse some applications e.g. not o eq -> neq, not o lt -> ge

parent d20a46a6
......@@ -37,6 +37,12 @@ void __gtI(int dst_idx) {
target->_bool = readI(arg(2)) > readI(arg(1));
}
void __geI(int dst_idx) {
Thunk* target = get_dst(dst_idx);
target->desc = (Desc*) __BOOL__;
target->_bool = readI(arg(2)) >= readI(arg(1));
}
void __ltI(int dst_idx) {
Thunk* target = get_dst(dst_idx);
target->desc = (Desc*) __BOOL__;
......@@ -132,6 +138,7 @@ void init_prim() {
add_prim(2, "multI", &__multI);
add_prim(2, "divI", &__divI);
add_prim(2, "gtI", &__gtI);
add_prim(2, "geI", &__geI);
add_prim(2, "geC", &__geC);
add_prim(2, "ltI", &__ltI);
add_prim(2, "eqI", &__eqI);
......
......@@ -23,6 +23,13 @@ import System.File
, currentFun :: String
}
// Fusion of function applications for some very basic cases
simplify (SApplication var1 [SApplication var2 args]) | unpackVar var1 == "not" && unpackVar var2 == "eqI"
= SApplication (NormalVar "neqI" 0) args
simplify (SApplication var1 [SApplication var2 args]) | unpackVar var1 == "not" && unpackVar var2 == "ltI"
= SApplication (NormalVar "geI" 0) args
simplify x = x
unBoxableType (Type "I") = True
unBoxableType (Type "C") = True
unBoxableType (Type "B") = True
......@@ -85,11 +92,13 @@ sList0 f [] a = a
sNum num a = a <++ num <++ " "
sText text a = a <++ sNum (textSize text) <++ text
sTerm ctx (SLit lit) a = a <++ "L" <++ lit
sTerm ctx (SVar var) a = a <++ sVarApp ctx var
sTerm ctx (SApplication var terms) a = a <++ appType ctx var <++ sList (sTerm {ctx & inspine = False}) terms <++ sVar ctx var
sTerm ctx (SSelect expr cs) a = a <++ "S" <++ sTerm {ctx & inspine = False} expr <++ sList (sSelectCase ctx) (sortBy selectCaseOrder cs)
sTerm ctx (SIf cond texpr fexpr) a = a <++ "I" <++ sTerm {ctx & inspine = False} cond <++ sTerm ctx texpr <++ sTerm ctx fexpr
sTerm ctx t a = sTermS ctx (simplify t) a
where
sTermS ctx (SLit lit) a = a <++ "L" <++ lit
sTermS ctx (SVar var) a = a <++ sVarApp ctx var
sTermS ctx (SApplication var terms) a = a <++ appType ctx var <++ sList (sTerm {ctx & inspine = False}) terms <++ sVar ctx var
sTermS ctx (SSelect expr cs) a = a <++ "S" <++ sTerm {ctx & inspine = False} expr <++ sList (sSelectCase ctx) (sortBy selectCaseOrder cs)
sTermS ctx (SIf cond texpr fexpr) a = a <++ "I" <++ sTerm {ctx & inspine = False} cond <++ sTerm ctx texpr <++ sTerm ctx fexpr
isLocalVar ctx var = member (unpackVar var) ctx.vars
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment