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 "", ; + 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 - 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 < 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"; + +