"Committed_by_peb"

4 files changed, 120 insertions, 122 deletions

diff --git a/src/GF/Infra/Ident.hs b/src/GF/Infra/Ident.hs
index b805e551f..2589357ef 100644
--- a/src/GF/Infra/Ident.hs
+++ b/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
diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs
index cabba0c3b..ac903e8ec 100644
--- a/src/GF/Infra/Modules.hs
+++ b/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
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index af2f53735..bac3aac6d 100644
--- a/src/GF/Infra/Option.hs
+++ b/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
-	       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
+module Option 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
-gStartCat      = aOpt "startcat" -- used in grammar, to avoid clash w res word
+firstCat       = aOpt "cat"      
+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"
diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs
index 5d4c147e0..51dfc71e8 100644
--- a/src/GF/Infra/UseIO.hs
+++ b/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,
-	      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
+module UseIO 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))