[clean up handling of CompNode
John Meacham <john@repetae.net>**20090808055025
 Ignore-this: 8a8eb7fd1c397b26bb99bdfffd15ac09
] hunk ./Makefile.am 217
-	./jhc -v -funboxed-tuples $(RTSOPTS) $(JHC_TEST)  --ho-dir tmp/libho -ilib/base --noauto --build-hl lib/base/base.cabal -o $@
+	./jhc -funboxed-tuples $(RTSOPTS) $(JHC_TEST)  --ho-dir tmp/libho -ilib/base --noauto --build-hl lib/base/base.cabal -o $@
hunk ./Makefile.am 221
-	./jhc -v $(RTSOPTS) $(JHC_TEST)  --ho-dir tmp/libho -ilib/applicative  --noauto -L- -L. -p base --build-hl lib/applicative/applicative.cabal -o $@
+	./jhc $(RTSOPTS) $(JHC_TEST)  --ho-dir tmp/libho -ilib/applicative  --noauto -L- -L. -p base --build-hl lib/applicative/applicative.cabal -o $@
hunk ./Makefile.am 225
-	./jhc -v $(RTSOPTS) $(JHC_TEST) -Idata -Ilib/containers/include --ho-dir tmp/libho -ilib/containers  --noauto -L- -L. -p base -p applicative --build-hl lib/containers.cabal -fcpp -o $@
+	./jhc $(RTSOPTS) $(JHC_TEST) -Idata -Ilib/containers/include --ho-dir tmp/libho -ilib/containers  --noauto -L- -L. -p base -p applicative --build-hl lib/containers.cabal -fcpp -o $@
hunk ./Makefile.am 229
-	./jhc -v $(RTSOPTS) $(JHC_TEST) --ho-dir tmp/libho -ilib/haskell98 --noauto -L- -L. -p base --build-hl lib/haskell98.cabal -o $@
+	./jhc $(RTSOPTS) $(JHC_TEST) --ho-dir tmp/libho -ilib/haskell98 --noauto -L- -L. -p base --build-hl lib/haskell98.cabal -o $@
hunk ./src/FrontEnd/FrontEnd.hs 2
---    parseFiles,
-    makeLibrary,
hunk ./src/FrontEnd/FrontEnd.hs 24
---makeLibrary ifunc func hl = do buildLibrary ifunc (doModules func) hl
-makeLibrary ifunc func hl = undefined -- do buildLibrary ifunc (doModules func) hl
hunk ./src/Ho/Build.hs 245
-data CompNode = CompNode !HoHash [CompNode] !(IORef CompUnit)
+data CompNode = CompNode !HoHash [CompNode] !(IORef CompLink)
+data CompLink
+    = CompLinkNone
+    | CompLinkUnit CompUnit
+    | CompCollected CollectedHo CompLink
+    | CompTcCollected HoTcInfo CompLink
hunk ./src/Ho/Build.hs 255
-    = CompHo   (Maybe String)  HoHeader HoIDeps Ho
+    = CompHo (Maybe String)  HoHeader HoIDeps Ho
hunk ./src/Ho/Build.hs 257
-    | CompPhony
-    | CompCollected CollectedHo CompUnit
+--    | CompCollected CollectedHo CompUnit
hunk ./src/Ho/Build.hs 259
-    | CompLib ModuleGroup
hunk ./src/Ho/Build.hs 281
-    providesModules CompPhony        = []
+--    providesModules CompPhony        = []
+ --   providesModules (CompCollected _ cu) = providesModules cu
+
+instance ProvidesModules CompLink where
+    providesModules CompLinkNone = []
+    providesModules (CompLinkUnit cu) = providesModules cu
hunk ./src/Ho/Build.hs 288
+    providesModules (CompTcCollected _ cu) = providesModules cu
hunk ./src/Ho/Build.hs 428
-            cur <- newIORef cu
+            cur <- newIORef (CompLinkUnit cu)
hunk ./src/Ho/Build.hs 440
-    CompNode hash (concat xs) `fmap` newIORef CompPhony
+    CompNode hash (concat xs) `fmap` newIORef CompLinkNone
hunk ./src/Ho/Build.hs 453
+countNodes (CompNode hh deps ref) = do
+    ds <- mapM countNodes deps
+    let g cn =  case cn of
+            CompLinkNone -> return Set.empty
+            CompLinkUnit cu -> f cu
+            CompTcCollected _ cu -> g cu
+            CompCollected _ cu -> g cu
+        f cu = case cu of
+            CompTCed _ _ cn   -> f cn
+--            CompCollected _ _ -> return Set.empty
+            CompHo _ hoh idep _  -> do
+                ds <- mconcat `fmap` mapM countNodes deps
+                return $ ds `Set.union` Set.fromList (map (show.fst) (hoDepends idep))
+            CompSources sc    -> do
+                ds <- mconcat `fmap` mapM countNodes deps
+                return $ ds `Set.union` Set.fromList (map sourceIdent sc)
+    cm <- readIORef ref >>= g
+    return (Set.unions (cm:ds))
+
hunk ./src/Ho/Build.hs 476
-    let countNodes (CompNode hh deps ref) = readIORef ref >>= \cn -> case cn of
-            CompCollected _ _ -> return Set.empty
-            CompPhony         -> mconcat `fmap` mapM countNodes deps
-            CompHo _ hoh idep _  -> do ds <- mconcat `fmap` mapM countNodes deps
-                                       return $ ds `Set.union` Set.fromList (map (show.fst) (hoDepends idep))
-            CompSources sc    -> do ds <- mconcat `fmap` mapM countNodes deps
-                                    return $ ds `Set.union` Set.fromList (map sourceIdent sc)
-        tickProgress = modifyMVar cur $ \val -> return (val+1,val)
+    let tickProgress = modifyMVar cur $ \val -> return (val+1,val)
hunk ./src/Ho/Build.hs 481
-            CompCollected ch _ -> error "compcollected in typechecknig phase"
-            CompTCed tcc _ _  -> return tcc
-            CompTcError -> error "comptcerror"
-            CompPhony -> do
-                xs <- mconcat `fmap` mapM f deps
-                writeIORef ref (CompTCed xs Nothing CompPhony)
-                return xs
-            CompHo _ hoh idep ho  -> do
-                ctc <- mconcat `fmap` mapM f deps
-                forM_ (hoDepends idep) $ \_ -> tickProgress
-                let ctc' = hoTcInfo ho `mappend` ctc
-                writeIORef ref (CompTCed ctc' Nothing cn)
-                return ctc'
-            CompSources sc -> do
+            CompLinkNone -> do
hunk ./src/Ho/Build.hs 483
-                let hdep = [ h | CompNode h _ _ <- deps]
-                modules <- forM sc $ \x -> case x of
-                    SourceParsed { sourceHash = h,sourceModule = mod } -> return (h,mod)
-                    SourceRaw { sourceHash = h,sourceLBS = lbs, sourceFP = fp } -> do
-                        mod <- parseHsSource fp lbs
-                        return (h,mod)
-                showProgress (snds modules)
-                (htc,tidata) <- doModules' ctc (snds modules)
-                let ctc' = htc `mappend` ctc
-                writeIORef ref (CompTCed ctc' (Just (htc,tidata,modules,map sourceHoName sc)) cn)
-                return ctc'
+                writeIORef ref (CompTcCollected ctc CompLinkNone)
+                return ctc
+            CompTcCollected ctc _ -> return ctc
+            CompLinkUnit lu -> case lu of
+--                CompCollected ch _ -> error "compcollected in typechecknig phase"
+                CompTCed tcc _ _  -> return tcc
+                CompTcError -> error "comptcerror"
+                CompHo _ hoh idep ho  -> do
+                    ctc <- mconcat `fmap` mapM f deps
+                    forM_ (hoDepends idep) $ \_ -> tickProgress
+                    let ctc' = hoTcInfo ho `mappend` ctc
+                    writeIORef ref (CompTcCollected ctc' cn)
+                    return ctc'
+                CompSources sc -> do
+                    ctc <- mconcat `fmap` mapM f deps
+                    let hdep = [ h | CompNode h _ _ <- deps]
+                    modules <- forM sc $ \x -> case x of
+                        SourceParsed { sourceHash = h,sourceModule = mod } -> return (h,mod)
+                        SourceRaw { sourceHash = h,sourceLBS = lbs, sourceFP = fp } -> do
+                            mod <- parseHsSource fp lbs
+                            return (h,mod)
+                    showProgress (snds modules)
+                    (htc,tidata) <- doModules' ctc (snds modules)
+                    let ctc' = htc `mappend` ctc
+                    writeIORef ref (CompTcCollected ctc' (CompLinkUnit $ CompTCed ctc' (Just (htc,tidata,modules,map sourceHoName sc)) lu))
+                    return ctc'
hunk ./src/Ho/Build.hs 519
-    let countNodes (CompNode hh deps ref) = readIORef ref >>= g where
-            g cn =  case cn of
-                CompTCed _ _ cn   -> g cn
-                CompCollected _ _ -> return Set.empty
-                CompPhony         -> mconcat `fmap` mapM countNodes deps
-                CompHo _ hoh idep _  -> do ds <- mconcat `fmap` mapM countNodes deps
-                                           return $ ds `Set.union` Set.fromList (map (show.fst) (hoDepends idep))
-                CompSources sc    -> do ds <- mconcat `fmap` mapM countNodes deps
-                                        return $ ds `Set.union` Set.fromList (map sourceIdent sc)
-        tickProgress = modifyMVar cur $ \val -> return (val+1,val)
+    let tickProgress = modifyMVar cur $ \val -> return (val+1,val)
hunk ./src/Ho/Build.hs 526
-                CompPhony -> do
+                CompLinkNone -> do
hunk ./src/Ho/Build.hs 528
-                    writeIORef ref (CompCollected xs CompPhony)
+                    writeIORef ref (CompCollected xs CompLinkNone)
hunk ./src/Ho/Build.hs 530
-                CompHo _ hoh idep ho -> do
+                CompTcCollected _ cl -> g cl
+                CompLinkUnit cu -> h cu
+            h cu = case cu of
+                cn@(CompHo _ hoh idep ho) -> do
hunk ./src/Ho/Build.hs 537
-                    writeIORef ref (CompCollected cho cn)
+                    writeIORef ref (CompCollected cho (CompLinkUnit cn))
hunk ./src/Ho/Build.hs 539
-                CompTCed _ Nothing nn -> g nn
+                CompTCed _ Nothing nn -> h nn
hunk ./src/Ho/Build.hs 563
-                    writeIORef ref (CompCollected cho' (CompHo Nothing hoh idep newHo))
+                    writeIORef ref (CompCollected cho' (CompLinkUnit $ CompHo Nothing hoh idep newHo))
hunk ./src/Ho/Build.hs 567
---    showProgress maxModules cur ms
---        = forM_ ms $ \modName ->
---          do curModule <- tickProgress cur
---             let l = ceiling (logBase 10 (fromIntegral maxModules+1) :: Double) :: Int
---             printf "[%*d of %*d] %s\n" l curModule l maxModules (show $ hsModuleName modName)
hunk ./src/Ho/Build.hs 725
-             -> (CollectedHo -> [HsModule] -> IO (CollectedHo,Ho))
+             -> (CollectedHo -> Ho -> TiData -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
hunk ./src/Ho/Build.hs 728
-buildLibrary ifunc func = undefined
-{-
hunk ./src/Ho/Build.hs 732
+        cho <- parseFiles (map Left allmods) ifunc func
+        return ()
+    -- 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)
+
+{-
+    ans fp = do
+        (desc,name,hmods,emods) <- parse fp
+        let allmods  = sort (emods ++ hmods)
hunk ./src/Main.hs 101
-        BuildHl hl    -> makeLibrary processInitialHo processDecls hl
+        BuildHl hl    -> buildLibrary processInitialHo processDecls hl
hunk ./src/Options.hs 179
+    optBatch       :: !Int,                    -- ^ How many modules to attempt in parallel
hunk ./src/Options.hs 214
+    optBatch       = 10,
hunk ./src/Options.hs 249
+--    , Option []    ["batch"]     (ReqArg (optBatch_s . read) "15") "number of modules to compile as a group at once, lower numbers trade speed for memory"