diff options
| -rw-r--r-- | compiler/ghci/ByteCodeGen.hs | 4 | ||||
| -rw-r--r-- | compiler/ghci/RtClosureInspect.hs | 5 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Linear/Main.hs | 9 | ||||
| -rw-r--r-- | compiler/utils/BufWrite.hs | 5 |
4 files changed, 10 insertions, 13 deletions
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs index e752fc28bc..0d4c64b4d1 100644 --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -1388,7 +1388,7 @@ pushAtom _ _ (AnnLit lit) = do pushAtom _ _ expr = pprPanic "ByteCodeGen.pushAtom" - (pprCoreExpr (deAnnotate (undefined, expr))) + (pprCoreExpr (deAnnotate' expr)) -- ----------------------------------------------------------------------------- @@ -1628,7 +1628,7 @@ atomPrimRep e | Just e' <- bcView e = atomPrimRep e' atomPrimRep (AnnVar v) = bcIdPrimRep v atomPrimRep (AnnLit l) = typePrimRep (literalType l) atomPrimRep (AnnCoercion {}) = VoidRep -atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate (undefined,other))) +atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate' other)) atomRep :: AnnExpr' Id ann -> ArgRep atomRep e = toArgRep (atomPrimRep e) diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index a76a298172..f4076bb21b 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, ScopedTypeVariables, MagicHash, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables, MagicHash, UnboxedTuples #-} ----------------------------------------------------------------------------- -- @@ -702,13 +702,12 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do -- -- [SPJ May 11] I don't understand the difference between my_ty and old_ty - go max_depth _ _ _ | seq max_depth False = undefined go 0 my_ty _old_ty a = do traceTR (text "Gave up reconstructing a term after" <> int max_depth <> text " steps") clos <- trIO $ getClosureData dflags a return (Suspension (tipe clos) my_ty a Nothing) - go max_depth my_ty old_ty a = do + go !max_depth my_ty old_ty a = do let monomorphic = not(isTyVarTy my_ty) -- This ^^^ is a convention. The ancestor tests for -- monomorphism and passes a type instead of a tv diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index 9f71158301..edb2394954 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- @@ -579,10 +579,9 @@ releaseRegs regs = do let platform = targetPlatform dflags assig <- getAssigR free <- getFreeRegsR - let loop _ free _ | free `seq` False = undefined - loop assig free [] = do setAssigR assig; setFreeRegsR free; return () - loop assig free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs - loop assig free (r:rs) = + let loop assig !free [] = do setAssigR assig; setFreeRegsR free; return () + loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs + loop assig !free (r:rs) = case lookupUFM assig r of Just (InBoth real _) -> loop (delFromUFM assig r) (frReleaseReg platform real free) rs diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs index 48a2c4c940..eff57059de 100644 --- a/compiler/utils/BufWrite.hs +++ b/compiler/utils/BufWrite.hs @@ -64,9 +64,8 @@ bPutStr :: BufHandle -> String -> IO () bPutStr (BufHandle buf r hdl) !str = do i <- readFastMutInt r loop str i - where loop _ i | i `seq` False = undefined - loop "" i = do writeFastMutInt r i; return () - loop (c:cs) i + where loop "" !i = do writeFastMutInt r i; return () + loop (c:cs) !i | i >= buf_size = do hPutBuf hdl buf buf_size loop (c:cs) 0 |