[perform all typechecking before starting any compilation for a better user experience
John Meacham <john@repetae.net>**20090807034745
 Ignore-this: ab2f471b15c98af845392cbbe6852139
] hunk ./src/FrontEnd/FrontEnd.hs 2
-    parseFiles,
+--    parseFiles,
hunk ./src/FrontEnd/FrontEnd.hs 4
+    doModules',
hunk ./src/FrontEnd/FrontEnd.hs 17
-import Ho.Build
hunk ./src/FrontEnd/FrontEnd.hs 18
+import Ho.Type
hunk ./src/FrontEnd/FrontEnd.hs 26
-makeLibrary ifunc func hl = do buildLibrary ifunc (doModules func) hl
+--makeLibrary ifunc func hl = do buildLibrary ifunc (doModules func) hl
+makeLibrary ifunc func hl = undefined -- do buildLibrary ifunc (doModules func) hl
hunk ./src/FrontEnd/FrontEnd.hs 31
+{-
hunk ./src/FrontEnd/FrontEnd.hs 40
+-}
hunk ./src/FrontEnd/FrontEnd.hs 53
-    --func ho ho' tiData
+
+-- Process modules found by Ho
+doModules' :: HoTcInfo -> [HsModule] -> IO  (HoTcInfo,Tc.TiData)
+doModules' htc ms  = do
+    ms <- mapM modInfo ms
+    when (dump FD.Defs) $ flip mapM_ ms $ \m -> do
+         putStrLn $ " ---- Definitions for" <+> show (modInfoName m) <+> "----";
+         mapM_ print ( modInfoDefs m)
+    ms <- determineExports [ (x,y,z) | (x,(y,z)) <- Map.toList $ hoDefs htc] (Map.toList $ hoExports htc) ms
+    Tc.tiModules htc ms
hunk ./src/FrontEnd/HsPretty.hs 534
+ppHsExp (HsLocatedExp (Located _ x)) = ppHsExp x
hunk ./src/Ho/Build.hs 4
-    compileModules,
+--    compileModules,
+    parseFiles,
hunk ./src/Ho/Build.hs 43
+import FrontEnd.FrontEnd
hunk ./src/Ho/Build.hs 250
-    | CompTCed Bool CompUnit
+    | CompTCed HoTcInfo (Maybe (HoTcInfo,TiData,[(HoHash,HsModule)],[String])) CompUnit
+    | CompTCedSource HoTcInfo TiData [(HoHash,HsModule)] [String]
+    | CompTcError
hunk ./src/Ho/Build.hs 367
-compileModules :: [Either Module String]                             -- ^ Either a module or filename to find
+parseFiles :: [Either Module String]                             -- ^ Either a module or filename to find
hunk ./src/Ho/Build.hs 369
-               -> (CollectedHo -> [HsModule] -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
+               -> (CollectedHo -> Ho -> TiData -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
+--               -> (CollectedHo -> [HsModule] -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
hunk ./src/Ho/Build.hs 373
-compileModules need ifunc func = do
+parseFiles need ifunc func = do
hunk ./src/Ho/Build.hs 375
-    processCug cug >>= mkPhonyCompNode needed >>= compileCompNode ifunc func
+    cnode <- processCug cug >>= mkPhonyCompNode needed
+    typeCheckGraph cnode
+    compileCompNode ifunc func cnode
hunk ./src/Ho/Build.hs 427
-{-
-typeCheckGraph :: CompNode -> IO Bool
+typeCheckGraph :: CompNode -> IO HoTcInfo
hunk ./src/Ho/Build.hs 440
-          do curModule <- tickProgress cur
-             printf fmtStr curModule maxModules (show $ hsModuleName modName)
-        fmtStr = printf "[%%%dd of %*d] %%s]" fmtLen fmtLen maxModules where
-            fmtLen = ceiling (logBase 10 (fromIntegral maxModules+1) :: Double) :: Int
+          do curModule <- tickProgress
+             printf "[%*d of %*d] %s\n" fmtLen curModule fmtLen maxModules (show $ hsModuleName modName)
+--             printf fmtStr curModule maxModules (show $ hsModuleName modName)
+        --fmtStr = printf "[%%%id of %*d] %%s]" fmtLen fmtLen maxModules where
+        fmtLen = ceiling (logBase 10 (fromIntegral maxModules+1) :: Double) :: Int
hunk ./src/Ho/Build.hs 446
-            CompCollected ch _ -> return False
-            CompTCed errors _ -> return errors
+            CompCollected ch _ -> error "compcollected in typechecknig phase"
+            CompTCed tcc _ _  -> return tcc
+            CompTcError -> error "comptcerror"
hunk ./src/Ho/Build.hs 450
-                xs <- or `fmap` mapM f deps
-                writeIORef ref (CompTCed xs CompPhony)
+                xs <- mconcat `fmap` mapM f deps
+                writeIORef ref (CompTCed xs Nothing CompPhony)
hunk ./src/Ho/Build.hs 453
-            CompHo {} -> return False
+            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'
hunk ./src/Ho/Build.hs 460
+                ctc <- mconcat `fmap` mapM f deps
hunk ./src/Ho/Build.hs 462
-                cho <- mconcat `fmap` mapM f deps
hunk ./src/Ho/Build.hs 468
---                (cho',newHo) <- func cho (snds modules)
---
---                let hoh = HoHeader {
---                             hohVersion = current_version,
---                             hohName = Left mgName,
---                             hohHash       = hh,
---                             hohArchDeps = [],
---                             hohLibDeps   = []
---                             }
---                    idep = HoIDeps {
---                            hoIDeps = Map.fromList [ (h,(hsModuleName mod,hsModuleRequires mod)) | (h,mod) <- modules],
---                            hoDepends    = [ (hsModuleName mod,h) | (h,mod) <- modules],
---                            hoModDepends = hdep
---                            }
---                    (mgName:_) = sort $ map (hsModuleName . snd) modules
---
---                recordHoFile newHo idep (map sourceHoName sc) hoh
---                writeIORef ref (CompCollected cho' (CompHo Nothing hoh idep newHo))
---                return cho'
+                (htc,tidata) <- doModules' ctc (snds modules)
+                let ctc' = htc `mappend` ctc
+                --writeIORef ref (CompTCed ctc' (Just (htc,tidata,modules,map sourceHoName sc)) cn)
+                writeIORef ref (CompTCed ctc' (Just (htc,tidata,modules,map sourceHoName sc)) CompPhony)
+                return ctc'
hunk ./src/Ho/Build.hs 475
--}
hunk ./src/Ho/Build.hs 476
-                -> (CollectedHo -> [HsModule] -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
+                -> (CollectedHo -> Ho -> TiData  -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
hunk ./src/Ho/Build.hs 482
-    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)
+    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)
hunk ./src/Ho/Build.hs 498
-    f n cur (CompNode hh deps ref) = readIORef ref >>= \cn -> case cn of
-        CompCollected ch _ -> return ch
-        CompPhony -> do
-            xs <- mconcat `fmap` mapM (f n cur) deps
-            writeIORef ref (CompCollected xs CompPhony)
-            return xs
-        CompHo _ hoh idep ho -> do
-            cho <- mconcat `fmap` mapM (f n cur) deps
-            forM_ (hoDepends idep) $ \_ -> tickProgress cur
-            cho <- ifunc cho ho
-            writeIORef ref (CompCollected cho cn)
-            return cho
-        CompSources sc -> do
-            let hdep = [ h | CompNode h _ _ <- deps]
-            cho <- mconcat `fmap` mapM (f n cur) 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 n cur (snds modules)
-            (cho',newHo) <- func cho (snds modules)
+    f n cur (CompNode hh deps ref) = readIORef ref >>= g where
+        g cn = case cn of
+            CompCollected ch _ -> return ch
+            CompPhony -> do
+                xs <- mconcat `fmap` mapM (f n cur) deps
+                writeIORef ref (CompCollected xs CompPhony)
+                return xs
+            CompHo _ hoh idep ho -> do
+                cho <- mconcat `fmap` mapM (f n cur) deps
+                forM_ (hoDepends idep) $ \_ -> tickProgress cur
+                cho <- ifunc cho ho
+                writeIORef ref (CompCollected cho cn)
+                return cho
+            CompTCed _ Nothing nn -> g nn
+            CompTCed _ (Just (htc,tidata,modules,shns)) _  -> do
+                let hdep = [ h | CompNode h _ _ <- deps]
+                cho <- mconcat `fmap` mapM (f n cur) deps
+                --showProgress n cur (snds modules)
+                --(cho',newHo) <- func cho (snds modules)
+                (cho',newHo) <- func cho mempty { hoTcInfo = htc } tidata
hunk ./src/Ho/Build.hs 519
-            let hoh = HoHeader {
-                         hohVersion = current_version,
-                         hohName = Left mgName,
-                         hohHash       = hh,
-                         hohArchDeps = [],
-                         hohLibDeps   = []
-                         }
-                idep = HoIDeps {
-                        hoIDeps = Map.fromList [ (h,(hsModuleName mod,hsModuleRequires mod)) | (h,mod) <- modules],
-                        hoDepends    = [ (hsModuleName mod,h) | (h,mod) <- modules],
-                        hoModDepends = hdep
-                        }
-                (mgName:_) = sort $ map (hsModuleName . snd) modules
+                let hoh = HoHeader {
+                             hohVersion = current_version,
+                             hohName = Left mgName,
+                             hohHash       = hh,
+                             hohArchDeps = [],
+                             hohLibDeps   = []
+                             }
+                    idep = HoIDeps {
+                            hoIDeps = Map.fromList [ (h,(hsModuleName mod,hsModuleRequires mod)) | (h,mod) <- modules],
+                            hoDepends    = [ (hsModuleName mod,h) | (h,mod) <- modules],
+                            hoModDepends = hdep
+                            }
+                    (mgName:_) = sort $ map (hsModuleName . snd) modules
hunk ./src/Ho/Build.hs 533
-            recordHoFile newHo idep (map sourceHoName sc) hoh
-            writeIORef ref (CompCollected cho' (CompHo Nothing hoh idep newHo))
-            return cho'
+                recordHoFile newHo idep shns hoh
+                writeIORef ref (CompCollected cho' (CompHo Nothing hoh idep newHo))
+                return cho'
+            CompSources _ -> error "sources still exist!?"
hunk ./src/Ho/Build.hs 539
-findModule :: [Either Module String]                                -- ^ Either a module or filename to find
-              -> (CollectedHo -> Ho -> IO CollectedHo)              -- ^ Process initial ho loaded from file
-              -> (CollectedHo -> [HsModule] -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
-              -> IO (CollectedHo,[(Module,MD5.Hash)],Ho)            -- ^ (Final accumulated ho,just the ho read to satisfy this command)
-findModule need ifunc func  = do
-    (needed,cug) <- loadModules (optHls options) need
-    cnodes <- processCug cug
-    rnode <- mkPhonyCompNode needed cnodes
-    cho <- compileCompNode ifunc func rnode
-    return (cho,undefined,undefined)
hunk ./src/Ho/Build.hs 730
+findModule :: [Either Module String]                                -- ^ Either a module or filename to find
+              -> (CollectedHo -> Ho -> IO CollectedHo)              -- ^ Process initial ho loaded from file
+              -> (CollectedHo -> [HsModule] -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
+              -> IO (CollectedHo,[(Module,MD5.Hash)],Ho)            -- ^ (Final accumulated ho,just the ho read to satisfy this command)
+findModule need ifunc func  = do
+    (needed,cug) <- loadModules (optHls options) need
+    cnodes <- processCug cug
+    rnode <- mkPhonyCompNode needed cnodes
+    typeCheckGraph rnode
+    cho <- compileCompNode ifunc func rnode
+    return (cho,undefined,undefined)