[redo library code to be special case of a ho file, remove a lot of old infrastructure.
John Meacham <john@repetae.net>**20070825021247] hunk ./Ho/LibraryMap.hs 1
-module Ho.LibraryMap(
-    libraryMapFind,
-    loadedLibraries,
-    libraryList
-    ) where
-
-import Ho.Type
-import Options(options,optHlPath,optHls)
-import Control.Monad.Identity
-
-import qualified Data.Map as Map
-import System.Directory
-import System.IO.Unsafe
-
-type LibraryMap = Map.Map LibraryName FilePath
-
-----
-
-{-# NOINLINE globalLibraryMap #-}
-globalLibraryMap :: LibraryMap
-globalLibraryMap = unsafePerformIO $ getLibraryMap $ optHlPath options
-
-
-loadedLibraries = runIdentity $ do
-    rs <- mapM libraryMapFind (optHls options)
-    return $ map fst rs
-
-----
-
-libraryMapFind :: Monad m => LibraryName -> m (LibraryName,FilePath)
-libraryMapFind pn =
-  case Map.lookup pn globalLibraryMap of
-    Just x  -> return (pn,x)
-    Nothing -> case range (pn++"-") (pn++"-"++repeat maxBound) globalLibraryMap of
-                 [] -> fail ("LibraryMap: Library "++pn++" not found!")
-                 xs -> return $ last xs
-
-libraryList :: [(LibraryName,FilePath)]
-libraryList = Map.toList globalLibraryMap
-
----- range queries for Data.Map
-
-range :: Ord k => k -> k -> Map.Map k v -> [(k,v)]
-range low high = Map.toList . fst . Map.split high . snd . Map.split low
-
-----
-
-getLibraryMap :: [FilePath] -> IO LibraryMap
-getLibraryMap fps = fmap Map.unions $ mapM getPM fps
-
-getPM fp = flip catch (\_ -> return Map.empty) $ do
-    raw <- getDirectoryContents fp
-    return $ Map.fromList $ flip concatMap raw $ \e ->
-        case reverse e of
-          ('l':'h':'.':r) -> [(reverse r,fp++"/"++e)]
-          _               -> []
-
rmfile ./Ho/LibraryMap.hs
hunk ./FrontEnd/FrontEnd.hs 18
-import Ho.Library(loadLibraries)
hunk ./FrontEnd/FrontEnd.hs 38
-    libraries <- loadLibraries
-    initialHo <- ifunc mempty (initialHo `mappend` libraries)
-    (initialHo,ho) <- findModule initialHo fs ifunc (doModules func)
+    (initialHo,ho) <- findModule fs ifunc (doModules func)
hunk ./Ho/Build.hs 8
+    createLibrary,
hunk ./Ho/Build.hs 51
-import Ho.LibraryMap
+import Ho.Library
hunk ./Ho/Build.hs 59
+import Version(versionString)
hunk ./Ho/Build.hs 149
-        let cd (m,h) = do
+        let cd (m,h) | h /= SHA1.emptyHash = do
hunk ./Ho/Build.hs 156
+            cd _ = return ()
hunk ./Ho/Build.hs 222
-findModule :: CollectedHo                                           -- ^ Accumulated Ho
-              -> [Either Module String]                             -- ^ Either a module or filename to find
+findModule :: [Either Module String]                             -- ^ Either a module or filename to find
hunk ./Ho/Build.hs 226
-findModule cho need ifunc func  = do
+findModule need ifunc func  = do
hunk ./Ho/Build.hs 228
+
+    putVerboseLn $ "Loading libraries:" <+> show (optHls options)
+    forM_ (optHls options) $ \l -> do
+        (n',fn) <- findLibrary l
+        putVerboseLn $ "Found" <+> show (l,n') <+> "at" <+> fn
+        checkTheHoFile r_dm fn
hunk ./Ho/Build.hs 242
-                    return (mp,readHo,((hs,(m,fd),s):rs))
+                    return (mp `mappend` mempty { choFiles = Map.singleton m fd },readHo,((hs,(m,fd),s):rs))
hunk ./Ho/Build.hs 246
-                    return (mp `union` mprovides hoh, ho `mappend` readHo,rs)
+                    return (mp `mappend` mempty { choModules = mprovides hoh, choFiles = Map.fromList $ hohDepends hoh }, ho `mappend` readHo,rs)
hunk ./Ho/Build.hs 251
-    (mp,readHo,ms) <- f (concat ms) Set.empty
+    (cho,readHo,ms) <- f (concat ms) Set.empty
hunk ./Ho/Build.hs 274
-            f (cho' `mappend` mempty { choModules = mprovides hoh }) (readHo `mappend` newHo)  scs
+            f (cho' `mappend` mempty { choFiles = Map.fromList $ hohDepends hoh, choModules = mprovides hoh }) (readHo `mappend` newHo)  scs
hunk ./Ho/Build.hs 276
-    cho <- ifunc cho { choModules = choModules cho `union` mp } readHo
+    cho <- ifunc cho (initialHo `mappend` readHo)
hunk ./Ho/Build.hs 291
+    return $ Just (hh,ho)
hunk ./Ho/Build.hs 295
-    if (all (`elem` loadedLibraries) (Map.keys $ hoLibraries ho)) then do
+    --if (all (`elem` loadedLibraries) (Map.keys $ hoLibraries ho)) then do
hunk ./Ho/Build.hs 297
-        return $ Just (hh,ho)
-     else do
-        putErrLn $ "No library dep for ho file:" <+> fn
-        return Nothing
+     --   return $ Just (hh,ho)
+     --else do
+     --   putErrLn $ "No library dep for ho file:" <+> fn
+     --   return Nothing
hunk ./Ho/Build.hs 473
+---------------------------------
+-- library specific routines
+---------------------------------
+
+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
+    let jfield x = maybe (error "createLibrary: description lacks required field "++show x) id $ field x
+    let mfield x = maybe [] (words . map (\c -> if c == ',' then ' ' else c)) $ field x
+    let name  = jfield "name"
+        vers  = jfield "version"
+        hmods = snub $ mfield "hidden-modules"
+        emods = snub $ mfield "exposed-modules"
+    let allmods  = sort $ map Module (emods ++ hmods)
+    (cho,ho) <- wtd (map Module 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 [ (m,SHA1.emptyHash) | m <- mkeys (hoExports ho)] [] lhash pdesc
+    recordHoFile ho [outName] hoh
+
+
+
+
hunk ./Ho/Library.hs 2
-    loadLibraries,
-    createLibrary
+    readDescFile,
+    findLibrary,
+    libraryList
hunk ./Ho/Library.hs 9
-import Data.List(sort)
-import Data.Monoid
hunk ./Ho/Library.hs 10
+import System.Directory
hunk ./Ho/Library.hs 14
-import Ho.Build
-import Ho.Binary
-import Ho.LibraryMap
hunk ./Ho/Library.hs 15
-import HsSyn
hunk ./Ho/Library.hs 16
-import PackedString
-import Util.SHA1(emptyHash,sha1file)
-import Util.SetLike
-import Version(versionString)
hunk ./Ho/Library.hs 21
-data Library = Library {
-    libraryDesc  :: [(PackedString,PackedString)],
-    libraryHo    :: Ho,
-    libraryFP    :: FilePath,
-    librarySHA1  :: CheckSum
-    }
-type LMap = Map.Map LibraryName Library
-
--- Load a library in a recursive fashion
-
-libraryDeps :: Library -> [(LibraryName, CheckSum)]
-libraryDeps = Map.toList . hoLibraries . libraryHo
-
-loadP :: Maybe CheckSum -> LMap -> LibraryName -> IO LMap
-loadP mbcs got name = do
-    (n',fp) <- libraryMapFind name
-    case Map.lookup n' got of
-      Nothing -> do
-        pkg <- readLibraryFile n' fp mbcs
-        let got' = Map.insert n' pkg got
-        foldM (\gm (pn,cs) -> loadP (Just cs) gm pn) got' $ libraryDeps pkg
-      Just pkg | mbcs == Nothing                -> return got
-               | mbcs == Just (librarySHA1 pkg) -> return got
-               | otherwise                      -> fail ("Checksum mismatch for library "++name)
-
--- load libraries
hunk ./Ho/Library.hs 23
+-- Write a library and mutilate it to fit the description
hunk ./Ho/Library.hs 25
-loadLibraries :: IO Ho
-loadLibraries = do
-    wdump FD.Progress $ putErrLn $ "Loading libraries: " ++ show (optHls options)
-    ps <- foldM (loadP Nothing) Map.empty (optHls options)
-    return $ mconcat (map libraryHo (Map.elems ps))
hunk ./Ho/Library.hs 26
--- Write a library and mutilate it to fit the description
hunk ./Ho/Library.hs 28
+-------------------------
+-- parse description file
+-------------------------
hunk ./Ho/Library.hs 32
-createLibrary ::
-    FilePath
-    -> ([Module] -> IO 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
-    let jfield x = maybe (error "createLibrary: description lacks required field "++show x) id $ field x
-    let mfield x = maybe [] (words . map (\c -> if c == ',' then ' ' else c)) $ field x
-    let name  = jfield "name"
-        vers  = jfield "version"
-        hmods = snub $ mfield "hidden-modules"
-        emods = snub $ mfield "exposed-modules"
-    let allmods  = sort $ map Module (emods ++ hmods)
-    ho <- wtd (map Module 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" ]
-    writeLibraryFile outName $ Library pdesc ho "" emptyHash
+readDescFile :: FilePath -> IO [(String,String)]
+readDescFile fp = do
+    wdump FD.Progress $ putErrLn $ "Reading: " ++ show fp
+    fc <- CharIO.readFile fp
+    case parseLibraryDescription fc of
+        Left err -> fail $ "Error reading library description file: " ++ show fp ++ " " ++ err
+        Right ps -> return ps
hunk ./Ho/Library.hs 65
+--------------------------------
+-- finding and listing libraries
+--------------------------------
hunk ./Ho/Library.hs 69
-readDescFile :: FilePath -> IO [(String,String)]
-readDescFile fp = do
-    wdump FD.Progress $ putErrLn $ "Reading: " ++ show fp
-    fc <- CharIO.readFile fp
-    case parseLibraryDescription fc of
-        Left err -> fail $ "Error reading library description file: " ++ show fp ++ " " ++ err
-        Right ps -> return ps
+type LibraryMap = Map.Map LibraryName FilePath
+
+
+findLibrary ::  LibraryName -> IO (LibraryName,FilePath)
+findLibrary pn = do
+    lm <- getLibraryMap (optHlPath options)
+    case Map.lookup pn lm of
+        Just x  -> return (pn,x)
+        Nothing -> case range (pn++"-") (pn++"-"++repeat maxBound) lm of
+                 [] -> fail ("LibraryMap: Library "++pn++" not found!")
+                 xs -> return $ last xs
+
+
+
+libraryList :: IO [(LibraryName,FilePath)]
+libraryList = Map.toList `fmap` getLibraryMap (optHlPath options)
hunk ./Ho/Library.hs 86
--- IO with Libraries
+---- range queries for Data.Map
hunk ./Ho/Library.hs 88
+range :: Ord k => k -> k -> Map.Map k v -> [(k,v)]
+range low high = Map.toList . fst . Map.split high . snd . Map.split low
hunk ./Ho/Library.hs 91
-readLibraryFile :: LibraryName -> FilePath -> Maybe CheckSum -> IO Library
-readLibraryFile lname fp mbcs = do
-    wdump FD.Progress $ putErrLn $ "Loading library: " ++ show lname ++ " @ " ++ show fp
-    pkgCS <- sha1file fp
-    when (maybe False (pkgCS /=) mbcs) $
-        putErrDie ("Loading library "++show fp++" failed: Checksum does not match")
-    mho <- checkForHoFile fp
-    case mho of
-      Nothing       -> putErrDie ("Loading library "++fp++" failed due to missing dependencies")
-      Just (hoh,ho) -> return $
-          Library { libraryDesc = hohMetaInfo hoh,
-                    libraryFP   = fp,
-                    librarySHA1 = pkgCS,
-                    libraryHo   = ho -- { hoModules = Map.map (const $ Right (lname,pkgCS)) $ hoModules ho }
-                  }
+----
hunk ./Ho/Library.hs 93
-writeLibraryFile :: FilePath -> Library -> IO ()
-writeLibraryFile fp pkg = recordHoFile (libraryHo pkg) [fp] hoh >> return ()
-    where hoh = HoHeader [] [] (librarySHA1 pkg) (libraryDesc pkg)
+getLibraryMap :: [FilePath] -> IO LibraryMap
+getLibraryMap fps = fmap Map.unions $ mapM getPM fps where
+    getPM fp = flip catch (\_ -> return Map.empty) $ do
+        raw <- getDirectoryContents fp
+        return $ Map.fromList $ flip concatMap raw $ \e ->
+            case reverse e of
+              ('l':'h':'.':r) -> [(reverse r,fp++"/"++e)]
+              _               -> []
hunk ./Ho/Type.hs 6
-import Atom(Atom)
hunk ./Ho/Type.hs 31
+    choFiles :: Map.Map Module SHA1.Hash,
hunk ./Ho/Type.hs 41
+        choFiles = choFiles a `mappend` choFiles b,
hunk ./Ho/Type.hs 51
-collectedHo = CollectedHo { choModules = mempty, choExternalNames = mempty, choHo = mempty, choVarMap = mempty }
+collectedHo = CollectedHo { choFiles = mempty, choModules = mempty, choExternalNames = mempty, choHo = mempty, choVarMap = mempty }
hunk ./Main.hs 56
-import Ho.LibraryMap
hunk ./Main.hs 108
-            sequence_ [ putStrLn name | (name,_) <- libraryList ]
+            ll <- libraryList
+            sequence_ [ putStrLn name | (name,_) <- ll ]
hunk ./Main.hs 121
-    (_,ho) <- parseFiles (map Left mods) processInitialHo processDecls
+    (cho,ho) <- parseFiles (map Left mods) processInitialHo processDecls
hunk ./Main.hs 123
-    return ho
+    return (cho,ho)