"Committed_by_peb"

src/GF/CFGM/PrintCFGrammar.hs

@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
 -- Module      : PrintCFGrammar
--- Maintainer  : (Maintainer)
+-- Maintainer  : BB
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:08 $ 
+-- > CVS $Date: 2005/02/24 11:46:34 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- Handles printing a CFGrammar in CFGM format.
 -----------------------------------------------------------------------------

src/GF/Canon/CMacros.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:06 $ 
+-- > CVS $Date: 2005/02/24 11:46:34 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.20 $
+-- > CVS $Revision: 1.21 $
 --
 -- Macros for building and analysing terms in GFC concrete syntax.
 --
@@ -143,6 +143,7 @@ patt2term p = case p of
 anyTerm :: Term
 anyTerm  = LI (A.identC "_") --- should not happen
 
+matchPatt :: [Case] -> Term -> Err Term
 matchPatt cs0 (FV ts) = liftM FV $ mapM (matchPatt cs0) ts
 matchPatt cs0 trm = term2patt trm >>= match cs0 where
   match cs t = 
@@ -199,6 +200,7 @@ allLinFields trm = case trm of
   _ -> prtBad "fields can only be sought in a record not in" trm
 
 -- | deprecated
+isLinLabel :: Label -> Bool
 isLinLabel l = case l of
      L (A.IC ('s':cs)) | all isDigit cs -> True
      -- peb (28/4-04), for MCFG grammars to work:
@@ -217,8 +219,10 @@ allLinValues trm = do
   lts <- allLinFields trm
   mapM (mapPairsM (return . allCaseValues)) lts
 
+redirectIdent :: A.Ident -> CIdent -> CIdent
 redirectIdent n f@(CIQ _ c) = CIQ n c
 
+ciq :: A.Ident -> A.Ident -> CIdent
 ciq n f = CIQ n f
 
 wordsInTerm :: Term -> [String]

src/GF/Compile/ShellState.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:09 $ 
+-- > CVS $Date: 2005/02/24 11:46:34 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.35 $
+-- > CVS $Revision: 1.36 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -68,6 +68,7 @@ data Statistics =
   ---                      -- etc
    deriving (Eq,Ord)
 
+emptyShellState :: ShellState
 emptyShellState = ShSt {
   abstract   = Nothing,
   concrete   = Nothing,
@@ -83,10 +84,15 @@ emptyShellState = ShSt {
   statistics = []
   }
 
+optInitShellState :: Options -> ShellState
 optInitShellState os = addGlobalOptions os emptyShellState
 
 type Language = Ident
+
+language :: String -> Language
 language = identC
+
+prLanguage :: Language -> String
 prLanguage = prIdent
 
 -- | grammar for one language in a state, comprising its abs and cnc
@@ -100,6 +106,7 @@ data StateGrammar = StGr {
   loptions :: Options
   }
 
+emptyStateGrammar :: StateGrammar
 emptyStateGrammar = StGr {
   absId   = identC "#EMPTY", ---
   cncId   = identC "#EMPTY", ---
@@ -110,7 +117,15 @@ emptyStateGrammar = StGr {
   loptions = noOptions
   }
 
--- | analysing shell grammar into parts
+-- analysing shell grammar into parts
+
+stateGrammarST    :: StateGrammar -> CanonGrammar
+stateCF           :: StateGrammar -> CF
+statePInfo        :: StateGrammar -> Cnv.PInfo
+stateMorpho       :: StateGrammar -> Morpho
+stateOptions      :: StateGrammar -> Options
+stateGrammarWords :: StateGrammar -> [String]
+
 stateGrammarST = grammar
 stateCF        = cf
 statePInfo     = pInfo
@@ -118,6 +133,7 @@ stateMorpho    = morpho
 stateOptions   = loptions
 stateGrammarWords = allMorphoWords . stateMorpho
 
+cncModuleIdST :: StateGrammar -> CanonGrammar
 cncModuleIdST = stateGrammarST
 
 -- | form a shell state from a canonical grammar
@@ -201,6 +217,7 @@ testSameAbstract sh mcnc = do
     _ -> return a'
 -}
 
+abstractName :: ShellState -> String
 abstractName sh = maybe "(none)" P.prt (abstract sh)
 
 -- | throw away those abstracts that are not needed --- could be more aggressive
@@ -278,6 +295,11 @@ stateGrammarOfLang st l = StGr {
    can = M.partOfGrammar allCan 
            (l, maybe M.emptyModInfo id (lookup l (M.modules allCan)))
 
+grammarOfLang :: ShellState -> Language -> CanonGrammar
+cfOfLang      :: ShellState -> Language -> CF
+morphoOfLang  :: ShellState -> Language -> Morpho
+optionsOfLang :: ShellState -> Language -> Options
+
 grammarOfLang st = stateGrammarST . stateGrammarOfLang st
 cfOfLang st      = stateCF        . stateGrammarOfLang st
 morphoOfLang st  = stateMorpho    . stateGrammarOfLang st
@@ -304,7 +326,17 @@ stateAbstractGrammar st = StGr {
   }
 
 
--- | analysing shell state into parts
+-- analysing shell state into parts
+
+globalOptions                   :: ShellState -> Options
+allLanguages                    :: ShellState -> [Language]
+allCategories                   :: ShellState -> [G.Cat]
+allStateGrammars                :: ShellState -> [StateGrammar]
+allStateGrammarsWithNames       :: ShellState -> [(Language, StateGrammar)]
+allGrammarFileNames             :: ShellState -> [String]
+allActiveStateGrammarsWithNames :: ShellState -> [(Language, StateGrammar)]
+allActiveGrammars               :: ShellState -> [StateGrammar]
+
 globalOptions = gloptions
 allLanguages  = map (fst . fst) . concretes
 allCategories = map fst . allCatsOf . canModules
@@ -350,6 +382,7 @@ firstAbsCat :: Options -> StateGrammar -> G.QIdent
 firstAbsCat opts = cfCat2Cat . firstCatOpts opts
 
 -- | a grammar can have start category as option startcat=foo ; default is S 
+stateFirstCat :: StateGrammar -> CFCat
 stateFirstCat sgr =
   maybe (string2CFCat a "S") (string2CFCat a) $ 
   getOptVal (stateOptions sgr) gStartCat
@@ -369,6 +402,7 @@ hasStateAbstract = maybe False (const True) . maybeStateAbstract
 abstractOfState = maybe emptyAbstractST id . maybeStateAbstract
 -}
 
+stateIsWord :: StateGrammar -> String -> Bool
 stateIsWord sg = isKnownWord (stateMorpho sg)
 
 
@@ -420,6 +454,7 @@ type ShellStateOperErr = ShellState -> Err ShellState
 reinitShellState :: ShellStateOper
 reinitShellState = const emptyShellState
 
+languageOn, languageOff :: Language -> ShellStateOper
 languageOn  = languageOnOff True
 languageOff = languageOnOff False
 

src/GF/Data/Operations.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:15 $ 
+-- > CVS $Date: 2005/02/24 11:46:35 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.15 $
+-- > CVS $Revision: 1.16 $
 --
 -- some auxiliary GF operations. AR 19\/6\/1998 -- 6\/2\/2001
 --
@@ -239,8 +239,13 @@ errAndMsg (Ok a) = return (a,[])
 -- | a three-valued maybe type to express indirections
 data Perhaps a b = Yes a | May b | Nope deriving (Show,Read,Eq,Ord)
 
+yes :: a -> Perhaps a b
 yes = Yes
+
+may :: b -> Perhaps a b
 may = May
+
+nope :: Perhaps a b
 nope = Nope
 
 mapP :: (a -> c) -> Perhaps a b -> Perhaps c b
@@ -419,6 +424,7 @@ paragraphs = map unlines . chop . lines where
 indent :: Int -> String -> String
 indent i s = replicate i ' ' ++ s
 
+(+++), (++-), (++++), (+++++) :: String -> String -> String
 a +++ b   = a ++ " "    ++ b
 a ++- ""  = a 
 a ++- b   = a +++ b
@@ -432,26 +438,31 @@ prUpper s = s1 ++ s2' where
    c:t -> toUpper c : t
    _ -> s2
 
+prReplicate :: Int -> String -> String
 prReplicate n s = concat (replicate n s)
 
+prTList :: String -> [String] -> String
 prTList t ss = case ss of
   []   -> ""
   [s]  -> s
   s:ss -> s ++ t ++ prTList t ss
 
+prQuotedString :: String -> String
 prQuotedString x = "\"" ++ restoreEscapes x ++ "\""
 
+prParenth :: String -> String
 prParenth s = if s == "" then "" else "(" ++ s ++ ")"
 
+prCurly, prBracket :: String -> String
 prCurly   s = "{" ++ s ++ "}"
 prBracket s = "[" ++ s ++ "]"
 
-prArgList xx = prParenth (prTList "," xx)
+prArgList, prSemicList, prCurlyList :: [String] -> String
-
+prArgList   = prParenth . prTList "," 
 prSemicList = prTList " ; "
-
 prCurlyList = prCurly . prSemicList
 
+restoreEscapes :: String -> String
 restoreEscapes s = 
   case s of 
     []       -> []
@@ -476,6 +487,7 @@ prIfEmpty em _    _    [] = em
 prIfEmpty em nem1 nem2 s  = nem1 ++ s ++ nem2
 
 -- | Thomas Hallgren's wrap lines
+wrapLines :: Int -> String -> String
 wrapLines n "" = ""
 wrapLines n s@(c:cs) =
       if isSpace c
@@ -491,15 +503,17 @@ wrapLines n s@(c:cs) =
 --- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
 
 -- LaTeX code producing functions
-
+dollar, mbox, ital, boldf, verbat :: String -> String
 dollar s = '$' : s ++ "$"
 mbox s   = "\\mbox{" ++ s ++ "}"
 ital s   = "{\\em" +++ s ++ "}"
 boldf s  = "{\\bf" +++ s ++ "}"
 verbat s = "\\verbat!" ++ s ++ "!"
 
+mkLatexFile :: String -> String
 mkLatexFile s = begindocument +++++ s +++++ enddocument
 
+begindocument, enddocument :: String
 begindocument =
  "\\documentclass[a4paper,11pt]{article}" ++++ -- M.F. 25/01-02
  "\\setlength{\\parskip}{2mm}" ++++
@@ -510,7 +524,6 @@ begindocument =
  "\\setlength{\\textheight}{240mm}" ++++
  "\\setlength{\\textwidth}{158mm}" ++++
  "\\begin{document}\n"
-
 enddocument =
  "\n\\end{document}\n"
 

src/GF/Data/Parsers.hs

@@ -5,9 +5,9 @@
 -- Stability   : Almost Obsolete
 -- Portability : Haskell 98
 --
--- > CVS $Date: 2005/02/18 19:21:15 $ 
+-- > CVS $Date: 2005/02/24 11:46:35 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
 -- some parser combinators a la Wadler and Hutton.
 -- no longer used in many places in GF
@@ -142,24 +142,45 @@ lits ts = literals ts
 jL :: String -> Parser Char String
 jL = pJ . lits
 
+pParenth :: Parser Char a -> Parser Char a
 pParenth p = literal '(' +.. pJunk +.. p ..+ pJunk ..+ literal ')'
-pCommaList p = pTList "," (pJ p)                      -- p,...,p
-pOptCommaList p = pCommaList p ||| succeed []            -- the same or nothing
-pArgList p = pParenth (pCommaList p) ||| succeed [] -- (p,...,p), poss. empty
-pArgList2 p = pParenth (p ... jL "," +.. pCommaList p) *** uncurry (:) -- min.2 args
 
+-- | p,...,p
+pCommaList :: Parser Char a -> Parser Char [a]
+pCommaList p = pTList "," (pJ p)                      
+
+-- | the same or nothing
+pOptCommaList :: Parser Char a -> Parser Char [a]
+pOptCommaList p = pCommaList p ||| succeed []            
+
+-- | (p,...,p), poss. empty
+pArgList :: Parser Char a -> Parser Char [a]
+pArgList p = pParenth (pCommaList p) ||| succeed [] 
+
+-- | min. 2 args
+pArgList2 :: Parser Char a -> Parser Char [a]
+pArgList2 p = pParenth (p ... jL "," +.. pCommaList p) *** uncurry (:) 
+
+longestOfSome :: Parser a b -> Parser a [b]
 longestOfSome p = (p ... longestOfMany p) *** (\ (x,y) -> x:y)
 
+pIdent :: Parser Char String
 pIdent = pLetter ... longestOfMany pAlphaPlusChar *** uncurry (:)
   where alphaPlusChar c = isAlphaNum c || c=='_' || c=='\''
 
+pLetter, pDigit :: Parser Char Char
 pLetter = satisfy (`elem` (['A'..'Z'] ++ ['a'..'z'] ++ 
                            ['À' .. 'Û'] ++ ['à' .. 'û'])) -- no such in Char
-pDigit         = satisfy isDigit
+pDigit  = satisfy isDigit
-pLetters       = longestOfSome pLetter
+
+pLetters :: Parser Char String
+pLetters = longestOfSome pLetter
+
+pAlphanum, pAlphaPlusChar :: Parser Char Char
 pAlphanum      = pDigit ||| pLetter
 pAlphaPlusChar = pAlphanum ||| satisfy (`elem` "_'")
 
+pQuotedString :: Parser Char String
 pQuotedString = literal '"' +.. pEndQuoted where
  pEndQuoted =
        literal '"' *** (const [])

src/GF/Data/Str.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:16 $ 
+-- > CVS $Date: 2005/02/24 11:46:35 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -26,16 +26,16 @@ import List (isPrefixOf, isSuffixOf, intersperse)
 -- | abstract token list type. AR 2001, revised and simplified 20\/4\/2003
 newtype Str = Str [Tok]  deriving (Read, Show, Eq, Ord)
 
+-- | notice that having both pre and post would leave to inconsistent situations:
+--
+-- > pre {"x" ; "y" / "a"} ++ post {"b" ; "a" / "x"}
+--
+-- always violates a condition expressed by the one or the other
 data Tok = 
    TK String
  | TN Ss [(Ss, [String])] -- ^ variants depending on next string 
 --- | TP Ss [(Ss, [String])] -- variants depending on previous string
     deriving (Eq, Ord, Show, Read)
--- ^ notice that having both pre and post would leave to inconsistent situations:
---
--- > pre {"x" ; "y" / "a"} ++ post {"b" ; "a" / "x"}
---
--- always violates a condition expressed by the one or the other
 
 
 -- | a variant can itself be a token list, but for simplicity only a list of strings

src/GF/Data/Zipper.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:16 $ 
+-- > CVS $Date: 2005/02/24 11:46:36 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- Gérard Huet's zipper (JFP 7 (1997)). AR 10\/8\/2001
 -----------------------------------------------------------------------------
@@ -62,6 +62,7 @@ data Path a =
   | Node ([Tr a], (Path a, a), [Tr a]) 
    deriving Show
 
+leaf :: a -> Tr a
 leaf a = Tr (a,[])
 
 newtype Loc a = Loc (Tr a, Path a)     deriving Show
@@ -132,6 +133,7 @@ goBackN i st
 
 -- added mappings between locations and trees
 
+loc2tree :: Loc a -> Tr a
 loc2tree (Loc (t,p)) = case p of
   Top -> t
   Node (left,(p',v),right) -> 
@@ -143,8 +145,10 @@ loc2treeMarked (Loc (Tr (a,ts),p)) =
  where 
    (mark, nomark) = (\a -> (a,True), \a -> (a, False))
 
+tree2loc :: Tr a -> Loc a
 tree2loc t = Loc (t,Top)
 
+goRoot :: Loc a -> Loc a
 goRoot = tree2loc . loc2tree
 
 goLast :: Loc a -> Err (Loc a)

src/GF/Fudgets/CommandF.hs

@@ -1,15 +1,15 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : CommandF
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:36 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
--- (Description of the module)
+-- a graphical shell for any kind of GF with Zipper editing. AR 20\/8\/2001
 -----------------------------------------------------------------------------
 
 module CommandF where

src/GF/Grammar/MMacros.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:12 $ 
+-- > CVS $Date: 2005/02/24 11:46:34 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- some more abstractions on grammars, esp. for Edit
 -----------------------------------------------------------------------------
@@ -27,19 +27,33 @@ import Macros
 
 import Monad
 
+nodeTree :: Tree -> TrNode
+argsTree :: Tree -> [Tree]
+
 nodeTree (Tr (n,_)) = n
 argsTree (Tr (_,ts)) = ts
 
-isFocusNode (N (_,_,_,_,b)) = b
+isFocusNode    :: TrNode -> Bool
-bindsNode   (N (b,_,_,_,_)) = b
+bindsNode      :: TrNode -> Binds
-atomNode    (N (_,a,_,_,_)) = a
+atomNode       :: TrNode -> Atom
-valNode     (N (_,_,v,_,_)) = v
+valNode        :: TrNode -> Val
-constrsNode (N (_,_,_,(c,_),_)) = c
+constrsNode    :: TrNode -> Constraints
+metaSubstsNode :: TrNode -> MetaSubst
+
+isFocusNode    (N (_,_,_,_,b)) = b
+bindsNode      (N (b,_,_,_,_)) = b
+atomNode       (N (_,a,_,_,_)) = a
+valNode        (N (_,_,v,_,_)) = v
+constrsNode    (N (_,_,_,(c,_),_)) = c
 metaSubstsNode (N (_,_,_,(_,m),_)) = m
 
+atomTree :: Tree -> Atom
+valTree  :: Tree -> Val
+
 atomTree = atomNode . nodeTree 
 valTree  = valNode  . nodeTree
 
+mkNode :: Binds -> Atom -> Val -> (Constraints, MetaSubst) -> TrNode
 mkNode binds atom vtyp cs = N (binds,atom,vtyp,cs,False)
 
 type Var = Ident
@@ -91,14 +105,14 @@ vClos = VClos []
 uExp :: Exp
 uExp = Meta meta0
 
-mExp :: Exp
+mExp, mExp0 :: Exp
-mExp = Meta meta0
+mExp  = Meta meta0
-
 mExp0 = mExp
 
 meta2exp :: MetaSymb -> Exp
 meta2exp = Meta
 
+atomC :: Fun -> Atom
 atomC = AtC
 
 funAtom :: Atom -> Err Fun
@@ -114,6 +128,7 @@ atomIsMeta atom = case atom of
   AtM _ -> True
   _   -> False
 
+getMetaAtom :: Atom -> Err Meta
 getMetaAtom a = case a of
   AtM m -> return m
   _ -> Bad "the active node is not meta"
@@ -148,12 +163,17 @@ alphaConv oldvars (x,x') = substitute (x:x':oldvars) [(x,Vr x')]
 alphaFresh :: [Var] -> Exp -> Err Exp
 alphaFresh vs = refreshTermN $ maxVarIndex vs
 
+-- | done in a state monad
 alphaFreshAll :: [Var] -> [Exp] -> Err [Exp]
-alphaFreshAll vs = mapM $ alphaFresh vs -- done in a state monad
+alphaFreshAll vs = mapM $ alphaFresh vs 
 
+-- | for display
+val2exp :: Val -> Err Exp
+val2exp = val2expP False 
 
-val2exp = val2expP False     -- for display
+-- | for type checking
-val2expSafe = val2expP True  -- for type checking
+val2expSafe :: Val -> Err Exp
+val2expSafe = val2expP True  
 
 val2expP :: Bool -> Val -> Err Exp
 val2expP safe v = case v of
@@ -191,6 +211,7 @@ freeVarsExp e = case e of
   Prod x a b -> freeVarsExp a ++ filter (/=x) (freeVarsExp b)
   _ -> [] --- thus applies to abstract syntax only
 
+ident2string :: Ident -> String
 ident2string = prIdent
 
 tree :: (TrNode,[Tree]) -> Tree
@@ -230,7 +251,8 @@ ref2exp bounds typ ref = do
   return $ mkApp ref args
   -- no refreshment of metas
   
-type Ref = Exp -- invariant: only Con or Var
+-- | invariant: only 'Con' or 'Var'
+type Ref = Exp 
 
 fun2wrap :: [Var] -> ((Fun,Int),Type) -> Exp -> Err Exp
 fun2wrap oldvars ((fun,i),typ) exp = do
@@ -252,6 +274,7 @@ compatType v t = errVal True $ do
 
 ---
 
+mkJustProd :: Context -> Term -> Term
 mkJustProd cont typ = mkProd (cont,typ,[])
 
 int2var :: Int -> Ident
@@ -263,6 +286,7 @@ meta0 = int2meta 0
 termMeta0 :: Term
 termMeta0 = Meta meta0
 
+identVar :: Term -> Err Ident
 identVar (Vr x) = return x
 identVar _ = Bad "not a variable"
 

src/GF/Grammar/Macros.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:12 $ 
+-- > CVS $Date: 2005/02/24 11:46:34 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.17 $
+-- > CVS $Revision: 1.18 $
 --
 -- Macros for constructing and analysing source code terms.
 --
@@ -52,7 +52,8 @@ qTypeForm t = case t of
 qq :: QIdent -> Term
 qq (m,c) = Q m c
 
-typeForm = qTypeForm ---- no need to dist any more
+typeForm :: Type -> Err (Context, Cat, [Term])
+typeForm = qTypeForm ---- no need to distinguish any more
 
 cPredef :: Ident
 cPredef = identC "Predef"
@@ -160,6 +161,7 @@ stripTerm t = case t of
    stripPatt p = errVal p $ term2patt $ stripTerm $ patt2term p
 -}
 
+computed :: Term -> Term
 computed = Computed
 
 termForm :: Term -> Err ([(Ident)], Term, [Term])
@@ -219,6 +221,7 @@ mkLet defs t = foldr Let t defs
 mkLetUntyped :: Context -> Term -> Term
 mkLetUntyped defs = mkLet [(x,(Nothing,t)) | (x,t) <- defs]
 
+isVariable :: Term -> Bool
 isVariable (Vr _ ) = True
 isVariable _ = False
 
@@ -277,22 +280,30 @@ mkRecTypeN int lab typs = RecType [ (lab i, t) | (i,t) <- zip [int..] typs]
 mkRecType :: (Int -> Label) -> [Type] -> Type
 mkRecType = mkRecTypeN 0
 
+typeType, typePType, typeStr, typeTok, typeStrs :: Term
+
 typeType  = srt "Type"
 typePType = srt "PType"
 typeStr   = srt "Str"
 typeTok   = srt "Tok"
 typeStrs  = srt "Strs"
 
+typeString, typeInt :: Term
+typeInts :: Int -> Term
+
 typeString = constPredefRes "String"
 typeInt = constPredefRes "Int"
 typeInts i = App (constPredefRes "Ints") (EInt i)
 
+isTypeInts :: Term -> Bool
 isTypeInts ty = case ty of
   App c _ -> c == constPredefRes "Ints"
   _ -> False
 
+constPredefRes :: String -> Term
 constPredefRes s = Q (IC "Predef") (zIdent s)
 
+isPredefConstant :: Term -> Bool
 isPredefConstant t = case t of
   Q (IC "Predef") _ -> True
   Q (IC "PredefAbs") _ -> True
@@ -314,9 +325,11 @@ mkDecl typ = (wildIdent, typ)
 eqStrIdent :: Ident -> Ident -> Bool
 eqStrIdent = (==)
 
+tupleLabel, linLabel :: Int -> Label
 tupleLabel i = LIdent $ "p" ++ show i
 linLabel i = LIdent $ "s" ++ show i
 
+theLinLabel :: Label
 theLinLabel = LIdent "s"
 
 tuple2record :: [Term] -> [Assign]
@@ -354,15 +367,15 @@ plusRecord t1 t2 =
    (FV rs,_    ) -> mapM (`plusRecord` t2) rs >>= return . FV
    _ -> Bad ("cannot add records" +++ prt t1 +++ "and" +++ prt t2)
 
--- default linearization type
+-- | default linearization type
-
+defLinType :: Type
 defLinType = RecType [(LIdent "s",  typeStr)]
 
--- refreshing variables
+-- | refreshing variables
-
 varX :: Int -> Ident
 varX i = identV (i,"x")
 
+-- | refreshing variables
 mkFreshVar :: [Ident] -> Ident
 mkFreshVar olds = varX (maxVarIndex olds + 1) 
 
@@ -384,6 +397,8 @@ freshAsTerm s = Vr (varX (readIntArg s))
 string2term :: String -> Term
 string2term = ccK
 
+ccK :: String -> Term
+ccC :: Term -> Term -> Term
 ccK = K
 ccC = C
 
@@ -398,25 +413,37 @@ string2CnTrm = Cn . zIdent
 symbolOfIdent :: Ident -> String
 symbolOfIdent = prIdent
 
+symid :: Ident -> String
 symid = symbolOfIdent
 
+vr :: Ident -> Term
+cn :: Ident -> Term
+srt :: String -> Term
+meta :: MetaSymb -> Term
+cnIC :: String -> Term
+
 vr = Vr
 cn = Cn
 srt = Sort
 meta = Meta
 cnIC = cn . IC
 
+justIdentOf :: Term -> Maybe Ident
 justIdentOf (Vr x) = Just x
 justIdentOf (Cn x) = Just x
 justIdentOf _ = Nothing
 
+isMeta :: Term -> Bool
 isMeta (Meta _) = True
 isMeta _ = False
+
+mkMeta :: Int -> Term
 mkMeta = Meta . MetaSymb
 
 nextMeta :: MetaSymb -> MetaSymb
 nextMeta = int2meta . succ . metaSymbInt
 
+int2meta :: Int -> MetaSymb
 int2meta = MetaSymb
 
 metaSymbInt :: MetaSymb -> Int
@@ -503,6 +530,7 @@ allLinFields trm = case unComputed trm of
   _ -> prtBad "fields can only be sought in a record not in" trm
 
 -- | deprecated
+isLinLabel :: Label -> Bool
 isLinLabel l = case l of
      LIdent ('s':cs) | all isDigit cs -> True
      _ -> False
@@ -696,6 +724,7 @@ wordsInTerm trm = filter (not . null) $ case trm of
    _       -> collectOp wo trm
  where wo = wordsInTerm
 
+noExist :: Term
 noExist = FV []
 
 defaultLinType :: Type

src/GF/Infra/Ident.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:14 $ 
+-- > CVS $Date: 2005/02/24 11:46:34 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -47,6 +47,11 @@ prIdent i = case i of
   IAV (s,b,j) -> s ++ "_" ++ show b ++ "_" ++ show j
   IW -> "_"
 
+identC :: String -> Ident
+identV :: (Int, String) -> Ident
+identA :: (String, Int) -> Ident
+identAV:: (String, Int, Int) -> Ident
+identW :: Ident
 (identC, identV, identA, identAV, identW) = 
     (IC,     IV,     IA,     IAV,     IW)
 
@@ -54,18 +59,22 @@ prIdent i = case i of
 -- ident s = IC s
 
 -- | to mark argument variables
+argIdent :: Int -> Ident -> Int -> Ident
 argIdent 0 (IC c) i = identA  (c,i)
 argIdent b (IC c) i = identAV (c,b,i)
 
 -- | used in lin defaults
+strVar :: Ident
 strVar = identA ("str",0)
 
 -- | wild card
+wildIdent :: Ident
 wildIdent = identW
 
 isWildIdent :: Ident -> Bool
 isWildIdent = (== wildIdent)
 
+newIdent :: Ident
 newIdent = identC "#h"
 
 mkIdent :: String -> Int -> Ident

src/GF/Infra/Modules.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:15 $ 
+-- > CVS $Date: 2005/02/24 11:46:35 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.19 $
+-- > CVS $Revision: 1.20 $
 --
 -- Datastructures and functions for modules, common to GF and GFC.
 --
@@ -149,7 +149,10 @@ data OpenQualif =
  | OQIncomplete
   deriving (Eq,Show)
 
+oSimple :: i -> OpenSpec i
 oSimple = OSimple OQNormal
+
+oQualif :: i -> i -> OpenSpec i
 oQualif = OQualif OQNormal
 
 data ModuleStatus = 
@@ -162,6 +165,7 @@ openedModule o = case o of
   OSimple _ m -> m
   OQualif _ _ m -> m
 
+allOpens :: Module i f a -> [OpenSpec i]
 allOpens m = case mtype m of
   MTTransfer a b -> a : b : opens m
   _ -> opens m
@@ -245,6 +249,7 @@ data IdentM i = IdentM {
   }
   deriving (Eq,Show)
 
+typeOfModule :: ModInfo i f a -> ModuleType i
 typeOfModule mi = case mi of
   ModMod m -> mtype m
 
@@ -295,11 +300,13 @@ lookupInfo mo i = lookupTree show i (jments mo)
 allModMod :: (Show i,Eq i) => MGrammar i f a -> [(i,Module i f a)]
 allModMod gr = [(i,m) | (i, ModMod m) <- modules gr]
 
+isModAbs :: Module i f a -> Bool
 isModAbs m = case mtype m of
   MTAbstract -> True
 ----  MTUnion t -> isModAbs t
   _ -> False
 
+isModRes :: Module i f a -> Bool
 isModRes m = case mtype m of
   MTResource -> True
   MTReuse _ -> True
@@ -308,16 +315,19 @@ isModRes m = case mtype m of
   MTInstance _ -> True
   _ -> False
 
+isModCnc :: Module i f a -> Bool
 isModCnc m = case mtype m of
   MTConcrete _ -> True
 ----  MTUnion t -> isModCnc t
   _ -> False
 
+isModTrans :: Module i f a -> Bool
 isModTrans m = case mtype m of
   MTTransfer _ _ -> True
 ----  MTUnion t -> isModTrans t
   _ -> False
 
+sameMType :: Eq i => ModuleType i -> ModuleType i -> Bool
 sameMType m n = case (m,n) of
   (MTConcrete _, MTConcrete _) -> True
   (MTInstance _, MTInstance _) -> True
@@ -329,6 +339,7 @@ sameMType m n = case (m,n) of
   _ -> m == n
 
 -- | don't generate code for interfaces and for incomplete modules
+isCompilableModule :: ModInfo i f a -> Bool
 isCompilableModule m = case m of
   ModMod m -> case mtype m of
     MTInterface -> False

src/GF/Infra/Option.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:15 $ 
+-- > CVS $Date: 2005/02/24 11:46:35 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.19 $
+-- > CVS $Revision: 1.20 $
 --
 -- Options and flags used in GF shell commands and files.
 --
@@ -18,60 +18,12 @@
 --   - The constructor 'Opts' us udes in "API", "Shell" and "ShellCommands"
 -----------------------------------------------------------------------------
 
-module Option (-- * all kinds of options, should be kept abstract
+module Option where
-	       Option(..), Options(..), OptFun, OptFunId,
-	       noOptions, iOpt, aOpt, iOpts, oArg, oElem, eqOpt,
-	       getOptVal, getOptInt, optIntOrAll, optIntOrN, optIntOrOne,
-	       changeOptVal, addOption, addOptions, concatOptions,
-	       removeOption, removeOptions, options, unionOptions,
-
-	       -- * parsing options, with prefix pre (e.g. \"-\")
-	       getOptions, pOption, isOption,
-
-	       -- * printing options, without prefix
-	       prOpt, prOpts, 
-
-	       -- * a suggestion for option names 
-	       -- ** parsing
-	       strictParse, forgiveParse, ignoreParse, literalParse,
-	       rawParse, firstParse, dontParse, 
-	       -- ** grammar formats
-	       showAbstr, showXML, showOld, showLatex, showFullForm, 
-	       showEBNF, showCF, showWords, showOpts,
-	       isCompiled, isHaskell, noCompOpers, retainOpers, defaultGrOpts, 
-	       newParser, noCF, checkCirc, noCheckCirc, lexerByNeed,
-	       -- ** linearization
-	       allLin, firstLin, distinctLin, dontLin, showRecord, showStruct,
-	       xmlLin, latexLin, tableLin, defaultLinOpts, useUTF8, showLang, withMetas,
-	       -- ** other
-	       beVerbose, showInfo, beSilent, emitCode, getHelp, doMake, doBatch,
-	       notEmitCode, makeMulti, beShort, wholeGrammar, makeFudget, byLines, byWords,
-	       analMorpho, doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
-	       stripQualif, nostripQualif, showAll, fromSource,
-	       -- ** mainly for stand-alone
-	       useUnicode, optCompute, optCheck, optParaphrase, forJava,
-	       -- ** for edit session
-	       allLangs, absView,
-	       -- ** options that take arguments
-	       useTokenizer, useUntokenizer, useParser, withFun, firstCat, gStartCat,
-	       useLanguage, useResource, speechLanguage, useFont,
-	       grammarFormat, grammarPrinter, filterString, termCommand, transferFun,
-	       forForms, menuDisplay, sizeDisplay, typeDisplay,
-	       noDepTypes, extractGr, pathList, uniCoding,
-	       useName, useAbsName, useCncName, useResName, useFile, useOptimizer, 
-	       markLin, markOptXML, markOptJava, markOptStruct, markOptFocus,
-	       -- ** refinement order
-	       nextRefine, firstRefine, lastRefine, 
-	       -- ** Boolean flags
-	       flagYes, flagNo, caseYesNo,
-	       -- ** integer flags
-	       flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees
-	      ) where
 
 import List (partition)
 import Char (isDigit)
 
--- all kinds of options, to be kept abstract
+-- * all kinds of options, to be kept abstract
 
 newtype Option = Opt (String,[String]) deriving (Eq,Show,Read)
 newtype Options = Opts [Option] deriving (Eq,Show,Read)
@@ -79,20 +31,20 @@ newtype Options = Opts [Option] deriving (Eq,Show,Read)
 noOptions :: Options
 noOptions = Opts []
 
+-- | simple option -o
 iOpt :: String -> Option
 iOpt o = Opt (o,[])   
--- ^ simple option -o
 
+-- | option with argument -o=a
 aOpt :: String -> String -> Option
 aOpt o a = Opt (o,[a])  
--- ^ option with argument -o=a
 
 iOpts :: [Option] -> Options
 iOpts = Opts
 
+-- | value of option argument
 oArg :: String -> String
 oArg s = s 
--- ^ value of option argument
 
 oElem :: Option -> Options -> Bool
 oElem o (Opts os) = elem o os
@@ -135,6 +87,7 @@ changeOptVal os f x =
 addOption :: Option -> Options -> Options
 addOption o (Opts os) = iOpts (o:os)
 
+addOptions :: Options -> Options -> Options
 addOptions (Opts os) os0 = foldr addOption os0 os
 
 concatOptions :: [Options] -> Options
@@ -143,14 +96,16 @@ concatOptions = foldr addOptions noOptions
 removeOption :: Option -> Options -> Options
 removeOption o (Opts os) = iOpts (filter (/=o) os)
 
+removeOptions :: Options -> Options -> Options
 removeOptions (Opts os) os0 = foldr removeOption os0 os
 
+options :: [Option] -> Options
 options = foldr addOption noOptions
 
 unionOptions :: Options -> Options -> Options
 unionOptions (Opts os) (Opts os') = Opts (os ++ os')
 
--- parsing options, with prefix pre (e.g. "-")
+-- * parsing options, with prefix pre (e.g. \"-\")
 
 getOptions :: String -> [String] -> (Options, [String])
 getOptions pre inp = let
@@ -166,24 +121,39 @@ pOption pre s = case span (/= '=') (drop (length pre) s) of
 isOption :: String -> String -> Bool
 isOption pre = (==pre) . take (length pre)
 
--- printing options, without prefix
+-- * printing options, without prefix
 
+prOpt :: Option -> String
 prOpt (Opt (s,[])) = s
 prOpt (Opt (s,xs)) = s ++ "=" ++ concat xs
+
+prOpts :: Options -> String
 prOpts (Opts os) = unwords $ map prOpt os
 
--- a suggestion for option names
+-- * a suggestion for option names
+
+-- ** parsing
+
+strictParse, forgiveParse, ignoreParse, literalParse, rawParse, firstParse :: Option
+-- | parse as term instead of string
+dontParse :: Option
 
--- parsing
 strictParse  = iOpt "strict"
 forgiveParse = iOpt "n"
 ignoreParse  = iOpt "ign"
 literalParse = iOpt "lit"
 rawParse     = iOpt "raw"
 firstParse   = iOpt "1"
-dontParse    = iOpt "read" -- parse as term instead of string
+dontParse    = iOpt "read" 
+
+-- ** grammar formats
+
+showAbstr, showXML, showOld, showLatex, showFullForm,
+  showEBNF, showCF, showWords, showOpts,
+  isCompiled, isHaskell, noCompOpers, retainOpers,
+  newParser, noCF, checkCirc, noCheckCirc, lexerByNeed :: Option
+defaultGrOpts :: [Option]
 
--- grammar formats
 showAbstr   = iOpt "abs"
 showXML     = iOpt "xml"
 showOld     = iOpt "old"
@@ -205,7 +175,13 @@ checkCirc   = iOpt "nocirc"
 noCheckCirc = iOpt "nocheckcirc"
 lexerByNeed = iOpt "cflexer"
 
--- linearization
+-- ** linearization
+
+allLin, firstLin, distinctLin, dontLin,
+  showRecord, showStruct, xmlLin, latexLin,
+  tableLin, useUTF8, showLang, withMetas :: Option
+defaultLinOpts :: [Option]
+
 allLin      = iOpt "all"
 firstLin    = iOpt "one"
 distinctLin = iOpt "nub"
@@ -220,7 +196,14 @@ useUTF8     = iOpt "utf8"
 showLang    = iOpt "lang"
 withMetas   = iOpt "metas"
 
--- other
+-- ** other
+
+beVerbose, showInfo, beSilent, emitCode, getHelp,
+  doMake, doBatch, notEmitCode, makeMulti, beShort,
+  wholeGrammar, makeFudget, byLines, byWords, analMorpho,
+  doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
+  stripQualif, nostripQualif, showAll, fromSource :: Option
+
 beVerbose    = iOpt "v"
 showInfo     = iOpt "i"
 beSilent     = iOpt "s"
@@ -246,24 +229,41 @@ nostripQualif = iOpt "nostrip"
 showAll      = iOpt "all"
 fromSource   = iOpt "src"
 
--- mainly for stand-alone
+-- ** mainly for stand-alone
+
+useUnicode, optCompute, optCheck, optParaphrase, forJava :: Option
+
 useUnicode    = iOpt "unicode"
 optCompute    = iOpt "compute"
 optCheck      = iOpt "typecheck"
 optParaphrase = iOpt "paraphrase"
 forJava       = iOpt "java"
 
--- for edit session
+-- ** for edit session
+
+allLangs, absView :: Option
+
 allLangs  = iOpt "All"
 absView   = iOpt "Abs"
 
--- options that take arguments
+-- ** options that take arguments
+
+useTokenizer, useUntokenizer, useParser, withFun, 
+  useLanguage, useResource, speechLanguage, useFont,
+  grammarFormat, grammarPrinter, filterString, termCommand,
+  transferFun, forForms, menuDisplay, sizeDisplay, typeDisplay,
+  noDepTypes, extractGr, pathList, uniCoding :: String -> Option
+-- | used on command line
+firstCat :: String -> Option
+-- | used in grammar, to avoid clash w res word
+gStartCat :: String -> Option
+
 useTokenizer   = aOpt "lexer"
 useUntokenizer = aOpt "unlexer"
 useParser      = aOpt "parser"
 withFun        = aOpt "fun"
-firstCat       = aOpt "cat"      -- used on command line
+firstCat       = aOpt "cat"      
-gStartCat      = aOpt "startcat" -- used in grammar, to avoid clash w res word
+gStartCat      = aOpt "startcat" 
 useLanguage    = aOpt "lang"
 useResource    = aOpt "res"
 speechLanguage = aOpt "language"
@@ -282,6 +282,9 @@ extractGr      = aOpt "extract"
 pathList       = aOpt "path"
 uniCoding      = aOpt "coding"
 
+useName, useAbsName, useCncName, useResName, 
+  useFile, useOptimizer :: String -> Option
+
 useName        = aOpt "name"
 useAbsName     = aOpt "abs"
 useCncName     = aOpt "cnc"
@@ -289,6 +292,9 @@ useResName     = aOpt "res"
 useFile        = aOpt "file"
 useOptimizer   = aOpt "optimize"
 
+markLin :: String -> Option
+markOptXML, markOptJava, markOptStruct, markOptFocus :: String
+
 markLin        = aOpt "mark"
 markOptXML     = oArg "xml"
 markOptJava    = oArg "java"
@@ -296,16 +302,26 @@ markOptStruct  = oArg "struct"
 markOptFocus   = oArg "focus"
 
 
--- refinement order
+-- ** refinement order
+
+nextRefine :: String -> Option
+firstRefine, lastRefine :: String
+
 nextRefine  = aOpt "nextrefine"
 firstRefine = oArg "first"
 lastRefine  = oArg "last"
 
--- Boolean flags
+-- ** Boolean flags
+
+flagYes, flagNo :: String
+
 flagYes = oArg "yes"
 flagNo  = oArg "no"
 
--- integer flags
+-- ** integer flags
+
+flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees :: String -> Option
+
 flagDepth  = aOpt "depth"
 flagAlts   = aOpt "alts"
 flagLength = aOpt "length"

src/GF/Infra/UseIO.hs

@@ -5,56 +5,14 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:16 $ 
+-- > CVS $Date: 2005/02/24 11:46:36 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.8 $
+-- > CVS $Revision: 1.9 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
 
-module UseIO (prOptCPU,
+module UseIO where
-	      putCPU,
-	      putPoint,
-	      putPoint',
-	      readFileIf,
-	      FileName,
-	      InitPath,
-	      FullPath,
-	      getFilePath,
-	      readFileIfPath,
-	      doesFileExistPath,
-	      extendPathEnv,
-	      pFilePaths,
-	      prefixPathName,
-	      justInitPath,
-	      nameAndSuffix,
-	      unsuffixFile, fileBody,
-	      fileSuffix,
-	      justFileName,
-	      suffixFile,
-	      justModuleName,
-	      getLineWell,
-	      putStrFlush,
-	      putStrLnFlush,
-	      -- * a generic quiz session
-	      QuestionsAndAnswers,
-	      teachDialogue,
-	      -- * IO monad with error; adapted from state monad
-	      IOE(..),
-	      appIOE,
-	      ioe,
-	      ioeIO,
-	      ioeErr,
-	      ioeBad,
-	      useIOE,
-	      foldIOE,
-	      putStrLnE,
-	      putStrE,
-	      putPointE,
-	      putPointEVerb,
-	      readFileIOE,
-	      readFileLibraryIOE
-	     ) where
 
 import Operations
 import Arch (prCPU)
@@ -67,11 +25,13 @@ import Monad
 putShow' :: Show a => (c -> a) -> c -> IO ()
 putShow' f = putStrLn . show . length . show . f
 
+putIfVerb :: Options -> String -> IO ()
 putIfVerb opts msg =
       if oElem beVerbose opts
          then putStrLn msg
          else return ()
 
+putIfVerbW :: Options -> String -> IO ()
 putIfVerbW opts msg =
       if oElem beVerbose opts
          then putStr (' ' : msg)
@@ -88,8 +48,10 @@ errOptIO os e m = case m of
     putIfVerb os k
     return e
 
+prOptCPU :: Options -> Integer -> IO Integer
 prOptCPU opts = if (oElem noCPU opts) then (const (return 0)) else prCPU
 
+putCPU :: IO ()
 putCPU = do 
   prCPU 0 
   return ()
@@ -194,7 +156,7 @@ putStrFlush s = putStr s >> hFlush stdout
 putStrLnFlush :: String -> IO ()
 putStrLnFlush s = putStrLn s >> hFlush stdout
 
--- a generic quiz session
+-- * a generic quiz session
 
 type QuestionsAndAnswers = [(String, String -> (Integer,String))]
 
@@ -222,7 +184,7 @@ teachDialogue qas welc = do
       "You can interrupt the quiz by entering a line consisting of a dot ('.').\n"
 
 
--- IO monad with error; adapted from state monad
+-- * IO monad with error; adapted from state monad
 
 newtype IOE a = IOE (IO (Err a))
 

src/GF/Shell.hs

@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Shell
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:37 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.32 $
+-- > CVS $Revision: 1.33 $
 --
 -- GF shell command interpreter.
 -----------------------------------------------------------------------------
@@ -67,20 +67,32 @@ import VisualizeGrammar (visualizeSourceGrammar)
 
 type CommandLine = (CommandOpt, CommandArg,  [CommandOpt])
 
-type SrcTerm = G.Term -- term as returned by the command parser
+-- | term as returned by the command parser
+type SrcTerm = G.Term 
 
-type HState  = (ShellState,([String],Integer)) -- history & CPU
+-- | history & CPU
+type HState  = (ShellState,([String],Integer)) 
 
 type ShellIO = (HState, CommandArg) -> IO (HState, CommandArg)
 
 initHState :: ShellState -> HState
 initHState st = (st,([],0))
 
+cpuHState :: HState -> Integer
 cpuHState (_,(_,i)) = i
+
+optsHState :: HState -> Options
 optsHState (st,_) = globalOptions st
+
+putHStateCPU :: Integer -> HState -> HState
 putHStateCPU cpu (st,(h,_)) = (st,(h,cpu))
+
+updateHistory :: String -> HState -> HState
 updateHistory s (st,(h,cpu)) = (st,(s:h,cpu))
-earlierCommandH (_,(h,_)) = ((h ++ repeat "") !!) -- empty command if index over
+
+-- | empty command if index over
+earlierCommandH :: HState -> Int -> String
+earlierCommandH (_,(h,_)) = ((h ++ repeat "") !!) 
 
 execLinesH :: String -> [CommandLine] -> HState -> IO HState
 execLinesH s cs hst@(st, (h, _)) = do
@@ -91,13 +103,13 @@ execLinesH s cs hst@(st, (h, _)) = do
 ifImpure :: [CommandLine] -> Maybe (ImpureCommand,Options)
 ifImpure cls = foldr (const . Just) Nothing [(c,os) | ((CImpure c,os),_,_) <- cls]
 
--- the main function: execution of commands. put :: Bool forces immediate output
+-- | the main function: execution of commands. 'put :: Bool' forces immediate output
-
+--
 -- command line with consecutive (;) commands: no value transmitted
 execLines :: Bool -> [CommandLine] -> HState -> IO ([String],HState)
 execLines put cs st = foldM (flip (execLine put)) ([],st) cs
 
--- command line with piped (|) commands: no value returned
+-- | command line with piped (|) commands: no value returned
 execLine :: Bool -> CommandLine -> ([String],HState) -> IO ([String],HState)
 execLine put (c@(co, os), arg, cs) (outps,st) = do
   (st',val) <- execC c (st, arg)
@@ -110,7 +122,7 @@ execLine put (c@(co, os), arg, cs) (outps,st) = do
     execs []     arg st = return st
     execs (c:cs) arg st = execLine put (c, arg, cs) st
 
--- individual commands possibly piped: value returned; this is not a state monad
+-- | individual commands possibly piped: value returned; this is not a state monad
 execC :: CommandOpt -> ShellIO
 execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
 
@@ -315,12 +327,11 @@ justOutputArg opts f sa@(st,a) = f (utf (prCommandArg a)) >> return (st, AUnit)
 justOutput :: Options -> IO () -> ShellIO
 justOutput opts = justOutputArg opts . const
 
--- type system for command arguments; instead of plain strings...
+-- | type system for command arguments; instead of plain strings...
-
 data CommandArg = 
    AError  String 
  | ATrms   [Tree] 
- | ASTrm   String   -- to receive from parser 
+ | ASTrm   String   -- ^ to receive from parser 
  | AStrs   [Str] 
  | AString String 
  | AUnit 

src/GF/Shell/CommandL.hs

@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : CommandL
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:36 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.13 $
+-- > CVS $Revision: 1.14 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -32,8 +32,7 @@ import Monad (foldM)
 
 import UTF8
 
--- a line-based shell
+-- | a line-based shell
-
 initEditLoop :: CEnv -> IO () -> IO ()
 initEditLoop env resume = do
   let env' = startEditEnv env
@@ -55,8 +54,7 @@ editLoop env state resume = do
 
     editLoop env' state' resume
 
--- execute a command script and return a tree
+-- | execute a command script and return a tree
-
 execCommandHistory :: CEnv -> String -> IO (CEnv,Tree)
 execCommandHistory env s = do
   let env'  = startEditEnv env
@@ -77,14 +75,14 @@ getCommand = do
   s <- getLine
   return $ pCommand s
 
--- decodes UTF8 if u==False, i.e. if the grammar does not use UTF8;
+-- | decodes UTF8 if u==False, i.e. if the grammar does not use UTF8;
 -- used in the Java GUI, which always uses UTF8
-
 getCommandUTF :: Bool -> IO Command
 getCommandUTF u = do
   s <- getLine
   return $ pCommand $ if u then s else decodeUTF8 s 
 
+pCommand :: String -> Command
 pCommand = pCommandWords . words where 
   pCommandWords s = case s of
     "n" : cat : _ -> CNewCat cat
@@ -147,7 +145,8 @@ pCommand = pCommandWords . words where
     []            -> CVoid
     _             -> CError
 
--- well, this lists the commands of the line-based editor
+-- | well, this lists the commands of the line-based editor
+initEditMsg :: CEnv -> String
 initEditMsg env = unlines $
   "State-dependent editing commands are given in the menu:" :
   "  n [Cat] = new, r [Fun] = refine, w [Fun] [Int] = wrap,":
@@ -166,17 +165,19 @@ initEditMsg env = unlines $
 ---- ("  f [" ++ unwords (intersperse "|" allStringCommands) ++ "] = modify output") : 
   []
 
+initEditMsgEmpty :: CEnv -> String
 initEditMsgEmpty env = initEditMsg env +++++ unlines (
   "Start editing by n Cat selecting category\n\n" :
   "-------------\n" :
   ["n" +++ cat | (_,cat) <- newCatMenu env]
   )
 
+showCurrentState :: CEnv -> SState -> String
 showCurrentState env' state' =
   unlines (tr ++ ["",""] ++ msg ++ ["",""] ++ map fst menu) 
                  where (tr,msg,menu) = displaySStateIn env' state'
 
--- to read position; borrowed from Prelude; should be elsewhere
+-- | to read position; borrowed from Prelude; should be elsewhere
 readIntList :: String -> [Int]
 readIntList s = case [x | (x,t) <- reads s, ("","") <- lex t] of
                   [x] -> x

src/GF/Shell/Commands.hs

@@ -1,15 +1,19 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Commands
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:36 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.34 $
+-- > CVS $Revision: 1.35 $
 --
--- (Description of the module)
+-- temporary hacks for GF 2.0
+--
+-- Abstract command language for syntax editing. AR 22\/8\/2001.
+-- Most arguments are strings, to make it easier to receive them from e.g. Java.
+-- See "CommandsL" for a parser of a command language.
 -----------------------------------------------------------------------------
 
 module Commands where
@@ -52,7 +56,7 @@ import Option
 import Str (sstr) ----
 import UTF8 ----
 
-import Random (mkStdGen, newStdGen)
+import Random (StdGen, mkStdGen, newStdGen)
 import Monad (liftM2, foldM)
 import List (intersperse)
 
@@ -91,41 +95,46 @@ data Command =
  | CView
  | CMenu
  | CQuit
- | CHelp  (CEnv -> String) -- help message depends on grammar and interface
+ | CHelp  (CEnv -> String) -- ^ help message depends on grammar and interface
- | CError -- syntax error in command
+ | CError -- ^ syntax error in command
- | CVoid  -- empty command, e.g. just <enter>
+ | CVoid  -- ^ empty command, e.g. just \<enter\>
 
--- commands affecting CEnv
+ | CCEnvImport String         -- ^ |-- commands affecting 'CEnv'
- | CCEnvImport String
+ | CCEnvEmptyAndImport String -- ^ |
- | CCEnvEmptyAndImport String
+ | CCEnvOpenTerm String       -- ^ |
- | CCEnvOpenTerm String
+ | CCEnvOpenString String     -- ^ |
- | CCEnvOpenString String
+ | CCEnvEmpty                 -- ^ |
- | CCEnvEmpty
 
- | CCEnvOn  String
+ | CCEnvOn  String            -- ^ |
- | CCEnvOff String
+ | CCEnvOff String            -- ^ |
 
- | CCEnvGFShell String
+ | CCEnvGFShell String        -- ^ |==========
 
--- other commands using IO
+ | CCEnvRefineWithTree String -- ^ |-- other commands using 'IO'
- | CCEnvRefineWithTree String
+ | CCEnvRefineParse String    -- ^ |
- | CCEnvRefineParse String
+ | CCEnvSave String FilePath  -- ^ |==========
- | CCEnvSave String FilePath
 
+isQuit :: Command -> Bool
 isQuit CQuit = True
 isQuit _ = False
 
--- an abstract environment type
+-- | an abstract environment type
-
 type CEnv    = ShellState
 
+grammarCEnv :: CEnv -> StateGrammar
 grammarCEnv  = firstStateGrammar
+
+canCEnv :: CEnv -> CanonGrammar
 canCEnv  = canModules
+
+concreteCEnv, abstractCEnv :: StateGrammar -> I.Ident
 concreteCEnv = cncId
 abstractCEnv = absId
 
+stdGenCEnv :: CEnv -> SState -> StdGen
 stdGenCEnv env s = mkStdGen (length (displayJustStateIn env s) * 31 +11) ---
 
+initSStateEnv :: CEnv -> SState
 initSStateEnv env = case getOptVal (stateOptions sgr) gStartCat of
   Just cat -> action2commandNext (newCat gr (abs, I.identC cat)) initSState
   _ -> initSState
@@ -134,8 +143,7 @@ initSStateEnv env = case getOptVal (stateOptions sgr) gStartCat of
    abs = absId sgr
    gr  = stateGrammarST sgr
 
--- the main function
+-- | the main function
-
 execCommand :: CEnv -> Command -> SState -> IO (CEnv,SState)
 execCommand env c s = case c of
 
@@ -301,14 +309,14 @@ string2varPair s = case words s of
   _          -> Bad "expected format 'x y'"
 
 
-
+startEditEnv :: CEnv -> CEnv
 startEditEnv env = addGlobalOptions (options [sizeDisplay "short"]) env
 
--- seen on display
+-- | seen on display
-
 cMenuDisplay :: String -> Command
 cMenuDisplay s = CAddOption (menuDisplay s)
 
+newCatMenu :: CEnv -> [(Command, String)]
 newCatMenu env = [(CNewCat (prQIdent c), printname env initSState c) | 
                                   (c,[]) <- allCatsOf (canCEnv env)]
 
@@ -378,16 +386,19 @@ mkRefineMenuAll env sstate =
 -- there are three orthogonal parameters: Abs/[conc], short/long, typed/untyped
 -- the default is Abs, long, untyped; the Menus menu changes the parameter
 
+emptyMenuItem :: (Command, (String, String))
 emptyMenuItem = (CVoid,("",""))
 
 
 
 ---- allStringCommands = snd $ customInfo customStringCommand
-termCommandMenu, stringCommandMenu :: [(Command,String)]
+termCommandMenu :: [(Command,String)]
 termCommandMenu = [(CTermCommand s, s) | s <- allTermCommands]
 
+allTermCommands :: [String]
 allTermCommands = snd $ customInfo customEditCommand
 
+stringCommandMenu :: [(Command,String)]
 stringCommandMenu = []
 
 displayCommandMenu :: CEnv -> [(Command,String)]
@@ -413,7 +424,7 @@ changeMenuLanguage s = CAddOption (menuDisplay s)
 changeMenuSize s     = CAddOption (sizeDisplay s)
 changeMenuTyped s    = CAddOption (typeDisplay s)
 
-
+menuState :: CEnv -> SState -> [String]
 menuState env = map snd . mkRefineMenu env
 
 prState :: State -> [String]
@@ -437,7 +448,7 @@ displaySStateIn env state = (tree',msg,menu) where
   linAll = map lin grs
   separ  = singleton . map unlines . intersperse [replicate 72 '*']
 
----- the Boolean is a temporary hack to have two parallel GUIs
+-- | the Boolean is a temporary hack to have two parallel GUIs
 displaySStateJavaX :: Bool -> CEnv -> SState -> String
 displaySStateJavaX isNew env state = encodeUTF8 $ mkUnicode $
                                      unlines $ tagXML "gfedit" $ concat [
@@ -467,8 +478,9 @@ displaySStateJavaX isNew env state = encodeUTF8 $ mkUnicode $
     Just lang -> optDecodeUTF8 (stateGrammarOfLang env (language lang)) 
     _ -> id
 
--- the env is UTF8 if the display language is 
+-- | the env is UTF8 if the display language is 
---- should be independent
+--
+-- should be independent
 isCEnvUTF8 :: CEnv -> SState -> Bool
 isCEnvUTF8 env st = maybe False id $ do
    lang <- getOptVal opts menuDisplay
@@ -477,6 +489,7 @@ isCEnvUTF8 env st = maybe False id $ do
   where
     opts = addOptions (optsSState st) (globalOptions env)
 
+langAbstract, langXML :: I.Ident
 langAbstract = language "Abstract"
 langXML      = language "XML"
 
@@ -517,13 +530,26 @@ printname env state f = case getOptVal opts menuDisplay of
      gr  = grammar sgr
      mf  = ciq (cncId sgr) (snd f)
 
---- XML printing; does not belong here!
+-- * XML printing; does not belong here!
 
+tagsXML :: String -> [[String]] -> [String]
 tagsXML t = concatMap (tagXML t)
-tagAttrXML t av ss = mkTagAttrXML t av : map (indent 2) ss ++ [mkEndTagXML t]
+
-tagXML t ss = mkTagXML t : map (indent 2) ss ++ [mkEndTagXML t]
+tagAttrXML :: String -> (String, String) -> [String] -> [String]
-mkTagXML t = '<':t ++ ">"
+tagAttrXML t av ss = mkTagAttrXML t av : map (indent 2) ss ++ [mkEndTagXML t]
-mkEndTagXML t = mkTagXML ('/':t)
+
-mkTagAttrsXML t avs = '<':t +++ unwords [a++"="++v | (a,v) <- avs] ++">"
+tagXML :: String -> [String] -> [String]
-mkTagAttrXML  t av  = mkTagAttrsXML t [av]
+tagXML t ss = mkTagXML t : map (indent 2) ss ++ [mkEndTagXML t]
+
+mkTagXML :: String -> String
+mkTagXML t = '<':t ++ ">"
+
+mkEndTagXML :: String -> String
+mkEndTagXML t = mkTagXML ('/':t)
+
+mkTagAttrsXML :: String -> [(String, String)] -> String
+mkTagAttrsXML t avs = '<':t +++ unwords [a++"="++v | (a,v) <- avs] ++">"
+
+mkTagAttrXML :: String -> (String, String) -> String
+mkTagAttrXML t av  = mkTagAttrsXML t [av]
 

src/GF/Shell/JGF.hs

@@ -1,15 +1,15 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : JGF
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:37 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.9 $
+-- > CVS $Revision: 1.10 $
 --
--- (Description of the module)
+-- GF editing session controlled by e.g. a Java program. AR 16\/11\/2001
 -----------------------------------------------------------------------------
 
 module JGF where
@@ -31,16 +31,16 @@ import UTF8
 
 -- GF editing session controlled by e.g. a Java program. AR 16/11/2001
 
----- the Boolean is a temporary hack to have two parallel GUIs
+-- | the Boolean is a temporary hack to have two parallel GUIs
 sessionLineJ :: Bool -> ShellState -> IO ()
 sessionLineJ isNew env = do
   putStrLnFlush $ initEditMsgJavaX env
   let env' = addGlobalOptions (options [sizeDisplay "short",beSilent]) env
   editLoopJnewX isNew env' (initSState)
 
--- this is the real version, with XML
+-- | this is the real version, with XML
-
+--
----- the Boolean is a temporary hack to have two parallel GUIs
+-- the Boolean is a temporary hack to have two parallel GUIs
 editLoopJnewX :: Bool -> CEnv -> SState -> IO ()
 editLoopJnewX isNew env state = do
   c <- getCommandUTF (isCEnvUTF8 env state) ----
@@ -60,10 +60,12 @@ editLoopJnewX isNew env state = do
       putStrLnFlush package
       editLoopJnewX isNew env' state'
 
+welcome :: String
 welcome = 
   "An experimental GF Editor for Java." ++ 
   "(c) Kristofer Johannisson, Janna Khegai, and Aarne Ranta 2002 under CNU GPL."
 
+initEditMsgJavaX :: CEnv -> String
 initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $ 
   tagsXML "newcat"   [["n" +++ cat]     | (_,cat) <- newCatMenu env] ++
   tagXML  "topic"    [abstractName env] ++
@@ -71,5 +73,7 @@ initEditMsgJavaX env = encodeUTF8 $ mkUnicode $ unlines $ tagXML "gfinit" $
   concat [tagAttrXML "language" ("file",file) [prLanguage lang] |
            (file,lang) <- zip (allGrammarFileNames env) (allLanguages env)]
 
+
+initAndEditMsgJavaX :: Bool -> CEnv -> SState -> String
 initAndEditMsgJavaX isNew env state = 
   initEditMsgJavaX env ++++ displaySStateJavaX isNew env state

src/GF/Shell/PShell.hs

@@ -1,15 +1,15 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : PShell
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:37 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.17 $
+-- > CVS $Revision: 1.18 $
 --
--- (Description of the module)
+-- parsing GF shell commands. AR 11\/11\/2001
 -----------------------------------------------------------------------------
 
 module PShell where
@@ -29,8 +29,7 @@ import IO
 
 -- parsing GF shell commands. AR 11/11/2001
 
--- getting a sequence of command lines as input
+-- | getting a sequence of command lines as input
-
 getCommandLines :: IO (String,[CommandLine])
 getCommandLines = do
   s <- fetchCommand "> "
@@ -67,8 +66,7 @@ pInputString s = case s of
   ('"':_:_) -> [AString (init (tail s))]
   _         -> [AError "illegal string"]
 
--- command rl can be written remove_language etc.
+-- | command @rl@ can be written @remove_language@ etc.
-
 abbrevCommand :: String -> String
 abbrevCommand = hds . words . map u2sp where
   u2sp c = if c=='_' then ' ' else c

src/GF/Shell/ShellCommands.hs

@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : ShellCommands
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:37 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.22 $
+-- > CVS $Revision: 1.23 $
 --
 -- The datatype of shell commands and the list of their options.
 -----------------------------------------------------------------------------

src/GF/Shell/SubShell.hs

@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : SubShell
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:37 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -35,7 +35,10 @@ editSession opts st
    st'   = addGlobalOptions opts st
    font  = maybe myUniFont mkOptFont $ getOptVal opts useFont
 
+myUniFont :: String
 myUniFont = "-mutt-clearlyu-medium-r-normal--0-0-100-100-p-0-iso10646-1"
+
+mkOptFont :: String -> String
 mkOptFont = id
 
 translateSession :: Options -> ShellState -> IO ()
@@ -49,6 +52,7 @@ translateSession opts st = do
                   else translateBetweenAll grs cat s
   translateLoop opts trans
 
+translateLoop :: Options -> (String -> String) -> IO ()
 translateLoop opts trans = do
   let fud  = oElem makeFudget opts
       font = maybe myUniFont mkOptFont $ getOptVal opts useFont

src/GF/Shell/TeachYourself.hs

@@ -1,15 +1,15 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : TeachYourself
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:37 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
--- (Description of the module)
+-- translation and morphology quiz. AR 10\/5\/2000 -- 12\/4\/2002
 -----------------------------------------------------------------------------
 
 module TeachYourself where
@@ -71,15 +71,17 @@ morphoTrainList opts ig number = do
    gr = grammar ig
    cnc = cncId ig
 
--- compare answer to the list of right answers, increase score and give feedback 
+-- | compare answer to the list of right answers, increase score and give feedback 
 mkAnswer :: [String] -> String -> (Integer, String) 
 mkAnswer as s = if (elem (norml s) as) 
                    then (1,"Yes.") 
                    else (0,"No, not" +++ s ++ ", but" ++++ unlines as)
 
+
+norml :: String -> String
 norml = unwords . words
 
---- the maximal number of precompiled quiz problems
+-- | the maximal number of precompiled quiz problems
 infinity :: Integer
 infinity = 123 
 

src/GF/Source/GrammarToSource.hs

@@ -5,14 +5,19 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:20 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.16 $
+-- > CVS $Revision: 1.17 $
 --
 -- From internal source syntax to BNFC-generated (used for printing).
 -----------------------------------------------------------------------------
 
-module GrammarToSource where
+module GrammarToSource ( trGrammar, 
+			 trModule,
+			 trAnyDef,
+			 trLabel,
+			 trt, tri, trp
+		       ) where
 
 import Operations
 import Grammar
@@ -205,6 +210,7 @@ tri i = case prIdent i of
   
 trb i = if isWildIdent i then P.BWild else P.BIdent (tri i)
 
+trLabel :: Label -> P.Label
 trLabel i = case i of
   LIdent s -> P.LIdent $ identC s
   LVar i -> P.LVar $ toInteger i

src/GF/Source/SourceToGrammar.hs

@@ -5,14 +5,20 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:21 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.20 $
+-- > CVS $Revision: 1.21 $
 --
 -- based on the skeleton Haskell module generated by the BNF converter
 -----------------------------------------------------------------------------
 
-module SourceToGrammar where
+module SourceToGrammar ( transGrammar,
+			 transInclude,
+			 transModDef,
+			 transOldGrammar,
+			 transExp,
+			 newReservedWords
+		       ) where
 
 import qualified Grammar as G
 import qualified PrGrammar as GP
@@ -321,7 +327,7 @@ getDefsGen d = case d of
     e'  <- transExp e
     return [(id',(nope, yes (G.Eqs [(ps',e')])))]
 
--- sometimes you need this special case, e.g. in linearization rules
+-- | sometimes you need this special case, e.g. in linearization rules
 getDefs :: Def -> Err [(Ident, (G.Perh G.Type, G.Perh G.Term))]
 getDefs d = case d of
   DPatt id patts e  -> do
@@ -331,7 +337,7 @@ getDefs d = case d of
     return [(id',(nope, yes (M.mkAbs xs e')))]
   _ -> getDefsGen d
 
--- accepts a pattern that is either a variable or a wild card
+-- | accepts a pattern that is either a variable or a wild card
 tryMakeVar :: Patt -> Err Ident
 tryMakeVar p = do
   p' <- transPatt p
@@ -434,6 +440,7 @@ erecord2term ds = do
     _ -> Bad $ "illegal record field" +++ GP.prt (fst f)
 
   
+locdef2fields :: LocDef -> Err [(Ident, (Maybe G.Type, Maybe G.Type))]
 locdef2fields d = case d of
     LDDecl ids t -> do
       labs <- mapM transIdent ids
@@ -522,9 +529,8 @@ transDDecl x = case x of
   DDDec binds exp  -> transDecl $ DDec binds exp
   DDExp exp  ->  transDecl $ DExp exp
 
--- to deal with the old format, sort judgements in three modules, forming
+-- | to deal with the old format, sort judgements in three modules, forming
 -- their names from a given string, e.g. file name or overriding user-given string
-
 transOldGrammar :: Options -> FilePath -> OldGrammar -> Err G.SourceGrammar
 transOldGrammar opts name0 x = case x of
   OldGr includes topdefs  -> do --- includes must be collected separately
@@ -594,7 +600,8 @@ transInclude x = case x of
                       --- unsafe hack ; cf. GetGrammar.oldLexer
 
 
-newReservedWords = 
+newReservedWords :: [String]
+newReservedWords =
   words $ "abstract concrete interface incomplete " ++ 
           "instance out open resource reuse transfer union with where"
 

src/GF/Speech/SRG.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/22 13:35:19 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
 --
 -- Representation of, conversion to, and utilities for 
 -- printing of a general Speech Recognition Grammar. 
@@ -41,8 +41,9 @@ data SRG = SRG { grammarName :: String    -- ^ grammar name
 data SRGRule = SRGRule String String [SRGAlt] -- ^ SRG category name, original category name
 	                                      --   and productions
 type SRGAlt = [Symbol String Token]
+
+-- | SRG category name and original name
 type CatName = (String,String) 
--- ^ SRG category name and original name
 
 type CatNames = FiniteMap String String
 

src/GF/System/Arch.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:10 $ 
+-- > CVS $Date: 2005/02/24 11:46:34 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
 --
 -- architecture\/compiler dependent definitions for unix\/hbc
 -----------------------------------------------------------------------------
@@ -35,11 +35,13 @@ myStdGen int0 = do
   let int = int0 + ctSec cal + fromInteger (div (ctPicosec cal) 10000000)
   return $ mkStdGen int
 
+prCPU :: Integer -> IO Integer
 prCPU cpu = do 
   cpu' <- getCPUTime
   putStrLn (show ((cpu' - cpu) `div` 1000000000) ++ " msec")
   return cpu'
 
+welcomeArch :: String
 welcomeArch = "This is the system compiled with ghc."
 
 fetchCommand :: String -> IO (String)

src/GF/UseGrammar/Custom.hs

@@ -1,15 +1,28 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Custom
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:21 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.41 $
+-- > CVS $Revision: 1.42 $
 --
 -- A database for customizable GF shell commands. 
+--
+-- databases for customizable commands. AR 21\/11\/2001.
+-- for:  grammar parsers, grammar printers, term commands, string commands.
+-- idea: items added here are usable throughout GF; nothing else need be edited.
+-- they are often usable through the API: hence API cannot be imported here!
+--
+-- Major redesign 3\/4\/2002: the first entry in each database is DEFAULT.
+-- If no other value is given, the default is selected.
+-- Because of this, two invariants have to be preserved:
+--
+--  - no databases may be empty
+--
+--  - additions are made to the end of the database
 -----------------------------------------------------------------------------
 
 module Custom where
@@ -104,59 +117,61 @@ import ExtraDiacritics (mkExtraDiacritics)
 -- Major redesign 3/4/2002: the first entry in each database is DEFAULT.
 -- If no other value is given, the default is selected.
 -- Because of this, two invariants have to be preserved:
--- ** no databases may be empty
+--  - no databases may be empty
--- ** additions are made to the end of the database
+--  - additions are made to the end of the database
 
--- these are the databases; the comment gives the name of the flag
+-- * these are the databases; the comment gives the name of the flag
 
--- grammarFormat, "-format=x" or file suffix
+-- | grammarFormat, \"-format=x\" or file suffix
 customGrammarParser :: CustomData (FilePath -> IOE C.CanonGrammar) 
 
--- grammarPrinter, "-printer=x"
+-- | grammarPrinter, \"-printer=x\"
 customGrammarPrinter :: CustomData (StateGrammar -> String)             
 
--- multiGrammarPrinter, "-printer=x"
+-- | multiGrammarPrinter, \"-printer=x\"
 customMultiGrammarPrinter :: CustomData (CanonGrammar -> String)    
 
--- syntaxPrinter, "-printer=x"
+-- | syntaxPrinter, \"-printer=x\"
 customSyntaxPrinter  :: CustomData (GF.Grammar -> String)        
 
--- termPrinter, "-printer=x"
+-- | termPrinter, \"-printer=x\"
 customTermPrinter  :: CustomData (StateGrammar -> Tree -> String)
 
--- termCommand, "-transform=x"
+-- | termCommand, \"-transform=x\"
 customTermCommand    :: CustomData (StateGrammar -> Tree -> [Tree])
 
--- editCommand, "-edit=x"
+-- | editCommand, \"-edit=x\"
 customEditCommand    :: CustomData (StateGrammar -> Action)
 
--- filterString, "-filter=x"
+-- | filterString, \"-filter=x\"
 customStringCommand  :: CustomData (StateGrammar -> String -> String)
 
--- useParser, "-parser=x"
+-- | useParser, \"-parser=x\"
 customParser         :: CustomData (StateGrammar -> CFCat -> CFParser)
 
--- useTokenizer, "-lexer=x"
+-- | useTokenizer, \"-lexer=x\"
 customTokenizer      :: CustomData (StateGrammar -> String -> [CFTok])  
 
--- useUntokenizer, "-unlexer=x" --- should be from token list to string
+-- | useUntokenizer, \"-unlexer=x\" --- should be from token list to string
 customUntokenizer    :: CustomData (StateGrammar -> String -> String)  
 
--- uniCoding, "-coding=x"
+-- | uniCoding, \"-coding=x\"
+--
 -- contains conversions from different codings to the internal
 -- unicode coding
 customUniCoding :: CustomData (String -> String)
 
--- this is the way of selecting an item
+-- | this is the way of selecting an item
 customOrDefault :: Options -> OptFun -> CustomData a -> a
 customOrDefault opts optfun db = maybe (defaultCustomVal db) id $ 
                                    customAsOptVal opts optfun db
 
--- to produce menus of custom operations
+-- | to produce menus of custom operations
 customInfo :: CustomData a -> (String, [String])
 customInfo c = (titleCustomData c, map (ciStr . fst) (dbCustomData c))
 
 -------------------------------
+-- * types and stuff 
 
 type CommandId = String
 
@@ -170,8 +185,14 @@ ciOpt :: CommandId -> Option
 ciOpt = iOpt
 
 newtype CustomData a = CustomData (String, [(CommandId,a)])
+
+customData :: String -> [(CommandId, a)] -> CustomData a
 customData title db = CustomData (title,db)
+
+dbCustomData :: CustomData a -> [(CommandId, a)]
 dbCustomData (CustomData (_,db)) = db
+
+titleCustomData :: CustomData a -> String
 titleCustomData (CustomData (t,_)) = t
 
 lookupCustom :: CustomData a -> CommandId -> Maybe a
@@ -182,13 +203,13 @@ customAsOptVal opts optfun db = do
   arg <- getOptVal opts optfun
   lookupCustom db (strCI arg)
 
--- take the first entry from the database
+-- | take the first entry from the database
 defaultCustomVal :: CustomData a -> a
 defaultCustomVal (CustomData (s,db)) = 
   ifNull (error ("empty database:" +++ s)) (snd . head) db
 
 -------------------------------------------------------------------------
--- and here's the customizable part:
+-- * and here's the customizable part:
 
 -- grammar parsers: the ID is also used as file name suffix
 customGrammarParser = 

src/GF/UseGrammar/Editing.hs

@@ -1,15 +1,16 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Editing
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.10 $
+-- > CVS $Revision: 1.11 $
 --
--- (Description of the module)
+-- generic tree editing, with some grammar notions assumed. AR 18\/8\/2001.
+-- 19\/6\/2003 for GFC
 -----------------------------------------------------------------------------
 
 module Editing where
@@ -31,7 +32,7 @@ type CGrammar = GFC.CanonGrammar
 
 type State = Loc TrNode
 
--- the "empty" state
+-- | the "empty" state
 initState :: State
 initState = tree2loc uTree 
 
@@ -60,25 +61,26 @@ actFun s = case actAtom s of
   AtC f -> return f
   t -> prtBad "active atom: expected function, found" t
 
+actExp :: State -> Exp
 actExp = tree2exp . actTree
 
--- current local bindings
+-- | current local bindings
 actBinds :: State -> Binds
 actBinds = bindsNode . nodeTree . actTree
 
--- constraints in current subtree
+-- | constraints in current subtree
 actConstrs :: State -> Constraints
 actConstrs = allConstrsTree . actTree   
 
--- constraints in the whole tree
+-- | constraints in the whole tree
 allConstrs :: State -> Constraints
 allConstrs = allConstrsTree . loc2tree   
 
--- metas in current subtree
+-- | metas in current subtree
 actMetas :: State -> [Meta]
 actMetas = metasTree . actTree   
 
--- metas in the whole tree
+-- | metas in the whole tree
 allMetas :: State -> [Meta]
 allMetas = metasTree . loc2tree
 
@@ -100,32 +102,37 @@ allPrevVars = map fst . allPrevBinds
 allVars :: State -> [Var]
 allVars = map fst . allBinds
 
+vGenIndex :: State -> Int
 vGenIndex = length . allBinds
 
+actIsMeta :: State -> Bool
 actIsMeta = atomIsMeta . actAtom
 
 actMeta :: State -> Err Meta
 actMeta = getMetaAtom . actAtom
 
--- meta substs are not only on the actual path...
+-- | meta substs are not only on the actual path...
 entireMetaSubst :: State -> MetaSubst
 entireMetaSubst = concatMap metaSubstsNode . scanTree . loc2tree
 
+isCompleteTree :: Tree -> Bool
 isCompleteTree = null . filter atomIsMeta . map atomNode . scanTree 
+
+isCompleteState :: State -> Bool
 isCompleteState = isCompleteTree . loc2tree
 
 initStateCat :: Context -> Cat -> Err State
 initStateCat cont cat = do
   return $ tree2loc (Tr (mkNode [] mAtom (cat2val cont cat) ([],[]), []))
 
--- this function only concerns the body of an expression...
+-- | this function only concerns the body of an expression...
 annotateInState :: CGrammar -> Exp -> State -> Err Tree
 annotateInState gr exp state = do
   let binds = allBinds state
       val   = actVal state
   annotateIn gr binds exp (Just val)
 
--- ...whereas this one works with lambda abstractions
+-- | ...whereas this one works with lambda abstractions
 annotateExpInState :: CGrammar -> Exp -> State -> Err Tree
 annotateExpInState gr exp state = do
   let cont  = allPrevBinds state
@@ -139,7 +146,7 @@ treeByExp trans gr exp0 state = do
   exp <- trans exp0
   annotateExpInState gr exp state
 
--- actions
+-- * actions
 
 type Action = State -> Err State
 
@@ -172,6 +179,7 @@ goPrevNewMeta s = goBack  s >>= goPrevMeta
 
 goNextMetaIfCan = actionIfPossible goNextMeta
 
+actionIfPossible :: Action -> Action
 actionIfPossible a s = return $ errVal s (a s)
 
 goFirstMeta, goLastMeta :: Action
@@ -276,18 +284,16 @@ refineWithAtom der gr at state = do
   exp <- ref2exp oldvars typ at
   refineWithExpTC der gr exp state
 
--- in this command, we know that the result is well-typed, since computation
+-- | in this command, we know that the result is well-typed, since computation
 -- rules have been type checked and the result is equal
-
 computeSubTree :: CGrammar -> Action
 computeSubTree gr state = do
   let exp = tree2exp (actTree state)
   tree <- treeByExp (compute gr) gr exp state
   replaceSubTree tree state
 
--- but here we don't, since the transfer flag isn't type checked,
+-- | but here we don't, since the transfer flag isn't type checked,
 -- and computing the transfer function is not checked to preserve equality
-
 transferSubTree :: Maybe Fun -> CGrammar -> Action
 transferSubTree Nothing _ s = return s
 transferSubTree (Just fun) gr state = do
@@ -348,11 +354,11 @@ peelFunHead gr (f@(m,c),i) state = do
   state' <- replaceSubTree tree state
   reCheckState gr state' --- must be unfortunately done. 20/11/2001
 
--- an expensive operation
+-- | an expensive operation
 reCheckState :: CGrammar -> State -> Err State
 reCheckState gr st = annotate gr (tree2exp (loc2tree st)) >>= return . tree2loc
 
--- extract metasubstitutions from constraints and solve them
+-- | extract metasubstitutions from constraints and solve them
 solveAll :: CGrammar -> State -> Err State
 solveAll gr st = solve st >>= solve where 
   solve st0 = do ---- why need twice?
@@ -362,7 +368,7 @@ solveAll gr st = solve st >>= solve where
     metaSubstRefinements gr ms $ 
       mapLoc (reduceConstraintsNode gr . performMetaSubstNode ms) st
 
--- active refinements
+-- * active refinements
 
 refinementsState :: CGrammar -> State -> [(Term,(Val,Bool))]
 refinementsState gr state = 

src/GF/UseGrammar/Generate.hs

@@ -1,24 +1,30 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Generate
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.7 $
+-- > CVS $Revision: 1.8 $
 --
--- (Description of the module)
+-- Generate all trees of given category and depth. AR 30\/4\/2004
+--
+-- (c) Aarne Ranta 2004 under GNU GPL
+--
+-- Purpose: to generate corpora. We use simple types and don't
+-- guarantee the correctness of bindings\/dependences.
 -----------------------------------------------------------------------------
 
-module Generate where
+module Generate (generateTrees) where
 
 import GFC
 import LookAbs
 import PrGrammar
 import Macros
 import Values
+import Grammar (Cat)
 
 import Operations
 import Zipper
@@ -32,11 +38,8 @@ import List
 -- guarantee the correctness of bindings/dependences.
 
 
--- the main function takes an abstract syntax and returns a list of trees
+-- | the main function takes an abstract syntax and returns a list of trees
-
+generateTrees :: GFCGrammar -> Bool -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
---- if type were shown more modules should be imported
--- generateTrees :: 
--- GFCGrammar -> Bool -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
 generateTrees gr ifm cat n mn mt = map str2tr $ generate gr' ifm cat' n mn mt'
   where
     gr' = gr2sgr gr

src/GF/UseGrammar/GetTree.hs

@@ -1,15 +1,17 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : GetTree
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
 --
--- (Description of the module)
+-- how to form linearizable trees from strings and from terms of different levels
+--
+-- 'String' --> raw 'Term' --> annot, qualif 'Term' --> 'Tree'
 -----------------------------------------------------------------------------
 
 module GetTree where

src/GF/UseGrammar/Information.hs

@@ -1,18 +1,20 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Information
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
--- (Description of the module)
+-- information on module, category, function, operation, parameter,... 
+-- AR 16\/9\/2003.
+-- uses source grammar
 -----------------------------------------------------------------------------
 
-module Information where
+module Information (showInformation) where
 
 import Grammar
 import Ident
@@ -32,20 +34,18 @@ import UseIO
 -- information on module, category, function, operation, parameter,... AR 16/9/2003
 -- uses source grammar
 
--- the top level function
+-- | the top level function
-
 showInformation :: Options -> ShellState -> Ident -> IOE ()
 showInformation opts st c = do
   is <- ioeErr $ getInformation opts st c
   mapM_ (putStrLnE . prInformation opts c) is
 
--- the data type of different kinds of information
+-- | the data type of different kinds of information
-
 data Information = 
    IModAbs  SourceAbs
  | IModRes  SourceRes
  | IModCnc  SourceCnc
- | IModule  SourceAbs ---- to be deprecated
+ | IModule  SourceAbs -- ^ to be deprecated
  | ICatAbs  Ident Context [Ident]
  | ICatCnc  Ident Type    [CFRule] Term
  | IFunAbs  Ident Type    (Maybe Term)
@@ -97,8 +97,7 @@ prInformation opts c i = unlines $ prt c : case i of
     "type" +++ show ty
     ]
 
--- also finds out if an identifier is defined in many places
+-- | also finds out if an identifier is defined in many places
-
 getInformation :: Options -> ShellState -> Ident -> Err [Information]
 getInformation opts st c = allChecks $ [
   do

src/GF/UseGrammar/Linear.hs

@@ -1,15 +1,15 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Linear
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:38 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.13 $
+-- > CVS $Revision: 1.14 $
 --
--- (Description of the module)
+-- Linearization for canonical GF. AR 7\/6\/2003
 -----------------------------------------------------------------------------
 
 module Linear where
@@ -37,14 +37,15 @@ import List (intersperse)
 
 -- Linearization for canonical GF. AR 7/6/2003
 
--- The worker function: linearize a Tree, return
+-- | The worker function: linearize a Tree, return
 -- a record. Possibly mark subtrees.
-
+--
 -- NB. Constants in trees are annotated by the name of the abstract module.
 -- A concrete module name must be given to find (and choose) linearization rules.
--- If no marking is wanted, noMark  :: Marker.
+--
--- For xml marking, use     markXML :: Marker
+--  - If no marking is wanted, 'noMark'  :: 'Marker'.
-
+--
+--  - For xml marking, use     'markXML' :: 'Marker'
 linearizeToRecord :: CanonGrammar -> Marker -> Ident -> A.Tree -> Err Term
 linearizeToRecord gr mk m = lin [] where
 
@@ -85,14 +86,13 @@ linearizeToRecord gr mk m = lin [] where
     _ -> lookCat c >>= comp [tK (prt_ t)]
 
 
--- thus the special case:
+-- | thus the special case:
-
 linearizeNoMark :: CanonGrammar -> Ident -> A.Tree -> Err Term
 linearizeNoMark gr = linearizeToRecord gr noMark
 
--- expand tables in linearized term to full, normal-order tables
+-- | expand tables in linearized term to full, normal-order tables
+--
 -- NB expand from inside-out so that values are not looked up in copies of branches
-
 expandLinTables :: CanonGrammar -> Term -> Err Term
 expandLinTables gr t = case t of
   R rs -> liftM (R . map (uncurry Ass)) $ mapPairsM exp [(l,r) | Ass l r <- rs]
@@ -110,38 +110,36 @@ expandLinTables gr t = case t of
    exp  = expandLinTables gr
    comp = ccompute gr []
 
--- from records, one can get to records of tables of strings
+-- | from records, one can get to records of tables of strings
-
 rec2strTables :: Term -> Err [[(Label,[([Patt],[Str])])]]
 rec2strTables r = do
   vs <- allLinValues r
   mapM (mapPairsM (mapPairsM strsFromTerm)) vs
 
--- from these tables, one may want to extract the ones for the "s" label
+-- | from these tables, one may want to extract the ones for the "s" label
-
 strTables2sTables :: [[(Label,[([Patt],[Str])])]] -> [[([Patt],[Str])]]
 strTables2sTables ts = [t | r <- ts, (l,t) <- r, l == linLab0]
 
 linLab0 :: Label
 linLab0 = L (identC "s")
 
--- to get lists of token lists is easy
+-- | to get lists of token lists is easy
 sTables2strs :: [[([Patt],[Str])]] -> [[Str]]
 sTables2strs = map snd . concat
 
--- from this, to get a list of strings
+-- | from this, to get a list of strings
 strs2strings :: [[Str]] -> [String]
 strs2strings = map unlex
 
--- this is just unwords; use an unlexer from Text to postprocess
+-- | this is just unwords; use an unlexer from Text to postprocess
 unlex :: [Str] -> String
 unlex = concat . map sstr . take 1 ----
 
--- finally, a top-level function to get a string from an expression
+-- | finally, a top-level function to get a string from an expression
 linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
 linTree2string mk gr m e = head $ linTree2strings mk gr m e -- never empty
 
--- you can also get many strings
+-- | you can also get many strings
 linTree2strings :: Marker -> CanonGrammar -> Ident -> A.Tree -> [String]
 linTree2strings mk gr m e = err return id $ do
   t  <- linearizeToRecord gr mk m e
@@ -150,8 +148,7 @@ linTree2strings mk gr m e = err return id $ do
   let ss = strs2strings $ sTables2strs $ strTables2sTables ts
   ifNull (prtBad "empty linearization of" e) return ss   -- thus never empty
 
--- argument is a Tree, value is a list of strs; needed in Parsing
+-- | argument is a Tree, value is a list of strs; needed in Parsing
-
 allLinsOfTree :: CanonGrammar -> Ident -> A.Tree -> [Str]
 allLinsOfTree gr a e = err (singleton . str) id $ do
   e' <- return e ---- annotateExp gr e
@@ -160,11 +157,11 @@ allLinsOfTree gr a e = err (singleton . str) id $ do
   ts <- rec2strTables r'
   return $ concat $ sTables2strs $ strTables2sTables ts
 
--- the value is a list of structures arranged as records of tables of terms
+-- | the value is a list of structures arranged as records of tables of terms
 allLinsAsRec :: CanonGrammar -> Ident -> A.Tree -> Err [[(Label,[([Patt],Term)])]]
 allLinsAsRec gr c t = linearizeNoMark gr c t >>= expandLinTables gr >>= allLinValues
 
--- the value is a list of structures arranged as records of tables of strings
+-- | the value is a list of structures arranged as records of tables of strings
 -- only taking into account string fields
 allLinTables :: CanonGrammar ->Ident ->A.Tree ->Err [[(Label,[([Patt],[String])])]]
 allLinTables gr c t = do
@@ -207,15 +204,14 @@ linearizeToStrss gr mk e = do
   return $ map strsFromTerm $ allInTable t 
 -}
 
--- the value is a list of strings, not forgetting their arguments
+-- | the value is a list of strings, not forgetting their arguments
 allLinsOfFun :: CanonGrammar -> CIdent -> Err [[(Label,[([Patt],Term)])]]
 allLinsOfFun gr f = do
   t <- lookupLin gr f 
   allLinValues t
 
 
--- returns printname if one exists; otherwise linearizes with metas
+-- | returns printname if one exists; otherwise linearizes with metas
-
 printOrLinearize :: CanonGrammar -> Ident -> A.Fun -> String
 printOrLinearize gr c f@(m, d) = errVal (prt fq) $ 
   case lookupPrintname gr (CIQ c d) of

src/GF/UseGrammar/MoreCustom.hs

@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : MoreCustom
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -17,6 +17,19 @@ module MoreCustom where
 -- All these lists are supposed to be empty!
 -- Items should be added to ../Custom.hs instead.
 
+moreCustomGrammarParser,
+  moreCustomGrammarPrinter,
+  moreCustomMultiGrammarPrinter,
+  moreCustomSyntaxPrinter,
+  moreCustomTermPrinter,
+  moreCustomTermCommand,
+  moreCustomEditCommand,
+  moreCustomStringCommand,
+  moreCustomParser,
+  moreCustomTokenizer,
+  moreCustomUntokenizer,
+  moreCustomUniCoding :: [a]
+
 moreCustomGrammarParser = []
 moreCustomGrammarPrinter = []
 moreCustomMultiGrammarPrinter = []

src/GF/UseGrammar/Morphology.hs

@@ -1,15 +1,20 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Morphology
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- Morphological analyser constructed from a GF grammar.
+--
+-- we first found the binary search tree sorted by word forms more efficient
+-- than a trie, at least for grammars with 7000 word forms
+-- (18\/11\/2003) but this may change since we have to use a trie 
+-- for decompositions and also want to use it in the parser
 -----------------------------------------------------------------------------
 
 module Morphology where
@@ -35,11 +40,12 @@ import Trie2
 
 -- we first found the binary search tree sorted by word forms more efficient
 -- than a trie, at least for grammars with 7000 word forms
--- (18/11/2003) but this may change since we have to use a trie 
+-- (18\/11\/2003) but this may change since we have to use a trie 
 -- for decompositions and also want to use it in the parser
 
 type Morpho = Trie Char String
 
+emptyMorpho :: Morpho
 emptyMorpho = emptyTrie
 
 appMorpho :: Morpho -> String -> (String,[String])
@@ -96,13 +102,18 @@ prMorphoAnalysisShort (w,fs) = prBracket (w' ++ prTList "/" fs) where
 tagPrt :: Print a => (a,a) -> String
 tagPrt (m,c) = "+" ++ prt c --- module name
 
--- print all words recognized
+-- | print all words recognized
-
 allMorphoWords :: Morpho -> [String]
 allMorphoWords = map fst . collapse
 
 -- analyse running text and show results either in short form or on separate lines
+
+-- | analyse running text and show results in short form
+morphoTextShort :: Morpho -> String -> String
 morphoTextShort mo = unwords . map (prMorphoAnalysisShort . appMorpho mo) . words
+
+-- | analyse running text and show results on separate lines
+morphoText :: Morpho -> String -> String
 morphoText mo = unlines . map (('\n':) . prMorphoAnalysis . appMorpho mo) . words
 
 -- format used in the Italian Verb Engine

src/GF/UseGrammar/Paraphrases.hs

@@ -1,15 +1,19 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Paraphrases
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
--- (Description of the module)
+-- paraphrases of GF terms. AR 6\/10\/1998 -- 24\/9\/1999 -- 5\/7\/2000 -- 5\/6\/2002
+--
+-- Copyright (c) Aarne Ranta 1998--99, under GNU General Public License (see GPL)
+--
+-- thus inherited from the old GF. Incomplete and inefficient...
 -----------------------------------------------------------------------------
 
 module Paraphrases (mkParaphrases) where

src/GF/UseGrammar/Parsing.hs

@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Parsing
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.13 $
+-- > CVS $Revision: 1.14 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -132,7 +132,7 @@ trees2trms opts sg cn as ts0 info = do
 
 --- too much type checking in building term info? return FullTerm to save work?
 
--- raw parsing: so simple it is for a context-free CF grammar
+-- | raw parsing: so simple it is for a context-free CF grammar
 cf2trm0 :: CFTree -> C.Exp
 cf2trm0 (CFTree (fun, (_, trees))) = mkAppAtom (cffun2trm fun) (map cf2trm0 trees)
  where

src/GF/UseGrammar/Randomized.hs

@@ -1,15 +1,16 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Randomized
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
--- (Description of the module)
+-- random generation and refinement. AR 22\/8\/2001.
+-- implemented as sequence of refinement menu selecsions, encoded as integers
 -----------------------------------------------------------------------------
 
 module Randomized where
@@ -26,16 +27,17 @@ import Random --- (mkStdGen, StdGen, randoms) --- bad import for hbc
 -- random generation and refinement. AR 22/8/2001
 -- implemented as sequence of refinement menu selecsions, encoded as integers
 
+myStdGen :: Int -> StdGen
 myStdGen = mkStdGen ---
 
--- build one random tree; use mx to prevent infinite search
+-- | build one random tree; use mx to prevent infinite search
 mkRandomTree :: StdGen -> Int -> CGrammar -> Either Cat Fun -> Err Tree
 mkRandomTree gen mx gr cat = mkTreeFromInts (take mx (randoms gen)) gr cat
 
 refineRandom :: StdGen -> Int -> CGrammar -> Action
 refineRandom gen mx = mkStateFromInts $ take mx $ map abs (randoms gen)
 
--- build a tree from a list of integers
+-- | build a tree from a list of integers
 mkTreeFromInts :: [Int] -> CGrammar -> Either Cat Fun -> Err Tree
 mkTreeFromInts ints gr catfun = do
   st0   <- either (\cat -> newCat gr cat initState)

src/GF/UseGrammar/RealMoreCustom.hs

@@ -1,15 +1,19 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : MoreCustom
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
--- (Description of the module)
+-- databases for customizable commands. AR 21\/11\/2001
+--
+-- Extends "Custom".
+--
+-- obsolete???
 -----------------------------------------------------------------------------
 
 module MoreCustom where
@@ -53,6 +57,7 @@ import qualified TransPredCalc as PC
 -- databases for customizable commands. AR 21/11/2001
 -- Extends ../Custom.
 
+moreCustomGrammarParser :: CustomData (FilePath -> IOE C.CanonGrammar) 
 moreCustomGrammarParser = 
   [
    (strCIm "gfl",  S.parseGrammar . extractGFLatex)   
@@ -66,6 +71,7 @@ moreCustomGrammarParser =
   pAsGrammar p = err Bad (\g -> return (([],noOptions),g)) . p
 
 
+moreCustomGrammarPrinter :: CustomData (StateGrammar -> String)             
 moreCustomGrammarPrinter = 
   [
    (strCIm "happy",   cf2HappyS . stateCF)
@@ -84,8 +90,10 @@ moreCustomGrammarPrinter =
 --- also include printing via grammar2syntax!
   ]
 
+moreCustomMultiGrammarPrinter :: CustomData (CanonGrammar -> String)    
 moreCustomMultiGrammarPrinter = []
 
+moreCustomSyntaxPrinter  :: CustomData (GF.Grammar -> String)        
 moreCustomSyntaxPrinter = 
   [ 
     (strCIm "gf",    S.prSyntax) -- DEFAULT
@@ -93,28 +101,33 @@ moreCustomSyntaxPrinter =
 -- add your own grammar printers here
   ]
 
+moreCustomTermPrinter  :: CustomData (StateGrammar -> Tree -> String)
 moreCustomTermPrinter = 
   [ 
     (strCIm "xml",    \g t -> unlines $ prElementX $ term2elemx (stateAbstract g) t)
 -- add your own term printers here
   ]
 
+moreCustomTermCommand    :: CustomData (StateGrammar -> Tree -> [Tree])
 moreCustomTermCommand = 
   [
    (strCIm "predcalc",   \_ t -> PC.transfer t)
 -- add your own term commands here
   ]
 
+moreCustomEditCommand    :: CustomData (StateGrammar -> Action)
 moreCustomEditCommand = 
   [
 -- add your own edit commands here
   ]
 
+moreCustomStringCommand  :: CustomData (StateGrammar -> String -> String)
 moreCustomStringCommand = 
   [
 -- add your own string commands here
   ]
 
+moreCustomParser         :: CustomData (StateGrammar -> CFCat -> CFParser)
 moreCustomParser = 
   [
    (strCIm "chart",    chartParser . stateCF)
@@ -124,19 +137,23 @@ moreCustomParser =
 -- add your own parsers here
   ]
 
+moreCustomTokenizer      :: CustomData (StateGrammar -> String -> [CFTok])  
 moreCustomTokenizer = 
   [
 -- add your own tokenizers here
   ]
 
+moreCustomUntokenizer    :: CustomData (StateGrammar -> String -> String)  
 moreCustomUntokenizer = 
   [
 -- add your own untokenizers here
   ]
 
+moreCustomUniCoding :: CustomData (String -> String)
 moreCustomUniCoding = 
   [
 -- add your own codings here
   ]
 
+strCIm :: String -> CommandId
 strCIm = id

src/GF/UseGrammar/Session.hs

@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Session
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.7 $
+-- > CVS $Revision: 1.8 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -27,8 +27,11 @@ import Operations
 
 -- keep these abstract
 
-type SState = [(State,([Exp],[Clip]),SInfo)] -- exps: candidate refinements,clipboard
+-- | 'Exp'-list: candidate refinements,clipboard
-type SInfo  = ([String],(Int,Options))       -- string is message, int is the view
+type SState = [(State,([Exp],[Clip]),SInfo)] 
+
+-- | 'String' is message, 'Int' is the view
+type SInfo  = ([String],(Int,Options))       
 
 initSState :: SState
 initSState = [(initState, ([],[]), (["Select 'New' category to start"],(0,noOptions)))] 
@@ -36,8 +39,21 @@ initSState = [(initState, ([],[]), (["Select 'New' category to start"],(0,noOpti
 
 type Clip = Tree ---- (Exp,Type)
 
+-- | (peb): Something wrong with this definition??
+-- Shouldn't the result type be 'SInfo'?
+--
+-- > okInfo :: Int -> SInfo == ([String], (Int, Options))
+okInfo :: n -> ([s], (n, Bool))
 okInfo n = ([],(n,True))
 
+stateSState :: SState -> State
+candsSState :: SState -> [Exp]
+clipSState  :: SState -> [Clip]
+infoSState  :: SState -> SInfo
+msgSState   :: SState -> [String]
+viewSState  :: SState -> Int
+optsSState  :: SState -> Options
+
 stateSState ((s,_,_):_)     = s
 candsSState ((_,(ts,_),_):_)= ts
 clipSState  ((_,(_,ts),_):_)= ts
@@ -46,16 +62,17 @@ msgSState   ((_,_,(m,_)):_) = m
 viewSState  ((_,_,(_,(v,_))):_) = v
 optsSState  ((_,_,(_,(_,o))):_) = o
 
+treeSState :: SState -> Tree
 treeSState = actTree . stateSState
 
 
--- from state to state
+-- | from state to state
-
 type ECommand = SState -> SState
 
--- elementary commands
+-- * elementary commands
+
+-- ** change state, drop cands, drop message, preserve options
 
--- change state, drop cands, drop message, preserve options
 changeState :: State -> ECommand
 changeState s ss = changeMsg [] $ (s,([],clipSState ss),infoSState ss) : ss 
 
@@ -77,16 +94,18 @@ withMsg m c = changeMsg m . c
 changeStOptions :: (Options -> Options) -> ECommand
 changeStOptions f ((s,ts,(m,(v,o))):ss) = (s,ts,(m,(v, f o))) : ss
 
+noNeedForMsg :: ECommand
 noNeedForMsg = changeMsg [] -- everything's all right: no message
 
+candInfo :: [Exp] -> [String]
 candInfo ts = case length ts of
   0 -> ["no acceptable alternative"]
   1 -> ["just one acceptable alternative"]
   n -> [show n +++ "alternatives to select"]
 
--- keep SState abstract from this on
+-- * keep SState abstract from this on
 
--- editing commands
+-- ** editing commands
 
 action2command :: Action -> ECommand
 action2command act state = case act (stateSState state) of 

src/GF/UseGrammar/TeachYourself.hs

@@ -1,15 +1,17 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : TeachYourself
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:22 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
--- (Description of the module)
+-- translation and morphology quiz. AR 10\/5\/2000 -- 12\/4\/2002
+--
+-- outdated?? @shell\/TeachYourself@ is loaded instead of this...
 -----------------------------------------------------------------------------
 
 module TeachYourself where
@@ -75,6 +77,7 @@ mkAnswer as s = if (elem (norml s) as)
                    then (1,"Yes.") 
                    else (0,"No, not" +++ s ++ ", but" ++++ unlines as)
 
+norml :: String -> String
 norml = unwords . words
 
 --- the maximal number of precompiled quiz problems

src/GF/UseGrammar/Tokenize.hs

@@ -1,18 +1,28 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Tokenize
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:23 $ 
+-- > CVS $Date: 2005/02/24 11:46:39 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.9 $
+-- > CVS $Revision: 1.10 $
 --
--- (Description of the module)
+-- lexers = tokenizers, to prepare input for GF grammars. AR 4\/1\/2002.
+-- an entry for each is included in 'Custom.customTokenizer'
 -----------------------------------------------------------------------------
 
-module Tokenize where
+module Tokenize ( tokWords,
+		  tokLits,
+		  tokVars,
+		  lexHaskell,
+		  lexHaskellLiteral,
+		  lexHaskellVar,
+		  lexText,
+		  lexC2M, lexC2M',
+		  lexTextLiteral,
+		) where
 
 import Operations
 ---- import UseGrammar (isLiteral,identC)
@@ -23,8 +33,7 @@ import Char
 -- lexers = tokenizers, to prepare input for GF grammars. AR 4/1/2002
 -- an entry for each is included in Custom.customTokenizer
 
--- just words
+-- | just words
-
 tokWords :: String -> [CFTok]
 tokWords = map tS . words
 
@@ -61,15 +70,13 @@ mkTL :: String -> CFTok
 mkTL s = if (all isDigit s) then (tI s) else (tL ("'" ++ s ++ "'"))
 
 
--- Haskell lexer, usable for much code
+-- | Haskell lexer, usable for much code
-
 lexHaskell :: String -> [CFTok]
 lexHaskell ss = case lex ss of
   [(w@(_:_),ws)] -> tS w : lexHaskell ws
   _ -> []
 
--- somewhat shaky text lexer
+-- | somewhat shaky text lexer
-
 lexText :: String -> [CFTok]
 lexText = uncap . lx where
 
@@ -87,8 +94,7 @@ lexText = uncap . lx where
   uncap (TS (c:cs) : ws) = tC (c:cs) : ws
   uncap s = s
 
--- lexer for C--, a mini variant of C
+-- | lexer for C--, a mini variant of C
-
 lexC2M :: String -> [CFTok]
 lexC2M = lexC2M' False
 
@@ -125,7 +131,7 @@ reservedAnsiC s = case lookupTree show s ansiCtree of
   Ok False -> True 
   _ -> False
 
--- for an efficient lexer: precompile this!
+-- | for an efficient lexer: precompile this!
 ansiCtree = buildTree $ [(s,True)  | s <- reservedAnsiCSymbols] ++
                         [(s,False) | s <- reservedAnsiCWords]
 
@@ -140,8 +146,7 @@ reservedAnsiCWords = words $
     "union unsigned void volatile while " ++
     "main printin putchar"  --- these are not ansi-C
 
--- turn unknown tokens into string literals; not recursively for literals 123, 'foo'
+-- | turn unknown tokens into string literals; not recursively for literals 123, 'foo'
-
 unknown2string :: (String -> Bool) -> [CFTok] -> [CFTok]
 unknown2string isKnown = map mkOne where
   mkOne t@(TS s) 
@@ -162,6 +167,8 @@ unknown2var isKnown = map mkOne where
   mkOne t@(TC s) = if isKnown s then t else tV s
   mkOne t        = t
 
+lexTextLiteral, lexHaskellLiteral, lexHaskellVar :: (String -> Bool) -> String -> [CFTok]
+
 lexTextLiteral    isKnown = unknown2string (eitherUpper isKnown) . lexText
 lexHaskellLiteral isKnown = unknown2string isKnown . lexHaskell
 

src/GF/UseGrammar/Transfer.hs

@@ -1,15 +1,15 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : (Module)
+-- Module      : Transfer
--- Maintainer  : (Maintainer)
+-- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:23 $ 
+-- > CVS $Date: 2005/02/24 11:46:40 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
--- (Description of the module)
+-- linearize, parse, etc, by transfer. AR 9\/10\/2003
 -----------------------------------------------------------------------------
 
 module Transfer where

src/haddock/haddock-check.perl

@@ -21,9 +21,10 @@ $nonOperCharColon = qr/[^\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~\:]/;
 
 $operSym = qr/$operChar $operCharColon*/x;
 $funSym = qr/[a-z] \w* \'*/x;
+$funOrOper = qr/(?: $funSym | \($operSym\) )/x;
 
 $keyword = qr/(?: type | data | module | newtype | infix[lr]? | import | instance | class )/x;
-$keyOper = qr/^( ?: \.\. | \:\:? | \= | \\ | \| | \<\- | \-\> | \@ | \~ | \=\> | \. )$/x;
+$keyOper = qr/^(?: \.\. | \:\:? | \= | \\ | \| | \<\- | \-\> | \@ | \~ | \=\> | \. )$/x;
 
 sub check_headerline {
   my ($title, $regexp) = @_;
@@ -101,13 +102,13 @@ for $file (@FILES) {
     print "   > No export list\n";
 
     # function definitions
-    while (/^ (.*? $nonOperCharColon) = (?!$operCharColon)/gmx) {
+    while (/^ (.*? $nonOperCharColon) = (?! $operCharColon)/gmx) {
       $defn = $1;
       next if $defn =~ /^ $keyword \b/x;
 
       if ($defn =~ /\` ($funSym) \`/x) {
 	$fn = $1;
-      } elsif ($defn =~ /(?<!$operCharColon) ($operSym)/x
+      } elsif ($defn =~ /(?<! $operCharColon) ($operSym)/x
 	       && $1 !~ $keyOper) {
 	$fn = "($1)";
       } elsif ($defn =~ /^($funSym)/x) {
@@ -121,30 +122,29 @@ for $file (@FILES) {
     }
   }
 
-  # removing from export list...
+  # fixing exportlist (double spaces as separator)
+  $exportlist = " $exportlist ";
+  $exportlist =~ s/(\s | \,)+/  /gx;
 
-  # ...ordinary functions
+  # removing functions with type signatures from export list
-  while (/^ ($funSym) \s* ::/gmx) {
+  while (/^ ($funOrOper (\s* , \s* $funOrOper)*) \s* ::/gmx) {
-    $function = $1;
+    $functionlist = $1;
-    $exportlist =~ s/\b $function \b//gx;
+    while ($functionlist =~ s/^ ($funOrOper) (\s* , \s*)?//x) {
-  }
+      $function = $1;
-
+      $exportlist =~ s/\s \Q$function\E \s/ /gx;
-  # ...operations
+    }
-  while (/^ (\( $operSym \)) \s* ::/gmx) {
-    $function = $1;
-    $exportlist =~ s/\Q$function\E//g;
   }
 
   # reporting exported functions without type signatures
   $reported = 0;
-  while ($exportlist =~ /(\b $funSym \b | \( $operSym \))/gx) {
+  while ($exportlist =~ /\s ($funOrOper) \s/x) {
     $function = $1;
-    print "   > No type signature for function(s):"
+    $exportlist =~ s/\s \Q$function\E \s/ /gx;
-      unless $reported;
+    print "   > No type signature for function(s):\n    "
-    print "\n    " unless $reported++ % 500;
+      unless $reported++;
     print " $function";
   }
-  print "\n     ($reported functions)\n"
+  print "\n     $reported function(s)\n"
     if $reported;
 
 }