wrath/shaniqua-plugins
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make haddock happy

Browse Source
This commit is contained in:
Don Stewart 2005-09-03 03:37:58 +00:00
parent 1191f0595e
commit b4529492d9
5 changed files with 78 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
System/MkTemp.hs
View File

@ -239,7 +239,7 @@ mkdir0700 dir = createDirectory dir
System.Posix.Directory.createDirectory dir ownerModes System.Posix.Directory.createDirectory dir ownerModes
-} -}
-- | getProcessId, stolen from GHC (main/SysTools.lhs) -- | getProcessId, stolen from GHC /main\/SysTools.lhs/
-- --
#ifdef __MINGW32__ #ifdef __MINGW32__
-- relies on Int == Int32 on Windows -- relies on Int == Int32 on Windows

74
System/Plugins/Env.hs
View 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 -- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public -- modify it under the terms of the GNU Lesser General Public
@ -97,25 +96,26 @@ lookupFM = flip M.lookup
#endif #endif
-- --
-- We need to record what modules and packages we have loaded, so if we -- | We need to record what modules and packages we have loaded, so if
-- read a .hi file that wants to load something already loaded, we can -- we read a .hi file that wants to load something already loaded, we
-- safely ignore that request. We're in the IO monad anyway, so we can -- can safely ignore that request. We're in the IO monad anyway, so we
-- add some extra state of our own. -- can add some extra state of our own.
-- --
-- The state is a FiniteMap String (Module,Int) (a hash of package/object names -- The state is a FiniteMap String (Module,Int) (a hash of
-- to Modules and how many times they've been loaded). -- 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 -- 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 -- 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 -- 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 -- rather one provided via -package-conf). This is stored as a FiniteMap
-- FiniteMap PackageName PackageConfig. The problem then is whether a -- PackageName PackageConfig. The problem then is whether a user's
-- user's package.conf, that uses the same package name as an existing -- package.conf, that uses the same package name as an existing GHC
-- GHC package, should be allowed, or should shadow a library package? -- package, should be allowed, or should shadow a library package? I
-- I don't know, but I'm inclined to have the GHC package shadow the -- don't know, but I'm inclined to have the GHC package shadow the
-- user's package. -- 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 -- tracking system. He uses state to record dependency trees to allow
-- clean unloading and other fun. This is quite cool. We're just using -- 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 -- 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 loaded objects Env, apply 'f' to the package.conf
-- apply 'f' to the package.conf FM -- FM /locks up the MVar/ so you can't recursively call a function
-- *locks up the MVar* so you can't recursively call a function inside a -- inside a with any -Env function. Nice and threadsafe
-- with*Env function. Nice and threadsafe
-- --
withModEnv :: Env -> (ModEnv -> IO a) -> IO a withModEnv :: Env -> (ModEnv -> IO a) -> IO a
withDepEnv :: Env -> (DepEnv -> 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 :: String -> Module -> IO ()
addModule s m = modifyModEnv env $ \fm -> let c = maybe 0 snd (lookupFM fm s) 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) --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 :: String -> IO Bool
rmModule s = do modifyModEnv env $ \fm -> let c = maybe 1 snd (lookupFM fm s) 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)) 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 :: [(String,Module)] -> IO ()
addModules ns = mapM_ (uncurry addModule) ns addModules ns = mapM_ (uncurry addModule) ns
-- --
-- is a module/package already loaded? -- | is a module\/package already loaded?
-- --
isLoaded :: String -> IO Bool isLoaded :: String -> IO Bool
isLoaded s = withModEnv env $ \fm -> return $ isJust (lookupFM fm s) 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 :: Module -> [Module] -> IO ()
addModuleDeps m deps = modifyDepEnv env $ \fm -> return $ addToFM fm m deps 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 :: Module -> IO [Module]
getModuleDeps m = withDepEnv env $ \fm -> return $ fromMaybe [] (lookupFM fm m) 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 :: Module -> IO ()
rmModuleDeps m = modifyDepEnv env $ \fm -> return $ delFromFM fm m rmModuleDeps m = modifyDepEnv env $ \fm -> return $ delFromFM fm m
-- ----------------------------------------------------------- -- -----------------------------------------------------------
-- Package management stuff -- Package management stuff
-- --
-- insert a single package.conf (containing multiple configs) -- | Insert a single package.conf (containing multiple configs) means:
-- means: create a new FM. insert packages into FM. add FM to end of -- create a new FM. insert packages into FM. add FM to end of list of FM
-- list of FM stored in the environment. -- stored in the environment.
-- --
addPkgConf :: FilePath -> IO () addPkgConf :: FilePath -> IO ()
addPkgConf f = do addPkgConf f = do
@ -270,7 +271,7 @@ addPkgConf f = do
modifyPkgEnv env $ \ls -> return $ union ls ps 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 :: PkgEnvs -> [PackageConfig] -> PkgEnvs
union ls ps' = union ls ps' =
@ -278,8 +279,8 @@ union ls ps' =
in ls ++ [foldr (\p fm' -> addToFM fm' (packageName p) p) fm ps'] in ls ++ [foldr (\p fm' -> addToFM fm' (packageName p) p) fm ps']
-- --
-- generate a PkgEnv from the system package.conf -- | generate a PkgEnv from the system package.conf
-- * the path to the default package.conf was determined by ./configure * -- The path to the default package.conf was determined by /configure/
-- This imposes a constraint that you must build your plugins with the -- 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. -- 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. -- 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: -- What do we need to load? With the library_dirs as prefix paths:
-- * anything in the hs_libraries fields, $libdir expanded -- . anything in the hs_libraries fields, libdir expanded
-- * anything in the extra_libraries fields (i.e. cbits), expanded, --
-- . anything in the extra_libraries fields (i.e. cbits), expanded,
--
-- which includes system .so files. -- 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 -- library that lang depends upon, but which doesn't show up in the
-- interfaces for some reason. -- interfaces for some reason.
-- --
@ -342,7 +346,7 @@ classifyLdInput ('-':'l':lib) = return (Just (DLL lib))
classifyLdInput ('-':'L':path) = return (Just (DLLPath path)) classifyLdInput ('-':'L':path) = return (Just (DLLPath path))
classifyLdInput _ = return Nothing classifyLdInput _ = return Nothing
-- TODO need to define a MAC/DARWIN symbol -- TODO need to define a MAC\/DARWIN symbol
#if defined(MACOSX) #if defined(MACOSX)
mkSOName root = "lib" ++ root ++ ".dylib" mkSOName root = "lib" ++ root ++ ".dylib"
#elif defined(CYGWIN) || defined(__MINGW32__) #elif defined(CYGWIN) || defined(__MINGW32__)

12
System/Plugins/Load.hs
View File

@ -1,7 +1,7 @@
{-# OPTIONS -#include "Linker.h" #-} {-# 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 -- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public -- 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, -- 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 -- Load and unload\/Haskell modules at runtime. This is not really
-- \'dynamic loading\', as such -- that implies that you\'re working -- \'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 -- the function. I have no idea if this works for types, but that
-- doesn\'t mean that you can\'t try it :). -- 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 -- 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 -- 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 -- 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? Shared -> return () -- can't unload .so?
where name = case ky of Object s -> s ; Package pk -> pk 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. -- Load a .so type object file.
-- --

5
System/Plugins/Make.hs
View 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 -- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public -- 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 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" ] let ghc_opts = [ "-Onot" ]
output = [ "-o", obj, "-odir", odir, output = [ "-o", obj, "-odir", odir,

61
System/Plugins/Parser.hs
View File

@ -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 -- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License as -- 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 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 -- 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 -- just ensure they don't do anything bad, and that the names are
-- correct for the module. -- correct for the module.
-- --
-- Transformations: -- Transformations:
-- --
-- * Take src location pragmas from the conf file (1st file) -- . Take src location pragmas from the conf file (1st file)
-- * Use the template's (2nd argument) module name -- . Use the template's (2nd argument) module name
-- * Only use export list from template (2nd arg) -- . Only use export list from template (2nd arg)
-- * Merge top-level decls -- . Merge top-level decls
-- * need to force the type of the plugin to match the stub, -- . need to force the type of the plugin to match the stub,
-- overwriting any type they supply. -- overwriting any type they supply.
-- --
mergeModules :: HsModule -> -- ^ Configure module mergeModules :: HsModule -> -- Configure module
HsModule -> -- ^ Template module HsModule -> -- Template module
HsModule -- ^ A merge of the two HsModule -- A merge of the two
mergeModules (HsModule l _ _ is ds ) mergeModules (HsModule l _ _ is ds )
(HsModule _ m' es' is' ds') (HsModule _ m' es' is' ds')
@ -93,7 +92,7 @@ mergeModules (HsModule l _ _ is ds )
(mDecl ds ds') ) (mDecl ds ds') )
-- --
-- replace Module name with String. -- | replace Module name with String.
-- --
replaceModName :: HsModule -> String -> HsModule replaceModName :: HsModule -> String -> HsModule
replaceModName (HsModule l _ es is ds) nm = (HsModule l (Module nm) es is ds) 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 -- * ensure that the config file doesn't import the stub name
-- * merge import lists uniquely, and when they match, merge their decls -- * 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 -- 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. -- quick fix: strip all type signatures from the source.
-- --
mImps :: Module -> -- ^ plugin module name mImps :: Module -> -- plugin module name
[HsImportDecl] -> -- ^ conf file imports [HsImportDecl] -> -- conf file imports
[HsImportDecl] -> -- ^ stub file imports [HsImportDecl] -> -- stub file imports
[HsImportDecl] [HsImportDecl]
mImps plug_mod cimps timps = 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. -- Remove decls found in template, using those from the config file.
-- Need to sort decls by types, then decls first, in both. -- 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 (not.typeDecl) ds
--
mDecl ds es = let ds' = filter (\t->not $ typeDecl t) ds -- rm type sigs from plugin
in sortBy decls $! unionBy (=~) ds' es in sortBy decls $! unionBy (=~) ds' es
where where
decls a b = compare (encoding a) (encoding b) decls a b = compare (encoding a) (encoding b)
@ -167,16 +165,17 @@ instance SynEq HsImportDecl where
-- | Parsing option pragmas. -- | Parsing option pragmas.
-- --
-- This is not a type checker. If the user supplies bogus options, -- This is not a type checker. If the user supplies bogus options,
-- they'll get slightly mystical error messages. Also, we *want* to -- they'll get slightly mystical error messages. Also, we /want/ to
-- handle -package options, and other *static* flags. This is more than -- handle -package options, and other /static/ flags. This is more than
-- GHC. -- GHC.
-- --
-- GHC user's guide : -- 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 parsePragmas :: String -- ^ input src
-> ([String],[String]) -- ^ normal options, global options -> ([String],[String]) -- ^ normal options, global options
@ -197,7 +196,7 @@ parsePragmas s = look $ lines s
| otherwise -> ([],[]) | otherwise -> ([],[])
-- --
-- based on main/DriverUtil.hs -- based on main\/DriverUtil.hs
-- --
-- extended to handle dynamic options too -- extended to handle dynamic options too
-- --
@ -223,7 +222,7 @@ remove_spaces :: String -> String
remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace 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 :: Eq a => [a] -> [a] -> Bool
prefixMatch [] _str = True prefixMatch [] _str = True