[don't include modules from other libraries in newly created libraries
John Meacham <john@repetae.net>**20070828072608] hunk ./FrontEnd/FrontEnd.hs 30
-               -> IO (CollectedHo,Ho)     -- ^ (the final combined ho,all the loaded ho data)
+               -> IO CollectedHo          -- ^ (the final combined ho,all the loaded ho data)
hunk ./FrontEnd/FrontEnd.hs 34
-    res <- findModule fs ifunc (doModules func)
-    processIOErrors
+    (res,_,_) <- findModule fs ifunc (doModules func)
hunk ./Ho/Build.hs 222
-              -> IO (CollectedHo,Ho)                                -- ^ (Final accumulated ho,just the ho read to satisfy this command)
+              -> IO (CollectedHo,[(Module,SHA1.Hash)],Ho)                                -- ^ (Final accumulated ho,just the ho read to satisfy this command)
hunk ./Ho/Build.hs 238
-                    (mp,readHo,rs) <- f (hsModuleRequires hs ++ xs) (Set.insert m ds)
-                    return (mp `mappend` mempty { choFiles = Map.singleton m fd },readHo,((hs,(m,fd),s):rs))
+                    (mp,readHo,libHo,rs) <- f (hsModuleRequires hs ++ xs) (Set.insert m ds)
+                    return (mp `mappend` mempty { choFiles = Map.singleton m fd },readHo,libHo,((hs,(m,fd),s):rs))
hunk ./Ho/Build.hs 242
-                    (mp,readHo,rs) <- f (fsts (hohModDepends hoh) ++ xs) (Set.union ss ds)
-                    return (mp `mappend` mempty { choModules = mprovides hoh, choFiles = Map.fromList $ hohDepends hoh }, ho `mappend` readHo,rs)
+                    (mp,readHo,(libDeps,libHo),rs) <- f (fsts (hohModDepends hoh) ++ xs) (Set.union ss ds)
+                    let mp' = mp `mappend` mempty { choModules = mprovides hoh, choFiles = Map.fromList $ hohDepends hoh }
+                        ho' = ho `mappend` readHo
+                    case hohMetaInfo hoh of
+                        [] -> return (mp', ho',(libDeps,libHo `mappend` ho),rs)
+                        _  -> return (mp', ho',((m,hohHash hoh):libDeps,libHo),rs)
hunk ./Ho/Build.hs 250
-        f [] _ = return (mempty,mempty,mempty)
+        f [] _ = return (mempty,mempty,mempty,mempty)
hunk ./Ho/Build.hs 252
-    (cho,readHo,ms) <- f (concat ms) Set.empty
+    (cho,readHo,(libDeps,libHo), ms) <- f (concat ms) Set.empty
+    writeIORef r_dm (error "r_dm")  -- to encourage garbage collection.
hunk ./Ho/Build.hs 262
-    let f ho readHo [] = return (ho,readHo)
-        f ho readHo (sc:scs) = do
+    let f ho libHo [] = processIOErrors >> return (ho,libDeps,libHo)
+        f ho libHo (sc:scs) = do
hunk ./Ho/Build.hs 268
-            let hoh = fillInHohHash HoHeader { hohDepends    = [ x | (_,x,_) <- sc],
+            let hoh = fillInHohHash HoHeader {
+                                 hohDepends    = [ x | (_,x,_) <- sc],
hunk ./Ho/Build.hs 274
-            --modifyIORef r_dm (Map.union $ Map.fromList [ (hsModuleName hs,ModuleHo hoh newHo) | (hs,_,_) <- sc ])
hunk ./Ho/Build.hs 275
-            f (cho' `mappend` mempty { choFiles = Map.fromList $ hohDepends hoh, choModules = mprovides hoh }) (readHo `mappend` newHo)  scs
+            f (cho' `mappend` mempty { choFiles = Map.fromList $ hohDepends hoh, choModules = mprovides hoh }) (libHo `mappend` newHo)  scs
hunk ./Ho/Build.hs 278
-    f cho readHo scc
+    f cho libHo scc
hunk ./Ho/Build.hs 470
-buildLibrary ifunc func fp = createLibrary fp bl where
-    bl ms = findModule (map Left ms) ifunc func
+buildLibrary ifunc func = ans where
+    ans fp = do
+        (desc,name,hmods,emods) <- parse fp
+        let allmods  = sort (emods ++ hmods)
+        (cho,libDeps,ho) <- findModule (map Left (emods ++ hmods)) ifunc func
+        let unknownMods = [ m | m <- mkeys (hoExports ho), m `notElem` allmods  ]
+        mapM_ ((putStrLn . ("*** Module included in library that is not in export list: " ++)) . show) unknownMods
+        let outName = case optOutName options of
+                "hs.out" -> name ++ ".hl"
+                fn -> fn
+        let pdesc = [(packString n, packString v) | (n,v) <- ("jhc-hl-filename",outName):("jhc-description-file",fp):("jhc-compiled-by",versionString):desc, n /= "exposed-modules" ]
+        let lhash = SHA1.sha1String (show $ choFiles cho)
+        let hoh =  HoHeader {
+                hohHash = lhash,
+                hohDepends = [ (m,SHA1.emptyHash) | m <- mkeys (hoExports ho)],
+                hohModDepends = libDeps,
+                hohMetaInfo = pdesc
+                }
+        recordHoFile ho [outName] hoh
+
+    -- parse library description file
+    parse fp = do
+        putVerboseLn $ "Creating library from description file: " ++ show fp
+        desc <- readDescFile fp
+        when verbose2 $ mapM_ print desc
+        let field x = lookup x desc
+            jfield x = maybe (fail $ "createLibrary: description lacks required field " ++ show x) return $ field x
+            mfield x = maybe [] (words . map (\c -> if c == ',' then ' ' else c)) $ field x
+        name <- jfield "name"
+        vers <- jfield "version"
+        let hmods = map Module $ snub $ mfield "hidden-modules"
+            emods = map Module $ snub $ mfield "exposed-modules"
+        return (desc,name ++ "-" ++ vers,hmods,emods)
hunk ./Ho/Build.hs 504
-createLibrary ::
-    FilePath
-    -> ([Module] -> IO (CollectedHo,Ho))
-    -> IO ()
-createLibrary fp wtd = do
-    putVerboseLn $ "Creating library from description file: " ++ show fp
-    desc <- readDescFile fp
-    when verbose2 $ mapM_ print desc
-    let field x = lookup x desc
-        jfield x = maybe (fail $ "createLibrary: description lacks required field " ++ show x) return $ field x
-        mfield x = maybe [] (words . map (\c -> if c == ',' then ' ' else c)) $ field x
-    name <- jfield "name"
-    vers <- jfield "version"
-    let hmods = map Module $ snub $ mfield "hidden-modules"
-        emods = map Module $ snub $ mfield "exposed-modules"
-    let allmods  = sort (emods ++ hmods)
-    (cho,ho) <- wtd emods
-    let unknownMods = [ m | m <- mkeys (hoExports ho), m `notElem` allmods  ]
-    mapM_ ((putStrLn . ("*** Module included in library that is not in export list: " ++)) . show) unknownMods
-    let outName = case optOutName options of
-            "hs.out" -> name ++ "-" ++ vers ++ ".hl"
-            fn -> fn
-    let pdesc = [(packString n, packString v) | (n,v) <- ("jhc-hl-filename",outName):("jhc-description-file",fp):("jhc-compiled-by",versionString):desc, n /= "exposed-modules" ]
-    let lhash = SHA1.sha1String (show $ choFiles cho)
-    let hoh =  HoHeader {
-            hohHash = lhash,
-            hohDepends = [ (m,SHA1.emptyHash) | m <- mkeys (hoExports ho)],
-            hohModDepends = [],
-            hohMetaInfo = pdesc
-            }
-    recordHoFile ho [outName] hoh
hunk ./Main.hs 460
-compileModEnv' (cho,_) = do
+compileModEnv' cho = do
hunk ./Makefile 121
-clean-ho:
+ho-clean:
+	rm -f -- `find -name \*.ho`
+hl-clean: