1
0
forked from GitHub/gf-core

"Committed_by_peb"

This commit is contained in:
peb
2005-02-09 19:45:54 +00:00
parent c467ef8d03
commit 9afbd25b64
22 changed files with 241 additions and 176 deletions

View File

@@ -9,10 +9,9 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- Handles printing a CFGrammar in CFGM format.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Handles printing a CFGrammar in CFGM format.
module PrintCFGrammar (prCanonAsCFGM) where module PrintCFGrammar (prCanonAsCFGM) where
import AbsGFC import AbsGFC
@@ -32,8 +31,7 @@ import ErrM
import List (intersperse) import List (intersperse)
import Maybe (listToMaybe, maybe) import Maybe (listToMaybe, maybe)
-- FIXME: fix warning about bad -printer= value -- | FIXME: fix warning about bad -printer= value
prCanonAsCFGM :: CanonGrammar -> String prCanonAsCFGM :: CanonGrammar -> String
prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs
where where
@@ -43,7 +41,7 @@ prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs
fromOk (Bad y) = error y fromOk (Bad y) = error y
xs = [(i,getFlag fs "startcat") | (i,ModMod (Module{flags=fs})) <- cncms] 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 :: [Flag] -> String -> Maybe String
getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x] getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]

View File

@@ -10,6 +10,9 @@
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- Optimizations on GFC code: sharing, parametrization, value sets. -- 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 module Share (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
@@ -23,9 +26,6 @@ import Operations
import List import List
import qualified Modules as M import qualified Modules as M
-- optimization: sharing branches in tables. AR 25/4/2003
-- following advice of Josef Svenningsson
type OptSpec = [Integer] --- type OptSpec = [Integer] ---
doOptFactor opt = elem 2 opt doOptFactor opt = elem 2 opt

View File

@@ -10,6 +10,9 @@
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- Optimizations on GF source code: sharing, parametrization, value sets. -- 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 module BackOpt (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
@@ -22,15 +25,24 @@ import Operations
import List import List
import qualified Modules as M import qualified Modules as M
-- optimization: sharing branches in tables. AR 25/4/2003
-- following advice of Josef Svenningsson
type OptSpec = [Integer] --- type OptSpec = [Integer] ---
doOptFactor :: OptSpec
doOptFactor opt = elem 2 opt doOptFactor opt = elem 2 opt
doOptValues :: OptSpec
doOptValues opt = elem 3 opt doOptValues opt = elem 3 opt
shareOpt :: OptSpec
shareOpt = [] shareOpt = []
paramOpt :: OptSpec
paramOpt = [2] paramOpt = [2]
valOpt :: OptSpec
valOpt = [3] valOpt = [3]
allOpt :: OptSpec
allOpt = [2,3] allOpt = [2,3]
shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo) shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)

View File

@@ -9,7 +9,15 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > 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 module CheckGrammar where
@@ -36,20 +44,12 @@ import CheckM
import List import List
import Monad 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 :: [SourceModule] -> SourceModule -> Err ([SourceModule],String)
showCheckModule mos m = do showCheckModule mos m = do
(st,(_,msg)) <- checkStart $ checkModule mos m (st,(_,msg)) <- checkStart $ checkModule mos m
return (st, unlines $ reverse msg) 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 :: [SourceModule] -> SourceModule -> Check [SourceModule]
checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of 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 where
gr = MGrammar $ (name,mod):ms gr = MGrammar $ (name,mod):ms
-- check if a term is typable -- | check if a term is typable
justCheckLTerm :: SourceGrammar -> Term -> Err Term justCheckLTerm :: SourceGrammar -> Term -> Err Term
justCheckLTerm src t = do justCheckLTerm src t = do
((t',_),_) <- checkStart (inferLType src t) ((t',_),_) <- checkStart (inferLType src t)
@@ -131,9 +130,8 @@ checkCompleteGrammar abs cnc = mapM_ checkWarn $
then id then id
else (("Warning: no linearization of" +++ prt f):) 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. -- A May-value has always been checked in its origin module.
checkResInfo :: SourceGrammar -> (Ident,Info) -> Check (Ident,Info) checkResInfo :: SourceGrammar -> (Ident,Info) -> Check (Ident,Info)
checkResInfo gr (c,info) = do checkResInfo gr (c,info) = do
checkReservedId c checkReservedId c
@@ -289,7 +287,7 @@ checkPrintname :: SourceGrammar -> Perh Term -> Check ()
checkPrintname st (Yes t) = checkLType st t typeStr >> return () checkPrintname st (Yes t) = checkLType st t typeStr >> return ()
checkPrintname _ _ = return () checkPrintname _ _ = return ()
-- for grammars obtained otherwise than by parsing ---- update!! -- | for grammars obtained otherwise than by parsing ---- update!!
checkReservedId :: Ident -> Check () checkReservedId :: Ident -> Check ()
checkReservedId x = let c = prt x in checkReservedId x = let c = prt x in
if isResWord c if isResWord c
@@ -643,13 +641,13 @@ termWith t ct = do
ty <- ct ty <- ct
return (t,ty) return (t,ty)
-- light-weight substitution for dep. types -- | light-weight substitution for dep. types
substituteLType :: Context -> Type -> Check Type substituteLType :: Context -> Type -> Check Type
substituteLType g t = case t of substituteLType g t = case t of
Vr x -> return $ maybe t id $ lookup x g Vr x -> return $ maybe t id $ lookup x g
_ -> composOp (substituteLType g) t _ -> composOp (substituteLType g) t
-- compositional check/infer of binary operations -- | compositional check\/infer of binary operations
check2 :: (Term -> Check Term) -> (Term -> Term -> Term) -> check2 :: (Term -> Check Term) -> (Term -> Term -> Term) ->
Term -> Term -> Type -> Check (Term,Type) Term -> Term -> Type -> Check (Term,Type)
check2 chk con a b t = do check2 chk con a b t = do
@@ -707,8 +705,7 @@ checkEqLType env t u trm = do
sTypes = [typeStr, typeTok, typeString] sTypes = [typeStr, typeTok, typeString]
comp = computeLType env comp = computeLType env
-- linearization types and defaults -- | linearization types and defaults
linTypeOfType :: SourceGrammar -> Ident -> Type -> Check (Context,Type) linTypeOfType :: SourceGrammar -> Ident -> Type -> Check (Context,Type)
linTypeOfType cnc m typ = do linTypeOfType cnc m typ = do
(cont,cat) <- checkErr $ typeSkeleton typ (cont,cat) <- checkErr $ typeSkeleton typ

View File

@@ -49,12 +49,10 @@ import Arch
import Monad import Monad
-- environment variable for grammar search path -- | environment variable for grammar search path
gfGrammarPathVar = "GF_LIB_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 batchCompile f = liftM fst $ compileModule defOpts emptyShellState f
where where
defOpts = options [beVerbose, emitCode] defOpts = options [beVerbose, emitCode]
@@ -66,11 +64,10 @@ batchCompileOld f = compileOld defOpts f
where where
defOpts = options [beVerbose, emitCode] 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 -- 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. -- 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. -- If from command line, it is used as it is.
compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
---- IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)])) ---- IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
@@ -147,8 +144,7 @@ keepResModules opts gr =
else emptyMGrammar else emptyMGrammar
-- the environment -- | the environment
type CompileEnv = (Int,SourceGrammar, GFC.CanonGrammar) type CompileEnv = (Int,SourceGrammar, GFC.CanonGrammar)
emptyCompileEnv :: TimedCompileEnv emptyCompileEnv :: TimedCompileEnv
@@ -211,8 +207,7 @@ compileOne opts env@((_,srcgr,_),_) file = do
extendCompileEnvInt env (k',sm',cm) ft 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 :: Options -> CompileEnv -> SourceModule -> IOE (Int,SourceModule)
makeSourceModule opts env@(k,gr,can) mo@(i,mi) = case mi of makeSourceModule opts env@(k,gr,can) mo@(i,mi) = case mi of

View File

@@ -9,7 +9,10 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > 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 module Extend where
@@ -24,11 +27,6 @@ import Operations
import Monad 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 :: [SourceModule] -> SourceModule -> Err SourceModule
extendModule ms (name,mod) = case mod of 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) let me' = if isCompl then es else (filter (/=n) es)
return $ Module mt st fs me' ops js1 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. -- and the process is interrupted if unification fails.
-- If the extended module is incomplete, its judgements are just copied. -- If the extended module is incomplete, its judgements are just copied.
extendMod :: Bool -> Ident -> Ident -> BinTree (Ident,Info) -> BinTree (Ident,Info) -> extendMod :: Bool -> Ident -> Ident -> BinTree (Ident,Info) -> BinTree (Ident,Info) ->
Err (BinTree (Ident,Info)) Err (BinTree (Ident,Info))
extendMod isCompl name base old new = foldM try new $ tree2list old where extendMod isCompl name base old new = foldM try new $ tree2list old where

View File

@@ -9,7 +9,7 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- (Description of the module) -- this module builds the internal GF grammar that is sent to the type checker
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GetGrammar where module GetGrammar where
@@ -40,8 +40,6 @@ import Char (toUpper)
import List (nub) import List (nub)
import Monad (foldM) import Monad (foldM)
-- this module builds the internal GF grammar that is sent to the type checker
getSourceModule :: FilePath -> IOE SourceModule getSourceModule :: FilePath -> IOE SourceModule
getSourceModule file = do getSourceModule file = do
string <- readFileIOE file string <- readFileIOE file
@@ -90,10 +88,9 @@ err2err (E.Bad s) = Bad s
ioeEErr = ioeErr . err2err 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. -- change them by turning the final letter to upper case.
--- There is a risk of clash. --- There is a risk of clash.
oldLexer :: String -> [L.Token] oldLexer :: String -> [L.Token]
oldLexer = map change . L.tokens where oldLexer = map change . L.tokens where
change t = case t of change t = case t of

View File

@@ -32,15 +32,12 @@ import Monad
-- compilation of optimized grammars to canonical GF. AR 5/10/2001 -- 12/5/2003 -- 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 :: SourceGrammar -> String
showGFC = err id id . liftM (P.printTree . grammar2canon) . redGrammar 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 -- abstract syntax without dependent types
redGrammar :: SourceGrammar -> Err C.CanonGrammar redGrammar :: SourceGrammar -> Err C.CanonGrammar
redGrammar (MGrammar gr) = liftM MGrammar $ mapM redModInfo $ filter active gr where redGrammar (MGrammar gr) = liftM MGrammar $ mapM redModInfo $ filter active gr where
active (_,m) = case typeOfModule m of active (_,m) = case typeOfModule m of

View File

@@ -25,9 +25,8 @@ import Operations
import Monad import Monad
-- extracting resource r from abstract + concrete syntax -- | extracting resource r from abstract + concrete syntax.
-- AR 21/8/2002 -- 22/6/2003 for GF with modules -- AR 21\/8\/2002 -- 22\/6\/2003 for GF with modules
makeReuse :: SourceGrammar -> Ident -> [Ident] -> makeReuse :: SourceGrammar -> Ident -> [Ident] ->
MReuseType Ident -> Err SourceRes MReuseType Ident -> Err SourceRes
makeReuse gr r me mrc = do 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 _ -> 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 -- the second Boolean indicates if the definition needs be given
mkResDefs :: Bool -> Bool -> mkResDefs :: Bool -> Bool ->
SourceGrammar -> Ident -> Ident -> [Ident] -> [Ident] -> SourceGrammar -> Ident -> Ident -> [Ident] -> [Ident] ->
BinTree (Ident,Info) -> BinTree (Ident,Info) -> 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 Q n c | n == a || [n] == mae -> return $ Q r c ---- FIX for non-singleton exts
_ -> composOp (redirTyp always a mae) ty _ -> 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 isHardType t = case t of
Prod x a b -> not (isWild x) || isHardType a || isHardType b Prod x a b -> not (isWild x) || isHardType a || isHardType b
App _ _ -> True App _ _ -> True

View File

@@ -9,7 +9,8 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > 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 module MkUnion (makeUnion) where
@@ -26,9 +27,6 @@ import Option
import List import List
import Monad import Monad
-- building union of modules
-- AR 1/3/2004 --- OBSOLETE 15/9/2004 with multiple inheritance
makeUnion :: SourceGrammar -> Ident -> ModuleType Ident -> [(Ident,[Ident])] -> makeUnion :: SourceGrammar -> Ident -> ModuleType Ident -> [(Ident,[Ident])] ->
Err SourceModule Err SourceModule
makeUnion gr m ty imps = do makeUnion gr m ty imps = do

View File

@@ -10,6 +10,8 @@
-- > CVS $Revision $ -- > CVS $Revision $
-- --
-- Check correctness of module dependencies. Incomplete. -- Check correctness of module dependencies. Incomplete.
--
-- AR 13/5/2003
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module ModDeps where module ModDeps where
@@ -27,12 +29,9 @@ import Operations
import Monad import Monad
import List 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, -- appropriateness of import and extend types,
-- to build a dependency graph of modules, and to sort them topologically -- to build a dependency graph of modules, and to sort them topologically
mkSourceGrammar :: [(Ident,SourceModInfo)] -> Err SourceGrammar mkSourceGrammar :: [(Ident,SourceModInfo)] -> Err SourceGrammar
mkSourceGrammar ms = do mkSourceGrammar ms = do
let ns = map fst ms let ns = map fst ms
@@ -50,8 +49,7 @@ checkUniqueErr ms = do
let msg = checkUnique ms let msg = checkUnique ms
if null msg then return () else Bad $ unlines msg 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 :: [Ident] -> SourceModInfo -> Err ()
checkUniqueImportNames ns mo = case mo of checkUniqueImportNames ns mo = case mo of
ModMod m -> test [n | OQualif _ n v <- opens m, n /= v] 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" +++ ("import names clashing with module names among" +++
unwords (map prt ms)) 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])] 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 :: [(Ident,SourceModInfo)] -> Err Dependencies
moduleDeps ms = mapM deps ms where moduleDeps ms = mapM deps ms where
deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of 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)) let mods = iterFix (concatMap more) (more (m,undefined))
return $ [i | (i,MTInterface) <- mods] 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 -- its argument is typically a concrete module name
requiredCanModules :: (Eq i, Show i) => MGrammar i f a -> i -> [i] requiredCanModules :: (Eq i, Show i) => MGrammar i f a -> i -> [i]
requiredCanModules gr = nub . iterFix (concatMap more) . singleton where requiredCanModules gr = nub . iterFix (concatMap more) . singleton where
more i = errVal [] $ do more i = errVal [] $ do

View File

@@ -9,7 +9,18 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > 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 module Rename where
@@ -27,23 +38,14 @@ import Operations
import Monad import Monad
-- AR 14/5/2003 -- | this gives top-level access to renaming term input in the cc command
-- 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
renameSourceTerm :: SourceGrammar -> Ident -> Term -> Err Term renameSourceTerm :: SourceGrammar -> Ident -> Term -> Err Term
renameSourceTerm g m t = do renameSourceTerm g m t = do
mo <- lookupErr m (modules g) mo <- lookupErr m (modules g)
let status = (modules g,(m,mo)) --- <- buildStatus g m mo let status = (modules g,(m,mo)) --- <- buildStatus g m mo
renameTerm status [] t 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 :: [SourceModule] -> SourceModule -> Err [SourceModule]
renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of
ModMod m@(Module mt st fs me ops js) -> do 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 IC "String" -> return $ Q cPredefAbs cString
_ -> Bad s _ -> 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 :: Status -> Patt -> Err Patt
renameIdentPatt env p = do renameIdentPatt env p = do
let t = patt2term p let t = patt2term p
@@ -233,8 +235,7 @@ renameTerm env vars = ren vars where
return (p',t') return (p',t')
renpatt = renamePattern env 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 :: Status -> Patt -> Err (Patt,[Ident])
renamePattern env patt = case patt of renamePattern env patt = case patt of
@@ -286,8 +287,7 @@ renameContext b = renc [] where
_ -> return cont _ -> return cont
ren = renameTerm b 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 :: Status -> [Ident] -> Equation -> Err Equation
renameEquation b vs (ps,t) = do renameEquation b vs (ps,t) = do
(ps',vs') <- liftM unzip $ mapM (renamePattern b) ps (ps',vs') <- liftM unzip $ mapM (renamePattern b) ps

View File

@@ -33,9 +33,8 @@ import Option
import Monad import Monad
import List 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 -- only do this for resource: concrete is optimized in gfc form
optimizeModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) -> optimizeModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) ->
Err (Ident,SourceModInfo) Err (Ident,SourceModInfo)
optimizeModule opts ms mo@(_,mi) = case mi of 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) info' <- evalResInfo gr (i,info)
return $ updateRes g name 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 -- definition since the module is traversed in topological order
evalResInfo :: SourceGrammar -> (Ident,Info) -> Err Info evalResInfo :: SourceGrammar -> (Ident,Info) -> Err Info
evalResInfo gr (c,info) = case info of evalResInfo gr (c,info) = case info of
@@ -129,8 +127,7 @@ evalCncInfo gr cnc abs (c,info) = case info of
pEval = partEval gr pEval = partEval gr
eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":") 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 :: SourceGrammar -> (Context,Type) -> Term -> Err Term
partEval gr (context, val) trm = do partEval gr (context, val) trm = do
let vars = map fst context let vars = map fst context
@@ -159,8 +156,7 @@ recordExpand typ trm = case unComputed typ of
_ -> return trm _ -> return trm
-- auxiliaries for compiling the resource -- | auxiliaries for compiling the resource
allOperDependencies :: Ident -> BinTree (Ident,Info) -> [(Ident,[Ident])] allOperDependencies :: Ident -> BinTree (Ident,Info) -> [(Ident,[Ident])]
allOperDependencies m b = allOperDependencies m b =
[(f, nub (opty pty ++ opty pt)) | (f, ResOper pty pt) <- tree2list 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 _ | isTypeInts typ -> return $ EInt 0 -- exists in all as first val
_ -> prtBad "linearization type field cannot be" typ _ -> 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). -- 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 --- 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. --- defaults we would need for question marks - and we're not yet in canon.
evalPrintname :: SourceGrammar -> Ident -> MPr -> Perh Term -> Err Term evalPrintname :: SourceGrammar -> Ident -> MPr -> Perh Term -> Err Term
evalPrintname gr c ppr lin = evalPrintname gr c ppr lin =
case ppr of case ppr of

View File

@@ -25,9 +25,8 @@ import Ident
import Modules import Modules
import Operations import Operations
-- rebuilding instance + interface, and "with" modules, prior to renaming. -- | rebuilding instance + interface, and "with" modules, prior to renaming.
-- AR 24/10/2003 -- AR 24/10/2003
rebuildModule :: [SourceModule] -> SourceModule -> Err SourceModule rebuildModule :: [SourceModule] -> SourceModule -> Err SourceModule
rebuildModule ms mo@(i,mi) = do rebuildModule ms mo@(i,mi) = do
let gr = MGrammar ms let gr = MGrammar ms

View File

@@ -9,7 +9,11 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > 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 module RemoveLiT (removeLiT) where
@@ -24,12 +28,6 @@ import Operations
import Monad 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 :: SourceGrammar -> Err SourceGrammar
removeLiT gr = liftM MGrammar $ mapM (remlModule gr) (modules gr) removeLiT gr = liftM MGrammar $ mapM (remlModule gr) (modules gr)

View File

@@ -9,7 +9,17 @@
-- > CVS $Author $ -- > CVS $Author $
-- > CVS $Revision $ -- > 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 module Rename where
@@ -27,19 +37,10 @@ import Operations
import Monad 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 :: SourceGrammar -> Err SourceGrammar
renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g) 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 :: SourceGrammar -> Ident -> Term -> Err Term
renameSourceTerm g m t = do renameSourceTerm g m t = do
mo <- lookupErr m (modules g) mo <- lookupErr m (modules g)
@@ -93,7 +94,7 @@ renameIdentTerm env@(act,imps) t =
IC "String" -> return $ const $ Q cPredefAbs cString IC "String" -> return $ const $ Q cPredefAbs cString
_ -> Bad s _ -> 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 :: Status -> Patt -> Err Patt
renameIdentPatt env p = do renameIdentPatt env p = do
let t = patt2term p let t = patt2term p
@@ -210,8 +211,7 @@ renameTerm env vars = ren vars where
return (p',t') return (p',t')
renpatt = renamePattern env 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 :: Status -> Patt -> Err (Patt,[Ident])
renamePattern env patt = case patt of renamePattern env patt = case patt of
@@ -263,8 +263,7 @@ renameContext b = renc [] where
_ -> return cont _ -> return cont
ren = renameTerm b 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 :: Status -> [Ident] -> Equation -> Err Equation
renameEquation b vs (ps,t) = do renameEquation b vs (ps,t) = do
(ps',vs') <- liftM unzip $ mapM (renamePattern b) ps (ps',vs') <- liftM unzip $ mapM (renamePattern b) ps

View File

@@ -42,27 +42,29 @@ import List (nub,nubBy)
-- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished -- 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 { data ShellState = ShSt {
abstract :: Maybe Ident , -- pointer to actual abstract, if not empty st abstract :: Maybe Ident , -- ^ pointer to actual abstract, if not empty st
concrete :: Maybe Ident , -- pointer to primary concrete concrete :: Maybe Ident , -- ^ pointer to primary concrete
concretes :: [((Ident,Ident),Bool)], -- list of all concretes, and whether active concretes :: [((Ident,Ident),Bool)], -- ^ list of all concretes, and whether active
canModules :: CanonGrammar , -- compiled abstracts and concretes canModules :: CanonGrammar , -- ^ compiled abstracts and concretes
srcModules :: G.SourceGrammar , -- saved resource modules srcModules :: G.SourceGrammar , -- ^ saved resource modules
cfs :: [(Ident,CF)] , -- context-free grammars cfs :: [(Ident,CF)] , -- ^ context-free grammars
pInfos :: [(Ident,Cnv.PInfo)], -- peb 18/6 pInfos :: [(Ident,Cnv.PInfo)], -- ^ parser information, peb 18\/6
morphos :: [(Ident,Morpho)], -- morphologies morphos :: [(Ident,Morpho)], -- ^ morphologies
gloptions :: Options, -- global options gloptions :: Options, -- ^ global options
readFiles :: [(FilePath,ModTime)],-- files read readFiles :: [(FilePath,ModTime)],-- ^ files read
absCats :: [(G.Cat,(G.Context, -- cats, their contexts, absCats :: [(G.Cat,(G.Context,
[(G.Fun,G.Type)], -- functions to them, [(G.Fun,G.Type)],
[((G.Fun,Int),G.Type)]))], -- functions on them [((G.Fun,Int),G.Type)]))], -- ^ cats, (their contexts,
statistics :: [Statistics] -- statistics on grammars -- functions to them,
-- functions on them)
statistics :: [Statistics] -- ^ statistics on grammars
} }
data Statistics = data Statistics =
StDepTypes Bool -- whether there are dependent types StDepTypes Bool -- ^ whether there are dependent types
| StBoundVars [G.Cat] -- which categories have bound variables | StBoundVars [G.Cat] -- ^ which categories have bound variables
--- -- etc --- -- etc
deriving (Eq,Ord) deriving (Eq,Ord)
@@ -87,8 +89,7 @@ type Language = Ident
language = identC language = identC
prLanguage = prIdent 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 { data StateGrammar = StGr {
absId :: Ident, absId :: Ident,
cncId :: Ident, cncId :: Ident,
@@ -109,7 +110,7 @@ emptyStateGrammar = StGr {
loptions = noOptions loptions = noOptions
} }
-- analysing shell grammar into parts -- | analysing shell grammar into parts
stateGrammarST = grammar stateGrammarST = grammar
stateCF = cf stateCF = cf
statePInfo = pInfo statePInfo = pInfo
@@ -119,14 +120,12 @@ stateGrammarWords = allMorphoWords . stateMorpho
cncModuleIdST = stateGrammarST 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 :: Options -> (CanonGrammar, G.SourceGrammar) -> Err ShellState
grammar2shellState opts (gr,sgr) = grammar2shellState opts (gr,sgr) =
updateShellState opts emptyShellState ((0,sgr,gr),[]) --- is 0 safe? 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 -> updateShellState :: Options -> ShellState ->
((Int,G.SourceGrammar,CanonGrammar),[(FilePath,ModTime)]) -> ((Int,G.SourceGrammar,CanonGrammar),[(FilePath,ModTime)]) ->
---- (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) -> ---- (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) ->
@@ -186,8 +185,7 @@ prShellStateInfo sh = unlines [
abstractName sh = maybe "(none)" P.prt (abstract sh) 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 :: Maybe Ident -> CanonGrammar -> CanonGrammar
filterAbstracts abstr cgr = M.MGrammar (nubBy (\x y -> fst x == fst y) [m | m <- ms, needed m]) where filterAbstracts abstr cgr = M.MGrammar (nubBy (\x y -> fst x == fst y) [m | m <- ms, needed m]) where
ms = M.modules cgr 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) 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 _ -> 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 :: Options -> CanonGrammar -> Err StateGrammar
grammar2stateGrammar opts gr = do grammar2stateGrammar opts gr = do
st <- grammar2shellState opts (gr,M.emptyMGrammar) st <- grammar2shellState opts (gr,M.emptyMGrammar)
@@ -268,8 +265,7 @@ cfOfLang st = stateCF . stateGrammarOfLang st
morphoOfLang st = stateMorpho . stateGrammarOfLang st morphoOfLang st = stateMorpho . stateGrammarOfLang st
optionsOfLang st = stateOptions . 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 :: ShellState -> StateGrammar
firstStateGrammar st = errVal (stateAbstractGrammar st) $ do firstStateGrammar st = errVal (stateAbstractGrammar st) $ do
concr <- maybeErr "no concrete syntax" $ concrete st 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 globalOptions = gloptions
allLanguages = map (fst . fst) . concretes allLanguages = map (fst . fst) . concretes
allCategories = map fst . allCatsOf . canModules allCategories = map fst . allCatsOf . canModules
@@ -325,17 +321,17 @@ languageOfOptState :: Options -> ShellState -> Maybe Language
languageOfOptState opts st = languageOfOptState opts st =
maybe (concrete st) (return . language) $ getOptVal opts useLanguage 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 :: Options -> StateGrammar -> CFCat
firstCatOpts opts sgr = firstCatOpts opts sgr =
maybe (stateFirstCat sgr) (string2CFCat (P.prt (absId sgr))) $ maybe (stateFirstCat sgr) (string2CFCat (P.prt (absId sgr))) $
getOptVal opts firstCat getOptVal opts firstCat
-- the first cat for random generation -- | the first cat for random generation
firstAbsCat :: Options -> StateGrammar -> G.QIdent firstAbsCat :: Options -> StateGrammar -> G.QIdent
firstAbsCat opts = cfCat2Cat . firstCatOpts opts 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 = stateFirstCat sgr =
maybe (string2CFCat a "S") (string2CFCat a) $ maybe (string2CFCat a "S") (string2CFCat a) $
getOptVal (stateOptions sgr) gStartCat getOptVal (stateOptions sgr) gStartCat

View File

@@ -24,8 +24,7 @@ import Operations
import List import List
import Monad 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 :: SourceGrammar -> Ident -> Ident -> Info -> SourceGrammar
updateRes gr@(MGrammar ms) m i info = MGrammar $ map upd ms where updateRes gr@(MGrammar ms) m i info = MGrammar $ map upd ms where
upd (n,mod) 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) ModMod r -> (m,ModMod $ updateModule r i info)
_ -> (n,mod) --- no error msg _ -> (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 :: [(Ident,Info)] -> Err (BinTree (Ident, Info))
buildAnyTree ias = do buildAnyTree ias = do
ias' <- combineAnyInfos ias ias' <- combineAnyInfos ias
return $ buildTree 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 :: [(Ident,Info)] -> Err [(Ident,Info)]
combineAnyInfos = combineInfos unifyAnyInfo combineAnyInfos = combineInfos unifyAnyInfo

View File

@@ -12,7 +12,7 @@
-- AR 8-11-2003, using Markus Forsberg's implementation of Huet's @unglue@ -- 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 Trie2
import Operations import Operations

View File

@@ -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;
}
}

View File

@@ -6,9 +6,11 @@ katalogen src kommer att inneh
- GF.hs modulen Main - GF.hs modulen Main
- GF/ resten av Haskell-filerna - GF/ resten av Haskell-filerna
- JavaGUI/ java-filer - JavaGUI/ java-filer
- haddock-script.csh för att skapa haddock-dokumentation - haddock/ filer för haddock
- haddock-resources/ nödvändiga filer för haddock-script.csh - html/
- haddock/ html-resultat efter att ha kört haddock - resources/
- run-haddock.csh
- check-haddock.perl
modifiera gärna strukturen och kommentarerna nedan modifiera gärna strukturen och kommentarerna nedan
---------------------------------------------------------------------- ----------------------------------------------------------------------

49
src/tools/mkHelpFile.perl Normal file
View File

@@ -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";