X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmUtils.hs;h=35f24713619891c326178724328510d65bd500f2;hp=841f65b7fa836d858e5275d4d98dfdd599b8d177;hb=927df6486bc0dcb598b82702ca40c8fad0d9b25f;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69 diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 841f65b..35f2471 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -1,10 +1,3 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - ----------------------------------------------------------------------------- -- -- Cmm utilities. @@ -14,9 +7,6 @@ ----------------------------------------------------------------------------- module CmmUtils( - CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList, - isNopStmt, - primRepCmmType, primRepForeignHint, typeCmmType, typeForeignHint, @@ -28,8 +18,6 @@ module CmmUtils( mkIntCLit, zeroCLit, mkLblExpr, - - maybeAssignTemp, loadArgsIntoTemps ) where #include "HsVersions.h" @@ -38,10 +26,9 @@ import TyCon ( PrimRep(..) ) import Type ( Type, typePrimRep ) import CLabel -import Cmm -import OrdList +import CmmDecl +import CmmExpr import Outputable -import Unique --------------------------------------------------- -- @@ -70,7 +57,7 @@ primRepForeignHint IntRep = SignedHint primRepForeignHint WordRep = NoHint primRepForeignHint Int64Rep = SignedHint primRepForeignHint Word64Rep = NoHint -primRepForeignHint AddrRep = AddrHint -- NB! AddrHint, but NonPtrArg +primRepForeignHint AddrRep = AddrHint -- NB! AddrHint, but NonPtrArg primRepForeignHint FloatRep = NoHint primRepForeignHint DoubleRep = NoHint @@ -80,55 +67,6 @@ typeForeignHint = primRepForeignHint . typePrimRep --------------------------------------------------- -- --- CmmStmts --- ---------------------------------------------------- - -type CmmStmts = OrdList CmmStmt - -noStmts :: CmmStmts -noStmts = nilOL - -oneStmt :: CmmStmt -> CmmStmts -oneStmt = unitOL - -mkStmts :: [CmmStmt] -> CmmStmts -mkStmts = toOL - -plusStmts :: CmmStmts -> CmmStmts -> CmmStmts -plusStmts = appOL - -stmtList :: CmmStmts -> [CmmStmt] -stmtList = fromOL - - ---------------------------------------------------- --- --- CmmStmt --- ---------------------------------------------------- - -isNopStmt :: CmmStmt -> Bool --- If isNopStmt returns True, the stmt is definitely a no-op; --- but it might be a no-op even if isNopStmt returns False -isNopStmt CmmNop = True -isNopStmt (CmmAssign r e) = cheapEqReg r e -isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2 -isNopStmt s = False - -cheapEqExpr :: CmmExpr -> CmmExpr -> Bool -cheapEqExpr (CmmReg r) e = cheapEqReg r e -cheapEqExpr (CmmRegOff r 0) e = cheapEqReg r e -cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n' -cheapEqExpr e1 e2 = False - -cheapEqReg :: CmmReg -> CmmExpr -> Bool -cheapEqReg r (CmmReg r') = r==r' -cheapEqReg r (CmmRegOff r' 0) = r==r' -cheapEqReg r e = False - ---------------------------------------------------- --- -- CmmExpr -- --------------------------------------------------- @@ -139,6 +77,7 @@ isTrivialCmmExpr (CmmMachOp _ _) = False isTrivialCmmExpr (CmmLit _) = True isTrivialCmmExpr (CmmReg _) = True isTrivialCmmExpr (CmmRegOff _ _) = True +isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot" hasNoGlobalRegs :: CmmExpr -> Bool hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e @@ -187,7 +126,7 @@ cmmOffsetLit :: CmmLit -> Int -> CmmLit cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off) cmmOffsetLit (CmmInt m rep) byte_off = CmmInt (m + fromIntegral byte_off) rep -cmmOffsetLit other byte_off = pprPanic "cmmOffsetLit" (ppr byte_off) +cmmOffsetLit _ byte_off = pprPanic "cmmOffsetLit" (ppr byte_off) cmmLabelOff :: CLabel -> Int -> CmmLit -- Smart constructor for CmmLabelOff @@ -231,29 +170,3 @@ zeroCLit = CmmInt 0 wordWidth mkLblExpr :: CLabel -> CmmExpr mkLblExpr lbl = CmmLit (CmmLabel lbl) - ---------------------------------------------------- --- --- Helpers for foreign call arguments --- ---------------------------------------------------- - -loadArgsIntoTemps :: [Unique] - -> HintedCmmActuals - -> ([Unique], [CmmStmt], HintedCmmActuals) -loadArgsIntoTemps uniques [] = (uniques, [], []) -loadArgsIntoTemps uniques ((CmmHinted e hint):args) = - (uniques'', - new_stmts ++ remaining_stmts, - (CmmHinted new_e hint) : remaining_e) - where - (uniques', new_stmts, new_e) = maybeAssignTemp uniques e - (uniques'', remaining_stmts, remaining_e) = - loadArgsIntoTemps uniques' args - - -maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr) -maybeAssignTemp uniques e - | hasNoGlobalRegs e = (uniques, [], e) - | otherwise = (tail uniques, [CmmAssign local e], CmmReg local) - where local = CmmLocal (LocalReg (head uniques) (cmmExprType e))