[commit: ghc] master: Remove some `undefined`s (82282e8)

git at git.haskell.org git at git.haskell.org
Mon Jun 27 09:38:47 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/82282e8dc0599c105996fe2071b5439d50323225/ghc

>---------------------------------------------------------------

commit 82282e8dc0599c105996fe2071b5439d50323225
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Mon Jun 27 09:15:39 2016 +0000

    Remove some `undefined`s
    
    These get annoying when `undefined` is actually used as placeholder in WIP code.
    Some of these were also completely redundant (just call `deAnnotate'` instead of
    `deAnnotate` etc.).


>---------------------------------------------------------------

82282e8dc0599c105996fe2071b5439d50323225
 compiler/ghci/ByteCodeGen.hs               | 4 ++--
 compiler/ghci/RtClosureInspect.hs          | 5 ++---
 compiler/nativeGen/RegAlloc/Linear/Main.hs | 9 ++++-----
 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 e752fc2..0d4c64b 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 a76a298..f4076bb 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 9f71158..edb2394 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 48a2c4c..eff5705 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



More information about the ghc-commits mailing list