summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorpeb <unknown>2005-02-09 19:45:54 +0000
committerpeb <unknown>2005-02-09 19:45:54 +0000
commit9afbd25b64607e68fe6275fb6b743159001ca984 (patch)
treec1c7f0f1bd7f83d721f4e55318160edd1f0eee1b /src
parentc467ef8d0323d896778c6ed68ce0b23441f3a65a (diff)
"Committed_by_peb"
Diffstat (limited to 'src')
-rw-r--r--src/GF/CFGM/PrintCFGrammar.hs8
-rw-r--r--src/GF/Canon/Share.hs6
-rw-r--r--src/GF/Compile/BackOpt.hs18
-rw-r--r--src/GF/Compile/CheckGrammar.hs35
-rw-r--r--src/GF/Compile/Compile.hs15
-rw-r--r--src/GF/Compile/Extend.hs13
-rw-r--r--src/GF/Compile/GetGrammar.hs7
-rw-r--r--src/GF/Compile/GrammarToCanon.hs7
-rw-r--r--src/GF/Compile/MkResource.hs11
-rw-r--r--src/GF/Compile/MkUnion.hs6
-rw-r--r--src/GF/Compile/ModDeps.hs18
-rw-r--r--src/GF/Compile/NewRename.hs34
-rw-r--r--src/GF/Compile/Optimize.hs15
-rw-r--r--src/GF/Compile/Rebuild.hs3
-rw-r--r--src/GF/Compile/RemoveLiT.hs12
-rw-r--r--src/GF/Compile/Rename.hs31
-rw-r--r--src/GF/Compile/ShellState.hs64
-rw-r--r--src/GF/Compile/Update.hs9
-rw-r--r--src/GF/Data/Glue.hs2
-rw-r--r--src/haddock/haddock-check.perl46
-rw-r--r--src/module-structure.txt8
-rw-r--r--src/tools/mkHelpFile.perl49
22 files changed, 241 insertions, 176 deletions
diff --git a/src/GF/CFGM/PrintCFGrammar.hs b/src/GF/CFGM/PrintCFGrammar.hs
index 6fdd3d250..2b9b75887 100644
--- a/src/GF/CFGM/PrintCFGrammar.hs
+++ b/src/GF/CFGM/PrintCFGrammar.hs
@@ -9,10 +9,9 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- Handles printing a CFGrammar in CFGM format.
-----------------------------------------------------------------------------
--- Handles printing a CFGrammar in CFGM format.
module PrintCFGrammar (prCanonAsCFGM) where
import AbsGFC
@@ -32,8 +31,7 @@ import ErrM
import List (intersperse)
import Maybe (listToMaybe, maybe)
--- FIXME: fix warning about bad -printer= value
-
+-- | FIXME: fix warning about bad -printer= value
prCanonAsCFGM :: CanonGrammar -> String
prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs
where
@@ -43,7 +41,7 @@ prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs
fromOk (Bad y) = error y
xs = [(i,getFlag fs "startcat") | (i,ModMod (Module{flags=fs})) <- cncms]
--- FIXME: need to look in abstract module too
+-- | FIXME: need to look in abstract module too
getFlag :: [Flag] -> String -> Maybe String
getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
diff --git a/src/GF/Canon/Share.hs b/src/GF/Canon/Share.hs
index 89323eb2f..b6d1df520 100644
--- a/src/GF/Canon/Share.hs
+++ b/src/GF/Canon/Share.hs
@@ -10,6 +10,9 @@
-- > CVS $Revision $
--
-- Optimizations on GFC code: sharing, parametrization, value sets.
+--
+-- optimization: sharing branches in tables. AR 25\/4\/2003.
+-- following advice of Josef Svenningsson
-----------------------------------------------------------------------------
module Share (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
@@ -23,9 +26,6 @@ import Operations
import List
import qualified Modules as M
--- optimization: sharing branches in tables. AR 25/4/2003
--- following advice of Josef Svenningsson
-
type OptSpec = [Integer] ---
doOptFactor opt = elem 2 opt
diff --git a/src/GF/Compile/BackOpt.hs b/src/GF/Compile/BackOpt.hs
index d68b72635..1c030f8e1 100644
--- a/src/GF/Compile/BackOpt.hs
+++ b/src/GF/Compile/BackOpt.hs
@@ -10,6 +10,9 @@
-- > CVS $Revision $
--
-- Optimizations on GF source code: sharing, parametrization, value sets.
+--
+-- optimization: sharing branches in tables. AR 25\/4\/2003.
+-- following advice of Josef Svenningsson
-----------------------------------------------------------------------------
module BackOpt (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
@@ -22,15 +25,24 @@ import Operations
import List
import qualified Modules as M
--- optimization: sharing branches in tables. AR 25/4/2003
--- following advice of Josef Svenningsson
-
type OptSpec = [Integer] ---
+
+doOptFactor :: OptSpec
doOptFactor opt = elem 2 opt
+
+doOptValues :: OptSpec
doOptValues opt = elem 3 opt
+
+shareOpt :: OptSpec
shareOpt = []
+
+paramOpt :: OptSpec
paramOpt = [2]
+
+valOpt :: OptSpec
valOpt = [3]
+
+allOpt :: OptSpec
allOpt = [2,3]
shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 5418cddd9..eef7a14d9 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -9,7 +9,15 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
+--
+-- type checking also does the following modifications:
+--
+-- - types of operations and local constants are inferred and put in place
+--
+-- - both these types and linearization types are computed
+--
+-- - tables are type-annotated
-----------------------------------------------------------------------------
module CheckGrammar where
@@ -36,20 +44,12 @@ import CheckM
import List
import Monad
--- AR 4/12/1999 -- 1/4/2000 -- 8/9/2001 -- 15/5/2002 -- 27/11/2002 -- 18/6/2003
-
--- type checking also does the following modifications:
--- * types of operations and local constants are inferred and put in place
--- * both these types and linearization types are computed
--- * tables are type-annotated
-
showCheckModule :: [SourceModule] -> SourceModule -> Err ([SourceModule],String)
showCheckModule mos m = do
(st,(_,msg)) <- checkStart $ checkModule mos m
return (st, unlines $ reverse msg)
--- checking is performed in dependency order of modules
-
+-- | checking is performed in dependency order of modules
checkModule :: [SourceModule] -> SourceModule -> Check [SourceModule]
checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of
@@ -79,8 +79,7 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod
where
gr = MGrammar $ (name,mod):ms
--- check if a term is typable
-
+-- | check if a term is typable
justCheckLTerm :: SourceGrammar -> Term -> Err Term
justCheckLTerm src t = do
((t',_),_) <- checkStart (inferLType src t)
@@ -131,9 +130,8 @@ checkCompleteGrammar abs cnc = mapM_ checkWarn $
then id
else (("Warning: no linearization of" +++ prt f):)
--- General Principle: only Yes-values are checked.
+-- | General Principle: only Yes-values are checked.
-- A May-value has always been checked in its origin module.
-
checkResInfo :: SourceGrammar -> (Ident,Info) -> Check (Ident,Info)
checkResInfo gr (c,info) = do
checkReservedId c
@@ -289,7 +287,7 @@ checkPrintname :: SourceGrammar -> Perh Term -> Check ()
checkPrintname st (Yes t) = checkLType st t typeStr >> return ()
checkPrintname _ _ = return ()
--- for grammars obtained otherwise than by parsing ---- update!!
+-- | for grammars obtained otherwise than by parsing ---- update!!
checkReservedId :: Ident -> Check ()
checkReservedId x = let c = prt x in
if isResWord c
@@ -643,13 +641,13 @@ termWith t ct = do
ty <- ct
return (t,ty)
--- light-weight substitution for dep. types
+-- | light-weight substitution for dep. types
substituteLType :: Context -> Type -> Check Type
substituteLType g t = case t of
Vr x -> return $ maybe t id $ lookup x g
_ -> composOp (substituteLType g) t
--- compositional check/infer of binary operations
+-- | compositional check\/infer of binary operations
check2 :: (Term -> Check Term) -> (Term -> Term -> Term) ->
Term -> Term -> Type -> Check (Term,Type)
check2 chk con a b t = do
@@ -707,8 +705,7 @@ checkEqLType env t u trm = do
sTypes = [typeStr, typeTok, typeString]
comp = computeLType env
--- linearization types and defaults
-
+-- | linearization types and defaults
linTypeOfType :: SourceGrammar -> Ident -> Type -> Check (Context,Type)
linTypeOfType cnc m typ = do
(cont,cat) <- checkErr $ typeSkeleton typ
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index 4c530a76c..c1d33ed8e 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -49,12 +49,10 @@ import Arch
import Monad
--- environment variable for grammar search path
-
+-- | environment variable for grammar search path
gfGrammarPathVar = "GF_LIB_PATH"
--- in batch mode: write code in a file
-
+-- | in batch mode: write code in a file
batchCompile f = liftM fst $ compileModule defOpts emptyShellState f
where
defOpts = options [beVerbose, emitCode]
@@ -66,11 +64,10 @@ batchCompileOld f = compileOld defOpts f
where
defOpts = options [beVerbose, emitCode]
--- compile with one module as starting point
+-- | compile with one module as starting point
-- command-line options override options (marked by --#) in the file
-- As for path: if it is read from file, the file path is prepended to each name.
-- If from command line, it is used as it is.
-
compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
---- IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
@@ -147,8 +144,7 @@ keepResModules opts gr =
else emptyMGrammar
--- the environment
-
+-- | the environment
type CompileEnv = (Int,SourceGrammar, GFC.CanonGrammar)
emptyCompileEnv :: TimedCompileEnv
@@ -211,8 +207,7 @@ compileOne opts env@((_,srcgr,_),_) file = do
extendCompileEnvInt env (k',sm',cm) ft
--- dispatch reused resource at early stage
-
+-- | dispatch reused resource at early stage
makeSourceModule :: Options -> CompileEnv -> SourceModule -> IOE (Int,SourceModule)
makeSourceModule opts env@(k,gr,can) mo@(i,mi) = case mi of
diff --git a/src/GF/Compile/Extend.hs b/src/GF/Compile/Extend.hs
index 7f01db3a6..af6ff0c43 100644
--- a/src/GF/Compile/Extend.hs
+++ b/src/GF/Compile/Extend.hs
@@ -9,7 +9,10 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- AR 14\/5\/2003 -- 11\/11
+--
+-- The top-level function 'extendModule'
+-- extends a module symbol table by indirections to the module it extends
-----------------------------------------------------------------------------
module Extend where
@@ -24,11 +27,6 @@ import Operations
import Monad
--- AR 14/5/2003 -- 11/11
-
--- The top-level function $extendModule$
--- extends a module symbol table by indirections to the module it extends
-
extendModule :: [SourceModule] -> SourceModule -> Err SourceModule
extendModule ms (name,mod) = case mod of
@@ -58,10 +56,9 @@ extendModule ms (name,mod) = case mod of
let me' = if isCompl then es else (filter (/=n) es)
return $ Module mt st fs me' ops js1
--- When extending a complete module: new information is inserted,
+-- | When extending a complete module: new information is inserted,
-- and the process is interrupted if unification fails.
-- If the extended module is incomplete, its judgements are just copied.
-
extendMod :: Bool -> Ident -> Ident -> BinTree (Ident,Info) -> BinTree (Ident,Info) ->
Err (BinTree (Ident,Info))
extendMod isCompl name base old new = foldM try new $ tree2list old where
diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs
index ac340ccd1..415cea55e 100644
--- a/src/GF/Compile/GetGrammar.hs
+++ b/src/GF/Compile/GetGrammar.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- this module builds the internal GF grammar that is sent to the type checker
-----------------------------------------------------------------------------
module GetGrammar where
@@ -40,8 +40,6 @@ import Char (toUpper)
import List (nub)
import Monad (foldM)
--- this module builds the internal GF grammar that is sent to the type checker
-
getSourceModule :: FilePath -> IOE SourceModule
getSourceModule file = do
string <- readFileIOE file
@@ -90,10 +88,9 @@ err2err (E.Bad s) = Bad s
ioeEErr = ioeErr . err2err
--- To resolve the new reserved words:
+-- | To resolve the new reserved words:
-- change them by turning the final letter to upper case.
--- There is a risk of clash.
-
oldLexer :: String -> [L.Token]
oldLexer = map change . L.tokens where
change t = case t of
diff --git a/src/GF/Compile/GrammarToCanon.hs b/src/GF/Compile/GrammarToCanon.hs
index c090f1622..08542ec16 100644
--- a/src/GF/Compile/GrammarToCanon.hs
+++ b/src/GF/Compile/GrammarToCanon.hs
@@ -32,15 +32,12 @@ import Monad
-- compilation of optimized grammars to canonical GF. AR 5/10/2001 -- 12/5/2003
--- This is the top-level function printing a gfc file
-
+-- | This is the top-level function printing a gfc file
showGFC :: SourceGrammar -> String
showGFC = err id id . liftM (P.printTree . grammar2canon) . redGrammar
--- any grammar, first trying without dependent types
-
+-- | any grammar, first trying without dependent types
-- abstract syntax without dependent types
-
redGrammar :: SourceGrammar -> Err C.CanonGrammar
redGrammar (MGrammar gr) = liftM MGrammar $ mapM redModInfo $ filter active gr where
active (_,m) = case typeOfModule m of
diff --git a/src/GF/Compile/MkResource.hs b/src/GF/Compile/MkResource.hs
index 84c58fc0b..5237fb9d8 100644
--- a/src/GF/Compile/MkResource.hs
+++ b/src/GF/Compile/MkResource.hs
@@ -25,9 +25,8 @@ import Operations
import Monad
--- extracting resource r from abstract + concrete syntax
--- AR 21/8/2002 -- 22/6/2003 for GF with modules
-
+-- | extracting resource r from abstract + concrete syntax.
+-- AR 21\/8\/2002 -- 22\/6\/2003 for GF with modules
makeReuse :: SourceGrammar -> Ident -> [Ident] ->
MReuseType Ident -> Err SourceRes
makeReuse gr r me mrc = do
@@ -70,9 +69,8 @@ makeReuse gr r me mrc = do
_ -> prtBad "expected concrete to be the type of" c
--- the first Boolean indicates if the type needs be given
+-- | the first Boolean indicates if the type needs be given
-- the second Boolean indicates if the definition needs be given
-
mkResDefs :: Bool -> Bool ->
SourceGrammar -> Ident -> Ident -> [Ident] -> [Ident] ->
BinTree (Ident,Info) -> BinTree (Ident,Info) ->
@@ -119,8 +117,7 @@ mkResDefs hasT isC gr r a mext maext abs cnc = mapMTree (mkOne a maext) abs wher
Q n c | n == a || [n] == mae -> return $ Q r c ---- FIX for non-singleton exts
_ -> composOp (redirTyp always a mae) ty
--- no reuse for functions of HO/dep types
-
+-- | no reuse for functions of HO\/dep types
isHardType t = case t of
Prod x a b -> not (isWild x) || isHardType a || isHardType b
App _ _ -> True
diff --git a/src/GF/Compile/MkUnion.hs b/src/GF/Compile/MkUnion.hs
index f48f9eda2..6aefdbc75 100644
--- a/src/GF/Compile/MkUnion.hs
+++ b/src/GF/Compile/MkUnion.hs
@@ -9,7 +9,8 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- building union of modules.
+-- AR 1\/3\/2004 --- OBSOLETE 15\/9\/2004 with multiple inheritance
-----------------------------------------------------------------------------
module MkUnion (makeUnion) where
@@ -26,9 +27,6 @@ import Option
import List
import Monad
--- building union of modules
--- AR 1/3/2004 --- OBSOLETE 15/9/2004 with multiple inheritance
-
makeUnion :: SourceGrammar -> Ident -> ModuleType Ident -> [(Ident,[Ident])] ->
Err SourceModule
makeUnion gr m ty imps = do
diff --git a/src/GF/Compile/ModDeps.hs b/src/GF/Compile/ModDeps.hs
index 7e65239e4..797b445e0 100644
--- a/src/GF/Compile/ModDeps.hs
+++ b/src/GF/Compile/ModDeps.hs
@@ -10,6 +10,8 @@
-- > CVS $Revision $
--
-- Check correctness of module dependencies. Incomplete.
+--
+-- AR 13/5/2003
-----------------------------------------------------------------------------
module ModDeps where
@@ -27,12 +29,9 @@ import Operations
import Monad
import List
--- AR 13/5/2003
-
--- to check uniqueness of module names and import names, the
+-- | to check uniqueness of module names and import names, the
-- appropriateness of import and extend types,
-- to build a dependency graph of modules, and to sort them topologically
-
mkSourceGrammar :: [(Ident,SourceModInfo)] -> Err SourceGrammar
mkSourceGrammar ms = do
let ns = map fst ms
@@ -50,8 +49,7 @@ checkUniqueErr ms = do
let msg = checkUnique ms
if null msg then return () else Bad $ unlines msg
--- check that import names don't clash with module names
-
+-- | check that import names don't clash with module names
checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err ()
checkUniqueImportNames ns mo = case mo of
ModMod m -> test [n | OQualif _ n v <- opens m, n /= v]
@@ -62,11 +60,10 @@ checkUniqueImportNames ns mo = case mo of
("import names clashing with module names among" +++
unwords (map prt ms))
--- to decide what modules immediately depend on what, and check if the
--- dependencies are appropriate
-
type Dependencies = [(IdentM Ident,[IdentM Ident])]
+-- | to decide what modules immediately depend on what, and check if the
+-- dependencies are appropriate
moduleDeps :: [(Ident,SourceModInfo)] -> Err Dependencies
moduleDeps ms = mapM deps ms where
deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of
@@ -119,9 +116,8 @@ openInterfaces ds m = do
let mods = iterFix (concatMap more) (more (m,undefined))
return $ [i | (i,MTInterface) <- mods]
--- this function finds out what modules are really needed in the canoncal gr.
+-- | this function finds out what modules are really needed in the canoncal gr.
-- its argument is typically a concrete module name
-
requiredCanModules :: (Eq i, Show i) => MGrammar i f a -> i -> [i]
requiredCanModules gr = nub . iterFix (concatMap more) . singleton where
more i = errVal [] $ do
diff --git a/src/GF/Compile/NewRename.hs b/src/GF/Compile/NewRename.hs
index 1197410ed..60d079915 100644
--- a/src/GF/Compile/NewRename.hs
+++ b/src/GF/Compile/NewRename.hs
@@ -9,7 +9,18 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- AR 14/5/2003
+--
+-- The top-level function 'renameGrammar' does several things:
+--
+-- - extends each module symbol table by indirections to extended module
+--
+-- - changes unqualified and as-qualified imports to absolutely qualified
+--
+-- - goes through the definitions and resolves names
+--
+-- Dependency analysis between modules has been performed before this pass.
+-- Hence we can proceed by @fold@ing "from left to right".
-----------------------------------------------------------------------------
module Rename where
@@ -27,23 +38,14 @@ import Operations
import Monad
--- AR 14/5/2003
-
--- The top-level function $renameGrammar$ does several things:
--- * extends each module symbol table by indirections to extended module
--- * changes unqualified and as-qualified imports to absolutely qualified
--- * goes through the definitions and resolves names
--- Dependency analysis between modules has been performed before this pass.
--- Hence we can proceed by $fold$ing 'from left to right'.
-
--- this gives top-level access to renaming term input in the cc command
+-- | this gives top-level access to renaming term input in the cc command
renameSourceTerm :: SourceGrammar -> Ident -> Term -> Err Term
renameSourceTerm g m t = do
mo <- lookupErr m (modules g)
let status = (modules g,(m,mo)) --- <- buildStatus g m mo
renameTerm status [] t
--- this is used in the compiler, separately for each module
+-- | this is used in the compiler, separately for each module
renameModule :: [SourceModule] -> SourceModule -> Err [SourceModule]
renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of
ModMod m@(Module mt st fs me ops js) -> do
@@ -114,7 +116,7 @@ renameIdentTerm env@(imps,act@(_,ModMod this)) t =
IC "String" -> return $ Q cPredefAbs cString
_ -> Bad s
---- would it make sense to optimize this by inlining?
+-- | would it make sense to optimize this by inlining?
renameIdentPatt :: Status -> Patt -> Err Patt
renameIdentPatt env p = do
let t = patt2term p
@@ -233,8 +235,7 @@ renameTerm env vars = ren vars where
return (p',t')
renpatt = renamePattern env
--- vars not needed in env, since patterns always overshadow old vars
-
+-- | vars not needed in env, since patterns always overshadow old vars
renamePattern :: Status -> Patt -> Err (Patt,[Ident])
renamePattern env patt = case patt of
@@ -286,8 +287,7 @@ renameContext b = renc [] where
_ -> return cont
ren = renameTerm b
--- vars not needed in env, since patterns always overshadow old vars
-
+-- | vars not needed in env, since patterns always overshadow old vars
renameEquation :: Status -> [Ident] -> Equation -> Err Equation
renameEquation b vs (ps,t) = do
(ps',vs') <- liftM unzip $ mapM (renamePattern b) ps
diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs
index 47405f0b4..605d50061 100644
--- a/src/GF/Compile/Optimize.hs
+++ b/src/GF/Compile/Optimize.hs
@@ -33,9 +33,8 @@ import Option
import Monad
import List
--- partial evaluation of concrete syntax. AR 6/2001 -- 16/5/2003 -- 5/2/2005
+-- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
-- only do this for resource: concrete is optimized in gfc form
-
optimizeModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) ->
Err (Ident,SourceModInfo)
optimizeModule opts ms mo@(_,mi) = case mi of
@@ -77,9 +76,8 @@ evalModule ms mo@(name,mod) = case mod of
info' <- evalResInfo gr (i,info)
return $ updateRes g name i info'
--- only operations need be compiled in a resource, and this is local to each
+-- | only operations need be compiled in a resource, and this is local to each
-- definition since the module is traversed in topological order
-
evalResInfo :: SourceGrammar -> (Ident,Info) -> Err Info
evalResInfo gr (c,info) = case info of
@@ -129,8 +127,7 @@ evalCncInfo gr cnc abs (c,info) = case info of
pEval = partEval gr
eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
--- the main function for compiling linearizations
-
+-- | the main function for compiling linearizations
partEval :: SourceGrammar -> (Context,Type) -> Term -> Err Term
partEval gr (context, val) trm = do
let vars = map fst context
@@ -159,8 +156,7 @@ recordExpand typ trm = case unComputed typ of
_ -> return trm
--- auxiliaries for compiling the resource
-
+-- | auxiliaries for compiling the resource
allOperDependencies :: Ident -> BinTree (Ident,Info) -> [(Ident,[Ident])]
allOperDependencies m b =
[(f, nub (opty pty ++ opty pt)) | (f, ResOper pty pt) <- tree2list b]
@@ -196,11 +192,10 @@ mkLinDefault gr typ = do
_ | isTypeInts typ -> return $ EInt 0 -- exists in all as first val
_ -> prtBad "linearization type field cannot be" typ
--- Form the printname: if given, compute. If not, use the computed
+-- | Form the printname: if given, compute. If not, use the computed
-- lin for functions, cat name for cats (dispatch made in evalCncDef above).
--- We cannot use linearization at this stage, since we do not know the
--- defaults we would need for question marks - and we're not yet in canon.
-
evalPrintname :: SourceGrammar -> Ident -> MPr -> Perh Term -> Err Term
evalPrintname gr c ppr lin =
case ppr of
diff --git a/src/GF/Compile/Rebuild.hs b/src/GF/Compile/Rebuild.hs
index bdd759fa0..c40df28ff 100644
--- a/src/GF/Compile/Rebuild.hs
+++ b/src/GF/Compile/Rebuild.hs
@@ -25,9 +25,8 @@ import Ident
import Modules
import Operations
--- rebuilding instance + interface, and "with" modules, prior to renaming.
+-- | rebuilding instance + interface, and "with" modules, prior to renaming.
-- AR 24/10/2003
-
rebuildModule :: [SourceModule] -> SourceModule -> Err SourceModule
rebuildModule ms mo@(i,mi) = do
let gr = MGrammar ms
diff --git a/src/GF/Compile/RemoveLiT.hs b/src/GF/Compile/RemoveLiT.hs
index 17124291d..1c10bd9ab 100644
--- a/src/GF/Compile/RemoveLiT.hs
+++ b/src/GF/Compile/RemoveLiT.hs
@@ -9,7 +9,11 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- remove obsolete (Lin C) expressions before doing anything else. AR 21/6/2003
+--
+-- What the program does is replace the occurrences of Lin C with the actual
+-- definition T given in lincat C = T ; with {s : Str} if no lincat is found.
+-- The procedule is uncertain, if T contains another Lin.
-----------------------------------------------------------------------------
module RemoveLiT (removeLiT) where
@@ -24,12 +28,6 @@ import Operations
import Monad
--- remove obsolete (Lin C) expressions before doing anything else. AR 21/6/2003
-
--- What the program does is replace the occurrences of Lin C with the actual
--- definition T given in lincat C = T ; with {s : Str} if no lincat is found.
--- The procedule is uncertain, if T contains another Lin.
-
removeLiT :: SourceGrammar -> Err SourceGrammar
removeLiT gr = liftM MGrammar $ mapM (remlModule gr) (modules gr)
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index 9dd5121c7..3f9533791 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -9,7 +9,17 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- AR 14/5/2003
+-- The top-level function 'renameGrammar' does several things:
+--
+-- - extends each module symbol table by indirections to extended module
+--
+-- - changes unqualified and as-qualified imports to absolutely qualified
+--
+-- - goes through the definitions and resolves names
+--
+-- Dependency analysis between modules has been performed before this pass.
+-- Hence we can proceed by @fold@ing "from left to right".
-----------------------------------------------------------------------------
module Rename where
@@ -27,19 +37,10 @@ import Operations
import Monad
--- AR 14/5/2003
-
--- The top-level function $renameGrammar$ does several things:
--- * extends each module symbol table by indirections to extended module
--- * changes unqualified and as-qualified imports to absolutely qualified
--- * goes through the definitions and resolves names
--- Dependency analysis between modules has been performed before this pass.
--- Hence we can proceed by $fold$ing 'from left to right'.
-
renameGrammar :: SourceGrammar -> Err SourceGrammar
renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g)
--- this gives top-level access to renaming term input in the cc command
+-- | this gives top-level access to renaming term input in the cc command
renameSourceTerm :: SourceGrammar -> Ident -> Term -> Err Term
renameSourceTerm g m t = do
mo <- lookupErr m (modules g)
@@ -93,7 +94,7 @@ renameIdentTerm env@(act,imps) t =
IC "String" -> return $ const $ Q cPredefAbs cString
_ -> Bad s
---- would it make sense to optimize this by inlining?
+--- | would it make sense to optimize this by inlining?
renameIdentPatt :: Status -> Patt -> Err Patt
renameIdentPatt env p = do
let t = patt2term p
@@ -210,8 +211,7 @@ renameTerm env vars = ren vars where
return (p',t')
renpatt = renamePattern env
--- vars not needed in env, since patterns always overshadow old vars
-
+-- | vars not needed in env, since patterns always overshadow old vars
renamePattern :: Status -> Patt -> Err (Patt,[Ident])
renamePattern env patt = case patt of
@@ -263,8 +263,7 @@ renameContext b = renc [] where
_ -> return cont
ren = renameTerm b
--- vars not needed in env, since patterns always overshadow old vars
-
+-- | vars not needed in env, since patterns always overshadow old vars
renameEquation :: Status -> [Ident] -> Equation -> Err Equation
renameEquation b vs (ps,t) = do
(ps',vs') <- liftM unzip $ mapM (renamePattern b) ps
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 62ff09863..ebd85784a 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -42,27 +42,29 @@ import List (nub,nubBy)
-- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished
--- multilingual state with grammars and options
+-- | multilingual state with grammars and options
data ShellState = ShSt {
- abstract :: Maybe Ident , -- pointer to actual abstract, if not empty st
- concrete :: Maybe Ident , -- pointer to primary concrete
- concretes :: [((Ident,Ident),Bool)], -- list of all concretes, and whether active
- canModules :: CanonGrammar , -- compiled abstracts and concretes
- srcModules :: G.SourceGrammar , -- saved resource modules
- cfs :: [(Ident,CF)] , -- context-free grammars
- pInfos :: [(Ident,Cnv.PInfo)], -- peb 18/6
- morphos :: [(Ident,Morpho)], -- morphologies
- gloptions :: Options, -- global options
- readFiles :: [(FilePath,ModTime)],-- files read
- absCats :: [(G.Cat,(G.Context, -- cats, their contexts,
- [(G.Fun,G.Type)], -- functions to them,
- [((G.Fun,Int),G.Type)]))], -- functions on them
- statistics :: [Statistics] -- statistics on grammars
+ abstract :: Maybe Ident , -- ^ pointer to actual abstract, if not empty st
+ concrete :: Maybe Ident , -- ^ pointer to primary concrete
+ concretes :: [((Ident,Ident),Bool)], -- ^ list of all concretes, and whether active
+ canModules :: CanonGrammar , -- ^ compiled abstracts and concretes
+ srcModules :: G.SourceGrammar , -- ^ saved resource modules
+ cfs :: [(Ident,CF)] , -- ^ context-free grammars
+ pInfos :: [(Ident,Cnv.PInfo)], -- ^ parser information, peb 18\/6
+ morphos :: [(Ident,Morpho)], -- ^ morphologies
+ gloptions :: Options, -- ^ global options
+ readFiles :: [(FilePath,ModTime)],-- ^ files read
+ absCats :: [(G.Cat,(G.Context,
+ [(G.Fun,G.Type)],
+ [((G.Fun,Int),G.Type)]))], -- ^ cats, (their contexts,
+ -- functions to them,
+ -- functions on them)
+ statistics :: [Statistics] -- ^ statistics on grammars
}
data Statistics =
- StDepTypes Bool -- whether there are dependent types
- | StBoundVars [G.Cat] -- which categories have bound variables
+ StDepTypes Bool -- ^ whether there are dependent types
+ | StBoundVars [G.Cat] -- ^ which categories have bound variables
--- -- etc
deriving (Eq,Ord)
@@ -87,8 +89,7 @@ type Language = Ident
language = identC
prLanguage = prIdent
--- grammar for one language in a state, comprising its abs and cnc
-
+-- | grammar for one language in a state, comprising its abs and cnc
data StateGrammar = StGr {
absId :: Ident,
cncId :: Ident,
@@ -109,7 +110,7 @@ emptyStateGrammar = StGr {
loptions = noOptions
}
--- analysing shell grammar into parts
+-- | analysing shell grammar into parts
stateGrammarST = grammar
stateCF = cf
statePInfo = pInfo
@@ -119,14 +120,12 @@ stateGrammarWords = allMorphoWords . stateMorpho
cncModuleIdST = stateGrammarST
--- form a shell state from a canonical grammar
-
+-- | form a shell state from a canonical grammar
grammar2shellState :: Options -> (CanonGrammar, G.SourceGrammar) -> Err ShellState
grammar2shellState opts (gr,sgr) =
updateShellState opts emptyShellState ((0,sgr,gr),[]) --- is 0 safe?
--- update a shell state from a canonical grammar
-
+-- | update a shell state from a canonical grammar
updateShellState :: Options -> ShellState ->
((Int,G.SourceGrammar,CanonGrammar),[(FilePath,ModTime)]) ->
---- (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) ->
@@ -186,8 +185,7 @@ prShellStateInfo sh = unlines [
abstractName sh = maybe "(none)" P.prt (abstract sh)
--- throw away those abstracts that are not needed --- could be more aggressive
-
+-- | throw away those abstracts that are not needed --- could be more aggressive
filterAbstracts :: Maybe Ident -> CanonGrammar -> CanonGrammar
filterAbstracts abstr cgr = M.MGrammar (nubBy (\x y -> fst x == fst y) [m | m <- ms, needed m]) where
ms = M.modules cgr
@@ -234,8 +232,7 @@ changeMain (Just c) st@(ShSt _ _ cs ms ss cfs pis mos os rs acs s) =
return (ShSt (Just a) (Just c) cs' ms ss cfs pis mos os rs acs s)
_ -> P.prtBad "The state has no concrete syntax named" c
--- form just one state grammar, if unique, from a canonical grammar
-
+-- | form just one state grammar, if unique, from a canonical grammar
grammar2stateGrammar :: Options -> CanonGrammar -> Err StateGrammar
grammar2stateGrammar opts gr = do
st <- grammar2shellState opts (gr,M.emptyMGrammar)
@@ -268,8 +265,7 @@ cfOfLang st = stateCF . stateGrammarOfLang st
morphoOfLang st = stateMorpho . stateGrammarOfLang st
optionsOfLang st = stateOptions . stateGrammarOfLang st
--- the last introduced grammar, stored in options, is the default for operations
-
+-- | the last introduced grammar, stored in options, is the default for operations
firstStateGrammar :: ShellState -> StateGrammar
firstStateGrammar st = errVal (stateAbstractGrammar st) $ do
concr <- maybeErr "no concrete syntax" $ concrete st
@@ -290,7 +286,7 @@ stateAbstractGrammar st = StGr {
}
--- analysing shell state into parts
+-- | analysing shell state into parts
globalOptions = gloptions
allLanguages = map (fst . fst) . concretes
allCategories = map fst . allCatsOf . canModules
@@ -325,17 +321,17 @@ languageOfOptState :: Options -> ShellState -> Maybe Language
languageOfOptState opts st =
maybe (concrete st) (return . language) $ getOptVal opts useLanguage
--- command-line option -cat=foo overrides the possible start cat of a grammar
+-- | command-line option -cat=foo overrides the possible start cat of a grammar
firstCatOpts :: Options -> StateGrammar -> CFCat
firstCatOpts opts sgr =
maybe (stateFirstCat sgr) (string2CFCat (P.prt (absId sgr))) $
getOptVal opts firstCat
--- the first cat for random generation
+-- | the first cat for random generation
firstAbsCat :: Options -> StateGrammar -> G.QIdent
firstAbsCat opts = cfCat2Cat . firstCatOpts opts
--- a grammar can have start category as option startcat=foo ; default is S
+-- | a grammar can have start category as option startcat=foo ; default is S
stateFirstCat sgr =
maybe (string2CFCat a "S") (string2CFCat a) $
getOptVal (stateOptions sgr) gStartCat
diff --git a/src/GF/Compile/Update.hs b/src/GF/Compile/Update.hs
index e3c4df4bb..289e516b8 100644
--- a/src/GF/Compile/Update.hs
+++ b/src/GF/Compile/Update.hs
@@ -24,8 +24,7 @@ import Operations
import List
import Monad
--- update a resource module by adding a new or changing an old definition
-
+-- | update a resource module by adding a new or changing an old definition
updateRes :: SourceGrammar -> Ident -> Ident -> Info -> SourceGrammar
updateRes gr@(MGrammar ms) m i info = MGrammar $ map upd ms where
upd (n,mod)
@@ -34,16 +33,14 @@ updateRes gr@(MGrammar ms) m i info = MGrammar $ map upd ms where
ModMod r -> (m,ModMod $ updateModule r i info)
_ -> (n,mod) --- no error msg
--- combine a list of definitions into a balanced binary search tree
-
+-- | combine a list of definitions into a balanced binary search tree
buildAnyTree :: [(Ident,Info)] -> Err (BinTree (Ident, Info))
buildAnyTree ias = do
ias' <- combineAnyInfos ias
return $ buildTree ias'
--- unifying information for abstract, resource, and concrete
-
+-- | unifying information for abstract, resource, and concrete
combineAnyInfos :: [(Ident,Info)] -> Err [(Ident,Info)]
combineAnyInfos = combineInfos unifyAnyInfo
diff --git a/src/GF/Data/Glue.hs b/src/GF/Data/Glue.hs
index c541446b1..7f8fb6a94 100644
--- a/src/GF/Data/Glue.hs
+++ b/src/GF/Data/Glue.hs
@@ -12,7 +12,7 @@
-- AR 8-11-2003, using Markus Forsberg's implementation of Huet's @unglue@
-----------------------------------------------------------------------------
-module Glue (decomposeSimple, exTrie) where
+module Glue (decomposeSimple) where
import Trie2
import Operations
diff --git a/src/haddock/haddock-check.perl b/src/haddock/haddock-check.perl
new file mode 100644
index 000000000..cea2a6cb1
--- /dev/null
+++ b/src/haddock/haddock-check.perl
@@ -0,0 +1,46 @@
+
+# checking that a file is haddocky
+
+# limitations:
+# - does not check that 'type' declarations really are put in the export list
+# - there might be some problems with nested comments
+
+for $file (@ARGV) {
+ $file =~ s/\.hs//;
+
+ open F, "<$file.hs";
+ $_ = join "", <F>;
+ close F;
+
+ # print "- $file\n";
+
+ # removing comments:
+ s/\{-.*?-\}//gs;
+ s/--.*?\n/\n/g;
+
+ # export list:
+ if (/\nmodule\s+(\w+)\s+\((.*?)\)\s+where/s) {
+ ($module, $exportlist) = ($1, $2);
+
+ # removing modules from exportlist:
+ $exportlist =~ s/module\s+[A-Z]\w*//gs;
+
+ # type signatures:
+ while (/\n([a-z]\w*)\s*::/gs) {
+ $function = $1;
+ $exportlist =~ s/\b$function\b//;
+ }
+
+ while ($exportlist =~ /\b(\w+)\b/gs) {
+ $function = $1;
+ next if $function =~ /^[A-Z]/;
+ printf "%-30s | No type signature for '%s'\n", $file, $1;
+ }
+
+ } else {
+ printf "%-30s | No export list\n", $file;
+ }
+
+}
+
+
diff --git a/src/module-structure.txt b/src/module-structure.txt
index a5e6a3ff7..ff7d8e199 100644
--- a/src/module-structure.txt
+++ b/src/module-structure.txt
@@ -6,9 +6,11 @@ katalogen src kommer att innehålla (åtminstone) följande:
- GF.hs modulen Main
- GF/ resten av Haskell-filerna
- JavaGUI/ java-filer
- - haddock-script.csh för att skapa haddock-dokumentation
- - haddock-resources/ nödvändiga filer för haddock-script.csh
- - haddock/ html-resultat efter att ha kört haddock
+ - haddock/ filer för haddock
+ - html/
+ - resources/
+ - run-haddock.csh
+ - check-haddock.perl
modifiera gärna strukturen och kommentarerna nedan
----------------------------------------------------------------------
diff --git a/src/tools/mkHelpFile.perl b/src/tools/mkHelpFile.perl
new file mode 100644
index 000000000..91f434705
--- /dev/null
+++ b/src/tools/mkHelpFile.perl
@@ -0,0 +1,49 @@
+
+$infile = $#ARGV >= 0 ? '@'.join('@, @', @ARGV).'@' : '/the input file/';
+
+print <<EOF;
+----------------------------------------------------------------------
+-- |
+-- Module : HelpFile
+-- Maintainer : Aarne Ranta
+-- Stability : Stable (Autogenerated)
+-- Portability : Haskell 98
+--
+-- > CVS \$Date \$
+-- > CVS \$Author \$
+-- > CVS \$Revision \$
+--
+-- Help on shell commands. Generated from $infile by invoking the
+-- perl script \@mkHelpFile.perl\@.
+-- Automatically generated -- PLEASE DON'T EDIT THIS FILE,
+-- edit $infile instead.
+-----------------------------------------------------------------------------
+
+module HelpFile (txtHelpFileSummary, txtHelpCommand, txtHelpFile) where
+
+import Operations
+
+txtHelpFileSummary :: String
+txtHelpFileSummary =
+ unlines \$ map (concat . take 1 . lines) \$ paragraphs txtHelpFile
+
+txtHelpCommand :: String -> String
+txtHelpCommand c =
+ case lookup c [(takeWhile (/=',') p,p) | p <- paragraphs txtHelpFile] of
+ Just s -> s
+ _ -> "Command not found."
+
+txtHelpFile :: String
+txtHelpFile =
+EOF
+
+while (<>) {
+ chop;
+ s/([\"\\])/\\$1/g;
+ $pref = /^ / ? "\\n" : "\\n";
+ print " \"$pref$_\" ++\n";
+}
+
+print " []\n";
+
+