[jhc] darcs patch: haskell98 should re-export Prelude and N... (and 4
more)
Mark Wotton
mwotton at gmail.com
Wed Aug 19 01:08:07 EDT 2009
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 <john at repetae.net>
> * haskell98 should re-export Prelude and Numeric
>
> Thu Aug 13 19:36:17 PDT 2009 John Meacham <john at repetae.net>
> * clean up documentation, rename all environment variable to have a
> consistent JHC_ prefix
>
> Mon Aug 17 16:10:29 PDT 2009 John Meacham <john at repetae.net>
> * clean up stats some
>
> Tue Aug 18 20:52:36 PDT 2009 John Meacham <john at repetae.net>
> * 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 <john at repetae.net>
> * add fix for compiling on MacOSX, thanks to Mark Wotton.
>
> New patches:
>
> [haskell98 should re-export Prelude and Numeric
> John Meacham <john at repetae.net>**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 <john at repetae.net>**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
> -
> -<include text `/home/john/bin/jhc --help 2>&1`>
> -
> -things to pass to -d
> -
> -<include text `/home/john/bin/jhc -dhelp 2>&1`>
> -
> -things to pass to -f
> -
> -<include text `/home/john/bin/jhc -fhelp 2>&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
>
> -{- at 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 <john at repetae.net>**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 <john at repetae.net>**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 <john at repetae.net>**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 <sys/select.h>
> #include <sys/times.h>
> -#include <endian.h>
> +#include <sys/types.h>
> +#include <sys/param.h>
> #include <sys/utsname.h>
> #endif
> #include <setjmp.h>
>
> 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 <john at repetae.net>**20090813053325
> Ignore-this: 8970666bd27accca219beede653459da
> ]
> [add 'System.Mem' to jhc library
> John Meacham <john at repetae.net>**20090812074322
> Ignore-this: f979802508f0976e350e9064b6701973
> ]
> [clean up Main.hs
> John Meacham <john at repetae.net>**20090812061523
> Ignore-this: 75f574f8251cfcad6227bc48ac74b2f7
> ]
> [enable the ho cache, start using it by default.
> John Meacham <john at repetae.net>**20090812060012
> Ignore-this: a0d4d4afae50f05d5ce16f5b654d2072
> ]
> [use utf8-string routines in PackedString
> John Meacham <john at repetae.net>**20090811165405
> Ignore-this: ea852d2e75ba0cc13fe2c92723024565
> ]
> [TAG krasyupheasy
> John Meacham <john at repetae.net>**20090811155530
> Ignore-this: c3ad24b76191a311e2fc81123c2fa1cf
> ]
> Patch bundle hash:
> a7d14e301bd81a14a07a8c43505719f50ea35953
> _______________________________________________
> jhc mailing list
> jhc at 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
More information about the jhc
mailing list