X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCorePrep.lhs;h=fee95a588a156bb22f1c4f8b03d1d2fa93be67ba;hb=022fc24719ba4b98b8d9f19bfe7f75dd0f19d585;hp=fb31e4536d6997ff38c30f57db082643f225a442;hpb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs index fb31e45..fee95a5 100644 --- a/compiler/coreSyn/CorePrep.lhs +++ b/compiler/coreSyn/CorePrep.lhs @@ -23,6 +23,7 @@ import Var import VarSet import VarEnv import Id +import IdInfo import DataCon import PrimOp import BasicTypes @@ -33,7 +34,6 @@ import ErrUtils import DynFlags import Util import Outputable -import TysWiredIn \end{code} -- --------------------------------------------------------------------------- @@ -334,8 +334,6 @@ exprIsTrivial (Type _) = True exprIsTrivial (Lit lit) = True exprIsTrivial (App e arg) = isTypeArg arg && exprIsTrivial e exprIsTrivial (Note (SCC _) e) = False -exprIsTrivial (Note (TickBox {}) e) = False -exprIsTrivial (Note (BinaryTickBox {}) e) = False exprIsTrivial (Note _ e) = exprIsTrivial e exprIsTrivial (Cast e co) = exprIsTrivial e exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body @@ -383,22 +381,11 @@ corePrepExprFloat env (Note n@(SCC _) expr) deLamFloat expr1 `thenUs` \ (floats, expr2) -> returnUs (floats, Note n expr2) -corePrepExprFloat env (Note note@(TickBox {}) expr) +corePrepExprFloat env (Case (Var id) bndr ty [(DEFAULT,[],expr)]) + | Just (TickBox {}) <- isTickBoxOp_maybe id = corePrepAnExpr env expr `thenUs` \ expr1 -> deLamFloat expr1 `thenUs` \ (floats, expr2) -> - return (floats, Note note expr2) - -corePrepExprFloat env (Note note@(BinaryTickBox m t e) expr) - = corePrepAnExpr env expr `thenUs` \ expr1 -> - deLamFloat expr1 `thenUs` \ (floats, expr2) -> - getUniqueUs `thenUs` \ u -> - let bndr = mkSysLocal FSLIT("t") u boolTy in - return (floats, Case expr2 - bndr - boolTy - [ (DataAlt falseDataCon, [], Note (TickBox m e) (Var falseDataConId)) - , (DataAlt trueDataCon, [], Note (TickBox m t) (Var trueDataConId)) - ]) + return (floats, Case (Var id) bndr ty [(DEFAULT,[],expr2)]) corePrepExprFloat env (Note other_note expr) = corePrepExprFloat env expr `thenUs` \ (floats, expr') -> @@ -415,21 +402,6 @@ corePrepExprFloat env expr@(Lam _ _) where (bndrs,body) = collectBinders expr -corePrepExprFloat env (Case (Note note@(TickBox m n) expr) bndr ty alts) - = corePrepExprFloat env (Note note (Case expr bndr ty alts)) - -corePrepExprFloat env (Case (Note note@(BinaryTickBox m t e) expr) bndr ty alts) - = do { ASSERT(exprType expr `coreEqType` boolTy) - corePrepExprFloat env $ - Case expr bndr ty - [ (DataAlt falseDataCon, [], Note (TickBox m e) falseBranch) - , (DataAlt trueDataCon, [], Note (TickBox m t) trueBranch) - ] - } - where - (_,_,trueBranch) = findAlt (DataAlt trueDataCon) alts - (_,_,falseBranch) = findAlt (DataAlt falseDataCon) alts - corePrepExprFloat env (Case scrut bndr ty alts) = corePrepExprFloat env scrut `thenUs` \ (floats1, scrut1) -> deLamFloat scrut1 `thenUs` \ (floats2, scrut2) ->