"Committed_by_peb"

2026-04-26 21:12:50 -06:00 · 2005-02-24 10:46:37 +00:00
parent d669e538d6
commit 59b378a4e5
43 changed files with 786 additions and 493 deletions
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -1,15 +1,28 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Custom
+-- 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
-- ** additions are made to the end of the database
+--  - no databases may be empty
+--  - 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 = 
--- a/src/GF/UseGrammar/Editing.hs
+++ b/src/GF/UseGrammar/Editing.hs
@@ -1,15 +1,16 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Editing
+-- 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 = 
--- a/src/GF/UseGrammar/Generate.hs
+++ b/src/GF/UseGrammar/Generate.hs
@@ -1,24 +1,30 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Generate
+-- 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
-
--- if type were shown more modules should be imported
-- generateTrees :: 
-- GFCGrammar -> Bool -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
+-- | the main function takes an abstract syntax and returns a list of trees
+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
--- a/src/GF/UseGrammar/GetTree.hs
+++ b/src/GF/UseGrammar/GetTree.hs
@@ -1,15 +1,17 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : GetTree
+-- 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
--- a/src/GF/UseGrammar/Information.hs
+++ b/src/GF/UseGrammar/Information.hs
@@ -1,18 +1,20 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Information
+-- 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
--- a/src/GF/UseGrammar/Linear.hs
+++ b/src/GF/UseGrammar/Linear.hs
@@ -1,15 +1,15 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Linear
+-- 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
--- a/src/GF/UseGrammar/MoreCustom.hs
+++ b/src/GF/UseGrammar/MoreCustom.hs
@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : MoreCustom
+-- 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 = []
--- a/src/GF/UseGrammar/Morphology.hs
+++ b/src/GF/UseGrammar/Morphology.hs
@@ -1,15 +1,20 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Morphology
+-- 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
--- a/src/GF/UseGrammar/Paraphrases.hs
+++ b/src/GF/UseGrammar/Paraphrases.hs
@@ -1,15 +1,19 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Paraphrases
+-- 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
--- a/src/GF/UseGrammar/Parsing.hs
+++ b/src/GF/UseGrammar/Parsing.hs
@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Parsing
+-- 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
--- a/src/GF/UseGrammar/Randomized.hs
+++ b/src/GF/UseGrammar/Randomized.hs
@@ -1,15 +1,16 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Randomized
+-- 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)
--- a/src/GF/UseGrammar/RealMoreCustom.hs
+++ b/src/GF/UseGrammar/RealMoreCustom.hs
@@ -1,15 +1,19 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : MoreCustom
+-- 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
--- a/src/GF/UseGrammar/Session.hs
+++ b/src/GF/UseGrammar/Session.hs
@@ -1,13 +1,13 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Session
+-- 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
-type SInfo  = ([String],(Int,Options))       -- string is message, int is the view
+-- | 'Exp'-list: candidate refinements,clipboard
+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 
--- a/src/GF/UseGrammar/TeachYourself.hs
+++ b/src/GF/UseGrammar/TeachYourself.hs
@@ -1,15 +1,17 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : TeachYourself
+-- 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
--- a/src/GF/UseGrammar/Tokenize.hs
+++ b/src/GF/UseGrammar/Tokenize.hs
@@ -1,18 +1,28 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Tokenize
+-- 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

--- a/src/GF/UseGrammar/Transfer.hs
+++ b/src/GF/UseGrammar/Transfer.hs
@@ -1,15 +1,15 @@
 ----------------------------------------------------------------------
 -- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
+-- Module      : Transfer
+-- 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