Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : unboxed-tuple-arguments2
http://hackage.haskell.org/trac/ghc/changeset/05750858f9cf2324f3af70001b4f7eb3ca6d1a8b >--------------------------------------------------------------- commit 05750858f9cf2324f3af70001b4f7eb3ca6d1a8b Author: Max Bolingbroke <[email protected]> Date: Sat Mar 17 11:17:38 2012 +0000 Remove StgTypeArg since it was never used and is probably broken anyway >--------------------------------------------------------------- compiler/codeGen/CgBindery.lhs | 9 +++------ compiler/codeGen/StgCmmEnv.hs | 1 - compiler/stgSyn/StgLint.lhs | 1 - compiler/stgSyn/StgSyn.lhs | 9 +-------- 4 files changed, 4 insertions(+), 16 deletions(-) diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs index 198e192..06442dc 100644 --- a/compiler/codeGen/CgBindery.lhs +++ b/compiler/codeGen/CgBindery.lhs @@ -411,15 +411,12 @@ getArgAmode (StgLitArg lit) = do { cmm_lit <- cgLit lit ; return (typeCgRep (literalType lit), CmmLit cmm_lit) } -getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg" - getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)] getArgAmodes [] = returnFC [] getArgAmodes (atom:atoms) - | isStgTypeArg atom = getArgAmodes atoms - | otherwise = do { amode <- getArgAmode atom - ; amodes <- getArgAmodes atoms - ; return ( amode : amodes ) } + = do { amode <- getArgAmode atom + ; amodes <- getArgAmodes atoms + ; return ( amode : amodes ) } \end{code} %************************************************************************ diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs index d8a7061..f128e3a 100644 --- a/compiler/codeGen/StgCmmEnv.hs +++ b/compiler/codeGen/StgCmmEnv.hs @@ -201,7 +201,6 @@ getArgAmode :: NonVoid StgArg -> FCode CmmExpr getArgAmode (NonVoid (StgVarArg var)) = do { info <- getCgIdInfo var; return (idInfoToAmode info) } getArgAmode (NonVoid (StgLitArg lit)) = liftM CmmLit $ cgLit lit -getArgAmode (NonVoid (StgTypeArg _)) = panic "getArgAmode: type arg" getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr] -- NB: Filters out void args, diff --git a/compiler/stgSyn/StgLint.lhs b/compiler/stgSyn/StgLint.lhs index 8d339da..3913a23 100644 --- a/compiler/stgSyn/StgLint.lhs +++ b/compiler/stgSyn/StgLint.lhs @@ -90,7 +90,6 @@ lintStgBindings whodunnit binds lintStgArg :: StgArg -> LintM (Maybe Type) lintStgArg (StgLitArg lit) = return (Just (literalType lit)) lintStgArg (StgVarArg v) = lintStgVar v -lintStgArg a = pprPanic "lintStgArg" (ppr a) lintStgVar :: Id -> LintM (Maybe Kind) lintStgVar v = do checkInScope v diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs index 5270aa9..d87e455 100644 --- a/compiler/stgSyn/StgSyn.lhs +++ b/compiler/stgSyn/StgSyn.lhs @@ -35,7 +35,7 @@ module StgSyn ( -- utils stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity, - isDllConApp, isStgTypeArg, + isDllConApp, stgArgType, pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs, @@ -99,11 +99,6 @@ data GenStgBinding bndr occ data GenStgArg occ = StgVarArg occ | StgLitArg Literal - | StgTypeArg Type -- For when we want to preserve all type info - -isStgTypeArg :: StgArg -> Bool -isStgTypeArg (StgTypeArg _) = True -isStgTypeArg _ = False -- | Does this constructor application refer to -- anything in a different *Windows* DLL? @@ -144,7 +139,6 @@ isAddrRep _ = False stgArgType :: StgArg -> Type stgArgType (StgVarArg v) = idType v stgArgType (StgLitArg lit) = literalType lit -stgArgType (StgTypeArg _) = panic "stgArgType called on stgTypeArg" \end{code} %************************************************************************ @@ -683,7 +677,6 @@ instance (Outputable bndr, Outputable bdee, Ord bdee) pprStgArg :: (Outputable bdee) => GenStgArg bdee -> SDoc pprStgArg (StgVarArg var) = ppr var pprStgArg (StgLitArg con) = ppr con -pprStgArg (StgTypeArg ty) = char '@' <+> ppr ty pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee) => GenStgExpr bndr bdee -> SDoc _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
