From b4529492d9d6abe42124e58e2488644924ef43ee Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Sat, 3 Sep 2005 03:37:58 +0000 Subject: [PATCH] Make haddock happy --- System/MkTemp.hs | 2 +- System/Plugins/Env.hs | 74 +++++++++++++++++++++------------------- System/Plugins/Load.hs | 12 +++---- System/Plugins/Make.hs | 5 ++- System/Plugins/Parser.hs | 61 ++++++++++++++++----------------- 5 files changed, 78 insertions(+), 76 deletions(-) diff --git a/System/MkTemp.hs b/System/MkTemp.hs index 2055542..f9db73d 100644 --- a/System/MkTemp.hs +++ b/System/MkTemp.hs @@ -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 diff --git a/System/Plugins/Env.hs b/System/Plugins/Env.hs index 08fba1e..43e04dc 100644 --- a/System/Plugins/Env.hs +++ b/System/Plugins/Env.hs @@ -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__) diff --git a/System/Plugins/Load.hs b/System/Plugins/Load.hs index ca3dfac..63da957 100644 --- a/System/Plugins/Load.hs +++ b/System/Plugins/Load.hs @@ -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. -- diff --git a/System/Plugins/Make.hs b/System/Plugins/Make.hs index c932f57..e6e9b84 100644 --- a/System/Plugins/Make.hs +++ b/System/Plugins/Make.hs @@ -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, diff --git a/System/Plugins/Parser.hs b/System/Plugins/Parser.hs index a051464..4f9a2f9 100644 --- a/System/Plugins/Parser.hs +++ b/System/Plugins/Parser.hs @@ -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