[commit: ghc] wip/names3: Fix some style issues (38c40f3)

[git at git.haskell.org]

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

On branch  : wip/names3
Link       : http://ghc.haskell.org/trac/ghc/changeset/38c40f3f6daffe1f4341bd3f4d6cc3f161332cc0/ghc

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

commit 38c40f3f6daffe1f4341bd3f4d6cc3f161332cc0
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Sep 28 18:25:54 2016 -0400

    Fix some style issues


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

38c40f3f6daffe1f4341bd3f4d6cc3f161332cc0
 compiler/iface/BinFingerprint.hs | 15 ++++++++-------
 compiler/iface/BinIface.hs       |  7 +++++--
 compiler/iface/IfaceSyn.hs       |  3 ++-
 compiler/iface/LoadIface.hs      |  6 ++++--
 4 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/compiler/iface/BinFingerprint.hs b/compiler/iface/BinFingerprint.hs
index 645aee0..bbf45d7 100644
--- a/compiler/iface/BinFingerprint.hs
+++ b/compiler/iface/BinFingerprint.hs
@@ -31,16 +31,17 @@ computeFingerprint :: (Binary a)
                    -> a
                    -> IO Fingerprint
 computeFingerprint put_nonbinding_name a = do
-  bh <- openBinMem (3*1024) -- just less than a block
-  bh <- return $ setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS
-  put_ bh a
-  fp <- fingerprintBinMem bh
-  return fp
+    bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block
+    put_ bh a
+    fp <- fingerprintBinMem bh
+    return fp
+  where
+    set_user_data bh =
+      setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS
 
 -- | Used when we want to fingerprint a structure without depending on the
 -- fingerprints of external Names that it refers to.
 putNameLiterally :: BinHandle -> Name -> IO ()
-putNameLiterally bh name = ASSERT( isExternalName name )
-  do
+putNameLiterally bh name = ASSERT( isExternalName name ) do
     put_ bh $! nameModule name
     put_ bh $! nameOccName name
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index def09fc..005d89e 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -306,7 +306,9 @@ putName _dict BinSymbolTable{
   | isKnownKeyName name
   , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
   = -- ASSERT(u < 2^(22 :: Int))
-    put_ bh (0x80000000 .|. (fromIntegral (ord c) `shiftL` 22) .|. (fromIntegral u :: Word32))
+    put_ bh (0x80000000
+             .|. (fromIntegral (ord c) `shiftL` 22)
+             .|. (fromIntegral u :: Word32))
 
   | otherwise
   = do symtab_map <- readIORef symtab_map_ref
@@ -336,7 +338,8 @@ getSymtabName _ncu _dict symtab bh = do
           u   = mkUnique tag ix
         in
           return $! case lookupKnownKeyName u of
-                      Nothing -> pprPanic "getSymtabName:unknown known-key unique" (ppr i $$ ppr (unpkUnique u))
+                      Nothing -> pprPanic "getSymtabName:unknown known-key unique"
+                                          (ppr i $$ ppr (unpkUnique u))
                       Just n  -> n
 
       _ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index a825454..164452a 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -369,7 +369,8 @@ ifaceConDeclFields x = case x of
     IfDataTyCon cons is_over labels -> map (help cons  is_over) labels
     IfNewTyCon  con  is_over labels -> map (help [con] is_over) labels
   where
-    help (dc:_) is_over lbl = mkFieldLabelOccs lbl (occName $ ifConName dc) is_over
+    help (dc:_) is_over lbl =
+        mkFieldLabelOccs lbl (occName $ ifConName dc) is_over
     help [] _ _ = error "ifaceConDeclFields: data type has no constructors!"
 
 ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index aba655c..48bc316 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -141,8 +141,10 @@ importDecl name
         -- Now look it up again; this time we should find it
         { eps <- getEps
         ; case lookupTypeEnv (eps_PTE eps) name of
-            Just thing -> return (Succeeded thing)
-            Nothing    -> return $ Failed (ifPprDebug (found_things_msg eps $$ empty) $$ not_found_msg)
+            Just thing -> return $ Succeeded thing
+            Nothing    -> let doc = ifPprDebug (found_things_msg eps $$ empty)
+                                    $$ not_found_msg
+                          in return $ Failed doc
     }}}
   where
     nd_doc = text "Need decl for" <+> ppr name