-{-# 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.
-----------------------------------------------------------------------------
module CmmUtils(
- CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
- isNopStmt,
-
primRepCmmType, primRepForeignHint,
typeCmmType, typeForeignHint,
mkIntCLit, zeroCLit,
mkLblExpr,
-
- maybeAssignTemp, loadArgsIntoTemps
) where
#include "HsVersions.h"
import Type ( Type, typePrimRep )
import CLabel
-import Cmm
-import OrdList
+import CmmDecl
+import CmmExpr
import Outputable
-import Unique
---------------------------------------------------
--
---------------------------------------------------
--
--- 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
--
---------------------------------------------------
isTrivialCmmExpr (CmmLit _) = True
isTrivialCmmExpr (CmmReg _) = True
isTrivialCmmExpr (CmmRegOff _ _) = True
+isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
hasNoGlobalRegs :: CmmExpr -> Bool
hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e
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
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))