Make haddock happy
This commit is contained in:
Don Stewart
parent
1191f0595e
commit
b4529492d9
@ -239,7 +239,7 @@ mkdir0700 dir = createDirectory dir
|
||||
System.Posix.Directory.createDirectory dir ownerModes
|
||||
-}
|
||||
|
||||
-- | getProcessId, stolen from GHC (main/SysTools.lhs)
|
||||
-- | getProcessId, stolen from GHC /main\/SysTools.lhs/
|
||||
--
|
||||
#ifdef __MINGW32__
|
||||
-- relies on Int == Int32 on Windows
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
{-# OPTIONS -cpp #-}
|
||||
--
|
||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
--
|
||||
-- This library is free software; you can redistribute it and/or
|
||||
-- modify it under the terms of the GNU Lesser General Public
|
||||
@ -97,25 +96,26 @@ lookupFM = flip M.lookup
|
||||
#endif
|
||||
|
||||
--
|
||||
-- We need to record what modules and packages we have loaded, so if we
|
||||
-- read a .hi file that wants to load something already loaded, we can
|
||||
-- safely ignore that request. We're in the IO monad anyway, so we can
|
||||
-- add some extra state of our own.
|
||||
-- | We need to record what modules and packages we have loaded, so if
|
||||
-- we read a .hi file that wants to load something already loaded, we
|
||||
-- can safely ignore that request. We're in the IO monad anyway, so we
|
||||
-- can add some extra state of our own.
|
||||
--
|
||||
-- The state is a FiniteMap String (Module,Int) (a hash of package/object names
|
||||
-- to Modules and how many times they've been loaded).
|
||||
-- The state is a FiniteMap String (Module,Int) (a hash of
|
||||
-- package\/object names to Modules and how many times they've been
|
||||
-- loaded).
|
||||
--
|
||||
-- It also contains the package.conf information, so that if there is a
|
||||
-- package dependency we can find it correctly, even if it has a
|
||||
-- non-standard path or name, and if it isn't an official package (but
|
||||
-- rather one provided via -package-conf). This is stored as a
|
||||
-- FiniteMap PackageName PackageConfig. The problem then is whether a
|
||||
-- user's package.conf, that uses the same package name as an existing
|
||||
-- GHC package, should be allowed, or should shadow a library package?
|
||||
-- I don't know, but I'm inclined to have the GHC package shadow the
|
||||
-- rather one provided via -package-conf). This is stored as a FiniteMap
|
||||
-- PackageName PackageConfig. The problem then is whether a user's
|
||||
-- package.conf, that uses the same package name as an existing GHC
|
||||
-- package, should be allowed, or should shadow a library package? I
|
||||
-- don't know, but I'm inclined to have the GHC package shadow the
|
||||
-- user's package.
|
||||
--
|
||||
-- This idea is based on *Hampus Ram's dynamic loader* dependency
|
||||
-- This idea is based on /Hampus Ram's dynamic loader/ dependency
|
||||
-- tracking system. He uses state to record dependency trees to allow
|
||||
-- clean unloading and other fun. This is quite cool. We're just using
|
||||
-- state to make sure we don't load the same package twice. Implementing
|
||||
@ -160,10 +160,9 @@ env = unsafePerformIO $ do
|
||||
|
||||
-- -----------------------------------------------------------
|
||||
--
|
||||
-- apply 'f' to the loaded objects Env
|
||||
-- apply 'f' to the package.conf FM
|
||||
-- *locks up the MVar* so you can't recursively call a function inside a
|
||||
-- with*Env function. Nice and threadsafe
|
||||
-- | apply 'f' to the loaded objects Env, apply 'f' to the package.conf
|
||||
-- FM /locks up the MVar/ so you can't recursively call a function
|
||||
-- inside a with any -Env function. Nice and threadsafe
|
||||
--
|
||||
withModEnv :: Env -> (ModEnv -> IO a) -> IO a
|
||||
withDepEnv :: Env -> (DepEnv -> IO a) -> IO a
|
||||
@ -195,7 +194,7 @@ lockAndWrite mvar ref f = withMVar mvar (\_->readIORef ref>>=f>>=writeIORef ref)
|
||||
|
||||
-- -----------------------------------------------------------
|
||||
--
|
||||
-- insert a loaded module name into the environment
|
||||
-- | insert a loaded module name into the environment
|
||||
--
|
||||
addModule :: String -> Module -> IO ()
|
||||
addModule s m = modifyModEnv env $ \fm -> let c = maybe 0 snd (lookupFM fm s)
|
||||
@ -205,7 +204,8 @@ addModule s m = modifyModEnv env $ \fm -> let c = maybe 0 snd (lookupFM fm s)
|
||||
--getModule s = withModEnv env $ \fm -> return (lookupFM fm s)
|
||||
|
||||
--
|
||||
-- remove a module name from the environment. Returns True if the module was actually removed.
|
||||
-- | remove a module name from the environment. Returns True if the
|
||||
-- module was actually removed.
|
||||
--
|
||||
rmModule :: String -> IO Bool
|
||||
rmModule s = do modifyModEnv env $ \fm -> let c = maybe 1 snd (lookupFM fm s)
|
||||
@ -216,13 +216,13 @@ rmModule s = do modifyModEnv env $ \fm -> let c = maybe 1 snd (lookupFM fm s)
|
||||
withModEnv env $ \fm -> return (isNothing (lookupFM fm s))
|
||||
|
||||
--
|
||||
-- insert a list of module names all in one go
|
||||
-- | insert a list of module names all in one go
|
||||
--
|
||||
addModules :: [(String,Module)] -> IO ()
|
||||
addModules ns = mapM_ (uncurry addModule) ns
|
||||
|
||||
--
|
||||
-- is a module/package already loaded?
|
||||
-- | is a module\/package already loaded?
|
||||
--
|
||||
isLoaded :: String -> IO Bool
|
||||
isLoaded s = withModEnv env $ \fm -> return $ isJust (lookupFM fm s)
|
||||
@ -239,30 +239,31 @@ loaded m = do t <- isLoaded m ; return (not t)
|
||||
--
|
||||
|
||||
--
|
||||
-- set the dependencies of a Module.
|
||||
-- | Set the dependencies of a Module.
|
||||
--
|
||||
addModuleDeps :: Module -> [Module] -> IO ()
|
||||
addModuleDeps m deps = modifyDepEnv env $ \fm -> return $ addToFM fm m deps
|
||||
|
||||
--
|
||||
-- Get module dependencies. Nothing if none have been recored.
|
||||
-- | Get module dependencies. Nothing if none have been recored.
|
||||
--
|
||||
getModuleDeps :: Module -> IO [Module]
|
||||
getModuleDeps m = withDepEnv env $ \fm -> return $ fromMaybe [] (lookupFM fm m)
|
||||
|
||||
|
||||
--
|
||||
-- Unrecord a module from the environment.
|
||||
-- | Unrecord a module from the environment.
|
||||
--
|
||||
rmModuleDeps :: Module -> IO ()
|
||||
rmModuleDeps m = modifyDepEnv env $ \fm -> return $ delFromFM fm m
|
||||
|
||||
-- -----------------------------------------------------------
|
||||
-- Package management stuff
|
||||
|
||||
--
|
||||
-- insert a single package.conf (containing multiple configs)
|
||||
-- means: create a new FM. insert packages into FM. add FM to end of
|
||||
-- list of FM stored in the environment.
|
||||
-- | Insert a single package.conf (containing multiple configs) means:
|
||||
-- create a new FM. insert packages into FM. add FM to end of list of FM
|
||||
-- stored in the environment.
|
||||
--
|
||||
addPkgConf :: FilePath -> IO ()
|
||||
addPkgConf f = do
|
||||
@ -270,7 +271,7 @@ addPkgConf f = do
|
||||
modifyPkgEnv env $ \ls -> return $ union ls ps
|
||||
|
||||
--
|
||||
-- add a new FM for the package.conf to the list of existing ones
|
||||
-- | add a new FM for the package.conf to the list of existing ones
|
||||
--
|
||||
union :: PkgEnvs -> [PackageConfig] -> PkgEnvs
|
||||
union ls ps' =
|
||||
@ -278,8 +279,8 @@ union ls ps' =
|
||||
in ls ++ [foldr (\p fm' -> addToFM fm' (packageName p) p) fm ps']
|
||||
|
||||
--
|
||||
-- generate a PkgEnv from the system package.conf
|
||||
-- * the path to the default package.conf was determined by ./configure *
|
||||
-- | generate a PkgEnv from the system package.conf
|
||||
-- The path to the default package.conf was determined by /configure/
|
||||
-- This imposes a constraint that you must build your plugins with the
|
||||
-- same ghc you use to build hs-plugins. This is reasonable, we feel.
|
||||
--
|
||||
@ -315,10 +316,13 @@ readPackageConf f = do
|
||||
-- return the path to all the libraries needed to load this package.
|
||||
--
|
||||
-- What do we need to load? With the library_dirs as prefix paths:
|
||||
-- * anything in the hs_libraries fields, $libdir expanded
|
||||
-- * anything in the extra_libraries fields (i.e. cbits), expanded,
|
||||
-- . anything in the hs_libraries fields, libdir expanded
|
||||
--
|
||||
-- . anything in the extra_libraries fields (i.e. cbits), expanded,
|
||||
--
|
||||
-- which includes system .so files.
|
||||
-- * also load any dependencies now, because of that weird mtl
|
||||
--
|
||||
-- . also load any dependencies now, because of that weird mtl
|
||||
-- library that lang depends upon, but which doesn't show up in the
|
||||
-- interfaces for some reason.
|
||||
--
|
||||
@ -342,7 +346,7 @@ classifyLdInput ('-':'l':lib) = return (Just (DLL lib))
|
||||
classifyLdInput ('-':'L':path) = return (Just (DLLPath path))
|
||||
classifyLdInput _ = return Nothing
|
||||
|
||||
-- TODO need to define a MAC/DARWIN symbol
|
||||
-- TODO need to define a MAC\/DARWIN symbol
|
||||
#if defined(MACOSX)
|
||||
mkSOName root = "lib" ++ root ++ ".dylib"
|
||||
#elif defined(CYGWIN) || defined(__MINGW32__)
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
{-# OPTIONS -#include "Linker.h" #-}
|
||||
{-# OPTIONS -fglasgow-exts -cpp #-}
|
||||
{-# OPTIONS -fglasgow-exts #-}
|
||||
--
|
||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
--
|
||||
-- This library is free software; you can redistribute it and/or
|
||||
-- modify it under the terms of the GNU Lesser General Public
|
||||
@ -351,7 +351,7 @@ reload m@(Module{path = p, iface = hi}) sym = do
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- This is a stripped-down version of André Pang's runtime_loader,
|
||||
-- which in turn is based on GHC's ghci/ObjLinker.lhs binding
|
||||
-- which in turn is based on GHC's ghci\/ObjLinker.lhs binding
|
||||
--
|
||||
-- Load and unload\/Haskell modules at runtime. This is not really
|
||||
-- \'dynamic loading\', as such -- that implies that you\'re working
|
||||
@ -361,7 +361,7 @@ reload m@(Module{path = p, iface = hi}) sym = do
|
||||
-- the function. I have no idea if this works for types, but that
|
||||
-- doesn\'t mean that you can\'t try it :).
|
||||
--
|
||||
-- read $fptools/ghc/compiler/ghci/ObjLinker.lhs for how to use this stuff
|
||||
-- read $fptools\/ghc\/compiler\/ghci\/ObjLinker.lhs for how to use this stuff
|
||||
--
|
||||
------------------------------------------------------------------------
|
||||
|
||||
@ -417,7 +417,7 @@ loadFunction (Module { iface = i }) valsym
|
||||
--
|
||||
-- the second argument to loadObject is a string to use as the unique
|
||||
-- identifier for this object. For normal .o objects, it should be the
|
||||
-- Z-encoded modid from the .hi file. For archives/packages, we can
|
||||
-- Z-encoded modid from the .hi file. For archives\/packages, we can
|
||||
-- probably get away with the package name
|
||||
--
|
||||
|
||||
@ -482,7 +482,7 @@ unloadObj (Module { path = p, kind = k, key = ky }) = case k of
|
||||
Shared -> return () -- can't unload .so?
|
||||
where name = case ky of Object s -> s ; Package pk -> pk
|
||||
--
|
||||
-- | from ghci/ObjLinker.c
|
||||
-- | from ghci\/ObjLinker.c
|
||||
--
|
||||
-- Load a .so type object file.
|
||||
--
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
{-# OPTIONS -cpp #-}
|
||||
--
|
||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
--
|
||||
-- This library is free software; you can redistribute it and/or
|
||||
-- modify it under the terms of the GNU Lesser General Public
|
||||
@ -224,7 +223,7 @@ build :: FilePath -- path to .hs source
|
||||
|
||||
build src obj extra_opts = do
|
||||
|
||||
let odir = dirname obj -- *always* put the .hi file next to the .o file
|
||||
let odir = dirname obj -- always put the .hi file next to the .o file
|
||||
|
||||
let ghc_opts = [ "-Onot" ]
|
||||
output = [ "-o", obj, "-odir", odir,
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{-# OPTIONS -cpp -fglasgow-exts #-}
|
||||
{-# OPTIONS -fglasgow-exts #-}
|
||||
--
|
||||
-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
|
||||
--
|
||||
-- This program is free software; you can redistribute it and/or
|
||||
-- modify it under the terms of the GNU General Public License as
|
||||
@ -67,24 +67,23 @@ pretty :: HsModule -> String
|
||||
pretty code = prettyPrintWithMode (defaultMode { linePragmas = True }) code
|
||||
|
||||
|
||||
-- |
|
||||
-- mergeModules : generate a full Haskell src file, give a .hs config
|
||||
-- | mergeModules : generate a full Haskell src file, give a .hs config
|
||||
-- file, and a stub to take default syntax and decls from. Mostly we
|
||||
-- just ensure they don't do anything bad, and that the names are
|
||||
-- correct for the module.
|
||||
--
|
||||
-- Transformations:
|
||||
-- Transformations:
|
||||
--
|
||||
-- * Take src location pragmas from the conf file (1st file)
|
||||
-- * Use the template's (2nd argument) module name
|
||||
-- * Only use export list from template (2nd arg)
|
||||
-- * Merge top-level decls
|
||||
-- * need to force the type of the plugin to match the stub,
|
||||
-- . Take src location pragmas from the conf file (1st file)
|
||||
-- . Use the template's (2nd argument) module name
|
||||
-- . Only use export list from template (2nd arg)
|
||||
-- . Merge top-level decls
|
||||
-- . need to force the type of the plugin to match the stub,
|
||||
-- overwriting any type they supply.
|
||||
--
|
||||
mergeModules :: HsModule -> -- ^ Configure module
|
||||
HsModule -> -- ^ Template module
|
||||
HsModule -- ^ A merge of the two
|
||||
mergeModules :: HsModule -> -- Configure module
|
||||
HsModule -> -- Template module
|
||||
HsModule -- A merge of the two
|
||||
|
||||
mergeModules (HsModule l _ _ is ds )
|
||||
(HsModule _ m' es' is' ds')
|
||||
@ -93,7 +92,7 @@ mergeModules (HsModule l _ _ is ds )
|
||||
(mDecl ds ds') )
|
||||
|
||||
--
|
||||
-- replace Module name with String.
|
||||
-- | replace Module name with String.
|
||||
--
|
||||
replaceModName :: HsModule -> String -> HsModule
|
||||
replaceModName (HsModule l _ es is ds) nm = (HsModule l (Module nm) es is ds)
|
||||
@ -104,15 +103,15 @@ replaceModName (HsModule l _ es is ds) nm = (HsModule l (Module nm) es is ds)
|
||||
-- * ensure that the config file doesn't import the stub name
|
||||
-- * merge import lists uniquely, and when they match, merge their decls
|
||||
--
|
||||
-- TODO : we don't merge imports of the same module from both files.
|
||||
-- TODO * we don't merge imports of the same module from both files.
|
||||
-- We should, and then merge the decls in their import list
|
||||
-- ** rename args, too confusing.
|
||||
-- * rename args, too confusing.
|
||||
--
|
||||
-- quick fix: strip all type signatures from the source.
|
||||
--
|
||||
mImps :: Module -> -- ^ plugin module name
|
||||
[HsImportDecl] -> -- ^ conf file imports
|
||||
[HsImportDecl] -> -- ^ stub file imports
|
||||
mImps :: Module -> -- plugin module name
|
||||
[HsImportDecl] -> -- conf file imports
|
||||
[HsImportDecl] -> -- stub file imports
|
||||
[HsImportDecl]
|
||||
|
||||
mImps plug_mod cimps timps =
|
||||
@ -126,11 +125,10 @@ mImps plug_mod cimps timps =
|
||||
-- Remove decls found in template, using those from the config file.
|
||||
-- Need to sort decls by types, then decls first, in both.
|
||||
--
|
||||
-- * could we write a pass to handle "editor, foo :: String" ?
|
||||
-- Could we write a pass to handle editor, foo :: String ?
|
||||
-- We must keep the type from the template.
|
||||
--
|
||||
-- we must keep the type from the template.
|
||||
--
|
||||
mDecl ds es = let ds' = filter (\t->not $ typeDecl t) ds -- rm type sigs from plugin
|
||||
mDecl ds es = let ds' = filter (not.typeDecl) ds
|
||||
in sortBy decls $! unionBy (=~) ds' es
|
||||
where
|
||||
decls a b = compare (encoding a) (encoding b)
|
||||
@ -167,16 +165,17 @@ instance SynEq HsImportDecl where
|
||||
-- | Parsing option pragmas.
|
||||
--
|
||||
-- This is not a type checker. If the user supplies bogus options,
|
||||
-- they'll get slightly mystical error messages. Also, we *want* to
|
||||
-- handle -package options, and other *static* flags. This is more than
|
||||
-- they'll get slightly mystical error messages. Also, we /want/ to
|
||||
-- handle -package options, and other /static/ flags. This is more than
|
||||
-- GHC.
|
||||
--
|
||||
-- GHC user's guide :
|
||||
-- "OPTIONS pragmas are only looked for at the top of your source
|
||||
-- files, upto the first (non-literate,non-empty) line not
|
||||
-- containing OPTIONS. Multiple OPTIONS pragmas are recognised."
|
||||
--
|
||||
-- based on getOptionsFromSource(), in main/DriverUtil.hs
|
||||
-- > OPTIONS pragmas are only looked for at the top of your source
|
||||
-- > files, up to the first (non-literate,non-empty) line not
|
||||
-- > containing OPTIONS. Multiple OPTIONS pragmas are recognised.
|
||||
--
|
||||
-- based on getOptionsFromSource(), in main\/DriverUtil.hs
|
||||
--
|
||||
parsePragmas :: String -- ^ input src
|
||||
-> ([String],[String]) -- ^ normal options, global options
|
||||
@ -197,7 +196,7 @@ parsePragmas s = look $ lines s
|
||||
| otherwise -> ([],[])
|
||||
|
||||
--
|
||||
-- based on main/DriverUtil.hs
|
||||
-- based on main\/DriverUtil.hs
|
||||
--
|
||||
-- extended to handle dynamic options too
|
||||
--
|
||||
@ -223,7 +222,7 @@ remove_spaces :: String -> String
|
||||
remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
|
||||
|
||||
--
|
||||
-- verbatim from utils/Utils.lhs
|
||||
-- verbatim from utils\/Utils.lhs
|
||||
--
|
||||
prefixMatch :: Eq a => [a] -> [a] -> Bool
|
||||
prefixMatch [] _str = True
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user