[code cleanups
John Meacham <john@repetae.net>**20070829004140] hunk ./Ho/Build.hs 16
-import IO(bracket)
hunk ./Ho/Build.hs 66
-magic2 = packString "John's Haskell Compiler"
hunk ./Ho/Build.hs 282
+-- Read in a Ho file.
hunk ./Ho/Build.hs 284
-checkForHoFile :: String            -- ^ file name to check for
-    -> IO (Maybe (HoHeader,Ho))
-checkForHoFile fn = flip catch (\e -> return Nothing) $ do
-    bracket (openBinaryFile fn ReadMode) (\_ -> return ()) $ \ fh -> do
-    lbs <- L.hGetContents fh
-    let (x,hh,ho,m2) = decode (decompress lbs)
-    if x /= magic then (putErrLn $ "Bad ho file:" <+> fn)  >> return Nothing else do
-    if m2 /= magic2 then (putErrLn $ "Bad ho file:" <+> fn)  >>  return Nothing else do
-    return $ Just (hh,ho)
+checkForHoFile :: String -> IO (Maybe (HoHeader,Ho))
+checkForHoFile fn = flip catch (\e -> return Nothing) $ Just `fmap` readHoFile fn
hunk ./Ho/Build.hs 287
-
-
-
--- | This reads in an entire ho file for diagnostic purposes.
hunk ./Ho/Build.hs 291
-    let (m1,hh,ho,m2) = decode (decompress c)
+    let (m1,hh,ho) = decode (decompress c)
hunk ./Ho/Build.hs 293
-    when (m2 /= magic2) (putErrDie $ "Bad ho file magic2:" <+> fn)
hunk ./Ho/Build.hs 296
-instance DocLike d => PPrint d SrcLoc where
-    pprint sl = tshow sl
-
-{-# NOINLINE dumpHoFile #-}
-dumpHoFile :: String -> IO ()
-dumpHoFile fn = do
-    (hoh,ho) <- readHoFile fn
-    putStrLn fn
-    when (not $ Prelude.null (hohDepends hoh)) $ putStrLn $ "Dependencies:\n" <>  vcat (map pprint $ sortUnder fst $ hohDepends hoh)
-    when (not $ Prelude.null (hohModDepends hoh)) $ putStrLn $ "ModDependencies:\n" <>  vcat (map pprint $ sortUnder fst $ hohModDepends hoh)
-    putStrLn $ "HoHash:" <+> pprint (hohHash hoh)
-    putStrLn $ "MetaInfo:\n" <> vcat (sort [text (' ':' ':unpackPS k) <> char ':' <+> show v | (k,v) <- hohMetaInfo hoh])
-    putStrLn $ "Modules contained:" <+> tshow (mkeys $ hoExports ho)
-    putStrLn $ "number of definitions:" <+> tshow (size $ hoDefs ho)
-    putStrLn $ "hoAssumps:" <+> tshow (size $ hoAssumps ho)
-    putStrLn $ "hoFixities:" <+> tshow (size $  hoFixities ho)
-    putStrLn $ "hoKinds:" <+> tshow (size $  hoKinds ho)
-    putStrLn $ "hoClassHierarchy:" <+> tshow (size $  hoClassHierarchy ho)
-    putStrLn $ "hoTypeSynonyms:" <+> tshow (size $  hoTypeSynonyms ho)
-    putStrLn $ "hoDataTable:" <+> tshow (size $  hoDataTable ho)
-    putStrLn $ "hoEs:" <+> tshow (size $  hoEs ho)
-    putStrLn $ "hoProps:" <+> tshow (size $  hoProps ho)
-    putStrLn $ "hoRules:" <+> tshow (size $  hoRules ho)
-    wdump FD.Exports $ do
-        putStrLn "---- exports information ----";
-        CharIO.putStrLn $  (pprint $ hoExports ho :: String)
-    wdump FD.Defs $ do
-        putStrLn "---- defs information ----";
-        CharIO.putStrLn $  (pprint $ hoDefs ho :: String)
-    when (dump FD.Kind) $ do
-        putStrLn "---- kind information ----";
-        CharIO.putStrLn $  (pprint $ hoKinds ho :: String)
-    when (dump FD.ClassSummary) $ do
-        putStrLn "---- class summary ---- "
-        printClassSummary (hoClassHierarchy ho)
-    when (dump FD.Class) $
-         do {putStrLn "---- class hierarchy ---- ";
-             printClassHierarchy (hoClassHierarchy ho)}
-    let rules = hoRules ho
-    wdump FD.Rules $ putStrLn "  ---- user rules ---- " >> printRules RuleUser rules
-    wdump FD.Rules $ putStrLn "  ---- user catalysts ---- " >> printRules RuleCatalyst rules
-    wdump FD.RulesSpec $ putStrLn "  ---- specializations ---- " >> printRules RuleSpecialization rules
-    wdump FD.Datatable $ do
-         putStrLn "  ---- data table ---- "
-         putDocM CharIO.putStr (showDataTable (hoDataTable ho))
-         putChar '\n'
-    wdump FD.Types $ do
-        putStrLn " ---- the types of identifiers ---- "
-        putStrLn $ PPrint.render $ pprint (hoAssumps ho)
-    wdump FD.Core $ do
-        putStrLn " ---- lambdacube  ---- "
-        mapM_ (\ (v,lc) -> putChar '\n' >> printCheckName'' (hoDataTable ho) v lc) (melems $ hoEs ho)
-    where
-    printCheckName'' :: DataTable -> TVr -> E -> IO ()
-    printCheckName'' _dataTable tvr e = do
-        when (dump FD.EInfo || verbose2) $ putStrLn (show $ tvrInfo tvr)
-        putStrLn (render $ hang 4 (pprint tvr <+> text "::" <+> pprint (tvrType tvr)))
-        putStrLn (render $ hang 4 (pprint tvr <+> equals <+> pprint e))
-
---recordHoFile :: Ho -> [(HsModule,FileDep,String,[FileDep])] -> [FileDep] -> IO [FileDep]
-
-emptyFileDep = error "emptyFileDep"
-
hunk ./Ho/Build.hs 329
-            if optNoWriteHo options then return emptyFileDep else do
+            if optNoWriteHo options then return () else do
hunk ./Ho/Build.hs 333
-            L.hPut fh (compress $ encode (magic,header,theho,magic2))
+            L.hPut fh (compress $ encode (magic,header,theho))
hunk ./Ho/Build.hs 440
+------------------------------------
+-- dumping contents of a ho file
+------------------------------------
+
hunk ./Ho/Build.hs 445
+instance DocLike d => PPrint d SrcLoc where
+    pprint sl = tshow sl
hunk ./Ho/Build.hs 448
+{-# NOINLINE dumpHoFile #-}
+dumpHoFile :: String -> IO ()
+dumpHoFile fn = do
+    (hoh,ho) <- readHoFile fn
+    putStrLn fn
+    when (not $ Prelude.null (hohDepends hoh)) $ putStrLn $ "Dependencies:\n" <>  vcat (map pprint $ sortUnder fst $ hohDepends hoh)
+    when (not $ Prelude.null (hohModDepends hoh)) $ putStrLn $ "ModDependencies:\n" <>  vcat (map pprint $ sortUnder fst $ hohModDepends hoh)
+    putStrLn $ "HoHash:" <+> pprint (hohHash hoh)
+    putStrLn $ "MetaInfo:\n" <> vcat (sort [text (' ':' ':unpackPS k) <> char ':' <+> show v | (k,v) <- hohMetaInfo hoh])
+    putStrLn $ "Modules contained:" <+> tshow (mkeys $ hoExports ho)
+    putStrLn $ "number of definitions:" <+> tshow (size $ hoDefs ho)
+    putStrLn $ "hoAssumps:" <+> tshow (size $ hoAssumps ho)
+    putStrLn $ "hoFixities:" <+> tshow (size $  hoFixities ho)
+    putStrLn $ "hoKinds:" <+> tshow (size $  hoKinds ho)
+    putStrLn $ "hoClassHierarchy:" <+> tshow (size $  hoClassHierarchy ho)
+    putStrLn $ "hoTypeSynonyms:" <+> tshow (size $  hoTypeSynonyms ho)
+    putStrLn $ "hoDataTable:" <+> tshow (size $  hoDataTable ho)
+    putStrLn $ "hoEs:" <+> tshow (size $  hoEs ho)
+    putStrLn $ "hoProps:" <+> tshow (size $  hoProps ho)
+    putStrLn $ "hoRules:" <+> tshow (size $  hoRules ho)
+    wdump FD.Exports $ do
+        putStrLn "---- exports information ----";
+        CharIO.putStrLn $  (pprint $ hoExports ho :: String)
+    wdump FD.Defs $ do
+        putStrLn "---- defs information ----";
+        CharIO.putStrLn $  (pprint $ hoDefs ho :: String)
+    when (dump FD.Kind) $ do
+        putStrLn "---- kind information ----";
+        CharIO.putStrLn $  (pprint $ hoKinds ho :: String)
+    when (dump FD.ClassSummary) $ do
+        putStrLn "---- class summary ---- "
+        printClassSummary (hoClassHierarchy ho)
+    when (dump FD.Class) $
+         do {putStrLn "---- class hierarchy ---- ";
+             printClassHierarchy (hoClassHierarchy ho)}
+    let rules = hoRules ho
+    wdump FD.Rules $ putStrLn "  ---- user rules ---- " >> printRules RuleUser rules
+    wdump FD.Rules $ putStrLn "  ---- user catalysts ---- " >> printRules RuleCatalyst rules
+    wdump FD.RulesSpec $ putStrLn "  ---- specializations ---- " >> printRules RuleSpecialization rules
+    wdump FD.Datatable $ do
+         putStrLn "  ---- data table ---- "
+         putDocM CharIO.putStr (showDataTable (hoDataTable ho))
+         putChar '\n'
+    wdump FD.Types $ do
+        putStrLn " ---- the types of identifiers ---- "
+        putStrLn $ PPrint.render $ pprint (hoAssumps ho)
+    wdump FD.Core $ do
+        putStrLn " ---- lambdacube  ---- "
+        mapM_ (\ (v,lc) -> putChar '\n' >> printCheckName'' (hoDataTable ho) v lc) (melems $ hoEs ho)
+    where
+    printCheckName'' :: DataTable -> TVr -> E -> IO ()
+    printCheckName'' _dataTable tvr e = do
+        when (dump FD.EInfo || verbose2) $ putStrLn (show $ tvrInfo tvr)
+        putStrLn (render $ hang 4 (pprint tvr <+> text "::" <+> pprint (tvrType tvr)))
+        putStrLn (render $ hang 4 (pprint tvr <+> equals <+> pprint e))