summaryrefslogtreecommitdiff
path: root/src/GF/UseGrammar
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/UseGrammar')
-rw-r--r--src/GF/UseGrammar/Custom.hs67
-rw-r--r--src/GF/UseGrammar/Editing.hs50
-rw-r--r--src/GF/UseGrammar/Generate.hs25
-rw-r--r--src/GF/UseGrammar/GetTree.hs12
-rw-r--r--src/GF/UseGrammar/Information.hs25
-rw-r--r--src/GF/UseGrammar/Linear.hs56
-rw-r--r--src/GF/UseGrammar/MoreCustom.hs21
-rw-r--r--src/GF/UseGrammar/Morphology.hs25
-rw-r--r--src/GF/UseGrammar/Paraphrases.hs14
-rw-r--r--src/GF/UseGrammar/Parsing.hs10
-rw-r--r--src/GF/UseGrammar/Randomized.hs16
-rw-r--r--src/GF/UseGrammar/RealMoreCustom.hs27
-rw-r--r--src/GF/UseGrammar/Session.hs43
-rw-r--r--src/GF/UseGrammar/TeachYourself.hs13
-rw-r--r--src/GF/UseGrammar/Tokenize.hs41
-rw-r--r--src/GF/UseGrammar/Transfer.hs10
16 files changed, 279 insertions, 176 deletions
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index 47c3edb6c..4b12dba1a 100644
--- 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 =
diff --git a/src/GF/UseGrammar/Editing.hs b/src/GF/UseGrammar/Editing.hs
index 155c26ba7..3e6ed0018 100644
--- 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 =
diff --git a/src/GF/UseGrammar/Generate.hs b/src/GF/UseGrammar/Generate.hs
index 3a816b7c6..7242bb595 100644
--- 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
diff --git a/src/GF/UseGrammar/GetTree.hs b/src/GF/UseGrammar/GetTree.hs
index 1b47c3148..b755ec7f3 100644
--- 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
diff --git a/src/GF/UseGrammar/Information.hs b/src/GF/UseGrammar/Information.hs
index 9c1b29eb1..ea94d1270 100644
--- 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
diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs
index a4835cc8c..4b2a4d9bb 100644
--- 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
diff --git a/src/GF/UseGrammar/MoreCustom.hs b/src/GF/UseGrammar/MoreCustom.hs
index 872f888cd..27dffcace 100644
--- 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 = []
diff --git a/src/GF/UseGrammar/Morphology.hs b/src/GF/UseGrammar/Morphology.hs
index 135546680..62aeb7725 100644
--- 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
diff --git a/src/GF/UseGrammar/Paraphrases.hs b/src/GF/UseGrammar/Paraphrases.hs
index b4132c607..2946c3625 100644
--- 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
diff --git a/src/GF/UseGrammar/Parsing.hs b/src/GF/UseGrammar/Parsing.hs
index 72b65b7df..4ed16b7d4 100644
--- 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
diff --git a/src/GF/UseGrammar/Randomized.hs b/src/GF/UseGrammar/Randomized.hs
index 26ef5d032..d893e663b 100644
--- 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)
diff --git a/src/GF/UseGrammar/RealMoreCustom.hs b/src/GF/UseGrammar/RealMoreCustom.hs
index f0e4a9a1e..86cb2623d 100644
--- 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
diff --git a/src/GF/UseGrammar/Session.hs b/src/GF/UseGrammar/Session.hs
index b2414bdf8..6e27d4971 100644
--- 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
diff --git a/src/GF/UseGrammar/TeachYourself.hs b/src/GF/UseGrammar/TeachYourself.hs
index d09c33514..d27f92c14 100644
--- 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
diff --git a/src/GF/UseGrammar/Tokenize.hs b/src/GF/UseGrammar/Tokenize.hs
index 97cce8546..cfbf8c8df 100644
--- 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
diff --git a/src/GF/UseGrammar/Transfer.hs b/src/GF/UseGrammar/Transfer.hs
index d9823df58..d0ac42688 100644
--- 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
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 20:23:24 +0000