removed src for 2.9

10 files changed, 0 insertions, 1970 deletions

diff --git a/src/GF/Infra/CheckM.hs b/src/GF/Infra/CheckM.hs
deleted file mode 100644
index 251ed2b8b..000000000
--- a/src/GF/Infra/CheckM.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : CheckM
--- Maintainer  : (Maintainer)
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:33 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Infra.CheckM (Check,
-	       checkError, checkCond, checkWarn, checkUpdate, checkInContext,
-	       checkUpdates, checkReset, checkResets, checkGetContext, 
-	       checkLookup, checkStart, checkErr, checkVal, checkIn, 
-	       prtFail
-	      ) where
-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Grammar.PrGrammar
-
--- | the strings are non-fatal warnings
-type Check a = STM (Context,[String]) a
-
-checkError :: String -> Check a
-checkError = raise
-
-checkCond :: String -> Bool -> Check ()
-checkCond s b = if b then return () else checkError s
-
--- | warnings should be reversed in the end
-checkWarn :: String -> Check ()
-checkWarn s = updateSTM (\ (cont,msg) -> (cont, s:msg))
-
-checkUpdate :: Decl -> Check ()
-checkUpdate d = updateSTM (\ (cont,msg) -> (d:cont, msg))
-
-checkInContext :: [Decl] -> Check r -> Check r
-checkInContext g ch = do
-  i <- checkUpdates g
-  r <- ch
-  checkResets i
-  return r
-
-checkUpdates :: [Decl] -> Check Int
-checkUpdates ds = mapM checkUpdate ds >> return (length ds)
-
-checkReset :: Check ()
-checkReset = checkResets 1
-
-checkResets :: Int -> Check ()
-checkResets i = updateSTM (\ (cont,msg) -> (drop i cont, msg))
-
-checkGetContext :: Check Context
-checkGetContext = do
-  (co,_) <- readSTM
-  return co
-
-checkLookup :: Ident -> Check Type
-checkLookup x = do
-  co <- checkGetContext
-  checkErr $ maybe (prtBad "unknown variable" x) return $ lookup x co
-
-checkStart :: Check a -> Err (a,(Context,[String]))
-checkStart c = appSTM c ([],[])
-
-checkErr :: Err a -> Check a
-checkErr e = stm (\s -> do
-  v <- e
-  return (v,s)
-  )
-
-checkVal :: a -> Check a
-checkVal v = return v
-
-prtFail :: Print a => String -> a -> Check b
-prtFail s t = checkErr $ prtBad s t
-
-checkIn :: String -> Check a -> Check a
-checkIn msg c = stm $ \s@(g,ws) -> case appSTM c s of
-  Bad e -> Bad $ msg ++++ e
-  Ok (v,(g',ws')) -> Ok (v,(g',ws2)) where
-    new = take (length ws' - length ws) ws'
-    ws2 = [msg ++++ w | w <- new] ++ ws
diff --git a/src/GF/Infra/Comments.hs b/src/GF/Infra/Comments.hs
deleted file mode 100644
index 0126db468..000000000
--- a/src/GF/Infra/Comments.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Comments
--- Maintainer  : (Maintainer)
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:34 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
---
--- comment removal
------------------------------------------------------------------------------
-
-module GF.Infra.Comments ( remComments
-		) where
-
--- | comment removal : line tails prefixed by -- as well as chunks in @{- ... -}@
-remComments :: String -> String
-remComments s = 
-  case s of
-    '"':s2 -> '"':pass remComments s2 -- comment marks in quotes not removed!
-    '{':'-':cs -> readNested cs
-    '-':'-':cs -> readTail cs
-    c:cs -> c : remComments cs
-    [] -> []
-   where
-     readNested t = 
-       case t of
-         '"':s2 -> '"':pass readNested s2
-         '-':'}':cs -> remComments cs
-         _:cs -> readNested cs
-         [] -> []
-     readTail t = 
-       case t of
-         '\n':cs -> '\n':remComments cs
-         _:cs -> readTail cs
-         [] -> []
-     pass f t = 
-       case t of
-         '"':s2 -> '"': f s2
-         c:s2 -> c:pass f s2
-         _ -> t
diff --git a/src/GF/Infra/CompactPrint.hs b/src/GF/Infra/CompactPrint.hs
deleted file mode 100644
index 486c9e183..000000000
--- a/src/GF/Infra/CompactPrint.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module GF.Infra.CompactPrint where
-import Data.Char
-
-compactPrint = compactPrintCustom keywordGF (const False)
-
-compactPrintGFCC = compactPrintCustom (const False) keywordGFCC
-
-compactPrintCustom pre post = dps . concat . map (spaceIf pre post) . words 
-
-dps = dropWhile isSpace
-
-spaceIf pre post w = case w of
-  _ | pre w -> "\n" ++ w
-  _ | post w -> w ++ "\n"
-  c:_ | isAlpha c || isDigit c -> " " ++ w
-  '_':_  -> " " ++ w
-  _ -> w
-
-keywordGF w = elem w ["cat","fun","lin","lincat","lindef","oper","param"]
-keywordGFCC w = 
-  last w == ';' || 
-  elem w ["flags","fun","cat","lin","oper","lincat","lindef","printname","param"]
diff --git a/src/GF/Infra/Ident.hs b/src/GF/Infra/Ident.hs
deleted file mode 100644
index 5ed860990..000000000
--- a/src/GF/Infra/Ident.hs
+++ /dev/null
@@ -1,155 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Ident
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/15 11:43:33 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.8 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Infra.Ident (-- * Identifiers
-	      Ident(..), prIdent,
-	      identC, identV, identA, identAV, identW,
-	      argIdent, strVar, wildIdent, isWildIdent,
-	      newIdent, mkIdent, varIndex,
-	      -- * refreshing identifiers
-	      IdState, initIdStateN, initIdState,
-	      lookVar, refVar, refVarPlus
-	     ) where
-
-import GF.Data.Operations
--- import Monad
-
-
--- | the constructors labelled /INTERNAL/ are
--- internal representation never returned by the parser
-data Ident = 
-   IC String            -- ^ raw identifier after parsing, resolved in Rename
- | IW                   -- ^ wildcard
---
--- below this constructor: internal representation never returned by the parser
- | IV (Int,String)      -- ^ /INTERNAL/ variable
- | IA (String,Int)      -- ^ /INTERNAL/ argument of cat at position
- | IAV (String,Int,Int) -- ^ /INTERNAL/ argument of cat with bindings at position
--- 
-
-  deriving (Eq, Ord, Show, Read)
-
-prIdent :: Ident -> String
-prIdent i = case i of
-  IC s -> s
-  IV (n,s) -> s ++ "_" ++ show n
-  IA (s,j) -> s ++ "_" ++ show j
-  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)
-
--- normal identifier
--- 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 x = case x of
-  IW -> True
-  IC "_" -> True
-  _ -> False
-
-newIdent :: Ident
-newIdent = identC "#h"
-
-mkIdent :: String -> Int -> Ident
-mkIdent s i = identV (i,s)
-
-varIndex :: Ident -> Int
-varIndex (IV (n,_)) = n
-varIndex _ = -1 --- other than IV should not count
-
--- refreshing identifiers
-
-type IdState = ([(Ident,Ident)],Int) 
-
-initIdStateN :: Int -> IdState
-initIdStateN i = ([],i)
-
-initIdState :: IdState
-initIdState = initIdStateN 0
-
-lookVar :: Ident -> STM IdState Ident
-lookVar a@(IA _) = return a
-lookVar x = do
-  (sys,_) <- readSTM
-  stm (\s -> maybe (Bad ("cannot find" +++ show x +++ prParenth (show sys))) 
-                   return $ 
-             lookup x sys >>= (\y -> return (y,s)))
-
-refVar :: Ident -> STM IdState Ident
-----refVar IW = return IW --- no update of wildcard
-refVar x = do
-  (_,m) <- readSTM
-  let x' = IV (m, prIdent x)
-  updateSTM (\ (sys,mx) -> ((x, x'):sys, mx + 1))
-  return x'
-
-refVarPlus :: Ident -> STM IdState Ident
-----refVarPlus IW = refVar (identC "h")
-refVarPlus x = refVar x
-
-
-{-
-------------------------------
--- to test
-
-refreshExp :: Exp -> Err Exp
-refreshExp e = err Bad (return . fst) (appSTM (refresh e) initState)
-
-refresh :: Exp -> STM State Exp
-refresh e = case e of
-  Atom x  -> lookVar x >>= return . Atom
-  App f a -> liftM2 App (refresh f) (refresh a)
-  Abs x b -> liftM2 Abs (refVar x)  (refresh b)
-  Fun xs a b -> do
-    a'  <- refresh a
-    xs' <- mapM refVar xs
-    b'  <- refresh b
-    return $ Fun xs' a' b'
-
-data Exp =
-   Atom Ident
- | App Exp Exp
- | Abs Ident Exp
- | Fun [Ident] Exp Exp
-  deriving Show
-
-exp1 = Abs (IC "y") (Atom (IC "y"))
-exp2 = Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "y")))
-exp3 = Abs (IC "y") (Abs (IC "z") (App (Atom (IC "y")) (Atom (IC "z"))))
-exp4 = Abs (IC "y") (Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "z"))))
-exp5 = Abs (IC "y") (Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "y"))))
-exp6 = Abs (IC "y") (Fun [IC "x", IC "y"] (Atom (IC "y")) (Atom (IC "y")))
-exp7 = Abs (IL "8") (Atom (IC "y"))
-
--}
diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs
deleted file mode 100644
index 4d50608c6..000000000
--- a/src/GF/Infra/Modules.hs
+++ /dev/null
@@ -1,416 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Modules
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/09 15:14:30 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.26 $
---
--- Datastructures and functions for modules, common to GF and GFC.
---
--- AR 29\/4\/2003
---
--- The same structure will be used in both source code and canonical.
--- The parameters tell what kind of data is involved.
--- Invariant: modules are stored in dependency order
------------------------------------------------------------------------------
-
-module GF.Infra.Modules (
-		MGrammar(..), ModInfo(..), Module(..), ModuleType(..),
-		MReuseType(..), MInclude (..),
-		extends, isInherited,inheritAll, 
-                updateMGrammar, updateModule, replaceJudgements, addFlag,
-		addOpenQualif, flagsModule, allFlags, mapModules,
-		MainGrammar(..), MainConcreteSpec(..), OpenSpec(..), OpenQualif(..),
-		oSimple, oQualif,
-		ModuleStatus(..),
-		openedModule, allOpens, depPathModule, allDepsModule, partOfGrammar,
-		allExtends, allExtendSpecs, allExtendsPlus, allExtensions, 
-                searchPathModule, addModule,
-		emptyMGrammar, emptyModInfo, emptyModule,
-		IdentM(..),
-		typeOfModule, abstractOfConcrete, abstractModOfConcrete,
-		lookupModule, lookupModuleType, lookupModMod, lookupInfo,
-		allModMod, isModAbs, isModRes, isModCnc, isModTrans,
-		sameMType, isCompilableModule, isCompleteModule,
-		allAbstracts, greatestAbstract, allResources,
-		greatestResource, allConcretes, allConcreteModules
-	       ) where
-
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Data.Operations
-
-import Data.List
-
-
--- AR 29/4/2003
-
--- The same structure will be used in both source code and canonical.
--- The parameters tell what kind of data is involved.
--- Invariant: modules are stored in dependency order
-
-data MGrammar i f a = MGrammar {modules :: [(i,ModInfo i f a)]}
-  deriving Show
-
-data ModInfo i f a =
-    ModMainGrammar (MainGrammar i)
-  | ModMod  (Module i f a)
-  | ModWith (Module i f a) (i,MInclude i) [OpenSpec i]
-  deriving Show
-
-data Module i f a = Module {
-    mtype   :: ModuleType i ,
-    mstatus :: ModuleStatus ,
-    flags   :: [f] ,
-    extend  :: [(i,MInclude i)],
-    opens   :: [OpenSpec i] ,
-    jments  :: BinTree i a
-  }
----  deriving Show
-instance Show (Module i f a) where
-  show _ = "cannot show Module with FiniteMap"
-
--- | encoding the type of the module
-data ModuleType i = 
-    MTAbstract 
-  | MTTransfer (OpenSpec i) (OpenSpec i) 
-  | MTResource
-  | MTConcrete i
-    -- ^ up to this, also used in GFC. Below, source only.
-  | MTInterface
-  | MTInstance i 
-  | MTReuse (MReuseType i)
-  | MTUnion (ModuleType i) [(i,[i])] -- ^ not meant to be recursive
-  deriving (Eq,Show)
-
-data MReuseType i = MRInterface i | MRInstance i i | MRResource i
-  deriving (Show,Eq)
-
-data MInclude i = MIAll | MIOnly [i] | MIExcept [i]
-  deriving (Show,Eq)
-
-extends :: Module i f a -> [i]
-extends = map fst . extend
-
-isInherited :: Eq i => MInclude i -> i -> Bool
-isInherited c i = case c of
-  MIAll -> True
-  MIOnly is -> elem i is
-  MIExcept is -> notElem i is
-
-inheritAll :: i -> (i,MInclude i)
-inheritAll i = (i,MIAll)
-
--- destructive update
-
--- | dep order preserved since old cannot depend on new
-updateMGrammar :: Ord i => MGrammar i f a -> MGrammar i f a -> MGrammar i f a
-updateMGrammar old new = MGrammar $ 
-  [(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns
- where
-   os = modules old
-   ns = modules new
-
-updateModule :: Ord i => Module i f t -> i -> t -> Module i f t
-updateModule (Module  mt ms fs me ops js) i t = 
-  Module mt ms fs me ops (updateTree (i,t) js)
-
-replaceJudgements :: Module i f t -> BinTree i t -> Module i f t
-replaceJudgements (Module mt ms fs me ops _) js = Module mt ms fs me ops js
-
-addOpenQualif :: i -> i -> Module i f t -> Module i f t
-addOpenQualif i j (Module mt ms fs me ops js) = 
-  Module mt ms fs me (oQualif i j : ops) js
-
-addFlag :: f -> Module i f t -> Module i f t
-addFlag f mo = mo {flags = f : flags mo} 
-
-flagsModule :: (i,ModInfo i f a) -> [f]
-flagsModule (_,mi) = case mi of
-  ModMod m -> flags m
-  _ -> []
-
-allFlags :: MGrammar i f a -> [f]
-allFlags gr = concat $ map flags $ [m | (_, ModMod m) <- modules gr]
-
-mapModules :: (Module i f a -> Module i f a) 
-	   -> MGrammar i f a -> MGrammar i f a 
-mapModules f = MGrammar . map (onSnd mapModules') . modules
-    where mapModules' (ModMod m) = ModMod (f m)
-	  mapModules' m = m
-
-data MainGrammar i = MainGrammar {
-    mainAbstract  :: i ,
-    mainConcretes :: [MainConcreteSpec i]
-  }
-  deriving Show
-
-data MainConcreteSpec i = MainConcreteSpec {
-    concretePrintname :: i ,
-    concreteName :: i ,
-    transferIn   :: Maybe (OpenSpec i) ,  -- ^ if there is an in-transfer
-    transferOut  :: Maybe (OpenSpec i)    -- ^ if there is an out-transfer
-  }
-  deriving Show
-
-data OpenSpec i = 
-   OSimple OpenQualif i 
- | OQualif OpenQualif i i
-  deriving (Eq,Show)
-
-data OpenQualif =
-   OQNormal
- | OQInterface
- | OQIncomplete
-  deriving (Eq,Show)
-
-oSimple :: i -> OpenSpec i
-oSimple = OSimple OQNormal
-
-oQualif :: i -> i -> OpenSpec i
-oQualif = OQualif OQNormal
-
-data ModuleStatus = 
-   MSComplete 
- | MSIncomplete 
-  deriving (Eq,Show)
-
-openedModule :: OpenSpec i -> i
-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
-
--- | initial dependency list
-depPathModule :: Ord i => Module i f a -> [OpenSpec i]
-depPathModule m = fors m ++ exts m ++ opens m where
-  fors m = case mtype m of
-    MTTransfer i j -> [i,j]
-    MTConcrete i   -> [oSimple i]
-    MTInstance i   -> [oSimple i]
-    _              -> []
-  exts m = map oSimple $ extends m
-
--- | all dependencies
-allDepsModule :: Ord i => MGrammar i f a -> Module i f a -> [OpenSpec i]
-allDepsModule gr m = iterFix add os0 where
-  os0 = depPathModule m
-  add os = [m | o <- os, Just (ModMod n) <- [lookup (openedModule o) mods], 
-                m <- depPathModule n]
-  mods = modules gr
-
--- | select just those modules that a given one depends on, including itself
-partOfGrammar :: Ord i => MGrammar i f a -> (i,ModInfo i f a) -> MGrammar i f a
-partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor] 
-  where
-    mods = modules gr
-    modsFor = case m of
-      ModMod n -> (i:) $ map openedModule $ allDepsModule gr n
-      ---- ModWith n i os -> i : map openedModule os ++ partOfGrammar (ModMod n) ----
-      _ -> [i]
-
--- | all modules that a module extends, directly or indirectly, without restricts
-allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
-allExtends gr i = case lookupModule gr i of
-  Ok (ModMod m) -> case extends m of 
-    [] -> [i]
-    is -> i : concatMap (allExtends gr) is
-  _ -> []
-
--- | all modules that a module extends, directly or indirectly, with restricts
-allExtendSpecs :: (Show i,Ord i) => MGrammar i f a -> i -> [(i,MInclude i)]
-allExtendSpecs gr i = case lookupModule gr i of
-  Ok (ModMod m) -> case extend m of 
-    [] -> [(i,MIAll)]
-    is -> (i,MIAll) : concatMap (allExtendSpecs gr . fst) is
-  _ -> []
-
--- | this plus that an instance extends its interface
-allExtendsPlus :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
-allExtendsPlus gr i = case lookupModule gr i of
-  Ok (ModMod m) -> i : concatMap (allExtendsPlus gr) (exts m)
-  _ -> []
- where
-   exts m = extends m ++ [j | MTInstance j <- [mtype m]]
-
--- | conversely: all modules that extend a given module, incl. instances of interface
-allExtensions :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
-allExtensions gr i = case lookupModule gr i of
-  Ok (ModMod m) -> let es = exts i in es ++ concatMap (allExtensions gr) es
-  _ -> []
- where
-   exts i = [j | (j,m) <- mods, elem i (extends m) 
-                             || elem (MTInstance i) [mtype m]]
-   mods = [(j,m) | (j,ModMod m) <- modules gr]
-
--- | initial search path: the nonqualified dependencies
-searchPathModule :: Ord i => Module i f a -> [i]
-searchPathModule m = [i | OSimple _ i <- depPathModule m]
-
--- | a new module can safely be added to the end, since nothing old can depend on it
-addModule :: Ord i => 
-             MGrammar i f a -> i -> ModInfo i f a -> MGrammar i f a
-addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
-
-emptyMGrammar :: MGrammar i f a
-emptyMGrammar = MGrammar []
-
-emptyModInfo :: ModInfo i f a
-emptyModInfo = ModMod emptyModule
-
-emptyModule :: Module i f a
-emptyModule = Module MTResource MSComplete [] [] [] emptyBinTree
-
--- | we store the module type with the identifier
-data IdentM i = IdentM {
-  identM :: i ,
-  typeM  :: ModuleType i
-  }
-  deriving (Eq,Show)
-
-typeOfModule :: ModInfo i f a -> ModuleType i
-typeOfModule mi = case mi of
-  ModMod m -> mtype m
-
-abstractOfConcrete :: (Show i, Eq i) => MGrammar i f a -> i -> Err i
-abstractOfConcrete gr c = do
-  m <- lookupModule gr c
-  case m of
-    ModMod n -> case mtype n of
-      MTConcrete a -> return a
-      _ -> Bad $ "expected concrete" +++ show c
-    _ -> Bad $ "expected concrete" +++ show c
-
-abstractModOfConcrete :: (Show i, Eq i) => 
-                         MGrammar i f a -> i -> Err (Module i f a)
-abstractModOfConcrete gr c = do
-  a <- abstractOfConcrete gr c
-  m <- lookupModule gr a
-  case m of
-    ModMod n -> return n
-    _ -> Bad $ "expected abstract" +++ show c
-
-
--- the canonical file name
-
---- canonFileName s = prt s ++ ".gfc"
-
-lookupModule :: (Show i,Eq i) => MGrammar i f a -> i -> Err (ModInfo i f a)
-lookupModule gr m = case lookup m (modules gr) of
-  Just i -> return i
-  _ -> Bad $ "unknown module" +++ show m 
-             +++ "among" +++ unwords (map (show . fst) (modules gr)) ---- debug
-
-lookupModuleType :: (Show i,Eq i) => MGrammar i f a -> i -> Err (ModuleType i)
-lookupModuleType gr m = do
-  mi <- lookupModule gr m
-  return $ typeOfModule mi
-
-lookupModMod :: (Show i,Eq i) => MGrammar i f a -> i -> Err (Module i f a)
-lookupModMod gr i = do
-  mo <- lookupModule gr i
-  case mo of 
-    ModMod m -> return m
-    _ -> Bad $ "expected proper module, not" +++ show i
-
-lookupInfo :: (Show i, Ord i) => Module i f a -> i -> Err a
-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
-----  MTUnion t -> isModRes t --- maybe not needed, since eliminated early
-  MTInterface -> True ---
-  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 (n,m) of
-  (MTConcrete _, MTConcrete _) -> True
-
-  (MTInstance _, MTInstance _) -> True
-  (MTInstance _, MTResource)   -> True
-  (MTInstance _, MTConcrete _) -> True
-
-  (MTInterface,  MTInstance _) -> True
-  (MTInterface,  MTResource)   -> True    -- for reuse
-  (MTInterface,  MTAbstract)   -> True    -- for reuse
-
-  (MTResource,   MTInstance _) -> True
-  (MTResource,   MTConcrete _) -> True    -- for reuse
-
-  _ -> 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
-    _ -> mstatus m == MSComplete
-  _ -> False ---
-
--- | interface and "incomplete M" are not complete
-isCompleteModule :: (Eq i) =>  Module i f a -> Bool
-isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
-
-
--- | all abstract modules sorted from least to most dependent
-allAbstracts :: Eq i => MGrammar i f a -> [i]
-allAbstracts gr = topoSort 
-  [(i,extends m) | (i,ModMod m) <- modules gr, mtype m == MTAbstract]
-
--- | the last abstract in dependency order (head of list)
-greatestAbstract :: Eq i => MGrammar i f a -> Maybe i
-greatestAbstract gr = case allAbstracts gr of
-  [] -> Nothing
-  as -> return $ last as
-
--- | all resource modules
-allResources :: MGrammar i f a -> [i]
-allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
-
--- | the greatest resource in dependency order
-greatestResource :: MGrammar i f a -> Maybe i
-greatestResource gr = case allResources gr of
-  [] -> Nothing
-  a -> return $ head a
-
--- | all concretes for a given abstract
-allConcretes :: Eq i => MGrammar i f a -> i -> [i]
-allConcretes gr a = 
-  [i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
-
--- | all concrete modules for any abstract
-allConcreteModules :: Eq i => MGrammar i f a -> [i]
-allConcreteModules gr = 
-  [i | (i, ModMod m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
deleted file mode 100644
index a44cd9db8..000000000
--- a/src/GF/Infra/Option.hs
+++ /dev/null
@@ -1,375 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Option
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/14 16:03:41 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.34 $
---
--- Options and flags used in GF shell commands and files.
---
--- The types 'Option' and 'Options' should be kept abstract, but:
---
---   - The constructor 'Opt' is used in "ShellCommands" and "GrammarToSource"
---
---   - The constructor 'Opts' us udes in "API", "Shell" and "ShellCommands"
------------------------------------------------------------------------------
-
-module GF.Infra.Option where
-
-import Data.List (partition)
-import Data.Char (isDigit)
-
--- * 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)
-
-noOptions :: Options
-noOptions = Opts []
-
--- | simple option -o
-iOpt :: String -> Option
-iOpt o = Opt (o,[])   
-
--- | option with argument -o=a
-aOpt :: String -> String -> Option
-aOpt o a = Opt (o,[a])  
-
-iOpts :: [Option] -> Options
-iOpts = Opts
-
--- | value of option argument
-oArg :: String -> String
-oArg s = s 
-
-oElem :: Option -> Options -> Bool
-oElem o (Opts os) = elem o os
-
-eqOpt :: String -> Option -> Bool
-eqOpt s (Opt (o, [])) = s == o
-eqOpt s _ = False
-
-type OptFun = String -> Option
-type OptFunId = String
-
-getOptVal :: Options -> OptFun -> Maybe String
-getOptVal (Opts os) fopt = 
-  case [a | opt@(Opt (o,[a])) <- os, opt == fopt a] of
-    a:_ -> Just a
-    _ -> Nothing
-
-isSetFlag :: Options -> OptFun -> Bool
-isSetFlag (Opts os) fopt = 
-  case [a | opt@(Opt (o,[a])) <- os, opt == fopt a] of
-    a:_ -> True
-    _ -> False
-
-getOptInt :: Options -> OptFun -> Maybe Int
-getOptInt opts f = do
-  s <- getOptVal opts f
-  if (not (null s) && all isDigit s) then return (read s) else Nothing 
-
-optIntOrAll :: Options -> OptFun -> [a] -> [a]
-optIntOrAll opts f = case getOptInt opts f of
-  Just i -> take i
-  _ -> id
-
-optIntOrN :: Options -> OptFun -> Int -> Int
-optIntOrN opts f n = case getOptInt opts f of
-  Just i -> i
-  _ -> n
-
-optIntOrOne :: Options -> OptFun -> Int
-optIntOrOne opts f = optIntOrN opts f 1
-
-changeOptVal :: Options -> OptFun -> String -> Options
-changeOptVal os f x = 
-  addOption (f x) $ maybe os (\y -> removeOption (f y) os) $ getOptVal os f
-
-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
-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. \"-\")
-
-getOptions :: String -> [String] -> (Options, [String])
-getOptions pre inp = let
-  (os,rest) = span (isOption pre) inp -- options before args
-  in
-  (Opts (map (pOption pre) os), rest)
-
-pOption :: String -> String -> Option
-pOption pre s = case span (/= '=') (drop (length pre) s) of
-  (f,_:a) -> aOpt f a
-  (o,[])  -> iOpt o
-
-isOption :: String -> String -> Bool
-isOption pre = (==pre) . take (length pre)
-
--- * 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
-
--- ** parsing
-
-strictParse, forgiveParse, ignoreParse, literalParse, rawParse, firstParse :: Option
--- | parse as term instead of string
-dontParse :: Option
-
-strictParse  = iOpt "strict"
-forgiveParse = iOpt "n"
-ignoreParse  = iOpt "ign"
-literalParse = iOpt "lit"
-rawParse     = iOpt "raw"
-firstParse   = iOpt "1"
-dontParse    = iOpt "read" 
-
-newParser, newerParser, newCParser, newMParser :: Option
-newParser   = iOpt "new"
-newerParser = iOpt "newer"
-newCParser  = iOpt "cfg"
-newMParser  = iOpt "mcfg"
-newFParser  = iOpt "fcfg"
-
-{-
-useParserMCFG, useParserMCFGviaCFG, useParserCFG, useParserCF :: Option
-
-useParserMCFG = iOpt "mcfg"
-useParserMCFGviaCFG = iOpt "mcfg-via-cfg"
-useParserCFG = iOpt "cfg"
-useParserCF = iOpt "cf"
--}
-
--- ** grammar formats
-
-showAbstr, showXML, showOld, showLatex, showFullForm,
-  showEBNF, showCF, showWords, showOpts,
-  isCompiled, isHaskell, noCompOpers, retainOpers,
-  noCF, checkCirc, noCheckCirc, lexerByNeed, useUTF8id :: Option
-defaultGrOpts :: [Option]
-
-showAbstr   = iOpt "abs"
-showXML     = iOpt "xml"
-showOld     = iOpt "old"
-showLatex   = iOpt "latex"
-showFullForm = iOpt "fullform" 
-showEBNF    = iOpt "ebnf"
-showCF      = iOpt "cf"
-showWords   = iOpt "ws"
-showOpts    = iOpt "opts"
--- showOptim   = iOpt "opt"
-isCompiled  = iOpt "gfc"
-isHaskell   = iOpt "gfhs"
-noCompOpers = iOpt "nocomp"
-retainOpers = iOpt "retain"
-defaultGrOpts = []
-noCF        = iOpt "nocf"
-checkCirc   = iOpt "nocirc"
-noCheckCirc = iOpt "nocheckcirc"
-lexerByNeed = iOpt "cflexer"
-useUTF8id   = iOpt "utf8id"
-elimSubs    = iOpt "subs"
-
--- ** 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"
-dontLin     = iOpt "show"
-showRecord  = iOpt "record"
-showStruct  = iOpt "structured"
-xmlLin      = showXML
-latexLin    = showLatex
-tableLin    = iOpt "table"
-defaultLinOpts = [firstLin]
-useUTF8     = iOpt "utf8"
-showLang    = iOpt "lang"
-showDefs    = iOpt "defs"
-withMetas   = iOpt "metas"
-
--- ** 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"
-invertGrep   = iOpt "v" --- same letter in unix
-showInfo     = iOpt "i"
-beSilent     = iOpt "s"
-emitCode     = iOpt "o"
-getHelp      = iOpt "help"
-doMake       = iOpt "make"
-doBatch      = iOpt "batch"
-notEmitCode  = iOpt "noemit"
-makeMulti    = iOpt "multi"
-beShort      = iOpt "short"
-wholeGrammar = iOpt "w"
-makeFudget   = iOpt "f"
-byLines      = iOpt "lines"
-byWords      = iOpt "words"
-analMorpho   = iOpt "morpho"
-doTrace      = iOpt "tr"
-noCPU        = iOpt "nocpu"
-doCompute    = iOpt "c"
-optimizeCanon = iOpt "opt"
-optimizeValues = iOpt "val"
-stripQualif   = iOpt "strip"
-nostripQualif = iOpt "nostrip"
-showAll      = iOpt "all"
-showFields   = iOpt "fields"
-showMulti    = iOpt "multi"
-fromSource   = iOpt "src"
-makeConcrete = iOpt "examples"
-fromExamples = iOpt "ex"
-openEditor   = iOpt "edit"
-getTrees     = iOpt "trees"
-
--- ** 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
-
-allLangs, absView :: Option
-
-allLangs  = iOpt "All"
-absView   = iOpt "Abs"
-
--- ** 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"
--- useStrategy    = aOpt "strategy" -- parsing strategy
-withFun        = aOpt "fun"
-firstCat       = aOpt "cat"      
-gStartCat      = aOpt "startcat" 
-useLanguage    = aOpt "lang"
-useResource    = aOpt "res"
-speechLanguage = aOpt "language"
-useFont        = aOpt "font"
-grammarFormat  = aOpt "format"
-grammarPrinter = aOpt "printer"
-filterString   = aOpt "filter"
-termCommand    = aOpt "transform"
-transferFun    = aOpt "transfer"
-forForms       = aOpt "forms"
-menuDisplay    = aOpt "menu"
-sizeDisplay    = aOpt "size"
-typeDisplay    = aOpt "types"
-noDepTypes     = aOpt "nodeptypes"
-extractGr      = aOpt "extract"
-pathList       = aOpt "path"
-uniCoding      = aOpt "coding"
-probFile       = aOpt "probs"
-noparseFile    = aOpt "noparse"
-usePreprocessor = aOpt "preproc"
-
--- peb 16/3-05:
-gfcConversion :: String -> Option
-gfcConversion  = aOpt "conversion"
-
-useName, useAbsName, useCncName, useResName, 
-  useFile, useOptimizer :: String -> Option
-
-useName        = aOpt "name"
-useAbsName     = aOpt "abs"
-useCncName     = aOpt "cnc"
-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"
-markOptStruct  = oArg "struct"
-markOptFocus   = oArg "focus"
-
-
--- ** refinement order
-
-nextRefine :: String -> Option
-firstRefine, lastRefine :: String
-
-nextRefine  = aOpt "nextrefine"
-firstRefine = oArg "first"
-lastRefine  = oArg "last"
-
--- ** Boolean flags
-
-flagYes, flagNo :: String
-
-flagYes = oArg "yes"
-flagNo  = oArg "no"
-
--- ** integer flags
-
-flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees :: String -> Option
-
-flagDepth  = aOpt "depth"
-flagAlts   = aOpt "alts"
-flagLength = aOpt "length"
-flagNumber = aOpt "number"
-flagRawtrees = aOpt "rawtrees"
-
-caseYesNo :: Options -> OptFun -> Maybe Bool
-caseYesNo opts f = do
-  v <- getOptVal opts f
-  if v == flagYes   then return True
-     else if v == flagNo then return False
-     else Nothing
diff --git a/src/GF/Infra/Print.hs b/src/GF/Infra/Print.hs
deleted file mode 100644
index 17f2c2188..000000000
--- a/src/GF/Infra/Print.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/06/17 14:15:18 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
---
--- Pretty-printing
------------------------------------------------------------------------------
-
-module GF.Infra.Print
-    (module GF.Infra.PrintClass
-    ) where
-
--- haskell modules:
-import Data.Char (toUpper)
--- gf modules:
-
-import GF.Infra.PrintClass
-import GF.Data.Operations (Err(..))
-import GF.Infra.Ident (Ident(..))
-import GF.Canon.AbsGFC
-import GF.CF.CF
-import GF.CF.CFIdent
-import qualified GF.Canon.PrintGFC as P
-
-------------------------------------------------------------
-
-----------------------------------------------------------------------
-
-instance Print Ident where
-    prt = P.printTree 
-
-instance Print Term where
-    prt (Arg arg)         = prt arg
-    prt (con `Par` [])    = prt con
-    prt (con `Par` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
-    prt (LI ident)        = "$" ++ prt ident
-    prt (R record)        = "{" ++ prtSep "; " record ++ "}"
-    prt (term `P` lbl)    = prt term ++ "." ++ prt lbl
-    prt (T _ table)       = "table{" ++ prtSep "; " table ++ "}"
-    prt (V _ terms)       = "values{" ++ prtSep "; " terms ++ "}"
-    prt (term `S` sel)    = "(" ++ prt term ++ " ! " ++ prt sel ++ ")"
-    prt (FV terms)        = "variants{" ++ prtSep " | " terms ++ "}"
-    prt (term `C` term')  = prt term ++ "  " ++ prt term'
-    prt (EInt n)          = prt n
-    prt (K tokn)          = show (prt tokn)
-    prt (E)               = show ""
-
-instance Print Patt where
-    prt (con `PC` [])     = prt con
-    prt (con `PC` pats)   = prt con ++ "(" ++ prtSep "," pats ++ ")"
-    prt (PV ident)        = "$" ++ prt ident
-    prt (PW)              = "_"
-    prt (PR record)       = "{" ++ prtSep ";" record ++ "}"
-
-instance Print Label where
-    prt (L ident)          = prt ident
-    prt (LV nr)            = "$" ++ show nr
-
-instance Print Tokn where
-    prt (KS str)          = str
-    prt tokn@(KP _ _)     = show tokn
-
-instance Print ArgVar where
-    prt (A cat argNr)     = prt cat ++ "#" ++ show argNr
-
-instance Print CIdent where
-    prt (CIQ _ ident)     = prt ident
-
-instance Print Case where
-    prt (pats `Cas` term) = prtSep "|" pats ++ "=>" ++ prt term
-
-instance Print Assign where
-    prt (lbl `Ass` term)  = prt lbl ++ "=" ++ prt term
-
-instance Print PattAssign where
-    prt (lbl `PAss` pat)  = prt lbl ++ "=" ++ prt pat
-
-instance Print Atom where
-    prt (AC c) = prt c
-    prt (AD c) = "<" ++ prt c ++ ">"
-    prt (AV i) = "$" ++ prt i
-    prt (AM n) = "?" ++ show n
-    prt atom   = show atom
-
-instance Print CType where
-    prt (RecType rtype) = "{" ++ prtSep "; " rtype ++ "}"
-    prt (Table ptype vtype) = "(" ++ prt ptype ++ " => " ++ prt vtype ++ ")"
-    prt (Cn cn) = prt cn
-    prt (TStr) = "Str"
-
-instance Print Labelling where
-    prt (lbl `Lbg` ctype) = prt lbl ++ ":" ++ prt ctype
-
-instance Print CFItem where
-    prt (CFTerm regexp) = prt regexp
-    prt (CFNonterm cat) = prt cat
-
-instance Print RegExp where
-    prt (RegAlts words) = "("++prtSep "|" words ++ ")"
-    prt (RegSpec tok) = prt tok
-
-instance Print CFTok where
-    prt (TS str) = str
-    prt (TC (c:str)) = '(' : toUpper c : ')' : str
-    prt (TL str) = show str
-    prt (TI n) = "#" ++ show n
-    prt (TV x) = "$" ++ prt x
-    prt (TM n s) = "?" ++ show n ++ s
-
-instance Print CFCat where
-    prt (CFCat (cid,lbl)) = prt cid ++ "-" ++ prt lbl
-
-instance Print CFFun where 
-    prt (CFFun fun) = prt (fst fun)
-
-instance Print Exp where
-    prt = P.printTree
-
-instance Print a => Print (Err a) where
-    prt (Ok a) = prt a
-    prt (Bad str) = str
-
diff --git a/src/GF/Infra/PrintClass.hs b/src/GF/Infra/PrintClass.hs
deleted file mode 100644
index 5e94984a6..000000000
--- a/src/GF/Infra/PrintClass.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-module GF.Infra.PrintClass where
-
-import Data.List (intersperse)
-
-class Print a where
-    prt :: a -> String
-    prtList :: [a] -> String
-    prtList as = "[" ++ prtSep "," as ++ "]"
-
-prtSep :: Print a => String -> [a] -> String
-prtSep sep = concat . intersperse sep . map prt
-
-prtBefore :: Print a => String -> [a] -> String
-prtBefore before = prtBeforeAfter before ""
-
-prtAfter :: Print a => String -> [a] -> String
-prtAfter after = prtBeforeAfter "" after
-
-prtBeforeAfter :: Print a => String -> String -> [a] -> String
-prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
-
-prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String
-prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ]
-prIO :: Print a => a -> IO ()
-prIO = putStr . prt
-
-instance Print a => Print [a] where
-    prt = prtList
-
-instance (Print a, Print b) => Print (a, b) where
-    prt (a, b) = "(" ++ prt a ++ "," ++ prt b ++ ")"
-
-instance (Print a, Print b, Print c) => Print (a, b, c) where
-    prt (a, b, c) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ ")"
-
-instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where
-    prt (a, b, c, d) = "(" ++ prt a ++ "," ++ prt b ++ "," ++ prt c ++ "," ++ prt d ++ ")"
-
-instance Print Char where
-    prt = return
-    prtList = id
-
-instance Print Int where
-    prt = show
-
-instance Print Integer where
-    prt = show
-
-instance Print a => Print (Maybe a) where
-    prt (Just a) = prt a
-    prt Nothing  = "Nothing"
diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs
deleted file mode 100644
index ce33ec23f..000000000
--- a/src/GF/Infra/ReadFiles.hs
+++ /dev/null
@@ -1,362 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : ReadFiles
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/11 23:24:34 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.26 $
---
--- Decide what files to read as function of dependencies and time stamps.
---
--- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004
---
--- to find all files that have to be read, put them in dependency order, and
--- decide which files need recompilation. Name @file.gf@ is returned for them,
--- and @file.gfc@ or @file.gfr@ otherwise.
------------------------------------------------------------------------------
-
-module GF.Infra.ReadFiles (-- * Heading 1
-		  getAllFiles,fixNewlines,ModName,getOptionsFromFile,
-		  -- * Heading 2
-		  gfcFile,gfFile,gfrFile,isGFC,resModName,isOldFile
-		 ) where
-
-import GF.System.Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
-
-import GF.Infra.Option
-import GF.Data.Operations
-import GF.Infra.UseIO
-
-import System
-import Data.Char
-import Control.Monad
-import Data.List
-import System.Directory
-import System.FilePath
-
-type ModName = String
-type ModEnv  = [(ModName,ModTime)]
-
-getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
-getAllFiles opts ps env file = do
-
-  -- read module headers from all files recursively
-  ds0  <- getImports ps file
-  let ds = [((snd m,map fst ms),p) | ((m,ms),p) <- ds0]
-  if oElem beVerbose opts 
-    then ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
-    else return ()
-    -- get a topological sorting of files: returns file names --- deletes paths
-  ds1 <- ioeErr $ either 
-           return 
-           (\ms -> Bad $ "circular modules" +++ 
-                     unwords (map show (head ms))) $ topoTest $ map fst ds
-
-  -- associate each file name with its path --- more optimal: save paths in ds1
-  let paths = [(f,p) | ((f,_),p) <- ds]
-  let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]]
-  if oElem fromSource opts 
-    then return [gfFile (p </> f) | (p,f) <- pds1]
-    else do
-
-
-    ds2 <- ioeIO $ mapM (selectFormat opts env) pds1
-
-    let ds4 = needCompile opts (map fst ds0) ds2
-    return ds4
-
--- to decide whether to read gf or gfc, or if in env; returns full file path
-
-data CompStatus =
-   CSComp -- compile: read gf
- | CSRead -- read gfc
- | CSEnv  -- gfc is in env
- | CSEnvR -- also gfr is in env
- | CSDont -- don't read at all
- | CSRes  -- read gfr
-  deriving (Eq,Show)
-
--- for gfc, we also return ModTime to cope with earlier compilation of libs
-
-selectFormat :: Options -> ModEnv -> (InitPath,ModName) -> 
-                IO (ModName,(InitPath,(CompStatus,Maybe ModTime)))
-
-selectFormat opts env (p,f) = do
-  let pf = p </> f
-  let mtenv = lookup f env   -- Nothing if f is not in env
-  let rtenv = lookup (resModName f) env
-  let fromComp = oElem isCompiled opts -- i -gfc
-  mtgfc <- getModTime $ gfcFile pf
-  mtgf  <- getModTime $ gfFile pf
-  let stat = case (rtenv,mtenv,mtgfc,mtgf) of
---        (_,Just tenv,_,_)        | fromComp -> (CSEnv, Just tenv)
-        (_,_,Just tgfc,_)        | fromComp -> (CSRead,Just tgfc)
---        (Just tenv,_,_,Just tgf) | laterModTime tenv tgf -> (CSEnvR,Just tenv)
---        (_,Just tenv,_,Just tgf) | laterModTime tenv tgf -> (CSEnv, Just tenv)
-        (_,_,Just tgfc,Just tgf) | laterModTime tgfc tgf -> 
-          case mtenv of 
---            Just tenv | laterModTime tenv tgfc -> (CSEnv,Just tenv)
-            _ -> (CSRead,Just tgfc)
-
-
---        (_,Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist
-        (_,_,_,        Nothing) -> (CSRead,Nothing)  -- source does not exist
-        _ -> (CSComp,Nothing)
-  return $ (f, (p,stat))
-
-needCompile :: Options -> 
-               [ModuleHeader] -> 
-               [(ModName,(InitPath,(CompStatus,Maybe ModTime)))] -> [FullPath]
-needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
-
-  deps = [(snd m,map fst ms) | (m,ms) <- headers]
-  typ m = maybe MTyOther id $ lookup m [(m,t) | ((t,m),_) <- headers]
-  uses m = [(n,u) | ((_,n),ms) <- headers, (k,u) <- ms, k==m]
-  stat0 m = maybe CSComp (fst . snd) $ lookup m sfiles0
-
-  allDeps = [(m,iterFix add ms) | (m,ms) <- deps] where
-    add os = [m | o <- os, Just n <- [lookup o deps],m <- n]
-
-  -- only treat reused, interface, or instantiation if needed
-  sfiles = sfiles0 ---- map relevant sfiles0
-  relevant fp@(f,(p,(st,_))) = 
-    let us = uses f
-        isUsed = not (null us)
-    in
-    if not (isUsed && all noComp us) then
-      fp else 
-    if (elem (typ f) [] ---- MTyIncomplete, MTyIncResource]
-        || 
-        (isUsed && all isAux us)) then
-      (f,(p,(CSDont,Nothing))) else
-      fp
-
-  isAux = flip elem [MUReuse,MUInstance,MUComplete] . snd
-  noComp = flip elem [CSRead,CSEnv,CSEnvR] . stat0 . fst
-
-  -- mark as to be compiled those whose gfc is earlier than a deeper gfc
-  sfiles1 = map compTimes sfiles
-  compTimes fp@(f,(p,(_, Just t))) =
-    if any (> t) [t' | Just fs <- [lookup f deps], 
-                       f0 <- fs,
-                       Just (_,(_,Just t')) <- [lookup f0 sfiles]]
-    then (f,(p,(CSComp, Nothing)))
-    else fp
-  compTimes fp = fp
-
-  -- start with the changed files themselves; returns [ModName]
-  changed = [f | (f,(_,(CSComp,_))) <- sfiles1] 
-
-  -- add other files that depend on some changed file; returns [ModName]
-  iter np = let new = [f | (f,fs) <- deps, 
-                           not (elem f np), any (flip elem np) fs]
-            in  if null new then np else (iter (new ++ np))
-
-  -- for each module in the full list, compile if depends on what needs compile
-  -- returns [FullPath]
-  mark cs = [(f,(path,st)) | 
-                (f,(path,(st0,_))) <- sfiles1, 
-                let st = if (elem f cs) then CSComp else st0]
-
-
-  -- if a compilable file depends on a resource, read gfr instead of gfc/env
-  -- but don't read gfr if already in env (by CSEnvR)
-  -- Also read res if the option "retain" is present
-  -- Also, if a "with" file has to be compiled, read its mother file from source
-
-  res cs = map mkRes cs where
-    mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
-      t | (not (null [m | (m,(_,CSComp)) <- cs,
-                                   Just ms <- [lookup m allDeps], elem f ms])
-                    || oElem retainOpers opts)
-        -> if elem t [MTyResource,MTyIncResource] 
-           then (f,(path,CSRes)) else
-              if t == MTyIncomplete
-              then (f,(path,CSComp)) else
-              x
-      _ -> x
-    mkRes x = x
-
-
-
-  -- construct list of paths to read
-  paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]]
-
-  mkName f p st = mk (p </> f) where
-    mk = case st of
-      CSComp -> gfFile
-      CSRead -> gfcFile
-      CSRes  -> gfrFile
-
-isGFC :: FilePath -> Bool
-isGFC = (== ".gfc") . takeExtensions
-
-gfcFile :: FilePath -> FilePath
-gfcFile f = addExtension f "gfc"
-
-gfrFile :: FilePath -> FilePath
-gfrFile f = addExtension f "gfr"
-
-gfFile :: FilePath -> FilePath
-gfFile f = addExtension f "gf"
-
-resModName :: ModName -> ModName
-resModName = ('#':)
-
--- to get imports without parsing the whole files
-
-getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)]
-getImports ps = get [] where
-  get ds file0 = do
-    let name = dropExtension file0 ---- dropExtension file0
-    (p,s) <- tryRead name
-    let ((typ,mname),imps) = importsOfFile s
-    let namebody = takeFileName name
-    ioeErr $ testErr  (mname == namebody) $ 
-             "module name" +++ mname +++ "differs from file name" +++ namebody
-    case imps of
-      _ | elem name (map (snd . fst . fst) ds) -> return ds  --- file already read
-      [] -> return $ (((typ,name),[]),p):ds
-      _ -> do
-        let files = map (gfFile . fst) imps 
-        foldM get ((((typ,name),imps),p):ds) files
-  tryRead name = do
-    file <- do
-      let file_gf = gfFile name
-      b <- doesFileExistPath ps file_gf                 -- try gf file first
-      if b then return file_gf else do
-        let file_gfr = gfrFile name
-        bb <- doesFileExistPath ps file_gfr             -- gfr file next
-        if bb then return file_gfr else do
-          return (gfcFile name)                         -- gfc next
-
-    readFileIfPath ps $ file
-
-
-
--- internal module dep information
-
-data ModUse =
-   MUReuse
- | MUInstance
- | MUComplete
- | MUOther
-  deriving (Eq,Show)
-
-data ModTyp =
-   MTyResource
- | MTyIncomplete
- | MTyIncResource -- interface, incomplete resource
- | MTyOther
-  deriving (Eq,Show)
-
-type ModuleHeader = ((ModTyp,ModName),[(ModName,ModUse)])
-
-importsOfFile :: String -> ModuleHeader
-importsOfFile = 
-  getModuleHeader .          -- analyse into mod header
-  filter (not . spec) .      -- ignore keywords and special symbols
-  unqual .                   -- take away qualifiers
-  unrestr .                  -- take away union restrictions
-  takeWhile (not . term) .   -- read until curly or semic
-  lexs .                     -- analyse into lexical tokens
-  unComm                     -- ignore comments before the headed line
- where
-    term = flip elem ["{",";"]
-    spec = flip elem ["of", "open","in",":", "->","=", "-","(", ")",",","**","union"]
-    unqual ws = case ws of
-      "(":q:ws' -> unqual ws'
-      w:ws' -> w:unqual ws'
-      _ -> ws
-    unrestr ws = case ws of
-      "[":ws' -> unrestr $ tail $ dropWhile (/="]") ws'
-      w:ws' -> w:unrestr ws'
-      _ -> ws
-
-getModuleHeader :: [String] -> ModuleHeader -- with, reuse
-getModuleHeader ws = case ws of
-  "incomplete":ws2 -> let ((ty,name),us) = getModuleHeader ws2 in
-    case ty of
-      MTyResource -> ((MTyIncResource,name),us)
-      _ -> ((MTyIncomplete,name),us)
-  "interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
-    ((MTyIncResource,name),us)
- 
-  "resource":name:ws2 -> case ws2 of
-    "reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
-    m:"with":ms -> ((MTyResource,name),(m,MUOther):[(n,MUComplete) | n <- ms])
-    ms -> ((MTyResource,name),[(n,MUOther) | n <- ms])
-
-  "instance":name:m:ws2 -> case ws2 of
-    "reuse":n:_ -> ((MTyResource,name),(m,MUInstance):[(n,MUReuse)])
-    n:"with":ms -> 
-      ((MTyResource,name),(m,MUInstance):(n,MUComplete):[(n,MUOther) | n <- ms])
-    ms -> ((MTyResource,name),(m,MUInstance):[(n,MUOther) | n <- ms])
-
-  "concrete":name:a:ws2 -> case span (/= "with") ws2 of
-
-    (es,_:ms) -> ((MTyOther,name),
-                  [(m,MUOther)    | m <- es] ++
-                  [(n,MUComplete) | n <- ms])
-    --- m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
-    (ms,[]) -> ((MTyOther,name),[(n,MUOther) | n <- a:ms])
-
-  _:name:ws2 -> case ws2 of
-    "reuse":m:_ -> ((MTyOther,name),[(m,MUReuse)])
-    ---- m:n:"with":ms -> 
-    ----  ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
-    m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
-    ms -> ((MTyOther,name),[(n,MUOther) | n <- ms])
-  _ -> error "the file is empty"
-
-unComm s = case s of
-      '-':'-':cs -> unComm $ dropWhile (/='\n') cs
-      '{':'-':cs -> dpComm cs
-      c:cs -> c : unComm cs
-      _ -> s
-    
-dpComm s = case s of
-      '-':'}':cs -> unComm cs
-      c:cs -> dpComm cs
-      _ -> s
-    
-lexs s = x:xs where 
-      (x,y) = head $ lex s
-      xs = if null y then [] else lexs y
-
--- | options can be passed to the compiler by comments in @--#@, in the main file
-getOptionsFromFile ::  FilePath -> IO Options
-getOptionsFromFile file = do
-  s <- readFileIfStrict file
-  let ls = filter (isPrefixOf "--#") $ lines s
-  return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
-
--- | check if old GF file
-isOldFile :: FilePath -> IO Bool
-isOldFile f = do
-  s <- readFileIfStrict f
-  let s' = unComm s
-  return $ not (null s') && old (head (words s'))
- where
-   old = flip elem $ words 
-     "cat category data def flags fun include lin lincat lindef lintype oper param pattern printname rule"
-
-
-
--- | old GF tolerated newlines in quotes. No more supported!
-fixNewlines :: String -> String
-fixNewlines s = case s of
-     '"':cs -> '"':mk cs
-     c  :cs -> c:fixNewlines cs
-     _ -> s
- where
-   mk s = case s of
-     '\\':'"':cs -> '\\':'"': mk cs
-     '"'     :cs -> '"' :fixNewlines cs
-     '\n'    :cs -> '\\':'n': mk cs
-     c       :cs -> c : mk cs
-     _ -> s 
-
diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs
deleted file mode 100644
index 4125a0417..000000000
--- a/src/GF/Infra/UseIO.hs
+++ /dev/null
@@ -1,330 +0,0 @@
-{-# OPTIONS -cpp #-}
-----------------------------------------------------------------------
--- |
--- Module      : UseIO
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/08/08 09:01:25 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.17 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Infra.UseIO where
-
-import GF.Data.Operations
-import GF.System.Arch (prCPU)
-import GF.Infra.Option
-import GF.Today (libdir)
-
-import System.Directory
-import System.IO
-import System.IO.Error
-import System.Environment
-import System.FilePath
-import Control.Monad
-
-#ifdef mingw32_HOST_OS
-import System.Win32.DLL
-import Foreign.Ptr
-#endif
-
-
-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)
-         else return ()
-
--- | obsolete with IOE monad
-errIO :: a -> Err a -> IO a
-errIO = errOptIO noOptions
-
-errOptIO :: Options -> a -> Err a -> IO a
-errOptIO os e m = case m of
-  Ok x  -> return x
-  Bad k -> do  
-    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 ()
-
-putPoint :: Show a => Options -> String -> IO a -> IO a
-putPoint = putPoint' id
-
-putPoint' :: Show a => (c -> a) -> Options -> String -> IO c -> IO c
-putPoint' f opts msg act = do
-  let sil x = if oElem beSilent opts then return () else x
-      ve  x = if oElem beVerbose opts then x else return ()
-  ve $ putStrLn msg
-  a <- act
-  ve $ putShow' f a
-  ve $ putCPU
-  return a
-
-readFileStrict :: String -> IO String
-readFileStrict f = do
-  s <- readFile f
-  return $ seq (length s) ()
-  return s
-
-readFileIf = readFileIfs readFile
-readFileIfStrict  = readFileIfs readFileStrict
-
-readFileIfs rf f = catch (rf f) (\_ -> reportOn f) where
- reportOn f = do
-   putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string")
-   return ""
-
-type FileName = String
-type InitPath = String
-type FullPath = String
-
-getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
-getFilePath ps file = do
-  getFilePathMsg ("file" +++ file +++ "not found\n") ps file
-
-getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath)
-getFilePathMsg msg paths file = get paths where
-  get []     = putStrFlush msg >> return Nothing
-  get (p:ps) = do
-    let pfile = p </> file
-    exist <- doesFileExist pfile
-    if exist then return (Just pfile) else get ps
----               catch (readFileStrict pfile >> return (Just pfile)) (\_ -> get ps)
-
-readFileIfPath :: [FilePath] -> String -> IOE (FilePath,String)
-readFileIfPath paths file = do
-  mpfile <- ioeIO $ getFilePath paths file
-  case mpfile of
-    Just pfile -> do
-      s <- ioeIO $ readFileStrict pfile
-      return (dropFileName pfile,s)
-    _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.")
-
-doesFileExistPath :: [FilePath] -> String -> IOE Bool
-doesFileExistPath paths file = do
-  mpfile <- ioeIO $ getFilePathMsg "" paths file
-  return $ maybe False (const True) mpfile
-
-gfLibraryPath    = "GF_LIB_PATH"
-
--- | environment variable for grammar search path
-gfGrammarPathVar = "GF_GRAMMAR_PATH"
-
-getLibraryPath :: IO FilePath
-getLibraryPath =
-  catch
-    (getEnv gfLibraryPath)
-#ifdef mingw32_HOST_OS
-    (\_ -> do exepath <- getModuleFileName nullPtr
-              let (path,_) = splitFileName exepath
-              canonicalizePath (combine path "../lib"))
-#else
-    (const (return libdir))
-#endif
-
--- | extends the search path with the
--- 'gfLibraryPath' and 'gfGrammarPathVar'
--- environment variables. Returns only existing paths.
-extendPathEnv :: [FilePath] -> IO [FilePath]
-extendPathEnv ps = do
-  b <- getLibraryPath                             -- e.g. GF_LIB_PATH
-  s <- catch (getEnv gfGrammarPathVar) (const (return ""))     -- e.g. GF_GRAMMAR_PATH
-  let ss = ps ++ splitSearchPath s
-  liftM concat $ mapM allSubdirs $ ss ++ [b </> s | s <- ss ++ ["prelude"]]
-  where
-    allSubdirs :: FilePath -> IO [FilePath]
-    allSubdirs [] = return [[]]
-    allSubdirs p = case last p of
-      '*' -> do let path = init p
-                fs <- getSubdirs path
-                return [path </> f | f <- fs]
-      _   -> do exists <- doesDirectoryExist p
-                if exists
-                  then return [p]
-                  else return []
-
-getSubdirs :: FilePath -> IO [FilePath]
-getSubdirs dir = do
-  fs  <- catch (getDirectoryContents dir) (const $ return [])
-  foldM (\fs f -> do let fpath = dir </> f
-                     p <- getPermissions fpath
-                     if searchable p && not (take 1 f==".")
-                       then return (fpath:fs)
-                       else return        fs ) [] fs
-
-justModuleName :: FilePath -> String
-justModuleName = dropExtension . takeFileName
-
-splitInModuleSearchPath :: String -> [FilePath]
-splitInModuleSearchPath s = case break isPathSep s of
-  (f,_:cs) -> f : splitInModuleSearchPath cs
-  (f,_)    -> [f]
-  where
-    isPathSep :: Char -> Bool
-    isPathSep c = c == ':' || c == ';'
-
---
-
-getLineWell :: IO String -> IO String
-getLineWell ios = 
-  catch getLine (\e -> if (isEOFError e) then ios else ioError e)
-
-putStrFlush :: String -> IO ()
-putStrFlush s = putStr s >> hFlush stdout
-
-putStrLnFlush :: String -> IO ()
-putStrLnFlush s = putStrLn s >> hFlush stdout
-
--- * a generic quiz session
-
-type QuestionsAndAnswers = [(String, String -> (Integer,String))]
-
-teachDialogue :: QuestionsAndAnswers -> String -> IO ()
-teachDialogue qas welc = do
-  putStrLn $ welc ++++ genericTeachWelcome
-  teach (0,0) qas
- where 
-    teach _ [] = do putStrLn "Sorry, ran out of problems"
-    teach (score,total) ((question,grade):quas) = do
-      putStr ("\n" ++ question ++ "\n> ") 
-      answer <- getLine
-      if (answer == ".") then return () else do
-        let (result, feedback) = grade answer
-            score' = score + result 
-            total' = total + 1
-        putStr (feedback ++++ "Score" +++ show score' ++ "/" ++ show total')
-        if (total' > 9 && fromInteger score' / fromInteger total' >= 0.75)
-           then do putStrLn "\nCongratulations - you passed!"
-           else teach (score',total') quas
-
-    genericTeachWelcome = 
-      "The quiz is over when you have done at least 10 examples" ++++
-      "with at least 75 % success." +++++
-      "You can interrupt the quiz by entering a line consisting of a dot ('.').\n"
-
-
--- * IO monad with error; adapted from state monad
-
-newtype IOE a = IOE (IO (Err a))
-
-appIOE :: IOE a -> IO (Err a)
-appIOE (IOE iea) = iea
-
-ioe :: IO (Err a) -> IOE a
-ioe = IOE
-
-ioeIO :: IO a -> IOE a
-ioeIO io = ioe (io >>= return . return)
-
-ioeErr :: Err a -> IOE a
-ioeErr = ioe . return 
-
-instance  Monad IOE where
-  return a    = ioe (return (return a))
-  IOE c >>= f = IOE $ do 
-                  x <- c          -- Err a
-                  appIOE $ err ioeBad f x         -- f :: a -> IOE a
-
-ioeBad :: String -> IOE a
-ioeBad = ioe . return . Bad
-
-useIOE :: a -> IOE a -> IO a
-useIOE a ioe = appIOE ioe >>= err (\s -> putStrLn s >> return a) return 
-
-foldIOE :: (a -> b -> IOE a) -> a -> [b] -> IOE (a, Maybe String)
-foldIOE f s xs = case xs of
-  [] -> return (s,Nothing)
-  x:xx -> do
-    ev <- ioeIO $ appIOE (f s x) 
-    case ev of 
-      Ok v  -> foldIOE f v xx
-      Bad m -> return $ (s, Just m)
-
-putStrLnE :: String -> IOE ()
-putStrLnE = ioeIO . putStrLnFlush 
-
-putStrE :: String -> IOE ()
-putStrE = ioeIO . putStrFlush 
-
--- this is more verbose
-putPointE :: Options -> String -> IOE a -> IOE a
-putPointE = putPointEgen (oElem beSilent)
-
--- this is less verbose
-putPointEsil :: Options -> String -> IOE a -> IOE a
-putPointEsil = putPointEgen (not . oElem beVerbose)
-
-putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
-putPointEgen cond opts msg act = do
-  let ve x = if cond opts then return () else x
-  ve $ ioeIO $ putStrFlush msg
-  a <- act
----  ve $ ioeIO $ putShow' id a --- replace by a statistics command
-  ve $ ioeIO $ putStrFlush " "
-  ve $ ioeIO $ putCPU
-  return a
-{-
-putPointE :: Options -> String -> IOE a -> IOE a
-putPointE opts msg act = do
-  let ve x = if oElem beVerbose opts then x else return ()
-  ve $ putStrE msg
-  a <- act
----  ve $ ioeIO $ putShow' id a --- replace by a statistics command
-  ve $ ioeIO $ putCPU
-  return a
--}
-
--- | forces verbosity
-putPointEVerb :: Options -> String -> IOE a -> IOE a
-putPointEVerb opts = putPointE (addOption beVerbose opts)
-
--- ((do {s <- readFile f; return (return s)}) ) 
-readFileIOE :: FilePath -> IOE (String)
-readFileIOE f = ioe $ catch (readFileStrict f >>= return . return)
-                            (\e -> return (Bad (show e)))
-
--- | like readFileIOE but look also in the GF library if file not found
---
--- intended semantics: if file is not found, try @\$GF_LIB_PATH\/file@
--- (even if file is an absolute path, but this should always fail)
--- it returns not only contents of the file, but also the path used
-readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String)
-readFileLibraryIOE ini f = ioe $ do
-  lp <- getLibraryPath
-  tryRead ini $ \_ ->
-    tryRead lp  $ \e ->
-      return (Bad (show e))
-  where
-    tryRead path onError =
-      catch (readFileStrict fpath >>= \s -> return (return (fpath,s)))
-            onError
-      where
-        fpath = path </> f
-
--- | example
-koeIOE :: IO ()
-koeIOE = useIOE () $ do
-  s  <- ioeIO  $ getLine
-  s2 <- ioeErr $ mapM (!? 2) $ words s
-  ioeIO $ putStrLn s2
-