darcs patch: haskell98 should re-export Prelude and N... (and 4 more)
I'm probably doing something silly, but using this release a minimal test program no longer compiles for me. 15:05 ~/projects/linux/tmp % cat tiny.hs main = putStrLn "foo" 15:05 ~/projects/linux/tmp % jhc tiny.hs jhc tiny.hs jhc 0.6.2 (-n krasyupheasy-10 ) Finding Dependencies... Using Ho Cache: '/Users/mwotton/.jhc/cache' Library was not found 'jhc' 15:05[1] ~/projects/linux/tmp % ls -al /usr/local/share/jhc-0.6/ total 2432 drwxr-xr-x 8 root admin 272 19 Aug 15:04 . drwxr-xr-x 41 mwotton admin 1394 14 Aug 12:17 .. -rw-r--r-- 1 root admin 42641 19 Aug 14:54 applicative-1.0.hl -rw-r--r-- 1 root admin 275418 19 Aug 14:54 base-1.0.hl -rw-r--r-- 1 root admin 483755 19 Aug 14:54 containers-0.2.0.hl -rw-r--r-- 1 root admin 4321 19 Aug 14:54 haskell98-1.0.hl drwxr-xr-x 3 root admin 102 19 Aug 14:54 include -rw-r--r-- 1 root admin 424014 19 Aug 14:54 jhc-1.0.hl 15:05 ~/projects/linux/tmp % Any tips? mark On 19/08/2009, at 2:12 PM, John Meacham wrote:
Thu Aug 13 19:26:59 PDT 2009 John Meacham
* haskell98 should re-export Prelude and Numeric Thu Aug 13 19:36:17 PDT 2009 John Meacham
* clean up documentation, rename all environment variable to have a consistent JHC_ prefix Mon Aug 17 16:10:29 PDT 2009 John Meacham
* clean up stats some Tue Aug 18 20:52:36 PDT 2009 John Meacham
* redo libraries such that only names from explicitly imported libraries are visible to the program being compiled. Tue Aug 18 21:10:30 PDT 2009 John Meacham
* add fix for compiling on MacOSX, thanks to Mark Wotton. New patches:
[haskell98 should re-export Prelude and Numeric John Meacham
**20090814022659 Ignore-this: bef4212af66c50e1220e752382337006 ] hunk ./lib/haskell98.cabal 18 build-depends: base exposed-modules: -- Haskell 98 (Prelude and Numeric are in the base package) - Array, CPUTime, Char, Complex, Directory, IO, Ix, List, Locale, + Prelude, Numeric, Array, CPUTime, Char, Complex, Directory, IO, Ix, List, Locale, Maybe, Monad, Random, Ratio, System, Time, [clean up documentation, rename all environment variable to have a consistent JHC_ prefix John Meacham **20090814023617 Ignore-this: 1dffad758c102990317e7fdbf658b9a3 ] hunk ./docs/using.txt 1 -= Using jhc = - -Installation of jhc involves building the jhc binary, placing it somewhere you -can execute it and putting the libraries somewhere. - -=== Building jhc === - -building jhc requires the most recent version of DrIFT 2.2.1 or better, which -can be gotten at http://repetae.net/john/computer/haskell/DrIFT/, GHC 6.6, -happy, Perl, and having darcs will help keep updated with the newest version -and submit patches. - -==== Getting the source ==== - -Because jhc uses subrepositories, you need to use multiple darcs commands to -pull everything needed to build jhc. - - darcs get http://repetae.net/john/repos/jhc - cd jhc - darcs get http://repetae.net/john/repos/Doc - cd lib - darcs get http://darcs.haskell.org/packages/haskell98/ - darcs get http://darcs.haskell.org/packages/QuickCheck/ - -The binary and zlib packages also need to be installed. - - http://hackage.haskell.org/cgi-bin/hackage-scripts/package/binary/ - http://hackage.haskell.org/cgi-bin/hackage-scripts/package/zlib/ - -==== making it ==== - -Assuming you have ghc 6.6, happy, and DrIFT installed, you may now run GNU -make by typing 'gmake' or just 'make' depending on your system and get a -binary 'jhc' out if nothing went wrong. - -Installation is done with 'gmake install' or for a custom installation -prefix 'gmake install PREFIX=/foo/bar'. This will install jhc and jhci -in ${PREFIX}/bin and base libraries in ${PREFIX}/lib, from where they -are automatically included when needed. - -=== Installing the libraries - the old way ==== - -The jhc libraries will be in the 'lib' directory. these may be installed -anywhere or left in place but the directory where they are installed *must be -writable by the user of jhc* otherwise the compiler cannot create its -intermediate files. - -Set the environment variable JHCPATH to the location of the library wherever -you put it, or pass -i<dir> to jhc every time you call it so it can find the -standard libraries. - -The first time you compile something, jhc will automatically create an -optimized version of the standard libraries in 'ho' files next to their source -code. This is why the library needs to be somewhere writable. Another effect -being the first time you run jhc, it will take much longer than future runs. - - -=== Running jhc === - -jhc always runs in a mode similar to 'ghc --make' and will find all -dependencies automatically. just run jhc on your file containing the Main module. - - jhc -v Main.hs - -it is HIGHLY HIGHLY recommended you pass the '-v' flag to jhc. jhc takes a very -long time to compile programs and without feedback you won't know if there is a -problem. Much of the debugging output contains Unicode characters, it helps if -your terminal is UTF8. - -While compiling, jhc will drop 'ho' files alongside your source code to speed -up future compilation. feel free to delete these if you want to. There are -various options for controlling the writing and reading of these ho files. - -=== Environment Variables === - -jhc understands the following environment variables - - JHCPATH - path to search for haskell source files, seperated by colons. - - JHCLIBPATH - path to search for jhc library files - -==== Options ==== - -general options - - &1`> - -things to pass to -d - - &1`> - -things to pass to -f - - &1 `> - ----- - -http://repetae.net/john/computer/jhc - rmfile ./docs/using.txt hunk ./Makefile.am 253 publish: docs/building.shtml docs/big-picture.pdf docs/ development.shtml docs/index.shtml docs/jhc.shtml manual.html docs/ manual.css cp -- $^ /home/john/public_html/computer/jhc -manual: utils/stitch.prl src/FlagDump.mkd src/FlagOpts.mkd options.mkd - find . ! -wholename '*/examples/*' ! -wholename '*/_darcs/*' ! - wholename '*/drift_processed/*' ! -wholename '*/regress/*' \( - name '*.hs' -o -name '*.hsc' -o -name '*.mkd' -o -wholename '*/src/ data/rts/*.c' \) | xargs perl utils/stitch.prl > manual.mkd +manual: utils/stitch.prl src/FlagDump.mkd src/FlagOpts.mkd options.mkd docs/*.mkd + find . ! -wholename */jhc-*/* ! -wholename '*/examples/*' ! - wholename '*/_darcs/*' ! -wholename '*/drift_processed/*' ! - wholename '*/regress/*' \( -name '*.hs' -o -name '*.hsc' -o -name '*.mkd' -o -wholename '*/src/data/rts/*.c' \) | xargs perl utils/ stitch.prl > manual.mkd pandoc manual.mkd --toc -s -f markdown -t html -s -c manual.css -o $@.html
hunk ./Makefile.am 257 -man: utils/stitch.prl src/FlagDump.mkd src/FlagOpts.mkd options.mkd docs/man_header.mkd - find . ! -wholename '*/examples/*' ! -wholename '*/_darcs/*' ! - wholename '*/drift_processed/*' ! -wholename '*/regress/*' \( - name '*.hs' -o -name '*.hsc' -o -name '*.mkd' -o -wholename '*/src/ data/rts/*.c' \) | xargs perl utils/stitch.prl -h docs/ man_header.mkd -c Using,Options > jhc_man.mkd +man: utils/stitch.prl src/FlagDump.mkd src/FlagOpts.mkd options.mkd docs/man_header.mkd docs/*.mkd + find . ! -wholename */jhc-*/ ! -wholename '*/examples/*' ! - wholename '*/_darcs/*' ! -wholename '*/drift_processed/*' ! - wholename '*/regress/*' \( -name '*.hs' -o -name '*.hsc' -o -name '*.mkd' -o -wholename '*/src/data/rts/*.c' \) | xargs perl utils/ stitch.prl -h docs/man_header.mkd -c Using,Options > jhc_man.mkd pandoc jhc_man.mkd -s -f markdown -t man -s -o jhc.1
options.mkd: jhc hunk ./docs/make.mkd 10 For instance, if you had a program 'HelloWorld.hs', the following would compile it to an executable named 'hello'.
- ; jhc -v HelloWorld.hs -o hello + ; jhc HelloWorld.hs -o hello
hunk ./docs/make.mkd 12 -Libraries are built by passing jhc a file describing the library via the ---build-hl option. The file format is a simplified version of the cabal format. -The name of the generated file will be <basename>-<version>.hl. +Jhc searches for modules in its search path, which defaults to the current +directory. Modules are searched for based on their names. For instance, the +module Data.Foo will be searched for in 'Data/Foo.hs'. As an extension, jhc will +also search for 'Data.Foo.hs'. The search path may be modifed with the '-i' +command line option, or by setting the 'JHC_PATH' environment variable. + +# Using Libraries
hunk ./docs/make.mkd 20 - ; jhc -v --build-hl mylibrary.cabal +jhc libraries are distributed as files with an 'hl' suffix, such as +'base-1.0.hl'. In order to use a haskell library you simply need to place the +file in a directory that jhc will search for it. For instance, $HOME/lib/jhc. +You may set the environment variable JHC_LIBRARY_PATH to specify alternate +locations to search for libraries or specify directory to search with the -L +command line option. -L- will clear the search path.
hunk ./docs/make.mkd 27 +You can then use libraries with the '-p' command line option, for instance if +you had a library 'mylibrary-1.0.hl' in your search path, the following would +use it.
hunk ./docs/make.mkd 31 -# installing and using libraries + ; jhc -p mylibrary MyProgram.hs -o myprogram
hunk ./docs/make.mkd 33 -jhc libraries are distributed as files with an 'hl' suffix, such as -'base-1.0.hl'. You simply need to drop this file somewhere that jhc can find -it. for instance, $HOME/lib/jhc. You can then set $JHCLIBPATH to said -directory, or specify it on the command line with the '-L' option. Extra -libraries are specified on the command line with the '-p' option.
hunk ./docs/make.mkd 34 - ; jhc -v -L/home/john/devel/jhc -pmylibrary MyProgram.hs -o myprogram +# Environment Variables + +Jhc's behavior is modified by several enviornment variables.
hunk ./docs/make.mkd 38 +JHC_OPTS +: this is read and appended to the command line of jhc invocations.
hunk ./docs/make.mkd 41 +JHC_PATH +: This specifies the path to search for modules. + +JHC_LIBRARY_PATH +: This specifies the path to search for libraries. + +JHC_CACHE +: This specified the directory jhc will use to cache values. having a valid cache is essential for jhc performance. It defaults to ~/.jhc/cache. + +# Building Haskell Libraries + +Libraries are built by passing jhc a file describing the library via the +--build-hl option. The file format is a simplified version of the cabal format. +The name of the generated file will be basename-version.hl.
hunk ./docs/make.mkd 56 -# Building Projects With make + ; jhc --build-hl mylibrary.cabal
hunk ./docs/make.mkd 58 -Using make to build projects with jhc is straightforward, simply add a line like the following in your Makefile +## Library File Format
hunk ./docs/make.mkd 60 +The library file is a simple list of key value pairs seperated by colon. The fields that jhc cares about are
hunk ./docs/make.mkd 62 - % : %.hs - jhc -v $< -o $@ + Name: The Name of your library + Version: The Version of your library + Exposed-Modules: Comma Seperated list of modules to be included in the library and made availabe to users of the library + Hidden-Modules: Comma Seperated list of modules that will be used by the library internally, but not be made available outside it.
hunk ./docs/make.mkd 67 -Or, to build a library, something similar to this will do. +Other fields are stored as-is inside of the generated hl file and can be seen with jhc --show-ho file.hl.
hunk ./docs/make.mkd 69 - %.hl : %.cabal - jhc -v --build-hl $< -o $@ hunk ./docs/unboxed.mkd 3 {-#Extensions
+# Module Search Path + +Modules in jhc are searched for based on their name as in other Haskell +compilers. However in addition to searching for 'Data/Foo.hs' for the module +'Data.Foo', jhc will also search for 'Data.Foo.hs'. + +# Rank-N Polymorphism + +Jhc supports higher ranked polymorphism. jhc will never infer types of higher +rank, however when the context unambiguously specifies a higher ranked type, it +will be infered. For instance, user supplied type annotations and arguments to +data constructors defined to by polymorphic will work. + +# Existential types + # Unboxed Values
Unboxed values in jhc are specified in a similar fashion to GHC however the hunk ./docs/unboxed.mkd 36
Unboxed strings are enabled with the -funboxed-values flag. They are specified like a normal string but have a '#' at the end. Unboxed strings -have types 'Addr__' which is as synonym for 'BitsPtr_' +have types 'Addr__' which is as synonym for 'BitsPtr_'.
## Unboxed Numbers
hunk ./docs/unboxed.mkd 44 with a '#' such as in 3# or 4#. Jhc supports a limited form of type inference for unboxed numbers, if the type is fully specified by the environment and it is a suitable unboxed numeric type then that type is used. Otherwise it -defaults to Int__. +defaults to Int__. Whether the type is fully specifed follows the same rules as +rank-n types.
hunk ./src/E/Type.hs 23 import Info.Types import qualified Info.Info as Info
-{-@Internals +{- @Internals
# Jhc core normalized forms
hunk ./src/Options.hs 284 ++ unwords xs ++ "\nValid flags:\n\n" ++ FlagOpts.helpMsg)
getArguments = do - x <- lookupEnv "JHCOPTS" + x <- lookupEnv "JHC_OPTS" let eas = maybe [] words x as <- System.getArgs return (eas ++ as) hunk ./src/Options.hs 329 True -> return o3 False-> return o3 { optHls = (autoloads ++ optHls o2) }
+ + findHoCache :: IO (Maybe FilePath) findHoCache = do hunk ./src/Options.hs 333 - cd <- lookupEnv "HOCACHEDIR" + cd <- lookupEnv "JHC_CACHE" case optHoCache options `mplus` cd of Just s -> do return (Just s) Just "-" -> do return Nothing hunk ./src/Options.hs 413 -- | Include directories taken from JHCPATH enviroment variable. initialIncludes :: [String] initialIncludes = unsafePerformIO $ do - p <- lookupEnv "JHCPATH" + p <- lookupEnv "JHC_PATH" let x = maybe "" id p return (".":(tokens (== ':') x))
hunk ./src/Options.hs 421 -- | Include directories taken from JHCLIBPATH enviroment variable. initialLibIncludes :: [String] initialLibIncludes = unsafePerformIO $ do - ps <- lookupEnv "JHCLIBPATH" + ps <- lookupEnv "JHC_LIBRARY_PATH" h <- lookupEnv "HOME" let paths = h ++ ["/usr/local","/usr"] bases = ["/lib","/share"] [clean up stats some John Meacham
**20090817231029 Ignore-this: ebfe3952f00720843c0da1fbbf33294 ] hunk ./src/Stats.hs 35 ) where -import Char import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.Writer hunk ./src/Stats.hs 51 import GenUtil import qualified Doc.Chars as C import qualified Util.IntBag as IB -import Options (dump) -import qualified FlagDump as FD - -
splitUp :: Int -> String -> [String] splitUp n str = filter (not . Prelude.null) (f n str) where hunk ./src/Stats.hs 86 draw :: Tree String -> [String] draw (Node x ts0) = x : drawSubTrees ts0 where drawSubTrees [] = [] - drawSubTrees [t] = + drawSubTrees [t] = {-[vLine] :-} shift lastBranch " " (draw t) drawSubTrees (t:ts) = {-[vLine] :-} shift branch (C.vLine ++ " ") (draw t) ++ drawSubTrees ts hunk ./src/Stats.hs 93
branch = C.lTee ++ C.hLine lastBranch = C.llCorner ++ C.hLine - + shift first other = zipWith (++) (first : repeat other) --vLine = chr 0x254F
hunk ./src/Stats.hs 105 deriving(Eq,Ord,Monoid)
prependStat :: String -> Stat -> Stat -prependStat name (Stat m) = Stat $ IB.fromList [ (fromAtom (toAtom $ "{" ++ name ++ "}." ++ fromAtom (unsafeIntToAtom x)),y) | (x,y) <- IB.toList m ] +prependStat name (Stat m) = Stat $ IB.fromList [ (fromAtom $ mappend (toAtom $ "{" ++ name ++ "}.") (unsafeIntToAtom x),y) | (x,y) <- IB.toList m ]
printStat greets (Stat s) = do let fs = createForest 0 $ sort [(splitUp (-1) $ fromAtom (unsafeIntToAtom x),y) | (x,y) <- IB.toList s] [redo libraries such that only names from explicitly imported libraries are visible to the program being compiled. John Meacham
**20090819035236 Ignore-this: 7eeb43ddaf2f975309b38190ca266150 ] hunk ./src/Ho/Binary.hs 23 current_version :: Int -current_version = 3 +current_version = 4
readHFile :: FilePath -> IO (FilePath,HoHeader,forall a . Binary a => ChunkType -> a) readHFile fn = do hunk ./src/Ho/Binary.hs 150 return (HoIDeps aa ab ac ad)
instance Data.Binary.Binary HoLib where - put (HoLib aa ab ac) = do + put (HoLib aa ab ac ad) = do Data.Binary.put aa Data.Binary.put ab Data.Binary.put ac hunk ./src/Ho/Binary.hs 154 + Data.Binary.put ad get = do aa <- get ab <- get hunk ./src/Ho/Binary.hs 159 ac <- get - return (HoLib aa ab ac) + ad <- get + return (HoLib aa ab ac ad)
instance Binary Data.Version.Version where hunk ./src/Ho/Build.hs 12
import Control.Concurrent import Control.Monad.Identity -import Data.Binary import Data.Char import Data.IORef import Data.List hiding(union) hunk ./src/Ho/Build.hs 18 import Data.Monoid import Data.Tree import Data.Version(Version,parseVersion,showVersion) -import Debug.Trace import Maybe import Monad import Prelude hiding(print,putStrLn) hunk ./src/Ho/Build.hs 23 import System.IO hiding(print,putStrLn) import System.Mem -import System.Posix.Files import Text.Printf hunk ./src/Ho/Build.hs 24 -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.UTF8 as LBSU import qualified Data.Map as Map hunk ./src/Ho/Build.hs 57 import Options import PackedString(PackedString,packString,unpackPS) import RawFiles(prelude_m4) -import Support.CFF import Util.FilterInput import Util.Gen hiding(putErrLn,putErr,putErrDie) import Util.SetLike hunk ./src/Ho/Build.hs 113
data ModDone = ModNotFound - | ModLibrary ModuleGroup Library + | ModLibrary Bool ModuleGroup Library | Found SourceCode
data Done = Done { hunk ./src/Ho/Build.hs 126 } {-! derive: update !-}
-fileOrModule f = case reverse f of - ('s':'h':'.':_) -> Right f - ('s':'h':'l':'.':_) -> Right f - _ -> Left $ Module f -
replaceSuffix suffix fp = reverse (dropWhile ('.' /=) (reverse fp)) + + suffix
hunk ./src/Ho/Build.hs 197 resolveDeps :: IORef Done -> Module -> IO () resolveDeps done_ref m = do done <- readIORef done_ref - if isJust $ m `mlookup` modEncountered done then return () else do - fetchSource done_ref (map fst $ searchPaths (show m)) (Just m) - return () + case m `mlookup` modEncountered done of + Just (ModLibrary False _ lib) -> putErrDie $ printf "ERROR: Attempt to import module '%s' which is a member of the library '%s'." (show m) (libName lib) + Just _ -> return () + Nothing -> fetchSource done_ref (map fst $ searchPaths (show m)) (Just m) >> return ()
type LibInfo = (Map.Map Module ModuleGroup, Map.Map ModuleGroup [ModuleGroup], Set.Set Module,Map.Map ModuleGroup HoBuild,Map.Map ModuleGroup HoTcInfo) hunk ./src/Ho/Build.hs 274 -- in terms of dependencies
-libModMap (Library _ libr _ _) = hoModuleMap libr
toCompUnitGraph :: Done -> [Module] -> IO (HoHash,CompUnitGraph) toCompUnitGraph done roots = do hunk ./src/Ho/Build.hs 280 let fs m = map inject $ maybe (error $ "can't find deps for: " ++ show m) snd (Map.lookup m (knownSourceMap done)) fs' m (Library _ libr _ _) = fromMaybe (error $ "can't find deps for: " ++ show m) (Map.lookup m (hoModuleDeps libr)) foundMods = [ ((m,Left (sourceHash sc)),fs (sourceHash sc)) | (m,Found sc) <- Map.toList (modEncountered done)] - foundMods' = Map.elems $ Map.fromList [ (mg,((mg,Right lib),fs' mg lib)) | (_,ModLibrary mg lib) <- Map.toList (modEncountered done)] + foundMods' = Map.elems $ Map.fromList [ (mg,((mg,Right lib),fs' mg lib)) | (_,ModLibrary _ mg lib) <- Map.toList (modEncountered done)] fullModMap = Map.unions (map libModMap $ Map.elems (loadedLibraries done)) inject m = Map.findWithDefault m m fullModMap gr = G.newGraph (foundMods ++ foundMods') (fst . fst) snd hunk ./src/Ho/Build.hs 285 gr' = G.sccGroups gr - lmods = Map.mapMaybe ( \ x -> case x of ModLibrary mg lib -
Just (mg,lib) ; _ -> Nothing) (modEncountered done) phomap = Map.fromListWith (++) (concat [ [ (m,[hh]) | (m,_) <- hoDepends idep ] | (hh,(_,_,idep,_)) <- Map.toList (hosEncountered done)]) sources = Map.fromList [ (m,sourceHash sc) | (m,Found sc) <- Map.toList (modEncountered done)]
hunk ./src/Ho/Build.hs 317 modifyIORef cug_ref ((mhash,(deps',CompSources $ map fs amods)):) return mhash g [((mg,Right lib@(Library _ libr mhot mhob)),ds)] = do - let Just mgs = Map.lookup mg (hoModuleDeps libr) - Just hob = Map.lookup mg mhob + let Just hob = Map.lookup mg mhob Just hot = Map.lookup mg mhot ho = Ho { hoModuleGroup = mg, hoBuild = hob, hoTcInfo = hot } myHash = libMgHash mg lib hunk ./src/Ho/Build.hs 372
-- return (rhash,cug')
-libHash (Library hoh _ _ _) = hohHash hoh -libMgHash mg lib = MD5.md5String $ show (libHash lib,mg) -libProvides mg (Library _ lib _ _) = [ m | (m,mg') <- Map.toList (hoModuleMap lib), mg == mg'] -libName (Library HoHeader { hohName = Right (name,vers) } _ _ _) = unpackPS name ++ "-" ++ showVersion vers
parseFiles :: [Either Module String] -- ^ Either a module or filename to find -> (CollectedHo -> Ho -> IO CollectedHo) -- ^ Process initial ho loaded from file hunk ./src/Ho/Build.hs 408 hosEncountered = Map.empty, modEncountered = Map.empty } - unless (null libs) $ putProgressLn $ "Loading libraries:" <+> show libs - forM_ (optHls options) $ \l -> do - (n',fn) <- findLibrary l - lib@(Library hoh libr _ _) <- catch (readHlFile fn) $ \_ -> - fail $ "Error loading library file: " ++ fn - let Right (libName,libVers) = hohName hoh - putProgressLn $ printf "Library: %-15s <%s>" n' fn - modifyIORef done_ref (modEncountered_u $ Map.union (Map.fromList [ (m,ModLibrary mg lib) | (m,mg) <- Map.toList (hoModuleMap libr) ])) - modifyIORef done_ref (loadedLibraries_u $ Map.insert libName lib) + (es,is) <- collectLibraries + let combModMap es = Map.unions [ Map.map ((,) l) mm | l@(Library _ HoLib { hoModuleMap = mm } _ _) <- es] + explicitModMap = combModMap es + implicitModMap = combModMap is + reexported = Set.fromList [ m | l <- es, (m,_) <- Map.toList $ hoReexports (libHoLib l) ] + modEnc exp emap = Map.fromList [ (m,ModLibrary (exp || Set.member m reexported) mg l) | (m,(l,mg)) <- Map.toList emap ] + + modifyIORef done_ref (loadedLibraries_u $ Map.union $ Map.fromList [ (libBaseName lib,lib) | lib <- es ++ is]) + modifyIORef done_ref (modEncountered_u $ Map.union (modEnc True explicitModMap)) + modifyIORef done_ref (modEncountered_u $ Map.union (modEnc False implicitModMap)) + +-- unless (null libs) $ putProgressLn $ "Loading libraries:" <+> show libs +-- forM_ (optHls options) $ \l -> do +-- (n',fn) <- findLibrary l +-- lib@(Library hoh libr _ _) <- catch (readHlFile fn) $ \_ -> +-- fail $ "Error loading library file: " ++ fn +-- let Right (libName,_libVers) = hohName hoh +-- putProgressLn $ printf "Library: %-15s <%s>" n' fn +-- modifyIORef done_ref (modEncountered_u $ Map.union (Map.fromList [ (m,ModLibrary mg lib) | (m,mg) <- Map.toList (hoModuleMap libr) ])) +-- modifyIORef done_ref (loadedLibraries_u $ Map.insert libName lib) done <- readIORef done_ref forM_ (Map.elems $ loadedLibraries done) $ \ lib@(Library hoh _ _ _) -> do let libsBad = filter (\ (p,h) -> fmap (libHash) (Map.lookup p (loadedLibraries done)) /= Just h) (hohLibDeps hoh) hunk ./src/Ho/Build.hs 464 fhash = MD5.md5String $ show fdeps fdeps = [ h | (h,(_,cu)) <- cs, not . null $ providesModules cu `intersect` need ]
--- take the list of CompNodes and what modules we want and create a root node --- that will reach all dependencies when compiled. - -mkPhonyCompNode :: [Module] -> [CompNode] -> IO CompNode -mkPhonyCompNode need cs = do - xs <- forM cs $ \cn@(CompNode _ _ cu) -> readIORef cu >>= \u -> return $ if null $ providesModules u `intersect` need then [] else [cn] - let hash = MD5.md5String $ show [ h | CompNode h _ _ <- concat xs ] - CompNode hash (concat xs) `fmap` newIORef (CompLinkUnit CompDummy)
printModProgress :: Int -> Int -> IO Int -> [HsModule] -> IO () printModProgress _ _ _ [] = return () hunk ./src/Ho/Build.hs 696 ans fp = do (desc,name,vers,hmods,emods) <- parse fp vers <- runReadP parseVersion vers - let allmods = snub (emods ++ hmods) + let allMods = emodSet `Set.union` hmodSet + emodSet = Set.fromList emods + hmodSet = Set.fromList hmods + -- TODO - must check we depend only on libraries hunk ./src/Ho/Build.hs 701 - (rnode@(CompNode lhash _ _),cho) <- parseFiles (map Left allmods) ifunc func + (rnode@(CompNode lhash _ _),cho) <- parseFiles (map Left $ Set.toList allMods) ifunc func (_,(mmap,mdeps,prvds,lcor,ldef)) <- let f (CompNode hs cd ref) = do cl <- readIORef ref hunk ./src/Ho/Build.hs 726 writeIORef ref (CompLinkLib res cn) return res in f rnode - let unknownMods = Set.toList $ Set.filter (`notElem` allmods) prvds - mapM_ ((putStrLn . ("*** Module included in library that is not in export list: " ++)) . show) unknownMods + let unknownMods = Set.toList $ Set.filter (`Set.notMember` allMods) prvds + mapM_ ((putStrLn . ("*** Module depended on in library that is not in export list: " ++)) . show) unknownMods + mapM_ ((putStrLn . ("*** We are re-exporting the following modules from other libraries: " ++)) . show) $ Set.toList (allMods Set.\\ prvds) let hoh = HoHeader { hohHash = lhash, hohName = Right (packString name,vers), hunk ./src/Ho/Build.hs 739 let outName = case optOutName options of Nothing -> name ++ "-" ++ showVersion vers ++ ".hl" Just fn -> fn - let pdesc = [(n, packString v) | (n,v) <- ("jhc-hl- filename",outName):("jhc-description-file",fp):("jhc-compiled- by",versionString):desc, n /= "exposed-modules" ] + let pdesc = [(packString n, packString v) | (n,v) <- ("jhc- hl-filename",outName):("jhc-description-file",fp):("jhc-compiled- by",versionString):desc, n /= "exposed-modules" ] libr = HoLib { hunk ./src/Ho/Build.hs 741 + hoReexports = Map.fromList [ (m,m) | m <- Set.toList $ allMods Set.\\ prvds], hoMetaInfo = pdesc, hoModuleMap = mmap, hoModuleDeps = mdeps hunk ./src/Ho/Build.hs 762 emods = map Module $ snub $ mfield "exposed-modules" return (desc,name,vers,hmods,emods)
---collectLibraries :: IO [FilePath] ---collectLibraries = concat `fmap` mapM f (optHlPath options) where --- f fp = do --- fs <- flip catch (\_ -> return []) $ getDirectoryContents fp --- flip mapM fs $ \e -> case reverse e of --- ('l':'h':'.':r) -> do --- (fn',hoh,mp) <- readHFile (fp++"/"++e) --- --- _ -> [] -
------------------------------------ -- dumping contents of a ho file hunk ./src/Ho/Build.hs 799 doHl fn = do Library hoh libr mhob mhot <- readHlFile fn doHoh hoh - showList "MetaInfo" (sort [text k <> char ':' <+> show v | (k,v) <- hoMetaInfo libr]) + showList "MetaInfo" (sort [text (unpackPS k) <> char ':' < +> show v | (k,v) <- hoMetaInfo libr]) showList "ModuleMap" (map pprint . sortUnder fst $ Map.toList $ hoModuleMap libr) showList "ModuleDeps" (map pprint . sortUnder fst $ Map.toList $ hoModuleDeps libr) hunk ./src/Ho/Build.hs 802 + showList "ModuleReexports" (map pprint . sortUnder fst $ Map.toList $ hoReexports libr)
doHo fn = do (hoh,idep,ho) <- readHoFile fn hunk ./src/Ho/Library.hs 4 module Ho.Library( readDescFile, findLibrary, - libraryList + collectLibraries, + libModMap, + libHash, + libMgHash, + libProvides, + libName, + libBaseName, + libHoLib, + listLibraries ) where
import Char hunk ./src/Ho/Library.hs 17 import Control.Monad -import System.IO +import Data.List +import Data.Maybe +import Data.Version(showVersion) import System.Directory hunk ./src/Ho/Library.hs 21 +import System.IO +import Text.Printf import qualified Data.Map as Map hunk ./src/Ho/Library.hs 24 -import Data.List +import qualified Data.Set as Set
hunk ./src/Ho/Library.hs 26 +import Data.Monoid import GenUtil hunk ./src/Ho/Library.hs 28 +import Ho.Binary +import Ho.Type import Options hunk ./src/Ho/Library.hs 31 +import PackedString(PackedString,packString,unpackPS) import qualified CharIO import qualified FlagDump as FD hunk ./src/Ho/Library.hs 34 +import qualified Support.MD5 as MD5 + +libModMap (Library _ libr _ _) = hoModuleMap libr +libHash (Library hoh _ _ _) = hohHash hoh +libMgHash mg lib = MD5.md5String $ show (libHash lib,mg) +libProvides mg (Library _ lib _ _) = [ m | (m,mg') <- Map.toList (hoModuleMap lib), mg == mg'] +libName (Library HoHeader { hohName = ~(Right (name,vers)) } _ _ _) = unpackPS name ++ "-" ++ showVersion vers +libBaseName (Library HoHeader { hohName = ~(Right (name,vers)) } _ _ _) = name +libModules (Library _ lib _ _) = ([ m | (m,_) <- Map.toList (hoModuleMap lib)],Map.toList (hoReexports lib)) +libHoLib (Library _ lib _ _) = lib + +libVersionCompare ~(Library HoHeader { hohName = Right (_,v1) } _ _ _ ) ~(Library HoHeader { hohName = Right (_,v2) } _ _ _) = compare v1 v2
type LibraryName = String
hunk ./src/Ho/Library.hs 101 [] -> fail ("LibraryMap: Library "++pn++" not found!") xs -> return $ last xs
-{- -collectLibraries :: IO [FilePath] -collectLibraries ms = concat `fmap` mapM f (optHlPath options) where - f fp = flip catch (\_ -> return []) $ do - fs <- getDirectoryContents fp - return $ flip concatMap fs $ \e -> - case reverse e of - ('l':'h':'.':r) | good e -> [(fp++"/"++e)] - _ -> [] - good e = case ms of - Nothing -> True - Just rs -> any (`isPrefixOf` e) rs - -collectPotentialLibraries :: Maybe [String] -> IO [FilePath] -collectPotentialLibraries ms = concat `fmap` mapM f (optHlPath options) where - f fp = flip catch (\_ -> return []) $ do - fs <- getDirectoryContents fp - return $ flip concatMap fs $ \e -> - case reverse e of - ('l':'h':'.':r) | good e -> [(fp++"/"++e)] - _ -> [] - good e = case ms of - Nothing -> True - Just rs -> any (`isPrefixOf` e) rs
hunk ./src/Ho/Library.hs 102 - -} +listLibraries :: IO () +listLibraries = do + putStrLn "Search path:" + mapM_ putStrLn (optHlPath options) + putStrLn "Libraries found:" + (_,byhashes) <- fetchAllLibraries + let nameComp a b = compare (libName a) (libName b) + forM_ (sortBy nameComp $ Map.elems byhashes) $ \ lib -> putStrLn (libName lib)
hunk ./src/Ho/Library.hs 113 - -libraryList :: IO [(LibraryName,FilePath)] -libraryList = Map.toList `fmap` getLibraryMap (optHlPath options) - ---- range queries for Data.Map
range :: Ord k => k -> k -> Map.Map k v -> [(k,v)] hunk ./src/Ho/Library.hs 129 ('l':'h':'.':r) -> [(reverse r,fp++"/"++e)] _ -> []
+maxBy c x1 x2 = case x1 `c` x2 of + LT -> x2 + _ -> x1 + +-- Collect all libraries and return those which are explicitly and implicitly imported. +-- +-- The basic process is: +-- - Find all libraries and create two indexes, a map of named libraries to +-- the newest version of them, and a map of library hashes to the libraries +-- themselves. +-- +-- - For all the libraries listed on the command line, find the newest +-- version of each of them, flag these as the explicitly imported libraries. +-- +-- - recursively find the dependencies by the hash's listed in the library deps. if the names +-- match a library already loaded, ensure the hash matches up. flag these libraries as 'implicit' unless +-- already flaged 'explicit' +-- +-- - perform sanity checks on final lists of implicit and explicit libraries. +-- +-- Library Checks needed: +-- - We have found versions of all libraries listed on the command line +-- - We have all dependencies of all libraries and the hash matches the proper library name +-- - no libraries directly export the same modules, (but re- exporting the same module is fine) +-- - conflicting versions of any particular library are not required due to dependencies +-- + +fetchAllLibraries :: IO (Map.Map PackedString Library,Map.Map HoHash Library) +fetchAllLibraries = ans where + ans = do + (bynames',byhashes') <- unzip `fmap` concatMapM f (optHlPath options) + let bynames = Map.unionsWith vcomb bynames' + byhashes = Map.unions byhashes' + vcomb = maxBy libVersionCompare + return (bynames,byhashes) + + f fp = do + fs <- flip catch (\_ -> return [] ) $ getDirectoryContents fp + flip mapM fs $ \e -> case reverse e of + ('l':'h':'.':r) -> do + flip catch (\_ -> return mempty) $ do + lib <- readHlFile (fp ++ "/" ++ e) + return (Map.singleton (libBaseName lib) lib, Map.singleton (libHash lib) lib) + _ -> return mempty + +collectLibraries :: IO ([Library],[Library]) +collectLibraries = ans where + ans = do + (bynames,byhashes) <- fetchAllLibraries + let f pn | Just x <- Map.lookup pn bynames = return x + | otherwise = putErrDie $ printf "Library was not found '%s'\n" (unpackPS pn) + es <- mapM f ( map packString $ optHls options) + checkForModuleConficts es + let f lmap _ [] = return lmap + f lmap lset ((ei,l):ls) + | libHash l `Set.member` lset = f lmap lset ls + | otherwise = case Map.lookup (libBaseName l) lmap of + Nothing -> f (Map.insert (libBaseName l) (ei,l) lmap) (Set.insert (libHash l) lset) (ls ++ newdeps) + Just (ei',l') | libHash l == libHash l' -> f (Map.insert (libBaseName l) (ei || ei',l) lmap) lset ls + Just (_,l') -> putErrDie $ printf "Conflicting versions of library '%s' are required. [%s]\n" (libName l) (show (libHash l,libHash l')) + where newdeps = [ (False,fromMaybe (error $ printf "Dependency '%s' with hash '%s' needed by '%s' was not found" (unpackPS p) (show h) (libName l)) (Map.lookup h byhashes)) | let Library HoHeader { hohLibDeps = ldeps } _ _ _ = l , (p,h) <- ldeps ] + finalmap <- f Map.empty Set.empty [ (True,l) | l <- es ] + checkForModuleConficts [ l | (_,l) <- Map.elems finalmap ] + when verbose $ forM_ (Map.toList finalmap) $ \ (n,(e,l)) -> do + printf "-- Base: %s Exported: %s Hash: %s Name: %s \n" (unpackPS n) (show e) (show $ libHash l) (libName l) + + return ([ l | (True,l) <- Map.elems finalmap ],[ l | (False,l) <- Map.elems finalmap ]) + + checkForModuleConficts ms = do + let mbad = Map.toList $ Map.filter (\c -> case c of [_] -> False; _ -> True) $ Map.fromListWith (++) [ (m,[l]) | l <- ms, m <- fst $ libModules l] + forM_ mbad $ \ (m,l) -> putErrLn $ printf "Module '%s' is exported by multiple libraries: %s" (show m) (show $ map libName l) + unless (null mbad) $ putErrDie "There were conflicting modules!" + + hunk ./src/Ho/Type.hs 104
data HoLib = HoLib { -- * arbitrary metainformation such as library author, web site, etc. - hoMetaInfo :: [(String,PackedString)], hoModuleMap :: Map.Map Module ModuleGroup, hunk ./src/Ho/Type.hs 105 - hoModuleDeps :: Map.Map ModuleGroup [ModuleGroup] + hoReexports :: Map.Map Module Module, + hoModuleDeps :: Map.Map ModuleGroup [ModuleGroup], + hoMetaInfo :: [(PackedString,PackedString)] }
hunk ./src/Main.hs 91 (argstring,_) <- getArgString return (argstring ++ "\n" ++ versionSimple) case optMode o of - BuildHl hl -> darg >> buildLibrary processInitialHo processDecls hl - ListLibraries -> do - when (optVerbose options > 0) $ do - putStrLn "Search path:" - mapM_ putStrLn (optHlPath options) - putStrLn "Libraries found:" - ll <- libraryList - sequence_ [ putStrLn name | (name,_) <- ll ] + BuildHl hl -> darg >> buildLibrary processInitialHo processDecls hl + ListLibraries -> listLibraries ShowHo ho -> dumpHoFile ho Version -> putStrLn versionString PrintHscOptions -> putStrLn $ "-I" ++ VC.datadir ++ "/" ++ VC.package ++ "-" ++ VC.shortVersion ++ "/include" [add fix for compiling on MacOSX, thanks to Mark Wotton. John Meacham
**20090819041030 Ignore-this: bdaeb7fde521f98e4580bca36b6b74d3 ] addfile ./examples/Options.hs hunk ./examples/Options.hs 1 + +import Jhc.Options +import Text.Printf + +main :: IO () +main = do + printf "isWindows: %s\n" (show isWindows) + printf "isPosix: %s\n" (show isPosix) + printf "isBigEndian: %s\n" (show isBigEndian) + printf "isLittleEndian: %s\n" (show isLittleEndian) + printf "Target: %s\n" (show target) + + +instance Show Target where + show Grin = "Grin" + show GhcHs = "GhcHs" + show DotNet = "DotNet" + show Java = "Java" hunk ./src/data/rts/jhc_rts_header.h 17 #ifndef __WIN32__ #include #include -#include +#include +#include #include #endif #include Context:
[initialize CAFs statically, add hs_init and friends to the rts to be compliant with the FFI spec, allow compiling without generating a 'main' John Meacham
**20090813053325 Ignore-this: 8970666bd27accca219beede653459da ] [add 'System.Mem' to jhc library John Meacham **20090812074322 Ignore-this: f979802508f0976e350e9064b6701973 ] [clean up Main.hs John Meacham **20090812061523 Ignore-this: 75f574f8251cfcad6227bc48ac74b2f7 ] [enable the ho cache, start using it by default. John Meacham **20090812060012 Ignore-this: a0d4d4afae50f05d5ce16f5b654d2072 ] [use utf8-string routines in PackedString John Meacham **20090811165405 Ignore-this: ea852d2e75ba0cc13fe2c92723024565 ] [TAG krasyupheasy John Meacham **20090811155530 Ignore-this: c3ad24b76191a311e2fc81123c2fa1cf ] Patch bundle hash: a7d14e301bd81a14a07a8c43505719f50ea35953 _______________________________________________ jhc mailing list jhc@haskell.org http://www.haskell.org/mailman/listinfo/jhc
-- I'm haunted by the freakish size of Nancy Reagan's head No way that thing came with her body. -- Mission of Burma, Nancy Reagan's Head
On Wed, Aug 19, 2009 at 03:08:07PM +1000, Mark Wotton wrote:
I'm probably doing something silly, but using this release a minimal test program no longer compiles for me.
The library format changed at some point, a change may have been in this patch bundle. Try building the libraries in the jhc dir then compiling with -L. and see if that works. if so, reinstall the libraries to the system locations.
Any tips?
Hmm.. what does jhc --list-libraries say? if it doesn't list those libraries, it isn't able to load them for some reason. Probably due to a format change. John -- John Meacham - ⑆repetae.net⑆john⑈ - http://notanumber.net/
On 19/08/2009, at 4:42 PM, John Meacham wrote:
On Wed, Aug 19, 2009 at 03:08:07PM +1000, Mark Wotton wrote:
I'm probably doing something silly, but using this release a minimal test program no longer compiles for me.
The library format changed at some point, a change may have been in this patch bundle. Try building the libraries in the jhc dir then compiling with -L. and see if that works. if so, reinstall the libraries to the system locations.
Any tips?
Hmm.. what does jhc --list-libraries say? if it doesn't list those libraries, it isn't able to load them for some reason. Probably due to a format change.
It gave nothing. But taking the tip, I deleted *.hl manually in the jhc source directory, and it worked - perhaps 'make distclean' should delete those too? My usual assumption is that 'distclean' corresponds to a pristine environment. mark
participants (2)
-
John Meacham -
Mark Wotton