remove all files that aren't used in GF-3.0

16 files changed, 0 insertions, 4332 deletions

diff --git a/src-3.0/GF/Compile/CheckGrammar.hs b/src-3.0/GF/Compile/CheckGrammar.hs
deleted file mode 100644
index b33d11017..000000000
--- a/src-3.0/GF/Compile/CheckGrammar.hs
+++ /dev/null
@@ -1,1078 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : CheckGrammar
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/11 23:24:33 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.31 $
---
--- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
---
--- type checking also does the following modifications:
---
---  - types of operations and local constants are inferred and put in place
---
---  - both these types and linearization types are computed
---
---  - tables are type-annotated
------------------------------------------------------------------------------
-
-module GF.Compile.CheckGrammar (
-  showCheckModule, justCheckLTerm, allOperDependencies, topoSortOpers) where
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Modules
-import GF.Grammar.Refresh ----
-
-import GF.Grammar.TypeCheck
-import GF.Grammar.Values (cPredefAbs) ---
-
-import GF.Grammar.PrGrammar
-import GF.Grammar.Lookup
-import GF.Grammar.LookAbs
-import GF.Grammar.Macros
-import GF.Grammar.ReservedWords ----
-import GF.Grammar.PatternMatch
-import GF.Grammar.AppPredefined
-import GF.Grammar.Lockfield (isLockLabel)
-
-import GF.Data.Operations
-import GF.Infra.CheckM
-
-import Data.List
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Control.Monad
-import Debug.Trace ---
-
-
-showCheckModule :: [SourceModule] -> SourceModule -> Err ([SourceModule],String)
-showCheckModule mos m = do
-  (st,(_,msg)) <- checkStart $ checkModule mos m
-  return (st, unlines $ reverse msg)
-
--- | checking is performed in the dependency order of modules
-checkModule :: [SourceModule] -> SourceModule -> Check [SourceModule]
-checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of
-
-  ModMod mo@(Module mt st fs me ops js) -> do
-    checkRestrictedInheritance ms (name, mo)
-    js' <- case mt of
-      MTAbstract -> mapMTree (checkAbsInfo gr name) js
-
-      MTTransfer a b -> mapMTree (checkAbsInfo gr name) js
-
-      MTResource -> mapMTree (checkResInfo gr name) js
-
-      MTConcrete a -> do
-        checkErr $ topoSortOpers $ allOperDependencies name js
-        ModMod abs <- checkErr $ lookupModule gr a
-        js1 <- checkCompleteGrammar abs mo
-        mapMTree (checkCncInfo gr name (a,abs)) js1
-
-      MTInterface -> mapMTree (checkResInfo gr name) js
-
-      MTInstance a -> do
-        ModMod abs <- checkErr $ lookupModule gr a
-        -- checkCompleteInstance abs mo -- this is done in Rebuild
-        mapMTree (checkResInfo gr name) js
-
-    return $ (name, ModMod (Module mt st fs me ops js')) : ms
-
-  _ -> return $ (name,mod) : ms
- where
-   gr  = MGrammar $ (name,mod):ms
-
--- check if restricted inheritance modules are still coherent
--- i.e. that the defs of remaining names don't depend on omitted names
----checkRestrictedInheritance :: [SourceModule] -> SourceModule -> Check ()
-checkRestrictedInheritance mos (name,mo) = do
-  let irs = [ii | ii@(_,mi) <- extend mo, mi /= MIAll]  -- names with restr. inh.
-  let mrs = [((i,m),mi) | (i,ModMod m) <- mos, Just mi <- [lookup i irs]] 
-                             -- the restr. modules themself, with restr. infos
-  mapM_ checkRem mrs
- where
-   checkRem ((i,m),mi) = do
-     let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m)))
-     let incld c   = Set.member c (Set.fromList incl)
-     let illegal c = Set.member c (Set.fromList excl)
-     let illegals = [(f,is) | 
-           (f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)]
-     case illegals of 
-       [] -> return ()
-       cs -> fail $ "In inherited module" +++ prt i ++
-               ", dependence of excluded constants:" ++++
-               unlines ["  " ++ prt f +++ "on" +++ unwords (map prt is) | 
-                              (f,is) <- cs]
-   allDeps = ---- transClosure $ Map.fromList $ 
-             concatMap (allDependencies (const True)) 
-                              [jments m | (_,ModMod m) <- mos]
-   transClosure ds = ds ---- TODO: check in deeper modules
-
--- | check if a term is typable
-justCheckLTerm :: SourceGrammar -> Term -> Err Term
-justCheckLTerm src t = do
-  ((t',_),_) <- checkStart (inferLType src t)
-  return t'
-
-checkAbsInfo :: SourceGrammar -> Ident -> (Ident,Info) -> Check (Ident,Info)
-checkAbsInfo st m (c,info) = do
----- checkReservedId c
- case info of
-   AbsCat (Yes cont) _ -> mkCheck "category" $ 
-     checkContext st cont ---- also cstrs
-   AbsFun (Yes typ0) md -> do
-    typ <- compAbsTyp [] typ0   -- to calculate let definitions
-    mkCheck "type of function" $ checkTyp st typ 
-    md' <- case md of
-       Yes d -> do
-         let d' = elimTables d
-         mkCheckWarn "definition of function" $ checkEquation st (m,c) d'
-         return $ Yes d'
-       _ -> return md
-    return $ (c,AbsFun (Yes typ) md')
-   _ -> return (c,info)
- where
-   mkCheck cat ss = case ss of
-     [] -> return (c,info)
-     ["[]"] -> return (c,info) ----
-     _  -> checkErr $ prtBad (unlines ss ++++ "in" +++ cat) c
-   ---- temporary solution when tc of defs is incomplete
-   mkCheckWarn cat ss = case ss of
-     [] -> return (c,info)
-     ["[]"] -> return (c,info) ----
-     _  -> checkWarn (unlines ss ++++ "in" +++ cat +++ prt c) >> return (c,info)
-   compAbsTyp g t = case t of
-     Vr x -> maybe (fail ("no value given to variable" +++ prt x)) return $ lookup x g
-     Let (x,(_,a)) b -> do
-       a' <- compAbsTyp g a
-       compAbsTyp ((x, a'):g) b
-     Prod x a b -> do
-       a' <- compAbsTyp g a
-       b' <- compAbsTyp ((x,Vr x):g) b
-       return $ Prod x a' b'
-     Abs _ _ -> return t
-     _ -> composOp (compAbsTyp g) t
-
-   elimTables e = case e of
-     S t a  -> elimSel (elimTables t) (elimTables a)
-     T _ cs -> Eqs [(elimPatt p, elimTables t) | (p,t) <- cs]
-     _ -> composSafeOp elimTables e
-   elimPatt p = case p of
-     PR lps -> map snd lps
-     _ -> [p]
-   elimSel t a = case a of
-     R fs -> mkApp t (map (snd . snd) fs)
-     _ -> mkApp t [a]
-
-checkCompleteGrammar :: SourceAbs -> SourceCnc -> Check (BinTree Ident Info)
-checkCompleteGrammar abs cnc = do
-  let js = jments cnc
-  let fs = tree2list $ jments abs
-  foldM checkOne js fs
- where
-   checkOne js i@(c,info) = case info of
-     AbsFun (Yes _) _ -> case lookupIdent c js of
-       Ok _ -> return js
-       _ -> do
-         checkWarn $ "WARNING: no linearization of" +++ prt c
-         return js
-     AbsCat (Yes _) _ -> case lookupIdent c js of
-       Ok (AnyInd _ _) -> return js
-       Ok (CncCat (Yes _) _ _) -> return js
-       Ok (CncCat _ mt mp) -> do
-         checkWarn $ 
-           "Warning: no linearization type for" +++ prt c ++ 
-           ", inserting default {s : Str}" 
-         return $ updateTree (c,CncCat (Yes defLinType) mt mp) js
-       _ -> do
-         checkWarn $ 
-           "Warning: no linearization type for" +++ prt c ++ 
-           ", inserting default {s : Str}" 
-         return $ updateTree (c,CncCat (Yes defLinType) nope nope) js
-     _ -> return js
-
--- | General Principle: only Yes-values are checked. 
--- A May-value has always been checked in its origin module.
-checkResInfo :: SourceGrammar -> Ident -> (Ident,Info) -> Check (Ident,Info)
-checkResInfo gr mo (c,info) = do
-  checkReservedId c
-  case info of
-    ResOper pty pde -> chIn "operation" $ do
-      (pty', pde') <- case (pty,pde) of
-         (Yes ty, Yes de) -> do
-           ty'     <- check ty typeType >>= comp . fst
-           (de',_) <- check de ty'
-           return (Yes ty', Yes de')
-         (_, Yes de) -> do
-           (de',ty') <- infer de
-           return (Yes ty', Yes de')
-         (_,Nope) -> do
-           checkWarn "No definition given to oper"
-           return (pty,pde)
-         _ -> return (pty, pde) --- other cases are uninteresting
-      return (c, ResOper pty' pde')
-
-    ResOverload tysts -> chIn "overloading" $ do
-      tysts' <- mapM (uncurry $ flip check) tysts
-      let tysts2 = [(y,x) | (x,y) <- tysts']
-      --- this can only be a partial guarantee, since matching
-      --- with value type is only possible if expected type is given
-      checkUniq $ 
-        sort [t : map snd xs | (x,_) <- tysts2, Ok (xs,t) <- [typeFormCnc x]]
-      return (c,ResOverload tysts2)
-
-    ResParam (Yes (pcs,_)) -> chIn "parameter type" $ do
-----      mapM ((mapM (computeLType gr . snd)) . snd) pcs
-      mapM_ ((mapM_ (checkIfParType gr . snd)) . snd) pcs
-      ts <- checkErr $ lookupParamValues gr mo c
-      return (c,ResParam (Yes (pcs, Just ts)))
-
-    _ ->  return (c,info)
- where
-   infer = inferLType gr
-   check = checkLType gr
-   chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ ":")
-   comp = computeLType gr
-
-   checkUniq xss = case xss of
-     x:y:xs 
-      | x == y -> raise $ "ambiguous for argument list" +++ 
-                         unwords (map (prtType gr) x)  
-      | otherwise -> checkUniq $ y:xs
-     _ -> return ()
-
-
-checkCncInfo :: SourceGrammar -> Ident -> (Ident,SourceAbs) -> 
-                (Ident,Info) -> Check (Ident,Info)
-checkCncInfo gr m (a,abs) (c,info) = do
-  checkReservedId c
-  case info of
-
-    CncFun _ (Yes trm) mpr -> chIn "linearization of" $ do
-      typ        <- checkErr $ lookupFunTypeSrc gr a c
-      cat0       <- checkErr $ valCat typ
-      (cont,val) <- linTypeOfType gr m typ         -- creates arg vars
-      (trm',_)   <- check trm (mkFunType (map snd cont) val)  -- erases arg vars
-      checkPrintname gr mpr
-      cat        <- return $ snd cat0
-      return (c, CncFun (Just (cat,(cont,val))) (Yes trm') mpr)
-                                                   -- cat for cf, typ for pe
-
-    CncCat (Yes typ) mdef mpr -> chIn "linearization type of" $ do
-      checkErr $ lookupCatContextSrc gr a c
-      typ'  <- checkIfLinType gr typ
-      mdef' <- case mdef of
-        Yes def -> do
-          (def',_) <- checkLType gr def (mkFunType [typeStr] typ)
-          return $ Yes def'
-        _ -> return mdef
-      checkPrintname gr mpr
-      return (c,CncCat (Yes typ') mdef' mpr)
-
-    _ -> checkResInfo gr m (c,info)
-
- where
-   env = gr
-   infer = inferLType gr
-   comp = computeLType gr 
-   check = checkLType gr
-   chIn cat = checkIn ("Happened in" +++ cat +++ prt c +++ ":")
-
-checkIfParType :: SourceGrammar -> Type -> Check ()
-checkIfParType st typ = checkCond ("Not parameter type" +++ prt typ) (isParType typ)
-  where
-   isParType ty = True ----
-{- case ty of
-     Cn typ -> case lookupConcrete st typ of
-       Ok (CncParType _ _ _) -> True
-       Ok (CncOper _ ty' _) -> isParType ty'
-       _ -> False
-     Q p t -> case lookupInPackage st (p,t) of
-       Ok (CncParType _ _ _) -> True
-       _ -> False
-     RecType r -> all (isParType . snd) r
-     _ -> False
--}
-
-checkIfStrType :: SourceGrammar -> Type -> Check ()
-checkIfStrType st typ = case typ of
-  Table arg val -> do
-    checkIfParType st arg 
-    checkIfStrType st val
-  _ | typ == typeStr -> return ()
-  _ -> prtFail "not a string type" typ
-
-
-checkIfLinType :: SourceGrammar -> Type -> Check Type
-checkIfLinType st typ0 = do
-  typ <- computeLType st typ0
-  case typ of
-    RecType r -> do
-      let (lins,ihs) = partition (isLinLabel .fst) r
-      --- checkErr $ checkUnique $ map fst r
-      mapM_ checkInh ihs
-      mapM_ checkLin lins
-    _ -> prtFail "a linearization type must be a record type instead of" typ
-  return typ
-
- where
-   checkInh (label,typ) = checkIfParType st typ
-   checkLin (label,typ) = return () ---- checkIfStrType st typ
-
-
-computeLType :: SourceGrammar -> Type -> Check Type
-computeLType gr t = do
-  g0 <- checkGetContext
-  let g = [(x, Vr x) | (x,_) <- g0]
-  checkInContext g $ comp t
- where
-  comp ty = case ty of
-
-    App (Q (IC "Predef") (IC "Ints")) _ -> return ty ---- shouldn't be needed
-    Q (IC "Predef") (IC "Int")          -> return ty ---- shouldn't be needed
-    Q (IC "Predef") (IC "Float")        -> return ty ---- shouldn't be needed
-    Q (IC "Predef") (IC "Error")        -> return ty ---- shouldn't be needed
-
-    Q m c | elem c [cPredef,cPredefAbs] -> return ty
-    Q m c | elem c [zIdent "Int"] -> 
-      return $ linTypeInt
-    Q m c | elem c [zIdent "Float",zIdent "String"] -> return defLinType ----
-
-    Q m ident -> checkIn ("module" +++ prt m) $ do
-      ty' <- checkErr (lookupResDef gr m ident) 
-      if ty' == ty then return ty else comp ty' --- is this necessary to test?
-
-    Vr ident  -> checkLookup ident -- never needed to compute!
-
-    App f a -> do
-      f' <- comp f
-      a' <- comp a
-      case f' of
-        Abs x b -> checkInContext [(x,a')] $ comp b
-        _ -> return $ App f' a'
-
-    Prod x a b -> do
-      a' <- comp a
-      b' <- checkInContext [(x,Vr x)] $ comp b
-      return $ Prod x a' b'
-
-    Abs x b -> do
-      b' <- checkInContext [(x,Vr x)] $ comp b
-      return $ Abs x b'
-
-    ExtR r s -> do
-      r' <- comp r
-      s' <- comp s
-      case (r',s') of
-        (RecType rs, RecType ss) -> checkErr (plusRecType r' s') >>= comp
-        _ -> return $ ExtR r' s'
-
-    RecType fs -> do
-      let fs' = sortBy (\x y -> compare (fst x) (fst y)) fs
-      liftM RecType $ mapPairsM comp fs'
-
-    _ | ty == typeTok -> return typeStr
-    _ | isPredefConstant ty -> return ty
-
-    _ -> composOp comp ty
-
-checkPrintname :: SourceGrammar -> Perh Term -> Check ()
-checkPrintname st (Yes t) = checkLType st t typeStr >> return ()
-checkPrintname _ _ = return ()
-
--- | for grammars obtained otherwise than by parsing ---- update!!
-checkReservedId :: Ident -> Check ()
-checkReservedId x = let c = prt x in
-         if isResWord c 
-            then checkWarn ("Warning: reserved word used as identifier:" +++ c)
-            else return ()
-
--- to normalize records and record types
-labelIndex :: Type -> Label -> Int
-labelIndex ty lab = case ty of
-  RecType ts -> maybe (error ("label index" +++ prt lab)) id $ lookup lab $ labs ts
-  _ -> error $ "label index" +++ prt ty
- where 
-  labs ts = zip (map fst (sortBy (\ x y -> compare (fst x) (fst y)) ts)) [0..]
-
--- the underlying algorithms
-
-inferLType :: SourceGrammar -> Term -> Check (Term, Type)
-inferLType gr trm = case trm of
-
-   Q m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
-
-   Q m ident -> checks [
-     termWith trm $ checkErr (lookupResType gr m ident) >>= comp
-     ,
-     checkErr (lookupResDef gr m ident) >>= infer
-     ,
-{-
-     do
-       over <- getOverload gr Nothing trm
-       case over of
-         Just trty -> return trty
-         _ -> prtFail "not overloaded" trm
-     ,
--}
-     prtFail "cannot infer type of constant" trm
-     ]
-
-   QC m ident | isPredef m -> termWith trm $ checkErr (typPredefined ident)
-
-   QC m ident -> checks [
-       termWith trm $ checkErr (lookupResType gr m ident) >>= comp
-       ,
-       checkErr (lookupResDef gr m ident) >>= infer
-       ,
-       prtFail "cannot infer type of canonical constant" trm
-       ]
-
-   Val ty i -> termWith trm $ return ty
-
-   Vr ident -> termWith trm $ checkLookup ident
-
-   Typed e t -> do
-     t' <- comp t
-     check e t'
-     return (e,t')
-
-   App f a -> do
-     over <- getOverload gr Nothing trm
-     case over of
-       Just trty -> return trty
-       _ -> do
-         (f',fty) <- infer f
-         fty' <- comp fty
-         case fty' of
-           Prod z arg val -> do 
-             a' <- justCheck a arg
-             ty <- if isWildIdent z 
-                      then return val
-                      else substituteLType [(z,a')] val
-             return (App f' a',ty) 
-           _ -> raise ("function type expected for"+++ 
-                      prt f +++"instead of" +++ prtType env fty)
-
-   S f x -> do
-     (f', fty) <- infer f
-     case fty of
-       Table arg val -> do
-         x'<- justCheck x arg
-         return (S f' x', val)
-       _ -> prtFail "table lintype expected for the table in" trm
-
-   P t i -> do
-     (t',ty) <- infer t   --- ??
-     ty' <- comp ty
------     let tr2 = PI t' i (labelIndex ty' i)
-     let tr2 = P t' i
-     termWith tr2 $ checkErr $ case ty' of
-       RecType ts -> maybeErr ("unknown label" +++ prt i +++ "in" +++ prt ty') $ 
-                     lookup i ts
-       _ -> prtBad ("record type expected for" +++ prt t +++ "instead of") ty'
-   PI t i _ -> infer $ P t i
-
-   R r -> do
-     let (ls,fs) = unzip r
-     fsts <- mapM inferM fs
-     let ts = [ty | (Just ty,_) <- fsts]
-     checkCond ("cannot infer type of record"+++ prt trm) (length ts == length fsts)
-     return $ (R (zip ls fsts), RecType (zip ls ts))
-
-   T (TTyped arg) pts -> do
-     (_,val) <- checks $ map (inferCase (Just arg)) pts
-     check trm (Table arg val)
-   T (TComp arg) pts -> do
-     (_,val) <- checks $ map (inferCase (Just arg)) pts
-     check trm (Table arg val)
-   T ti pts -> do  -- tries to guess: good in oper type inference
-     let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]
-     case pts' of 
-       [] -> prtFail "cannot infer table type of" trm
-----       PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] 
-       _  -> do 
-         (arg,val) <- checks $ map (inferCase Nothing) pts'
-         check trm (Table arg val)
-   V arg pts -> do
-     (_,val) <- checks $ map infer pts
-     return (trm, Table arg val)
-
-   K s  -> do
-     if elem ' ' s
-        then checkWarn ("WARNING: space in token \"" ++ s ++ 
-                        "\". Lexical analysis may fail.")
-        else return ()
-     return (trm, typeStr)
-
-   EInt i -> return (trm, typeInt)
-
-   EFloat i -> return (trm, typeFloat)
-
-   Empty -> return (trm, typeStr)
-
-   C s1 s2 -> 
-     check2 (flip justCheck typeStr) C s1 s2 typeStr
-
-   Glue s1 s2 -> 
-     check2 (flip justCheck typeStr) Glue s1 s2 typeStr ---- typeTok
-
----- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
-   Strs (Cn (IC "#conflict") : ts) -> do
-     trace ("WARNING: unresolved constant, could be any of" +++ unwords (map prt ts)) (infer $ head ts)
---     checkWarn ("WARNING: unresolved constant, could be any of" +++ unwords (map prt ts))
---     infer $ head ts
-
-   Strs ts -> do
-     ts' <- mapM (\t -> justCheck t typeStr) ts 
-     return (Strs ts', typeStrs)
-
-   Alts (t,aa) -> do
-     t'  <- justCheck t typeStr
-     aa' <- flip mapM aa (\ (c,v) -> do
-        c' <- justCheck c typeStr 
-        v' <- justCheck v typeStrs
-        return (c',v'))
-     return (Alts (t',aa'), typeStr)
-
-   RecType r -> do
-     let (ls,ts) = unzip r
-     ts' <- mapM (flip justCheck typeType) ts 
-     return (RecType (zip ls ts'), typeType)
-
-   ExtR r s -> do
-     (r',rT) <- infer r 
-     rT'     <- comp rT
-     (s',sT) <- infer s
-     sT'     <- comp sT
-
-     let trm' = ExtR r' s'
-     ---- trm'    <- checkErr $ plusRecord r' s'
-     case (rT', sT') of
-       (RecType rs, RecType ss) -> do
-         rt <- checkErr $ plusRecType rT' sT'
-         check trm' rt ---- return (trm', rt)
-       _ | rT' == typeType && sT' == typeType -> return (trm', typeType)
-       _ -> prtFail "records or record types expected in" trm
-
-   Sort _     -> 
-     termWith trm $ return typeType
-
-   Prod x a b -> do
-     a' <- justCheck a typeType
-     b' <- checkInContext [(x,a')] $ justCheck b typeType
-     return (Prod x a' b', typeType)
-
-   Table p t  -> do
-     p' <- justCheck p typeType --- check p partype! 
-     t' <- justCheck t typeType
-     return $ (Table p' t', typeType)
-
-   FV vs -> do
-     (_,ty) <- checks $ map infer vs
----     checkIfComplexVariantType trm ty
-     check trm ty
-
-   _ -> prtFail "cannot infer lintype of" trm
-
- where
-   env = gr
-   infer = inferLType env
-   comp = computeLType env 
-
-   check = checkLType env
-   
-   isPredef m = elem m [cPredef,cPredefAbs]
-
-   justCheck ty te = check ty te >>= return . fst
-
-   -- for record fields, which may be typed
-   inferM (mty, t) = do
-     (t', ty') <- case mty of
-       Just ty -> check ty t
-       _ -> infer t
-     return (Just ty',t')
-
-   inferCase mty (patt,term) = do
-     arg  <- maybe (inferPatt patt) return mty
-     cont <- pattContext env arg patt
-     i    <- checkUpdates cont
-     (_,val) <- infer term
-     checkResets i
-     return (arg,val)
-   isConstPatt p = case p of
-     PC _ ps -> True --- all isConstPatt ps
-     PP _ _ ps -> True --- all isConstPatt ps
-     PR ps -> all (isConstPatt . snd) ps
-     PT _ p -> isConstPatt p
-     PString _ -> True
-     PInt _ -> True
-     PFloat _ -> True
-     PChar -> True
-     PSeq p q -> isConstPatt p && isConstPatt q
-     PAlt p q -> isConstPatt p && isConstPatt q
-     PRep p -> isConstPatt p
-     PNeg p -> isConstPatt p
-     PAs _ p -> isConstPatt p
-     _ -> False
-
-   inferPatt p = case p of
-     PP q c ps | q /= cPredef -> checkErr $ lookupResType gr q c >>= valTypeCnc
-     PAs _ p  -> inferPatt p
-     PNeg p   -> inferPatt p
-     PAlt p q -> checks [inferPatt p, inferPatt q]
-     PSeq _ _ -> return $ typeStr
-     PChar    -> return $ typeStr
-     PRep _   -> return $ typeStr
-     _ -> infer (patt2term p) >>= return . snd
-
-
--- type inference: Nothing, type checking: Just t
--- the latter permits matching with value type
-getOverload :: SourceGrammar -> Maybe Type -> Term -> Check (Maybe (Term,Type))
-getOverload env@gr mt t = case appForm t of
-     (f@(Q m c), ts) -> case lookupOverload gr m c of
-       Ok typs -> do
-         ttys <- mapM infer ts
-         v <- matchOverload f typs ttys
-         return $ Just v
-       _ -> return Nothing
-     _ -> return Nothing
- where
-   infer = inferLType env
-   matchOverload f typs ttys = do
-     let (tts,tys) = unzip ttys
-     let vfs = lookupOverloadInstance tys typs
-
-     case [vf | vf@(v,f) <- vfs, matchVal mt v] of
-       [(val,fun)] -> return (mkApp fun tts, val)
-       [] -> raise $ "no overload instance of" +++ prt f +++ 
-         "for" +++ unwords (map (prtType env) tys) +++ "among" ++++ 
-         unlines ["  " ++ unwords (map (prtType env) ty) | (ty,_) <- typs] ++
-         maybe [] (("with value type" +++) . prtType env) mt
-
-      ----  ++++ "DEBUG" +++ unwords (map show tys) +++ ";" 
-      ----  ++++ unlines (map (show . fst) typs) ----
-
-       vfs' -> case [(v,f) | (v,f) <- vfs', noProd v] of
-         [(val,fun)] -> do
-           checkWarn $ "WARNING: overloading of" +++ prt f +++ 
-             "resolved by excluding partial applications:" ++++
-             unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
-           return (mkApp fun tts, val)
-
-         _ -> raise $ "ambiguous overloading of" +++ prt f +++
-           "for" +++ unwords (map (prtType env) tys) ++++ "with alternatives" ++++ 
-           unlines [prtType env ty | (ty,_) <- vfs']
-
-   matchVal mt v = elem mt ([Nothing,Just v] ++ unlocked) where
-     unlocked = case v of
-       RecType fs -> [Just $ RecType $ filter (not . isLockLabel . fst) fs]
-       _ -> []
-   ---- TODO: accept subtypes
-   ---- TODO: use a trie
-   lookupOverloadInstance tys typs = 
-     [(mkFunType rest val, t) | 
-       let lt = length tys,
-       (ty,(val,t)) <- typs, length ty >= lt,
-       let (pre,rest) = splitAt lt ty, 
-       pre == tys
-     ]
-
-   noProd ty = case ty of
-     Prod _ _ _ -> False
-     _ -> True
-
-checkLType :: SourceGrammar -> Term -> Type -> Check (Term, Type)
-checkLType env trm typ0 = do
-
-  typ <- comp typ0
-
-  case trm of
-
-    Abs x c -> do
-      case typ of
-        Prod z a b -> do 
-          checkUpdate (x,a)
-          (c',b') <- if isWildIdent z
-                        then check c b
-                        else do
-                          b' <- checkIn "abs" $ substituteLType [(z,Vr x)] b
-                          check c b'
-          checkReset
-          return $ (Abs x c', Prod x a b')
-        _ -> raise $ "product expected instead of" +++ prtType env typ
-
-    App f a -> do
-       over <- getOverload env (Just typ) trm
-       case over of
-         Just trty -> return trty
-         _ -> do
-          (trm',ty') <- infer trm
-          termWith trm' $ checkEq typ ty' trm'
-
-    Q _ _ -> do
-       over <- getOverload env (Just typ) trm
-       case over of
-         Just trty -> return trty
-         _ -> do
-          (trm',ty') <- infer trm
-          termWith trm' $ checkEq typ ty' trm'
-
-    T _ [] ->
-      prtFail "found empty table in type" typ
-    T _ cs -> case typ of 
-      Table arg val -> do 
-        case allParamValues env arg of
-          Ok vs -> do
-            let ps0 = map fst cs
-            ps <- checkErr $ testOvershadow ps0 vs
-            if null ps 
-              then return () 
-              else checkWarn $ "WARNING: patterns never reached:" +++ 
-                               concat (intersperse ", " (map prt ps))
-
-          _ -> return () -- happens with variable types
-        cs' <- mapM (checkCase arg val) cs
-        return (T (TTyped arg) cs', typ)
-      _ -> raise $ "table type expected for table instead of" +++ prtType env typ
-
-    R r -> case typ of --- why needed? because inference may be too difficult
-       RecType rr -> do
-         let (ls,_) = unzip rr        -- labels of expected type
-         fsts <- mapM (checkM r) rr   -- check that they are found in the record
-         return $ (R fsts, typ)       -- normalize record
-
-       _ -> prtFail "record type expected in type checking instead of" typ
-
-    ExtR r s -> case typ of
-       _ | typ == typeType -> do
-         trm' <- comp trm
-         case trm' of
-           RecType _ -> termWith trm $ return typeType
-           ExtR (Vr _) (RecType _) -> termWith trm $ return typeType 
-                                      -- ext t = t ** ...
-           _ -> prtFail "invalid record type extension" trm
-       RecType rr -> do
-         (r',ty,s') <- checks [
-            do (r',ty) <- infer r
-               return (r',ty,s)
-           ,
-            do (s',ty) <- infer s
-               return (s',ty,r)
-            ]
-         case ty of
-           RecType rr1 -> do
-                let (rr0,rr2) = recParts rr rr1
-                r2 <- justCheck r' rr0
-                s2 <- justCheck s' rr2
-                return $ (ExtR r2 s2, typ) 
-           _ -> raise ("record type expected in extension of" +++ prt r +++ 
-                       "but found" +++ prt ty)
-
-       ExtR ty ex -> do
-         r' <- justCheck r ty
-         s' <- justCheck s ex
-         return $ (ExtR r' s', typ) --- is this all?
-
-       _ -> prtFail "record extension not meaningful for" typ
-
-    FV vs -> do
-      ttys <- mapM (flip check typ) vs
----      checkIfComplexVariantType trm typ
-      return (FV (map fst ttys), typ) --- typ' ?
-
-    S tab arg -> checks [ do
-      (tab',ty) <- infer tab
-      ty'       <- comp ty
-      case ty' of
-        Table p t -> do
-          (arg',val) <- check arg p
-          checkEq typ t trm
-          return (S tab' arg', t)
-        _ -> raise $ "table type expected for applied table instead of" +++ 
-                   prtType env ty'
-     , do
-      (arg',ty) <- infer arg
-      ty'       <- comp ty
-      (tab',_)  <- check tab (Table ty' typ)
-      return (S tab' arg', typ)
-      ]
-    Let (x,(mty,def)) body -> case mty of
-      Just ty -> do
-        (def',ty') <- check def ty
-        checkUpdate (x,ty')
-        body' <- justCheck body typ
-        checkReset
-        return (Let (x,(Just ty',def')) body', typ)
-      _ -> do
-        (def',ty) <- infer def  -- tries to infer type of local constant
-        check (Let (x,(Just ty,def')) body) typ
-
-    _ -> do
-      (trm',ty') <- infer trm
-      termWith trm' $ checkEq typ ty' trm'
- where
-   cnc = env
-   infer = inferLType env
-   comp = computeLType env 
-
-   check = checkLType env
-   
-   justCheck ty te = check ty te >>= return . fst
-
-   checkEq = checkEqLType env
-
-   recParts rr t = (RecType rr1,RecType rr2) where 
-     (rr1,rr2) = partition (flip elem (map fst t) . fst) rr 
-
-   checkM rms (l,ty) = case lookup l rms of
-     Just (Just ty0,t) -> do
-       checkEq ty ty0 t
-       (t',ty') <- check t ty
-       return (l,(Just ty',t'))
-     Just (_,t) -> do
-       (t',ty') <- check t ty
-       return (l,(Just ty',t'))
-     _ -> prtFail "cannot find value for label" l
-
-   checkCase arg val (p,t) = do
-     cont <- pattContext env arg p
-     i    <- checkUpdates cont
-     t'   <- justCheck t val
-     checkResets i
-     return (p,t')
-
-pattContext :: LTEnv -> Type -> Patt -> Check Context
-pattContext env typ p = case p of
-  PV x | not (isWildIdent x) -> return [(x,typ)]
-  PP q c ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
-    t <- checkErr $ lookupResType cnc q c
-    (cont,v) <- checkErr $ typeFormCnc t
-    checkCond ("wrong number of arguments for constructor in" +++ prt p) 
-              (length cont == length ps)
-    checkEqLType env typ v (patt2term p)
-    mapM (uncurry (pattContext env)) (zip (map snd cont) ps) >>= return . concat
-  PR r -> do
-    typ' <- computeLType env typ
-    case typ' of
-      RecType t -> do
-        let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]
-        ----- checkWarn $ prt p ++++ show pts ----- debug
-        mapM (uncurry (pattContext env)) pts >>= return . concat
-      _ -> prtFail "record type expected for pattern instead of" typ'
-  PT t p' -> do
-    checkEqLType env typ t (patt2term p')
-    pattContext env typ p'
-
-  PAs x p -> do
-    g <- pattContext env typ p
-    return $ (x,typ):g
-
-  PAlt p' q -> do
-    g1 <- pattContext env typ p'
-    g2 <- pattContext env typ q
-    let pts = [pt | pt <- g1, notElem pt g2] ++ [pt | pt <- g2, notElem pt g1]
-    checkCond 
-      ("incompatible bindings of" +++ 
-       unwords (nub (map (prt . fst) pts))+++ 
-       "in pattern alterantives" +++ prt p) (null pts) 
-    return g1 -- must be g1 == g2
-  PSeq p q -> do
-    g1 <- pattContext env typ p
-    g2 <- pattContext env typ q
-    return $ g1 ++ g2
-  PRep p' -> noBind typeStr p'
-  PNeg p' -> noBind typ p'
-
-  _ -> return [] ---- check types!
- where 
-   cnc = env
-   noBind typ p' = do
-    co <- pattContext env typ p'
-    if not (null co)
-      then checkWarn ("no variable bound inside pattern" +++ prt p) 
-           >> return []
-      else return []
-
--- auxiliaries
-
-type LTEnv = SourceGrammar
-
-termWith :: Term -> Check Type -> Check (Term, Type)
-termWith t ct = do
-  ty <- ct
-  return (t,ty)
-
--- | light-weight substitution for dep. types
-substituteLType :: Context -> Type -> Check Type
-substituteLType g t = case t of
-  Vr x -> return $ maybe t id $ lookup x g
-  _ -> composOp (substituteLType g) t
-
--- | compositional check\/infer of binary operations
-check2 :: (Term -> Check Term) -> (Term -> Term -> Term) -> 
-          Term -> Term -> Type -> Check (Term,Type)
-check2 chk con a b t = do
-  a' <- chk a
-  b' <- chk b
-  return (con a' b', t)
-
-checkEqLType :: LTEnv -> Type -> Type -> Term -> Check Type
-checkEqLType env t u trm = do
-  (b,t',u',s) <- checkIfEqLType env t u trm
-  case b of
-    True  -> return t'
-    False -> raise $ s +++ "type of" +++ prt trm +++ 
-                        ": expected:" +++ prtType env t ++++ 
-                        "inferred:" +++ prtType env u
-
-checkIfEqLType :: LTEnv -> Type -> Type -> Term -> Check (Bool,Type,Type,String)
-checkIfEqLType env t u trm = do
-  t' <- comp t 
-  u' <- comp u
-  case t' == u' || alpha [] t' u' of
-    True -> return (True,t',u',[])
-    -- forgive missing lock fields by only generating a warning.
-    --- better: use a flag to forgive? (AR 31/1/2006)
-    _ -> case missingLock [] t' u' of
-      Ok lo -> do
-        checkWarn $ "WARNING: missing lock field" +++ unwords (map prt lo)
-        return (True,t',u',[])
-      Bad s -> return (False,t',u',s)
-
-  where
-
-   -- t is a subtype of u 
-   --- quick hack version of TC.eqVal
-   alpha g t u = case (t,u) of  
-
-     -- error (the empty type!) is subtype of any other type
-     (_,Q (IC "Predef") (IC "Error")) -> True
-
-     -- contravariance
-     (Prod x a b, Prod y c d) -> alpha g c a && alpha ((x,y):g) b d 
-                              
-     -- record subtyping
-     (RecType rs, RecType ts) -> all (\ (l,a) -> 
-                                   any (\ (k,b) -> alpha g a b && l == k) ts) rs
-     (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'
-     (ExtR r s, t) -> alpha g r t || alpha g s t
-
-     -- the following say that Ints n is a subset of Int and of Ints m >= n
-     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
-        App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n
-     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
-        Q (IC "Predef") (IC "Int"))                 -> True ---- check size!
-     
-     (Q (IC "Predef") (IC "Int"),  ---- why this ???? AR 11/12/2005
-        App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
-
-     ---- this should be made in Rename
-     (Q  m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
-                               || elem n (allExtendsPlus env m)
-                               || m == n --- for Predef
-     (QC m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
-                               || elem n (allExtendsPlus env m)
-     (QC m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
-                               || elem n (allExtendsPlus env m)
-     (Q  m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
-                               || elem n (allExtendsPlus env m)
-
-     (Table a b,  Table c d)  -> alpha g a c && alpha g b d
-     (Vr x,       Vr y)       -> x == y || elem (x,y) g || elem (y,x) g
-     _                        -> t == u 
-     --- the following should be one-way coercions only. AR 4/1/2001
-                                  || elem t sTypes && elem u sTypes
-                                  || (t == typeType && u == typePType) 
-                                  || (u == typeType && t == typePType) 
-
-   missingLock g t u = case (t,u) of  
-     (RecType rs, RecType ts) -> 
-       let 
-         ls = [l | (l,a) <- rs, 
-                   not (any (\ (k,b) -> alpha g a b && l == k) ts)]
-         (locks,others) = partition isLockLabel ls
-       in case others of
-         _:_ -> Bad $ "missing record fields" +++ unwords (map prt others)
-         _ -> return locks
-     -- contravariance
-     (Prod x a b, Prod y c d) -> do
-        ls1 <- missingLock g c a
-        ls2 <- missingLock g b d
-        return $ ls1 ++ ls2
-
-     _ -> Bad ""
-
-   sTypes = [typeStr, typeTok, typeString]
-   comp = computeLType env
-
--- printing a type with a lock field lock_C as C
-prtType :: LTEnv -> Type -> String
-prtType env ty = case ty of
-  RecType fs -> case filter isLockLabel $ map fst fs of
-    [lock] -> (drop 5 $ prt lock) --- ++++ "Full form" +++ prt ty
-    _ -> prtt ty
-  Prod x a b -> prtType env a +++ "->" +++ prtType env b
-  _ -> prtt ty
- where
-   prtt t = prt t
-   ---- use computeLType gr to check if really equal to the cat with lock
-
-
--- | linearization types and defaults
-linTypeOfType :: SourceGrammar -> Ident -> Type -> Check (Context,Type)
-linTypeOfType cnc m typ = do
-  (cont,cat) <- checkErr $ typeSkeleton typ
-  val  <- lookLin cat
-  args <- mapM mkLinArg (zip [0..] cont)
-  return (args, val)
- where
-   mkLinArg (i,(n,mc@(m,cat))) = do
-     val  <- lookLin mc
-     let vars = mkRecType varLabel $ replicate n typeStr
-	 symb = argIdent n cat i
-     rec <- checkErr $ errIn ("extending" +++ prt vars +++ "with" +++ prt val) $
-            plusRecType vars val
-     return (symb,rec)
-   lookLin (_,c) = checks [ --- rather: update with defLinType ?
-      checkErr (lookupLincat cnc m c) >>= computeLType cnc
-     ,return defLinType
-     ]
-
--- | dependency check, detecting circularities and returning topo-sorted list
-
-allOperDependencies :: Ident -> BinTree Ident Info -> [(Ident,[Ident])]
-allOperDependencies m = allDependencies (==m)
-
-allDependencies :: (Ident -> Bool) -> BinTree Ident Info -> [(Ident,[Ident])]
-allDependencies ism b = 
-  [(f, nub (concatMap opty (pts i))) | (f,i) <- tree2list b]
-  where
-    opersIn t = case t of
-      Q n c | ism n -> [c]
-      QC n c | ism n -> [c]
-      _ -> collectOp opersIn t
-    opty (Yes ty) = opersIn ty
-    opty _ = []
-    pts i = case i of
-      ResOper pty pt -> [pty,pt]
-      ResParam (Yes (ps,_)) -> [Yes t | (_,cont) <- ps, (_,t) <- cont]
-      CncCat pty _ _ -> [pty]
-      CncFun _   pt _ -> [pt]  ---- (Maybe (Ident,(Context,Type))
-      AbsFun pty ptr -> [pty] --- ptr is def, which can be mutual
-      AbsCat (Yes co) _ -> [Yes ty | (_,ty) <- co]
-      _              -> []
-
-topoSortOpers :: [(Ident,[Ident])] -> Err [Ident]
-topoSortOpers st = do
-  let eops = topoTest st
-  either 
-    return 
-    (\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops))))
-    eops
diff --git a/src-3.0/GF/Compile/Compile.hs b/src-3.0/GF/Compile/Compile.hs
deleted file mode 100644
index 422df0fd5..000000000
--- a/src-3.0/GF/Compile/Compile.hs
+++ /dev/null
@@ -1,401 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Compile
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/05 20:02:19 $
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.45 $
---
--- The top-level compilation chain from source file to gfc\/gfr.
------------------------------------------------------------------------------
-
-module GF.Compile.Compile (compileModule, compileEnvShSt, compileOne,
-		CompileEnv, TimedCompileEnv,gfGrammarPathVar,pathListOpts,
-	       getGFEFiles) where
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Infra.CompactPrint
-import GF.Grammar.PrGrammar
-import GF.Compile.Update
-import GF.Grammar.Lookup
-import GF.Infra.Modules
-import GF.Infra.ReadFiles
-import GF.Compile.ShellState
-import GF.Compile.MkResource
----- import MkUnion
-
--- the main compiler passes
-import GF.Compile.GetGrammar
-import GF.Compile.Extend
-import GF.Compile.Rebuild
-import GF.Compile.Rename
-import GF.Grammar.Refresh
-import GF.Compile.CheckGrammar
-import GF.Compile.Optimize
-import GF.Compile.Evaluate
-import GF.Compile.GrammarToCanon
---import GF.Devel.GrammarToGFCC -----
-import GF.Devel.OptimizeGF (subexpModule,unsubexpModule)
-import GF.Canon.Share
-import GF.Canon.Subexpressions (elimSubtermsMod,unSubelimModule)
-import GF.UseGrammar.Linear (unoptimizeCanonMod) ----
-
-import qualified GF.Canon.CanonToGrammar as CG
-
-import qualified GF.Canon.GFC as GFC
-import qualified GF.Canon.MkGFC as MkGFC
-import GF.Canon.GetGFC
-
-import GF.Data.Operations
-import GF.Infra.UseIO
-import GF.Text.UTF8 ----
-import GF.System.Arch
-
-import Control.Monad
-import System.Directory
-import System.FilePath
-
--- | in batch mode: write code in a file
-batchCompile f = liftM fst $ compileModule defOpts emptyShellState f
-  where
-    defOpts = options [emitCode] 
-batchCompileOpt f = liftM fst $ compileModule defOpts emptyShellState f
-  where
-    defOpts = options [emitCode, optimizeCanon] 
-
-batchCompileOld f = compileOld defOpts f
-  where
-    defOpts = options [emitCode] 
-
--- | compile with one module as starting point
--- command-line options override options (marked by --#) in the file
--- As for path: if it is read from file, the file path is prepended to each name.
--- If from command line, it is used as it is.
-compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
-----             IOE (GFC.CanonGrammar, (SourceGrammar,[(String,(FilePath,ModTime))]))
-
-compileModule opts st0 file | 
-     oElem showOld opts || 
-     elem suff [".cf",".ebnf",".gfm"] = do
-  let putp  = putPointE opts
-  let putpp = putPointEsil opts
-  let path = [] ----
-  grammar1 <- case suff of
-    ".cf"   -> putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file
-    ".ebnf" -> putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file
-    ".gfm"  -> putp ("- parsing" +++ suff +++ file) $ getSourceGrammar opts file
-    _       -> putp ("- parsing old gf" +++ file)   $ getOldGrammar opts file
-  let mods = modules grammar1
-  let env = compileEnvShSt st0 []
-  foldM (comp putpp path) env mods
- where
-   suff = takeExtensions file
-   comp putpp path env sm0 = do
-     (k',sm,eenv')  <- makeSourceModule opts (fst env) sm0
-     cm  <- putpp "  generating code... " $ generateModuleCode opts path sm
-     ft <- getReadTimes file ---
-     extendCompileEnvInt env (k',sm,cm) eenv' ft
-
-compileModule opts1 st0 file = do
-  opts0 <- ioeIO $ getOptionsFromFile file
-  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
-  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
-  let opts = addOptions opts1 opts0 
-  let fpath = dropFileName file
-  ps0 <- ioeIO $ pathListOpts opts fpath
-
-  let ps1 = if (useFileOpt && not useLineOpt) 
-              then (ps0 ++ map (combine fpath) ps0)
-              else ps0
-  ps <- ioeIO $ extendPathEnv ps1
-  let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
-  ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
-  let st = st0 --- if useFileOpt then emptyShellState else st0
-  let rfs = [(m,t) | (m,(_,t)) <- readFiles st]
-  let file' = if useFileOpt then takeFileName file else file -- to find file itself
-  files <- getAllFiles opts ps rfs file'
-  ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
-  let names = map justModuleName files
-  ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
-  let env0 = compileEnvShSt st names
-  (e,mm) <- foldIOE (compileOne opts) env0 files
-  maybe (return ()) putStrLnE mm
-  return e
-
-getReadTimes file = do
-  t <- ioeIO getNowTime
-  let m = justModuleName file
-  return $ (m,(file,t)) : [(resModName m,(file,t)) | not (isGFC file)]
-
-compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv
-compileEnvShSt st fs = ((0,sgr,cgr,eenv),fts) where
-  cgr = MGrammar [m | m@(i,_) <- modules (canModules st), notInc i]
-  sgr = MGrammar [m | m@(i,_) <- modules (srcModules st), notIns i]
-  notInc i = notElem (prt i) $ map dropExtension fs
-  notIns i = notElem (prt i) $ map dropExtension fs
-  fts = readFiles st
-  eenv = evalEnv st
-
-pathListOpts :: Options -> FileName -> IO [InitPath]
-pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptVal opts pathList
-
-reverseModules (MGrammar ms) = MGrammar $ reverse ms
-
-keepResModules :: Options -> SourceGrammar -> SourceGrammar
-keepResModules opts gr = 
-  if oElem retainOpers opts 
-    then MGrammar $ reverse [(i,mi) | (i,mi@(ModMod m)) <- modules gr, isModRes m]
-    else emptyMGrammar
-
-
--- | the environment
-type CompileEnv = (Int,SourceGrammar, GFC.CanonGrammar,EEnv)
-
-emptyCompileEnv :: TimedCompileEnv
-emptyCompileEnv = ((0,emptyMGrammar,emptyMGrammar,emptyEEnv),[])
-
-extendCompileEnvInt ((_,MGrammar ss, MGrammar cs,_),fts) (k,sm,cm) eenv ft = 
-  return ((k,MGrammar (sm:ss), MGrammar (cm:cs),eenv),ft++fts) --- reverse later
-
-extendCompileEnv e@((k,_,_,_),_) (sm,cm) = extendCompileEnvInt e (k,sm,cm)
-
-extendCompileEnvCanon ((k,s,c,e),fts) cgr eenv ft = 
-  return ((k,s, MGrammar (modules cgr ++ modules c),eenv),ft++fts)
-
-type TimedCompileEnv = (CompileEnv,[(String,(FilePath,ModTime))])
-
-compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv
-compileOne opts env@((_,srcgr,cancgr0,eenv),_) file = do
-
-  let putp = putPointE opts
-  let putpp = putPointEsil opts
-  let putpOpt v m act
-       | oElem beVerbose opts =  putp v act
-       | oElem beSilent opts  =  putpp v act
-       | otherwise = ioeIO (putStrFlush m) >> act
-
-  let gf   = takeExtensions file
-  let path = dropFileName file
-  let name = dropExtension file
-  let mos  = modules srcgr
-
-  case gf of
-    -- for multilingual canonical gf, just read the file and update environment
-    ".gfcm" -> do
-       cgr <- putp ("+ reading" +++ file) $ getCanonGrammar file
-       ft <- getReadTimes file
-       extendCompileEnvCanon env cgr eenv ft
-
-    -- for canonical gf, read the file and update environment, also source env
-    ".gfc" -> do
-       cm <- putp ("+ reading" +++ file) $ getCanonModule file
-       let cancgr = updateMGrammar (MGrammar [cm]) cancgr0 
-       sm <- ioeErr $ CG.canon2sourceModule $ unoptimizeCanonMod cancgr $ unSubelimModule cm
-       ft <- getReadTimes file
-       extendCompileEnv env (sm, cm) eenv ft
-
-    -- for compiled resource, parse and organize, then update environment
-    ".gfr" -> do
-       sm0 <- putp ("| reading" +++ file) $ getSourceModule opts file
-       let sm1 = unsubexpModule sm0
-       sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
----- experiment with not optimizing gfr 
-----      sm:_  <- putp "  optimizing " $ ioeErr $ evalModule mos sm1
-       let gfc = gfcFile name 
-       cm  <- putp ("+ reading" +++ gfc) $ getCanonModule gfc
-       ft  <- getReadTimes file
-       extendCompileEnv env (sm,cm) eenv ft
-
-    -- for gf source, do full compilation
-
-    _ -> do
-
-      --- hack fix to a bug in ReadFiles with reused concrete
-
-      let modu = dropExtension file
-      b1 <- ioeIO $ doesFileExist file
-      b2 <- ioeIO $ doesFileExist $ gfrFile modu
-      if not b1
-        then if b2 
-          then compileOne opts env $ gfrFile $ modu 
-          else compileOne opts env $ gfcFile $ modu 
-        else do
-
-       sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ 
-                                           getSourceModule opts file
-       (k',sm,eenv')  <- makeSourceModule opts (fst env) sm0
-       cm  <- putpp "  generating code... " $ generateModuleCode opts path sm
-       ft <- getReadTimes file
-
-       sm':_ <- case snd sm of
-----         ModMod n | isModRes n -> putp "  optimizing " $ ioeErr $ evalModule mos sm
-         _ -> return [sm]
-
-       extendCompileEnvInt env (k',sm',cm) eenv' ft
-
--- | dispatch reused resource at early stage
-makeSourceModule :: Options -> CompileEnv -> 
-                    SourceModule -> IOE (Int,SourceModule,EEnv)
-makeSourceModule opts env@(k,gr,can,eenv) mo@(i,mi) = case mi of
-
-  ModMod m -> case mtype m of
-    MTReuse c -> do
-      sm <- ioeErr $ makeReuse gr i (extend m) c
-      let mo2 = (i, ModMod sm)
-          mos = modules gr
-      --- putp "  type checking reused" $ ioeErr $ showCheckModule mos mo2
-      return $ (k,mo2,eenv)
-{- ---- obsolete
-    MTUnion ty imps -> do
-      mo' <- ioeErr $ makeUnion gr i ty imps
-      compileSourceModule opts env mo'
--}
-
-    _ -> compileSourceModule opts env mo
-  _ -> compileSourceModule opts env mo
- where
-   putp = putPointE opts
-
-compileSourceModule :: Options -> CompileEnv -> 
-                       SourceModule -> IOE (Int,SourceModule,EEnv)
-compileSourceModule opts env@(k,gr,can,eenv) mo@(i,mi) = do
-
-  let putp  = putPointE opts
-      putpp = putPointEsil opts
-      mos   = modules gr
-
-  if (oElem showOld opts && oElem emitCode opts) 
-    then do
-      let (file,out) = (gfFile (prt i), prGrammar (MGrammar [mo]))
-      putp ("  wrote file" +++ file) $ ioeIO $ writeFile file out
-    else return ()
-
-  mo1   <- ioeErr $ rebuildModule mos mo
-
-  mo1b  <- ioeErr $ extendModule mos mo1
-
-  case mo1b of
-    (_,ModMod n) | not (isCompleteModule n) -> do
-      return (k,mo1b,eenv)   -- refresh would fail, since not renamed
-    _ -> do
-      mo2:_ <- putpp "  renaming " $ ioeErr $ renameModule mos mo1b
-
-      (mo3:_,warnings) <- putpp "  type checking" $ ioeErr $ showCheckModule mos mo2
-      if null warnings then return () else putp warnings $ return ()
-
-      (k',mo3r:_) <- putpp "  refreshing " $ ioeErr $ refreshModule (k,mos) mo3
-
-      (mo4,eenv') <- 
-        ---- if oElem "check_only" opts 
-          putpp "  optimizing " $ ioeErr $ optimizeModule opts (mos,eenv) mo3r
-      return (k',mo4,eenv')
- where
-   ----   prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
-   prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo]
-
-generateModuleCode :: Options -> InitPath -> SourceModule -> IOE GFC.CanonModule
-generateModuleCode opts path minfo@(name,info) = do
-
---- DEPREC
----  if oElem (iOpt "gfcc") opts
----    then ioeIO $ putStrLn $ prGrammar2gfcc minfo
----    else return ()
-
-  let pname = path </> prt name
-  minfo0     <- ioeErr $ redModInfo minfo
-  let oopts  = addOptions opts (iOpts (flagsModule minfo))
-      optims = maybe "all_subs" id $ getOptVal oopts useOptimizer
-      optim  = takeWhile (/='_') optims
-      subs   = drop 1 (dropWhile (/='_') optims) == "subs"
-  minfo1     <- return $ 
-    case optim of
-      "parametrize" -> shareModule paramOpt minfo0  -- parametrization and sharing
-      "values"      -> shareModule valOpt minfo0    -- tables as courses-of-values
-      "share"       -> shareModule shareOpt minfo0  -- sharing of branches
-      "all"         -> shareModule allOpt minfo0    -- first parametrize then values
-      "none"        -> minfo0                       -- no optimization
-      _             -> shareModule shareOpt minfo0  -- sharing; default
-
-  -- do common subexpression elimination if required by flag "subs"
-  minfo' <- 
-    if subs
-      then ioeErr $ elimSubtermsMod minfo1
-      else return minfo1
-
-  -- for resource, also emit gfr. 
-  --- Also for incomplete, to create timestamped gfc/gfr files
-  case info of
-    ModMod m | emitsGFR m && emit && nomulti -> do
-      let rminfo = if isCompilable info 
-                   then subexpModule minfo 
-                   else (name, ModMod emptyModule) 
-      let (file,out) = (gfrFile pname, prGrammar (MGrammar [rminfo]))
-      putp ("  wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out
-    _ -> return ()
-  let encode = case getOptVal opts uniCoding of
-        Just "utf8" -> encodeUTF8
-        _ -> id
-  (file,out) <- do
-      code <- return $ MkGFC.prCanonModInfo minfo'
-      return (gfcFile pname, encode code)
-  if emit && nomulti ---- && isCompilable info 
-     then putp  ("  wrote file" +++ file) $ ioeIO $ writeFile file out
-     else putpp ("no need to save module" +++ prt name) $ return ()
-  return minfo'
- where 
-   putp  = putPointE opts
-   putpp = putPointEsil opts
-
-   emitsGFR m = isModRes m ---- && isCompilable info
-     ---- isModRes m || (isModCnc m && mstatus m == MSIncomplete)
-   isCompilable mi = case mi of
-     ModMod m -> not $ isModCnc m && mstatus m == MSIncomplete 
-     _ -> True
-   nomulti = not $ oElem makeMulti opts
-   emit  = oElem emitCode opts && not (oElem notEmitCode opts)
-
--- for old GF: sort into modules, write files, compile as usual
-
-compileOld :: Options -> FilePath -> IOE GFC.CanonGrammar
-compileOld opts file = do
-  let putp = putPointE opts
-  grammar1 <- putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
-  files <- mapM writeNewGF $ modules grammar1
-  ((_,_,grammar,_),_) <- foldM (compileOne opts) emptyCompileEnv files
-  return grammar
-
-writeNewGF :: SourceModule -> IOE FilePath
-writeNewGF m@(i,_) = do
-  let file = gfFile $ prt i
-  ioeIO $ writeFile file $ prGrammar (MGrammar [m])
-  ioeIO $ putStrLn $ "wrote file" +++ file
-  return file
-
---- this function duplicates a lot of code from compileModule.
---- It does not really belong here either.
--- It selects those .gfe files that a grammar depends on and that
--- are younger than corresponding gf
-
-getGFEFiles :: Options -> FilePath -> IO [FilePath]
-getGFEFiles opts1 file = useIOE [] $ do
-  opts0 <- ioeIO $ getOptionsFromFile file
-  let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
-  let useLineOpt = maybe False (const True) $ getOptVal opts1 pathList
-  let opts = addOptions opts1 opts0 
-  let fpath = dropFileName file
-  ps0 <- ioeIO $ pathListOpts opts fpath
-
-  let ps1 = if (useFileOpt && not useLineOpt) 
-              then (map (combine fpath) ps0)
-              else ps0
-  ps <- ioeIO $ extendPathEnv ps1
-  let file' = if useFileOpt then takeFileName file else file -- to find file itself
-  files <- getAllFiles opts ps [] file'
-  efiles <- ioeIO $ filterM doesFileExist [replaceExtension f "gfe" | f <- files]
-  es <- ioeIO $ mapM (uncurry selectLater) [(f, init f) | f <- efiles] -- init gfe == gf
-  return $ filter ((=='e') . last) es
diff --git a/src-3.0/GF/Compile/Evaluate.hs b/src-3.0/GF/Compile/Evaluate.hs
deleted file mode 100644
index a574fef40..000000000
--- a/src-3.0/GF/Compile/Evaluate.hs
+++ /dev/null
@@ -1,477 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Evaluate
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/01 15:39:12 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.19 $
---
--- Computation of source terms. Used in compilation and in @cc@ command.
------------------------------------------------------------------------------
-
-module GF.Compile.Evaluate (appEvalConcrete, EEnv, emptyEEnv) where
-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Data.Str
-import GF.Grammar.PrGrammar
-import GF.Infra.Modules
-import GF.Infra.Option
-import GF.Grammar.Macros
-import GF.Grammar.Lookup
-import GF.Grammar.Refresh
-import GF.Grammar.PatternMatch
-import GF.Grammar.Lockfield (isLockLabel) ----
-
-import GF.Grammar.AppPredefined
-
-import qualified Data.Map as Map
-
-import Data.List (nub,intersperse)
-import Control.Monad (liftM2, liftM)
-import Debug.Trace
-
-
-data EEnv = EEnv {
-  computd :: Map.Map (Ident,Ident) FTerm,
-  temp :: Int
-  }
-
-emptyEEnv = EEnv Map.empty 0
-
-lookupComputed :: (Ident,Ident) -> STM EEnv (Maybe FTerm)
-lookupComputed mc = do
-  env <- readSTM
-  return $ Map.lookup mc $ computd env
-
-updateComputed :: (Ident,Ident) -> FTerm -> STM EEnv ()
-updateComputed mc t = 
-  updateSTM (\e -> e{computd = Map.insert mc t (computd e)})
-
-getTemp :: STM EEnv Ident
-getTemp = do
-  env <- readSTM
-  updateSTM (\e -> e{temp = temp e + 1})
-  return $ identC ("#" ++ show (temp env))
-
-data FTerm = 
-    FTC Term
-  | FTF (Term -> FTerm)
-
-prFTerm :: Integer -> FTerm -> String
-prFTerm i t = case t of
-  FTC t -> prt t
-  FTF f -> show i +++ "->" +++ prFTerm (i + 1) (f (EInt i))
-
-term2fterm t = case t of
-  Abs x b -> FTF (\t -> term2fterm (subst [(x,t)] b))
-  _ -> FTC t
-
-traceFTerm c ft = ft ----
-----trace ("\n" ++ prt c +++ "=" +++ take 60 (prFTerm 0 ft)) ft
-
-fterm2term :: FTerm -> STM EEnv Term
-fterm2term t = case t of
-  FTC t -> return t
-  FTF f -> do
-    x <- getTemp
-    b <- fterm2term $ f (Vr x)
-    return $ Abs x b
-
-subst g t = case t of
-  Vr x -> maybe t id $ lookup x g
-  _ -> composSafeOp (subst g) t
-
-
-appFTerm :: FTerm -> [Term] -> FTerm
-appFTerm ft ts = case (ft,ts) of
-  (FTF f, x:xs) -> appFTerm (f x) xs 
-  (FTC c, _:_) -> FTC $ foldl App c ts
-  _ -> ft
-
-apps :: Term -> (Term,[Term])
-apps t = case t of
-  App f a -> (f',xs ++ [a]) where (f',xs) = apps f
-  _ -> (t,[])
-
-appEvalConcrete gr bt env = appSTM (evalConcrete gr bt) env
-
-evalConcrete :: SourceGrammar -> BinTree Ident Info -> STM EEnv (BinTree Ident Info)
-evalConcrete gr mo = mapMTree evaldef mo where
-
-  evaldef (f,info) = case info of
-    CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> 
-       evalIn ("\nerror in linearization of function" +++ prt f +++ ":") $ 
-      do
-      pde' <- case pde of
-        Yes de -> do
-          liftM yes $ pEval ty de
-        _ -> return pde
-      --- ppr' <-  liftM yes $ evalPrintname gr c ppr pde'
-      return $ (f, CncFun mt pde' ppr) -- only cat in type actually needed
-
-    _ ->  return (f,info)
-
-  pEval (context,val) trm = do ---- errIn ("parteval" +++ prt_ trm) $ do
-    let 
-      vars  = map fst context
-      args  = map Vr vars
-      subst = [(v, Vr v) | v <- vars]
-      trm1  = mkApp trm args
-    trm3 <- recordExpand val trm1 >>= comp subst >>= recomp subst
-    return $ mkAbs vars trm3
-
-  ---- temporary hack to ascertain full evaluation, because of bug in comp
-  recomp g t = if notReady t then comp g t else return t
-  notReady = not . null . redexes
-  redexes t = case t of
-    Q _ _ -> return [()]
-    _ -> collectOp redexes t
-
-  recordExpand typ trm = case unComputed typ of
-    RecType tys -> case trm of
-      FV rs -> return $ FV [R [assign lab (P r lab) | (lab,_) <- tys] | r <- rs]
-      _ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys]
-    _ -> return trm
-
-  comp g t = case t of
-
-    Q (IC "Predef") _ -> return t ----trace ("\nPredef:\n" ++ prt t) $ return t
-
-    Q p c -> do
-      md <- lookupComputed (p,c) 
-      case md of
-        Nothing -> do
-          d  <- lookRes (p,c)
-          updateComputed (p,c) $ traceFTerm c $ term2fterm d
-          return d
-        Just d -> fterm2term d >>= comp g
-    App f a -> case apps t of
-{- ----
-      (h@(QC p c),xs) -> do
-        xs' <- mapM (comp g) xs
-        case lookupValueIndex gr ty t of 
-        Ok v -> return v
-        _ -> return t
--}
-      (h@(Q p c),xs) | p == IC "Predef" -> do
-        xs' <- mapM (comp g) xs
-        (t',b) <- stmErr $ appPredefined (foldl App h xs')
-        if b then return t' else comp g t'
-      (h@(Q p c),xs) -> do
-        xs' <- mapM (comp g) xs
-        md <- lookupComputed (p,c) 
-        case md of
-          Just ft -> do
-            t <- fterm2term $ appFTerm ft xs'
-            comp g t
-          Nothing -> do
-            d  <- lookRes (p,c)
-            let ft = traceFTerm c $ term2fterm d
-            updateComputed (p,c) ft
-            t' <- fterm2term $ appFTerm ft xs'
-            comp g t'
-      _ -> do
-        f' <- comp g f
-        a' <- comp g a
-        case (f',a') of
-         (Abs x b,_) -> comp (ext x a' g) b
-         (QC _ _,_)  -> returnC $ App f' a'
-         (FV fs, _)  -> mapM (\c -> comp g (App c a')) fs >>= return . variants
-         (_, FV as)  -> mapM (\c -> comp g (App f' c)) as >>= return . variants
-
-         (Alias _ _ d, _) -> comp g (App d a')
-
-         (S (T i cs) e,_) -> prawitz g i (flip App a') cs e
-
-	 _ -> do
-           (t',b) <- stmErr $ appPredefined (App f' a')
-           if b then return t' else comp g t'
-
-
-    Vr x -> do
-       t' <- maybe (prtRaise (
-         "context" +++ show g +++ ": no value given to variable") x) return $ lookup x g
-       case t' of 
-         _ | t == t' -> return t
-         _ -> comp g t'
-
-    Abs x b -> do 
-       b' <- comp (ext x (Vr x) g) b
-       return $ Abs x b'
-
-    Let (x,(_,a)) b -> do
-       a' <- comp g a
-       comp (ext x a' g) b
-
-    Prod x a b -> do
-       a' <- comp g a
-       b' <- comp (ext x (Vr x) g) b
-       return $ Prod x a' b'
-
-    P t l | isLockLabel l -> return $ R [] 
-     ---- a workaround 18/2/2005: take this away and find the reason
-     ---- why earlier compilation destroys the lock field
-
-
-    P t l  -> do
-       t' <- comp g t
-       case t' of
-         FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . variants
-         R r   -> maybe 
-                   (prtRaise (prt t' ++ ": no value for label") l) (comp g . snd) $ 
-                    lookup l r 
-
-         ExtR a (R b) -> case lookup l b of  ----comp g (P (R b) l) of
-           Just (_,v) -> comp g v
-           _ -> comp g (P a l)
-         ExtR (R a) b -> case lookup l a of  ----comp g (P (R b) l) of
-           Just (_,v) -> comp g v
-           _ -> comp g (P b l)
-
-         S (T i cs) e -> prawitz g i (flip P l) cs e
-
-         _   -> returnC $ P t' l
-
-    S t@(T _ cc) v -> do
-       v'     <- comp g v
-       case v' of
-         FV vs -> do
-           ts' <- mapM (comp g . S t) vs
-           return $ variants ts' 
-         _ -> case matchPattern cc v' of
-           Ok (c,g') -> comp (g' ++ g) c
-           _ | isCan v' -> prtRaise ("missing case" +++ prt v' +++ "in") t 
-           _ -> do
-             t' <- comp g t
-             return $ S t' v' -- if v' is not canonical
-
-    S t v -> do
-       t'     <- comp g t
-       v'     <- comp g v
-       case t' of
-         T _ [(PV IW,c)] -> comp g c           --- an optimization
-         T _ [(PT _ (PV IW),c)] -> comp g c
-
-         T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization
-         T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c
-
-         FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
-
-         V ptyp ts -> do
-           vs <- stmErr $ allParamValues gr ptyp
-           ps <- stmErr $ mapM term2patt vs
-           let cc = zip ps ts
-           case v' of
-             FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants
-             _ -> case matchPattern cc v' of
-               Ok (c,g') -> comp (g' ++ g) c
-               _ | isCan v' -> prtRaise ("missing case" +++ prt v' +++ "in") t 
-               _ -> return $ S t' v' -- if v' is not canonical
-
-         T _ cc -> case v' of
-	   FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants
-           _ -> case matchPattern cc v' of
-             Ok (c,g') -> comp (g' ++ g) c
-             _ | isCan v' -> prtRaise ("missing case" +++ prt v' +++ "in") t 
-             _ -> return $ S t' v' -- if v' is not canonical
-
-         Alias _ _ d -> comp g (S d v')
-
-         S (T i cs) e -> prawitz g i (flip S v') cs e
-
-	 _    -> returnC $ S t' v'
-
-     -- normalize away empty tokens
-    K "" -> return Empty
-
-    -- glue if you can
-    Glue x0 y0 -> do
-       x <- comp g x0
-       y <- comp g y0
-       case (x,y) of
-         (Alias _ _ d, y)  -> comp g $ Glue d y
-         (x, Alias _ _ d)  -> comp g $ Glue x d
-
-         (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e
-         (s, S (T i cs) e) -> prawitz g i (Glue s) cs e
-         (_,Empty)         -> return x
-         (Empty,_)         -> return y
-         (K a, K b)        -> return $ K (a ++ b)
-         (_, Alts (d,vs)) -> do
-----         (K a, Alts (d,vs)) -> do
-            let glx = Glue x
-            comp g $ Alts (glx d, [(glx v,c) | (v,c) <- vs])
-         (Alts _, ka) -> checks [do
-            y' <- stmErr $ strsFromTerm ka
-----         (Alts _, K a) -> checks [do
-            x' <- stmErr $ strsFromTerm x -- this may fail when compiling opers
-            return $ variants [
-              foldr1 C (map K (str2strings (glueStr v u))) | v <- x', u <- y']
-----              foldr1 C (map K (str2strings (glueStr v (str a)))) | v <- x']
-           ,return $ Glue x y
-           ]
-         (FV ks,_)         -> do
-           kys <- mapM (comp g . flip Glue y) ks
-           return $ variants kys
-         (_,FV ks)         -> do
-           xks <- mapM (comp g . Glue x) ks
-           return $ variants xks
-
-         _ -> do
-           mapM_ checkNoArgVars [x,y]
-           r <- composOp (comp g) t
-           returnC r
-
-    Alts _ -> do
-       r <- composOp (comp g) t
-       returnC r
-
-     -- remove empty
-    C a b    -> do
-       a' <- comp g a
-       b' <- comp g b
-       case (a',b') of
-         (Alts _, K a) -> checks [do
-            as <- stmErr $ strsFromTerm a' -- this may fail when compiling opers
-            return $ variants [
-              foldr1 C (map K (str2strings (plusStr v (str a)))) | v <- as]
-            ,
-            return $ C a' b'
-           ]
-         (Empty,_) -> returnC b'
-         (_,Empty) -> returnC a'
-         _     -> returnC $ C a' b'
-
-     -- reduce free variation as much as you can
-    FV ts -> mapM (comp g) ts >>= returnC . variants
-
-     -- merge record extensions if you can
-    ExtR r s -> do
-       r' <- comp g r
-       s' <- comp g s
-       case (r',s') of
-         (Alias _ _ d, _)  -> comp g $ ExtR d s'
-         (_, Alias _ _ d)  -> comp g $ Glue r' d
-
-         (R rs, R ss) -> stmErr $ plusRecord r' s'
-         (RecType rs, RecType ss) -> stmErr $ plusRecType r' s'
-
-         (_, FV ss) -> liftM FV $ mapM (comp g) [ExtR t u | u <- ss]
-
-         _ -> return $ ExtR r' s'
-
-     -- case-expand tables
-     -- if already expanded, don't expand again
-    T i@(TComp _) cs -> do
-       -- if there are no variables, don't even go inside
-       cs' <- {-if (null g) then return cs else-} mapPairsM (comp g) cs
-       return $ T i cs'
-
-     --- this means some extra work; should implement TSh directly
-    TSh i cs -> comp g $ T i [(p,v) | (ps,v) <- cs, p <- ps]
-
-    T i cs -> do
-       pty0 <- stmErr $ getTableType i
-       ptyp <- comp g pty0
-       case allParamValues gr ptyp of
-         Ok vs -> do
-
-           cs'  <- mapM (compBranchOpt g) cs
-           sts  <- stmErr $ mapM (matchPattern cs') vs 
-           ts   <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
-           ps   <- stmErr $ mapM term2patt vs
-           let ps' = ps --- PT ptyp (head ps) : tail ps
-           return $ --- V ptyp ts -- to save space, just course of values
-                    T (TComp ptyp) (zip ps' ts)
-         _ -> do
-           cs' <- mapM (compBranch g) cs
-           return $ T i cs'  -- happens with variable types
-
-     -- otherwise go ahead
-    _ -> composOp (comp g) t >>= returnC
-
-  lookRes (p,c) = case lookupResDefKind gr p c of
-    Ok (t,_) | noExpand p -> return t
-    Ok (t,0) -> comp [] t
-    Ok (t,_) -> return t
-    Bad s -> raise s
-
-  noExpand p = errVal False $ do
-    mo <- lookupModMod gr p
-    return $ case getOptVal (iOpts (flags mo)) useOptimizer of
-      Just "noexpand" -> True
-      _ -> False
-
-  prtRaise s t = raise (s +++ prt t)
-
-  ext x a g = (x,a):g
-
-  returnC = return --- . computed
-
-  variants ts = case nub ts of
-       [t] -> t
-       ts  -> FV ts
-
-  isCan v = case v of
-       Con _    -> True
-       QC _ _   -> True
-       App f a  -> isCan f && isCan a
-       R rs     -> all (isCan . snd . snd) rs
-       _        -> False
-
-  compBranch g (p,v) = do
-       let g' = contP p ++ g
-       v' <- comp g' v
-       return (p,v')
-
-  compBranchOpt g c@(p,v) = case contP p of
-       [] -> return c
-       _ -> compBranch g c
-----       _ -> err (const (return c)) return $ compBranch g c
-
-  contP p = case p of
-       PV x -> [(x,Vr x)]
-       PC _ ps -> concatMap contP ps
-       PP _ _ ps -> concatMap contP ps
-       PT _ p -> contP p
-       PR rs -> concatMap (contP . snd) rs
-
-       PAs x p -> (x,Vr x) : contP p
-
-       PSeq p q -> concatMap contP [p,q]
-       PAlt p q -> concatMap contP [p,q]
-       PRep p   -> contP p
-       PNeg p   -> contP p
-
-       _ -> []
-
-  prawitz g i f cs e = do
-       cs' <- mapM (compBranch g) [(p, f v) | (p,v) <- cs]
-       return $ S (T i cs') e
-
--- | argument variables cannot be glued
-checkNoArgVars :: Term -> STM EEnv Term
-checkNoArgVars t = case t of
-  Vr (IA _)  -> raise $ glueErrorMsg $ prt t 
-  Vr (IAV _) -> raise $ glueErrorMsg $ prt t 
-  _ -> composOp checkNoArgVars t
-
-glueErrorMsg s = 
-  "Cannot glue (+) term with run-time variable" +++ s ++ "." ++++
-  "Use Prelude.bind instead."
-
-stmErr :: Err a -> STM s a
-stmErr e = stm (\s -> do
-  v <- e
-  return (v,s)
-  )
-
-evalIn :: String -> STM s a -> STM s a
-evalIn msg st = stm $ \s -> case appSTM st s of
-  Bad e -> Bad $ msg ++++ e
-  Ok vs -> Ok vs
diff --git a/src-3.0/GF/Compile/Flatten.hs b/src-3.0/GF/Compile/Flatten.hs
deleted file mode 100644
index 1168ca6da..000000000
--- a/src-3.0/GF/Compile/Flatten.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-module Flatten where
-
-import Data.List
--- import GF.Data.Operations
-
--- (AR 15/3/2006)
---
--- A method for flattening grammars: create many flat rules instead of
--- a few deep ones. This is generally better for parsins.
--- The rules are obtained as follows:
--- 1. write a config file tellinq which constants are variables: format 'c : C'
--- 2. generate a list of trees with their types: format 't : T'
--- 3. for each such tree, form a fun rule 'fun fui : X -> Y -> T' and a lin
---    rule 'lin fui x y = t' where x:X,y:Y is the list of variables in t, as
---    found in the config file.
--- 4. You can go on and produce def or transfer rules similar to the lin rules
---    except for the keyword.
---
--- So far this module is used outside gf. You can e.g. generate a list of
--- trees by 'gt', write it in a file, and then in ghci call
--- flattenGrammar <Config> <Trees> <OutFile>
-
-type Ident = String ---
-type Term  = String ---
-type Rule  = String ---
-
-type Config = [(Ident,Ident)]
-
-flattenGrammar :: FilePath -> FilePath -> FilePath -> IO ()
-flattenGrammar conff tf out = do
-  conf <- readFile conff >>= return . lines
-  ts   <- readFile tf    >>= return . lines
-  writeFile out $ mkFlatten conf ts
-
-mkFlatten :: [String] -> [String] -> String
-mkFlatten conff = unlines . concatMap getOne . zip [1..] where
-  getOne (k,t) = let (x,y) = mkRules conf ("fu" ++ show k) t in [x,y] 
-  conf = getConfig conff
-
-mkRules :: Config -> Ident -> Term -> (Rule,Rule)
-mkRules conf f t = (fun f ty, lin f (takeWhile (/=':') t)) where
-  args = mkArgs conf ts
-  ty   = concat [a ++ " -> " | a <- map snd args] ++ val
-  (ts,val) = let tt = lexTerm t in (init tt,last tt)
----  f  = identV t
-  fun c a = unwords   ["  fun", c, ":",a,";"] 
-  lin c a = unwords $ ["  lin", c] ++ map fst args ++ ["=",a,";"] 
-
-mkArgs :: Config -> [Ident] -> [(Ident,Ident)]
-mkArgs conf ids = [(x,ty) | x <- ids, Just ty <- [lookup x conf]]
-
-mkIdent :: Term -> Ident
-mkIdent = map mkChar where
-  mkChar c = case c of
-   '(' -> '6'
-   ')' -> '9'
-   ' ' -> '_'
-   _   -> c
-
--- to get just the identifiers
-lexTerm :: String -> [String]
-lexTerm ss = case lex ss of
-  [([c],ws)] | isSpec c ->     lexTerm ws
-  [(w@(_:_),ws)]        -> w : lexTerm ws
-  _ -> []
- where
-   isSpec = flip elem "();:"
-
-
-getConfig :: [String] -> Config
-getConfig = map getOne . filter (not . null) where
-  getOne line = case lexTerm line of
-    v:c:_ -> (v,c)
-
-ex = putStrLn fs where
-  fs = 
-    mkFlatten
-      ["man_N : N", 
-       "sleep_V : V"
-      ] 
-      ["PredVP (DefSg man_N) (UseV sleep_V) : Cl",
-       "PredVP (DefPl man_N) (UseV sleep_V) : Cl"
-      ]
-
-{-
--- result of ex
-  
-  fun fu1 : N -> V -> Cl ;
-  lin fu1 man_N sleep_V = PredVP (DefSg man_N) (UseV sleep_V)  ;
-  fun fu2 : N -> V -> Cl ;
-  lin fu2 man_N sleep_V = PredVP (DefPl man_N) (UseV sleep_V)  ;
--}
diff --git a/src-3.0/GF/Compile/GetGrammar.hs b/src-3.0/GF/Compile/GetGrammar.hs
deleted file mode 100644
index 294edbf9a..000000000
--- a/src-3.0/GF/Compile/GetGrammar.hs
+++ /dev/null
@@ -1,146 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GetGrammar
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/15 17:56:13 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.16 $
---
--- this module builds the internal GF grammar that is sent to the type checker
------------------------------------------------------------------------------
-
-module GF.Compile.GetGrammar (
-  getSourceModule, getSourceGrammar,
-  getOldGrammar, getCFGrammar, getEBNFGrammar
-		  ) where
-
-import GF.Data.Operations
-import qualified GF.Source.ErrM as E
-
-import GF.Infra.UseIO
-import GF.Grammar.Grammar
-import GF.Infra.Modules
-import GF.Grammar.PrGrammar
-import qualified GF.Source.AbsGF as A
-import GF.Source.SourceToGrammar
----- import Macros
----- import Rename
-import GF.Text.UTF8 ----
-import GF.Infra.Option
---- import Custom
-import GF.Source.ParGF
-import qualified GF.Source.LexGF as L
-
-import GF.CF.CF (rules2CF)
-import GF.CF.PPrCF
-import GF.CF.CFtoGrammar
-import GF.CF.EBNF
-
-import GF.Infra.ReadFiles ----
-
-import Data.Char (toUpper)
-import Data.List (nub)
-import qualified Data.ByteString.Char8 as BS
-import Control.Monad (foldM)
-import System (system)
-import System.FilePath
-
-getSourceModule :: Options -> FilePath -> IOE SourceModule
-getSourceModule opts file0 = do
-  file <- case getOptVal opts usePreprocessor of
-    Just p -> do
-      let tmp = "_gf_preproc.tmp"
-          cmd = p +++ file0 ++ ">" ++ tmp
-      ioeIO $ system cmd
-      -- ioeIO $ putStrLn $ "preproc" +++ cmd
-      return tmp
-    _ -> return file0
-  string0    <- readFileIOE file
-  let string = case getOptVal opts uniCoding of
-        Just "utf8" -> decodeUTF8 string0
-        _ -> string0
-  let tokens = myLexer (BS.pack string)
-  mo1  <- ioeErr $ pModDef tokens
-  ioeErr $ transModDef mo1
-
-getSourceGrammar :: Options -> FilePath -> IOE SourceGrammar
-getSourceGrammar opts file = do
-  string    <- readFileIOE file
-  let tokens = myLexer (BS.pack string)
-  gr1  <- ioeErr $ pGrammar tokens
-  ioeErr $ transGrammar gr1
-
-
--- for old GF format with includes
-
-getOldGrammar :: Options -> FilePath -> IOE SourceGrammar
-getOldGrammar opts file = do
-  defs <- parseOldGrammarFiles file
-  let g = A.OldGr A.NoIncl defs
-  let name = takeFileName file
-  ioeErr $ transOldGrammar opts name g
-
-parseOldGrammarFiles :: FilePath -> IOE [A.TopDef]
-parseOldGrammarFiles file = do
-   putStrLnE $ "reading grammar of old format" +++ file
-   (_, g) <- getImports "" ([],[]) file
-   return g  -- now we can throw away includes
-  where 
-   getImports oldInitPath (oldImps, oldG) f = do
-     (path,s) <- readFileLibraryIOE oldInitPath f
-     if not (elem path oldImps) 
-       then do
-         (imps,g) <- parseOldGrammar path
-         foldM (getImports (initFilePath path)) (path : oldImps, g ++ oldG) imps
-       else 
-         return (oldImps, oldG)
-
-parseOldGrammar :: FilePath -> IOE ([FilePath],[A.TopDef])
-parseOldGrammar file = do
-  putStrLnE $ "reading old file" +++ file
-  s <- ioeIO $ readFileIf file
-  A.OldGr incl topdefs <- ioeErr $ pOldGrammar $ oldLexer $ fixNewlines s
-  includes <- ioeErr $ transInclude incl
-  return (includes, topdefs)
-
-----
-
--- | To resolve the new reserved words: 
--- change them by turning the final letter to upper case.
---- There is a risk of clash. 
-oldLexer :: String -> [L.Token]
-oldLexer = map change . L.tokens . BS.pack where
-  change t = case t of
-    (L.PT p (L.TS s)) | elem s newReservedWords -> 
-        (L.PT p (L.TV (init s ++ [toUpper (last s)])))
-    _ -> t
-
-getCFGrammar :: Options -> FilePath -> IOE SourceGrammar
-getCFGrammar opts file = do
-  let mo = takeWhile (/='.') file
-  s    <- ioeIO  $ readFileIf file
-  let files = case words (concat (take 1 (lines s))) of
-        "--":"include":fs -> fs
-        _ -> []
-  ss   <- ioeIO  $ mapM readFileIf files
-  cfs  <- ioeErr $ mapM (pCF mo) $ s:ss
-  defs <- return $ cf2grammar $ rules2CF $ concat cfs
-  let g = A.OldGr A.NoIncl defs
----  let ma = justModuleName file
----  let mc = 'C':ma ---
----  let opts' = addOptions (options [useAbsName ma, useCncName mc]) opts
-  ioeErr $ transOldGrammar opts file g
-
-getEBNFGrammar :: Options -> FilePath -> IOE SourceGrammar
-getEBNFGrammar opts file = do
-  let mo = takeWhile (/='.') file
-  s    <- ioeIO $ readFileIf file
-  defs <- ioeErr $ pEBNFasGrammar s
-  let g = A.OldGr A.NoIncl defs
----  let ma = justModuleName file
----  let mc = 'C':ma ---
----  let opts' = addOptions (options [useAbsName ma, useCncName mc]) opts
-  ioeErr $ transOldGrammar opts file g
diff --git a/src-3.0/GF/Compile/GrammarToCanon.hs b/src-3.0/GF/Compile/GrammarToCanon.hs
deleted file mode 100644
index 09c0d3d95..000000000
--- a/src-3.0/GF/Compile/GrammarToCanon.hs
+++ /dev/null
@@ -1,293 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GrammarToCanon
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/11 23:24:33 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.23 $
---
--- Code generator from optimized GF source code to GFC.
------------------------------------------------------------------------------
-
-module GF.Compile.GrammarToCanon (showGFC,
-		       redModInfo, redQIdent
-		      ) where
-
-import GF.Data.Operations
-import GF.Data.Zipper
-import GF.Infra.Option
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Grammar.PrGrammar
-import GF.Infra.Modules
-import GF.Grammar.Macros
-import qualified GF.Canon.AbsGFC as G
-import qualified GF.Canon.GFC as C
-import GF.Canon.MkGFC
----- import Alias
-import qualified GF.Canon.PrintGFC as P
-
-import Control.Monad
-import Data.List (nub,sortBy)
-
--- compilation of optimized grammars to canonical GF. AR 5/10/2001 -- 12/5/2003
-
--- | This is the top-level function printing a gfc file
-showGFC :: SourceGrammar -> String
-showGFC = err id id . liftM (P.printTree . grammar2canon) . redGrammar
-
--- | any grammar, first trying without dependent types
--- abstract syntax without dependent types
-redGrammar :: SourceGrammar -> Err C.CanonGrammar
-redGrammar (MGrammar gr) = liftM MGrammar $ mapM redModInfo $ filter active gr where
-  active (_,m) = case typeOfModule m of
-    MTInterface -> False
-    _ -> True
-
-redModInfo :: (Ident, SourceModInfo) -> Err (Ident, C.CanonModInfo)
-redModInfo (c,info) = do
-  c'    <- redIdent c
-  info' <- case info of
-    ModMod m -> do
-      let isIncompl = not $ isCompleteModule m
-      (e,os) <- if isIncompl then return ([],[]) else redExtOpen m ----
-      flags <- mapM redFlag $ flags m 
-      (a,mt0) <- case mtype m of
-         MTConcrete a -> do
-           a' <- redIdent a
-           return (a', MTConcrete a') 
-         MTAbstract -> return (c',MTAbstract) --- c' not needed
-         MTResource -> return (c',MTResource) --- c' not needed
-         MTInterface -> return (c',MTResource) ---- not needed
-         MTInstance _ -> return (c',MTResource) --- c' not needed
-         MTTransfer x y -> return (c',MTTransfer (om x) (om y)) --- c' not needed
-
-      --- this generates empty GFC reosurce for interface and incomplete
-      let js = if isIncompl then emptyBinTree else jments m
-          mt = mt0 ---- if isIncompl then MTResource else mt0
-
-      defss <- mapM (redInfo a) $ tree2list $ js
-      let defs0 = concat defss
-      let lgh = length defs0
-      defs  <- return $ sorted2tree $ defs0  -- sorted, but reduced
-      let flags1 = if isIncompl then C.flagIncomplete : flags else flags
-      let flags' = G.Flg (identC "modulesize") (identC ("n"++show lgh)) : flags1
-      return $ ModMod $ Module mt MSComplete flags' e os defs
-  return (c',info')
- where
-   redExtOpen m = do
-     e' <- case extends m of
-       es -> mapM (liftM inheritAll . redIdent) es
-     os' <- mapM (\o -> case o of 
-              OQualif q _ i -> liftM (OSimple q) (redIdent i)
-              _ -> prtBad "cannot translate unqualified open in" c) $ opens m
-     return (e',nub os')
-   om = oSimple . openedModule --- normalizing away qualif
-
-redInfo :: Ident -> (Ident,Info) -> Err [(Ident,C.Info)]
-redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
-  c' <- redIdent c 
-  case info of
-    AbsCat (Yes cont) pfs -> do
-      let fs = case pfs of
-                 Yes ts -> [(m,c) | Q m c <- ts]
-                 _ -> []
-      returns c' $ C.AbsCat cont fs
-    AbsFun (Yes typ) pdf -> do
-      let df = case pdf of
-                 Yes t -> t  -- definition or "data"
-                 _ -> Eqs [] -- primitive notion
-      returns c' $ C.AbsFun typ df
-    AbsTrans t -> 
-      returns c' $ C.AbsTrans t
-
-    ResParam (Yes (ps,_)) -> do
-      ps' <- mapM redParam ps
-      returns c' $ C.ResPar ps'
-
-    CncCat pty ptr ppr -> case (pty,ptr,ppr) of
-      (Yes ty, Yes (Abs _ t), Yes pr) -> do
-        ty'  <- redCType ty
-        trm' <- redCTerm t
-        pr'  <- redCTerm pr 
-        return [(c', C.CncCat ty' trm' pr')]
-      _ -> prtBad ("cannot reduce rule for") c
-      
-    CncFun mt ptr ppr -> case (mt,ptr,ppr) of
-      (Just (cat,_), Yes trm, Yes pr) -> do
-        cat' <- redIdent cat
-        (xx,body,_) <- termForm trm
-        xx'   <- mapM redArgvar xx
-        body' <- errIn (prt body) $ redCTerm body ---- debug
-        pr'   <- redCTerm pr 
-        return [(c',C.CncFun (G.CIQ am cat') xx' body' pr')]
-      _ -> prtBad ("cannot reduce rule" +++ show info +++ "for") c ---- debug
-
-    AnyInd s b -> do
-      b' <- redIdent b
-      returns c' $ C.AnyInd s b'
-
-    _ -> return [] --- retain some operations
- where
-   returns f i = return [(f,i)]
-
-redQIdent :: QIdent -> Err G.CIdent
-redQIdent (m,c) = return $ G.CIQ m c
-
-redIdent :: Ident -> Err Ident
-redIdent x 
-  | isWildIdent x = return $ identC "h_" --- needed in declarations
-  | otherwise = return $ identC $ prt x ---
-
-redFlag :: Option -> Err G.Flag
-redFlag (Opt (f,[x])) = return $ G.Flg (identC f) (identC x)
-redFlag o = Bad $ "cannot reduce option" +++ prOpt o
-
-redDecl :: Decl -> Err G.Decl
-redDecl (x,a) = liftM2 G.Decl (redIdent x) (redType a)
-
-redType :: Type -> Err G.Exp
-redType = redTerm
-
-redTerm :: Type -> Err G.Exp
-redTerm t = return $ rtExp t
-
--- to normalize records and record types
-sortByFst :: Ord a => [(a,b)] -> [(a,b)]
-sortByFst = sortBy (\ x y -> compare (fst x) (fst y))
-
--- resource
-
-redParam :: Param -> Err G.ParDef
-redParam (c,cont) = do
-  c'    <- redIdent c
-  cont' <- mapM (redCType . snd) cont
-  return $ G.ParD c' cont'
-
-redArgvar :: Ident -> Err G.ArgVar
-redArgvar x = case x of
-  IA (x,i)     -> return $ G.A  (identC x) (toInteger i)
-  IAV (x,b,i) -> return $ G.AB (identC x) (toInteger b) (toInteger i)
-  _ -> Bad $ "cannot reduce" +++ show x +++ "as argument variable"
-
-redLindef :: Term -> Err G.Term
-redLindef t = case t of
-  Abs x b -> redCTerm b ---
-  _ -> redCTerm t
-
-redCType :: Type -> Err G.CType
-redCType t = case t of
-  RecType lbs -> do
-    let (ls,ts) = unzip lbs
-        ls' = map redLabel ls
-    ts' <- mapM redCType ts
-    return $ G.RecType $ map (uncurry G.Lbg) $ sortByFst $ zip ls' ts'
-  Table p v  -> liftM2 G.Table (redCType p) (redCType v)
-  Q m c    -> liftM G.Cn $ redQIdent (m,c)
-  QC m c   -> liftM G.Cn $ redQIdent (m,c)
-
-  App (Q (IC "Predef") (IC "Ints")) (EInt n) -> return $ G.TInts (toInteger n)
-
-  Sort "Str" -> return $ G.TStr
-  Sort "Tok" -> return $ G.TStr
-  _ -> prtBad "cannot reduce to canonical the type" t
-
-redCTerm :: Term -> Err G.Term
-redCTerm t = case t of
-  Vr x -> checkAgain 
-            (liftM G.Arg $ redArgvar x) 
-            (liftM G.LI  $ redIdent x) --- for parametrize optimization
-  App _ s -> do  -- only constructor applications can remain
-    (_,c,xx) <- termForm t
-    xx' <- mapM redCTerm xx
-    case c of
-      QC p c -> liftM2 G.Par (redQIdent (p,c)) (return xx')
-      Q (IC "Predef") (IC "error") -> fail $ "error: " ++ stringFromTerm s
-      _ -> prtBad "expected constructor head instead of" c
-  Q p c  -> liftM G.I (redQIdent (p,c))
-  QC p c -> liftM2 G.Par (redQIdent (p,c)) (return [])
-  R rs     -> do
-    let (ls,tts) = unzip rs
-        ls' = map redLabel ls
-    ts <- mapM (redCTerm . snd) tts
-    return $ G.R $ map (uncurry G.Ass) $ sortByFst $ zip ls' ts
-  RecType [] -> return $ G.R [] --- comes out in parsing
-  P tr l -> do
-    tr' <- redCTerm tr
-    return $ G.P tr' (redLabel l)
-  PI tr l _ -> redCTerm $ P tr l -----
-  T i cs     -> do
-    ty  <- getTableType i
-    ty' <- redCType ty
-    let (ps,ts) = unzip cs
-    ps' <- mapM redPatt ps
-    ts' <- mapM redCTerm ts
-    return $ G.T ty' $ map (uncurry G.Cas) $ zip (map singleton ps') ts'
-  TSh i cs -> do
-    ty  <- getTableType i
-    ty' <- redCType ty
-    let (pss,ts) = unzip cs
-    pss' <- mapM (mapM redPatt) pss
-    ts' <- mapM redCTerm ts
-    return $ G.T ty' $ map (uncurry G.Cas) $ zip pss' ts'
-  V ty ts     -> do
-    ty' <- redCType ty
-    ts' <- mapM redCTerm ts
-    return $ G.V ty' ts'
-  S u v -> liftM2 G.S (redCTerm u) (redCTerm v)
-  K s   -> return $ G.K (G.KS s)
-  EInt i -> return $ G.EInt i
-  EFloat i -> return $ G.EFloat i
-  C u v -> liftM2 G.C (redCTerm u) (redCTerm v)
-  FV ts -> liftM G.FV $ mapM redCTerm ts
----  Ready ss -> return $ G.Ready [redStr ss] --- obsolete
-
-  Alts (d,vs) -> do ---
-    d'  <- redCTermTok d
-    vs' <- mapM redVariant vs
-    return $ G.K $ G.KP d' vs'
-
-  Empty -> return $ G.E
-
----  Strs ss -> return $ G.Strs [s | K s <- ss] ---
-
----- Glue obsolete in canon, should not occur here
-  Glue x y -> redCTerm (C x y)
-
-  _ -> Bad ("cannot reduce term" +++ prt t)
-
-redPatt :: Patt -> Err G.Patt
-redPatt p = case p of
-  PP m c ps -> liftM2 G.PC (redQIdent (m,c)) (mapM redPatt ps) 
-  PR rs -> do
-    let (ls,tts) = unzip rs
-        ls' = map redLabel ls
-    ts <- mapM redPatt tts
-    return $ G.PR $  map (uncurry G.PAss) $ sortByFst $ zip ls' ts
-  PT _ q -> redPatt q
-  PInt i -> return $ G.PI i
-  PFloat i -> return $ G.PF i
-  PV x -> liftM G.PV $ redIdent x --- for parametrize optimization
-  _ -> prtBad "cannot reduce pattern" p
-
-redLabel :: Label -> G.Label
-redLabel (LIdent s) = G.L $ identC s
-redLabel (LVar i)   = G.LV $ toInteger i
-
-redVariant :: (Term, Term) -> Err G.Variant
-redVariant (v,c) = do
-  v' <- redCTermTok v
-  c' <- redCTermTok c
-  return $ G.Var v' c'
-
-redCTermTok :: Term -> Err [String]
-redCTermTok t = case t of
-  K s   -> return [s]
-  Empty -> return []
-  C a b -> liftM2 (++) (redCTermTok a) (redCTermTok b)
-  Strs ss -> return [s | K s <- ss] ---
-  _ -> prtBad "cannot get strings from term" t
-
diff --git a/src-3.0/GF/Compile/MkConcrete.hs b/src-3.0/GF/Compile/MkConcrete.hs
deleted file mode 100644
index d016a7e47..000000000
--- a/src-3.0/GF/Compile/MkConcrete.hs
+++ /dev/null
@@ -1,154 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : MkConcrete
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 
--- > CVS $Author: 
--- > CVS $Revision: 
---
--- Compile a gfe file into a concrete syntax by using the parser on a resource grammar.
------------------------------------------------------------------------------
-
-module GF.Compile.MkConcrete (mkConcretes) where
-
-import GF.Grammar.Values (Tree,tree2exp)
-import GF.Grammar.PrGrammar (prt_,prModule)
-import GF.Grammar.Grammar --- (Term(..),SourceModule)
-import GF.Grammar.Macros (composSafeOp, composOp, record2subst, zIdent)
-import GF.Compile.ShellState --(firstStateGrammar,stateGrammarWords)
-import GF.Compile.PGrammar (pTerm,pTrm)
-import GF.Compile.Compile
-import GF.Compile.PrOld (stripTerm)
-import GF.Compile.GetGrammar
-import GF.API
-import GF.API.IOGrammar
-import qualified GF.Embed.EmbedAPI as EA
-
-import GF.Data.Operations
-import GF.Infra.UseIO
-import GF.Infra.Option
-import GF.Infra.Modules
-import GF.Infra.ReadFiles
-import GF.System.Arch
-import GF.UseGrammar.Treebank
-
-import System.Directory
-import System.FilePath
-import Data.Char
-import Control.Monad
-import Data.List
-
--- translate strings into lin rules by parsing in a resource
--- grammar. AR 2/6/2005
-
--- Format of rule (on one line):
---    lin F x y = in C "ssss" ;
--- Format of resource path (on first line):
---    --# -resource=PATH
--- Other lines are copied verbatim.
--- A sequence of files can be processed with the same resource without
--- rebuilding the grammar and parser.
-
--- notice: we use a hand-crafted lexer and parser in order to preserve
--- the layout and comments in the rest of the file.
-
-mkConcretes :: Options -> [FilePath] -> IO ()
-mkConcretes opts files = do
-  ress <- mapM getResPath files
-  let grps = groupBy (\a b -> fst a == fst b) $ 
-               sortBy (\a b -> compare (fst a) (fst b)) $ zip ress files
-  mapM_ (mkCncGroups opts) [(rp,map snd gs) | gs@((rp,_):_) <- grps]
-
-mkCncGroups opts0 ((res,path),files) = do
-  putStrLnFlush $ "Going to preprocess examples in " ++ unwords files
-  putStrLn $ "Compiling resource " ++ res
-  let opts = addOptions (options [beSilent,pathList path]) opts0
-  let treebank = oElem (iOpt "treebank") opts
-  resf <- useIOE res $ do
-    (fp,_) <- readFileLibraryIOE "" res
-    return fp
-  egr <- appIOE $ shellStateFromFiles opts emptyShellState resf
-  (parser,morpho) <- if treebank then do
-      tb <- err (\_ -> error $ "no treebank of name" +++ path)
-                return
-                (egr >>= flip findTreebank (zIdent path))
-      return (\_ -> flip (,) "Not in treebank" . map pTrm . lookupTreebank tb,
-              isWordInTreebank tb)
-    else do
-      gr  <- err (\s -> putStrLn s >> error "resource grammar rejected") 
-                 (return . firstStateGrammar) egr
-      return 
-            (\cat s -> 
-                errVal ([],"No parse") $ 
-                optParseArgErrMsg (options [newFParser, firstCat cat, beVerbose]) gr s >>=
-                (\ (ts,e) -> return (map tree2exp ts, e)) , 
-            isKnownWord gr)
-  putStrLn "Building parser"
-  mapM_ (mkConcrete parser morpho) files
-
-type Parser = String -> String -> ([Term],String)
-type Morpho = String -> Bool 
-
-getResPath :: FilePath -> IO (String,String)
-getResPath file = do
-  s <- liftM lines $ readFileIf file
-  case filter (not . all isSpace) s of
-    res:path:_ | is "resource" res && is "path"     path -> return (val res, val path)
-    res:path:_ | is "resource" res && is "treebank" path -> return (val res, val path)
-    res:_ | is "resource" res -> return (val res, "")
-    _ -> error 
-           "expected --# -resource=FILE and optional --# -path=PATH or --# -treebank=IDENT"
- where
-   val = dropWhile (isSpace) . tail . dropWhile (not . (=='='))
-   is tag s = case words s of
-     "--#":w:_ -> isPrefixOf ('-':tag) w
-     _ -> False 
-
-
-mkConcrete :: Parser -> Morpho -> FilePath -> IO ()
-mkConcrete parser morpho file = do
-  src <- appIOE (getSourceModule noOptions file) >>= err error return
-  let (src',msgs) = mkModule parser morpho src
-  let out = addExtension (justModuleName file) "gf"
-  writeFile out $ "-- File generated by GF from " ++ file
-  appendFile out "\n"
-  appendFile out (prModule src')
-  appendFile out "{-\n"
-  appendFile out $ unlines $ filter (not . null) msgs
-  appendFile out "-}\n"
-
-mkModule :: Parser -> Morpho -> SourceModule -> (SourceModule,[String])
-mkModule parser morpho (name,src) = case src of 
-  ModMod m@(Module mt st fs me ops js) ->
-
-    let js1 = jments m
-        (js2,msgs) = err error id $ appSTM (mapMTree mkInfo js1) []
-        mod2 = ModMod $ Module mt st fs me ops $ js2
-    in ((name,mod2), msgs)
- where
-  mkInfo ni@(name,info) = case info of
-    CncFun mt (Yes trm) ppr -> do
-      trm' <- mkTrm trm
-      return (name, CncFun mt (Yes trm') ppr) 
-    _ -> return ni
-   where
-     mkTrm t = case t of
-       Example (P _ cat) s -> parse cat s t
-       Example (Vr  cat) s -> parse cat s t
-       _ -> composOp mkTrm t
-     parse cat s t = case parser (prt_ cat) s of
-       (tr:[], _) -> do
-         updateSTM ((("PARSED in" +++ prt_ name) : s : [prt_ tr]) ++)
-         return $ stripTerm tr
-       (tr:trs,_) -> do
-         updateSTM ((("AMBIGUOUS in" +++ prt_ name) : s : map prt_ trs) ++)
-         return $ stripTerm tr
-       ([],ms) -> do
-         updateSTM ((("NO PARSE in" +++ prt_ name) : s : ms : [morph s]) ++)
-         return t
-  morph s = case [w | w <- words s, not (morpho w)] of
-    [] -> ""
-    ws -> "unknown words: " ++ unwords ws
diff --git a/src-3.0/GF/Compile/MkResource.hs b/src-3.0/GF/Compile/MkResource.hs
deleted file mode 100644
index 10831b5c6..000000000
--- a/src-3.0/GF/Compile/MkResource.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : MkResource
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/30 21:08:14 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.14 $
---
--- Compile a gfc module into a "reuse" gfr resource, interface, or instance.
------------------------------------------------------------------------------
-
-module GF.Compile.MkResource (makeReuse) where
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Modules
-import GF.Grammar.Macros
-import GF.Grammar.Lockfield
-import GF.Grammar.PrGrammar
-
-import GF.Data.Operations
-
-import Control.Monad
-
--- | extracting resource r from abstract + concrete syntax.
--- AR 21\/8\/2002 -- 22\/6\/2003 for GF with modules
-makeReuse :: SourceGrammar -> Ident -> [(Ident,MInclude Ident)] -> 
-             MReuseType Ident -> Err SourceRes
-makeReuse gr r me mrc = do
-  flags <- return [] --- no flags are passed: they would not make sense
-  case mrc of
-    MRResource c -> do
-      (ops,jms) <- mkFull True c
-      return $ Module MTResource MSComplete flags me ops jms
-
-    MRInstance c a -> do
-      (ops,jms) <- mkFull False c
-      return $ Module (MTInstance a) MSComplete flags me ops jms
-
-    MRInterface c -> do
-      mc <- lookupModule gr c
-
-      (ops,jms) <- case mc of 
-        ModMod m -> case mtype m of
-          MTAbstract -> liftM ((,) (opens m)) $ 
-                          mkResDefs True False gr r c me 
-                            (extend m) (jments m) emptyBinTree
-          _ -> prtBad "expected abstract to be the type of" c
-        _ -> prtBad "expected abstract to be the type of" c
-
-      return $ Module MTInterface MSIncomplete flags me ops jms
-
- where
-    mkFull hasT c = do
-      mc <- lookupModule gr c
-
-      case mc of 
-        ModMod m -> case mtype m of
-          MTConcrete a -> do
-            ma <- lookupModule gr a
-            jmsA <- case ma of 
-               ModMod m' -> return $ jments m'
-               _ -> prtBad "expected abstract to be the type of" a
-            liftM ((,) (opens m)) $ 
-               mkResDefs hasT True gr r a me (extend m) jmsA (jments m)
-          _ -> prtBad "expected concrete to be the type of" c
-        _ -> prtBad "expected concrete to be the type of" c
-
-
--- | the first  Boolean indicates if the type needs be given
--- the second Boolean indicates if the definition needs be given
-mkResDefs :: Bool -> Bool -> 
-             SourceGrammar -> Ident -> Ident -> 
-             [(Ident,MInclude Ident)] -> [(Ident,MInclude Ident)] -> 
-             BinTree Ident Info -> BinTree Ident Info -> 
-             Err (BinTree Ident Info)
-mkResDefs hasT isC gr r a mext maext abs cnc = mapMTree (mkOne a maext) abs where
-
-  ifTyped  = yes --- if hasT then yes else const nope --- needed for TC
-  ifCompl  = if isC  then yes else const nope
-  doIf b t = if b then t else return typeType -- latter value not used
-
-  mkOne a mae (f,info) = case info of
-      AbsCat _ _ -> do
-        typ  <- doIf isC $ err (const (return defLinType)) return $ look cnc f
-        typ' <- doIf isC $ lockRecType f typ 
-        return (f, ResOper (ifTyped typeType) (ifCompl typ'))
-      AbsFun (Yes typ0) _ -> do
-        trm <- doIf isC $ look cnc f
-        testErr (not (isHardType typ0)) 
-                ("cannot build reuse for function" +++ prt f +++ ":" +++ prt typ0)
-        typ <- redirTyp True a mae typ0
-        cat <- valCat typ
-        trm' <- doIf isC $ unlockRecord (snd cat) trm 
-        return (f, ResOper (ifTyped typ) (ifCompl trm'))
-      AnyInd b n -> do
-        mo    <- lookupModMod gr n
-        info' <- lookupInfo mo f
-        mkOne n (extend mo) (f,info')
-
-  look cnc f = do
-     info <- lookupTree prt f cnc
-     case info of
-       CncCat (Yes ty) _ _ -> return ty
-       CncCat _ _ _        -> return defLinType
-       CncFun _ (Yes tr) _ -> return tr
-       AnyInd _ n -> do 
-         mo    <- lookupModMod gr n
-         t <- look (jments mo) f
-         redirTyp False n (extend mo) t
-       _ -> prtBad "not enough information to reuse" f
-
-  -- type constant qualifications changed from abstract to resource
-  redirTyp always a mae ty = case ty of
-    Q _ c | always -> return $ Q r c
-    Q n c | n == a || [n] == map fst mae -> return $ Q r c ---- FIX for non-singleton exts
-    _ -> composOp (redirTyp always a mae) ty
-
--- | no reuse for functions of HO\/dep types
-isHardType t = case t of
-  Prod x a b -> not (isWild x) || isHardType a || isHardType b
-  App _ _    -> True
-  _          -> False  
- where 
-   isWild x = isWildIdent x || prt x == "h_" --- produced by transl from canon
diff --git a/src-3.0/GF/Compile/MkUnion.hs b/src-3.0/GF/Compile/MkUnion.hs
deleted file mode 100644
index b4b1f40c8..000000000
--- a/src-3.0/GF/Compile/MkUnion.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : MkUnion
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:21:39 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.7 $
---
--- building union of modules.
--- AR 1\/3\/2004 --- OBSOLETE 15\/9\/2004 with multiple inheritance
------------------------------------------------------------------------------
-
-module GF.Compile.MkUnion (makeUnion) where
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Modules
-import GF.Grammar.Macros
-import GF.Grammar.PrGrammar
-
-import GF.Data.Operations
-import GF.Infra.Option
-
-import Data.List
-import Control.Monad
-
-makeUnion :: SourceGrammar -> Ident -> ModuleType Ident -> [(Ident,[Ident])] ->
-             Err SourceModule
-makeUnion gr m ty imps = do
-  ms    <- mapM (lookupModMod gr . fst) imps
-  typ   <- return ty ---- getTyp ms
-  ext   <- getExt [i | Just i <- map extends ms]
-  ops   <- return $ nub $ concatMap opens ms
-  flags <- return $ concatMap flags ms
-  js    <- liftM (buildTree . concat) $ mapM getJments imps
-  return $ (m, ModMod (Module typ MSComplete flags ext ops js))
-
- where
-   getExt es = case es of
-     [] -> return Nothing
-     i:is -> if all (==i) is then return (Just i) 
-               else Bad "different extended modules in union forbidden"
-   getJments (i,fs) = do
-     m  <- lookupModMod gr i
-     let js = jments m
-     if null fs 
-       then 
-         return (map (unqual i) $ tree2list js) 
-       else do
-         ds <- mapM (flip justLookupTree js) fs
-         return $ map (unqual i) $ zip fs ds
-
-   unqual i (f,d) = curry id f $ case d of
-     AbsCat  pty pts -> AbsCat (qualCo pty) (qualPs pts)
-     AbsFun  pty pt -> AbsFun (qualP pty) (qualP pt)
-     AbsTrans t     -> AbsTrans $ qual t
-     ResOper pty pt -> ResOper (qualP pty) (qualP pt)
-     CncCat  pty pt pp -> CncCat (qualP pty) (qualP pt) (qualP pp)
-     CncFun  mp pt pp -> CncFun (qualLin mp) (qualP pt) (qualP pp) ---- mp
-     ResParam (Yes ps) -> ResParam (yes (map qualParam ps)) 
-     ResValue pty ->  ResValue (qualP pty)
-     _ -> d
-    where
-     qualP pt = case pt of
-       Yes t -> yes $ qual t
-       _ -> pt
-     qualPs pt = case pt of
-       Yes ts -> yes $ map qual ts
-       _ -> pt
-     qualCo pco = case pco of
-       Yes co -> yes $ [(x,qual t) | (x,t) <- co]
-       _ -> pco
-     qual t = case t of
-       Q m c  | m==i -> Cn c
-       QC m c | m==i -> Cn c
-       _ -> composSafeOp qual t
-     qualParam (p,co) = (p,[(x,qual t) | (x,t) <- co])
-     qualLin (Just (c,(co,t))) = (Just (c,([(x,qual t) | (x,t) <- co], qual t)))
-     qualLin Nothing = Nothing
-     
diff --git a/src-3.0/GF/Compile/NewRename.hs b/src-3.0/GF/Compile/NewRename.hs
deleted file mode 100644
index cec8ed24f..000000000
--- a/src-3.0/GF/Compile/NewRename.hs
+++ /dev/null
@@ -1,294 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:21:41 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.6 $
---
--- AR 14\/5\/2003
---
--- The top-level function 'renameGrammar' does several things:
---
---   - extends each module symbol table by indirections to extended module
---
---   - changes unqualified and as-qualified imports to absolutely qualified
---
---   - goes through the definitions and resolves names
---
--- Dependency analysis between modules has been performed before this pass.
--- Hence we can proceed by @fold@ing "from left to right".
------------------------------------------------------------------------------
-
-module GF.Compile.NewRename (renameSourceTerm, renameModule) where
-
-import GF.Grammar.Grammar
-import GF.Grammar.Values
-import GF.Infra.Modules
-import GF.Infra.Ident
-import GF.Grammar.Macros
-import GF.Grammar.PrGrammar
-import GF.Grammar.AppPredefined
-import GF.Grammar.Lookup
-import GF.Compile.Extend
-import GF.Data.Operations
-
-import Control.Monad
-
--- | this gives top-level access to renaming term input in the cc command
-renameSourceTerm :: SourceGrammar -> Ident -> Term -> Err Term
-renameSourceTerm g m t = do
-  mo     <- lookupErr m (modules g)
-  let status = (modules g,(m,mo)) --- <- buildStatus g m mo
-  renameTerm status [] t
-
--- | this is used in the compiler, separately for each module
-renameModule :: [SourceModule] -> SourceModule -> Err [SourceModule]
-renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of
-  ModMod m@(Module mt st fs me ops js) -> do
-    let js1 = jments m
-    let status = (ms, (name, mod))
-    js2    <- mapMTree (renameInfo status) js1
-    let mod2 = ModMod $ Module mt st fs me (map forceQualif ops) js2
-    return $ (name,mod2) : ms
-
-type Status = ([SourceModule],SourceModule)   --- (StatusTree, [(OpenSpec Ident, StatusTree)])
-
---- type StatusTree = BinTree (Ident,StatusInfo)
-
---- type StatusInfo = Ident -> Term
-
-lookupStatusInfo :: Ident -> SourceModule -> Err Term
-lookupStatusInfo c (q,ModMod m) = do
-  i <- lookupTree prt c $ jments m
-  return $ case i of
-    AbsFun _ (Yes EData) -> QC q c
-    ResValue _           -> QC q c
-    ResParam _           -> QC q c
-    AnyInd True n        -> QC n c --- should go further?
-    AnyInd False n       -> Q  n c
-    _                    -> Q  q c
-lookupStatusInfo c (q,_) = prtBad "ModMod expected for" q
-
-lookupStatusInfoMany :: [SourceModule] -> Ident -> Err Term
-lookupStatusInfoMany (m:ms) c = case lookupStatusInfo c m of
-  Ok v -> return v
-  _ -> lookupStatusInfoMany ms c
-lookupStatusInfoMany [] x = 
-  prtBad "renaming failed to find unqualified constant" x
----- should also give error if stg is found in more than one module
-
-renameIdentTerm :: Status -> Term -> Err Term
-renameIdentTerm env@(imps,act@(_,ModMod this)) t = 
- errIn ("atomic term" +++ prt t +++ "given" +++ unwords (map (prt . fst) qualifs)) $
-   case t of
-  Vr c -> do
-    f <- err (predefAbs c) return $ lookupStatusInfoMany openeds c
-    return $ f
-  Cn c -> do
-    f <- lookupStatusInfoMany openeds c
-    return $ f
-  Q m' c | m' == cPredef {- && isInPredefined c -} -> return t
-  Q m' c -> do
-    m <- lookupErr m' qualifs
-    f <- lookupStatusInfo c m
-    return $ f
-  QC m' c | m' == cPredef {- && isInPredefined c -} -> return t
-  QC m' c -> do
-    m <- lookupErr m' qualifs
-    f <- lookupStatusInfo c m
-    return $ f
-  _ -> return t
- where
-   openeds = act : [(m,st) | OSimple _ m <- opens this, Just st <- [lookup m imps]]
-   qualifs = 
-     [(m, (n,st)) | OQualif _ m n <- opens this, Just st <- [lookup n imps]] 
-     ++ 
-     [(m, (m,st)) | OSimple _ m   <- opens this, Just st <- [lookup m imps]] 
-                                -- qualif is always possible
-
-   -- this facility is mainly for BWC with GF1: you need not import PredefAbs
-   predefAbs c s = case c of
-     IC "Int"    -> return $ Q cPredefAbs cInt
-     IC "String" -> return $ Q cPredefAbs cString
-     _ -> Bad s
-
--- | would it make sense to optimize this by inlining?
-renameIdentPatt :: Status -> Patt -> Err Patt
-renameIdentPatt env p = do
-  let t = patt2term p
-  t' <- renameIdentTerm env t
-  term2patt t'
-
-{- deprec !
-info2status :: Maybe Ident -> (Ident,Info) -> (Ident,StatusInfo)
-info2status mq (c,i) = (c, case i of
-  AbsFun _ (Yes EData) -> maybe Con QC mq
-  ResValue _  -> maybe Con QC mq
-  ResParam _  -> maybe Con QC mq
-  AnyInd True m -> maybe Con (const (QC m)) mq
-  AnyInd False m -> maybe Cn (const (Q m)) mq
-  _           -> maybe Cn  Q mq
-  )
-
-tree2status :: OpenSpec Ident -> BinTree (Ident,Info) -> BinTree (Ident,StatusInfo)
-tree2status o = case o of
-  OSimple _ i   -> mapTree (info2status (Just i))
-  OQualif _ i j -> mapTree (info2status (Just j))
-
-buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status
-buildStatus gr c mo = let mo' = self2status c mo in case mo of
-  ModMod m -> do
-    let gr1 = MGrammar $ (c,mo) : modules gr 
-        ops = [OSimple OQNormal e | e <- allExtendsPlus gr1 c] ++ allOpens m
-    mods <- mapM (lookupModule gr1 . openedModule) ops
-    let sts = map modInfo2status $ zip ops mods    
-    return $ if isModCnc m
-      then (NT, reverse sts) -- the module itself does not define any names
-      else (mo',reverse sts) -- so the empty ident is not needed
-
-modInfo2status :: (OpenSpec Ident,SourceModInfo) -> (OpenSpec Ident, StatusTree)
-modInfo2status (o,i) = (o,case i of
-  ModMod m -> tree2status o (jments m)
-  )
-
-self2status :: Ident -> SourceModInfo -> StatusTree
-self2status c i = mapTree (info2status (Just c)) js where   -- qualify internal
-  js = case i of
-    ModMod m 
-      | isModTrans m -> sorted2tree $ filter noTrans $ tree2list $ jments m 
-      | otherwise -> jments m
-  noTrans (_,d) = case d of  -- to enable other than transfer js in transfer module 
-    AbsTrans _ -> False
-    _ -> True
--}
-
-forceQualif o = case o of
-  OSimple q i   -> OQualif q i i
-  OQualif q _ i -> OQualif q i i
-  
-renameInfo :: Status -> (Ident,Info) -> Err (Ident,Info)
-renameInfo status (i,info) = errIn ("renaming definition of" +++ prt i) $ 
-                                liftM ((,) i) $ case info of
-  AbsCat pco pfs -> liftM2 AbsCat (renPerh (renameContext status) pco)
-                                  (renPerh (mapM rent) pfs)
-  AbsFun pty ptr -> liftM2 AbsFun (ren pty) (ren ptr)
-  AbsTrans f -> liftM AbsTrans (rent f)
-
-  ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
-  ResParam pp -> liftM ResParam (renPerh (mapM (renameParam status)) pp)
-  ResValue t  -> liftM ResValue (ren t)
-  CncCat pty ptr ppr -> liftM3 CncCat (ren pty) (ren ptr) (ren ppr)
-  CncFun mt  ptr ppr -> liftM2 (CncFun mt)      (ren ptr) (ren ppr)
-  _ -> return info
- where 
-   ren = renPerh rent
-   rent = renameTerm status []
-
-renPerh ren pt = case pt of
-  Yes t -> liftM Yes $ ren t
-  _ -> return pt
-
-renameTerm :: Status -> [Ident] -> Term -> Err Term
-renameTerm env vars = ren vars where
-  ren vs trm = case trm of
-    Abs x b    -> liftM  (Abs x) (ren (x:vs) b)
-    Prod x a b -> liftM2 (Prod x) (ren vs a) (ren (x:vs) b)
-    Typed a b  -> liftM2 Typed (ren vs a) (ren vs b)
-    Vr x      
-      | elem x vs -> return trm
-      | otherwise -> renid trm
-    Cn _   -> renid trm
-    Con _  -> renid trm
-    Q _ _  -> renid trm
-    QC _ _ -> renid trm
-    Eqs eqs -> liftM Eqs $ mapM (renameEquation env vars) eqs
-    T i cs -> do
-      i' <- case i of
-        TTyped ty -> liftM TTyped $ ren vs ty -- the only annotation in source
-        _ -> return i
-      liftM (T i') $ mapM (renCase vs) cs  
-
-    Let (x,(m,a)) b -> do
-      m' <- case m of
-        Just ty -> liftM Just $ ren vs ty
-        _ -> return m
-      a' <- ren vs a
-      b' <- ren (x:vs) b
-      return $ Let (x,(m',a')) b'
-
-    P t@(Vr r) l                     -- for constant t we know it is projection
-      | elem r vs -> return trm                           -- var proj first
-      | otherwise -> case renid (Q r (label2ident l)) of  -- qualif   second
-          Ok t -> return t
-          _ -> liftM (flip P l) $ renid t                 -- const proj last
-
-    _ -> composOp (ren vs) trm
-
-  renid = renameIdentTerm env
-  renCase vs (p,t) = do
-    (p',vs') <- renpatt p
-    t' <- ren (vs' ++ vs) t
-    return (p',t')
-  renpatt = renamePattern env
-
--- | vars not needed in env, since patterns always overshadow old vars
-renamePattern :: Status -> Patt -> Err (Patt,[Ident])
-renamePattern env patt = case patt of
-
-  PC c ps -> do
-    c' <- renameIdentTerm env $ Cn c
-    psvss <- mapM renp ps
-    let (ps',vs) = unzip psvss
-    case c' of
-      QC p d -> return (PP p d ps', concat vs)
-      Q  p d -> return (PP p d ps', concat vs) ---- should not happen
-      _ -> prtBad "unresolved pattern" c' ---- (PC c ps', concat vs)
-
-----  PP p c ps -> (PP p c ps',concat vs') where (ps',vs') = unzip $ map renp ps
-
-  PV x -> case renid patt of
-    Ok p -> return (p,[])
-    _    -> return (patt, [x])
-
-  PR r -> do
-    let (ls,ps) = unzip r
-    psvss <- mapM renp ps
-    let (ps',vs') = unzip psvss
-    return (PR (zip ls ps'), concat vs') 
-
-  _ -> return (patt,[])
-
- where 
-   renp  = renamePattern env
-   renid = renameIdentPatt env
-
-renameParam :: Status -> (Ident, Context) -> Err (Ident, Context)
-renameParam env (c,co) = do
-  co' <- renameContext env co
-  return (c,co')
-
-renameContext :: Status -> Context -> Err Context
-renameContext b = renc [] where
-  renc vs cont = case cont of
-    (x,t) : xts 
-      | isWildIdent x -> do
-          t'   <- ren vs t
-          xts' <- renc vs xts
-          return $ (x,t') : xts'
-      | otherwise -> do
-          t'   <- ren vs t
-          let vs' = x:vs
-          xts' <- renc vs' xts
-          return $ (x,t') : xts'
-    _ -> return cont
-  ren = renameTerm b
-
--- | vars not needed in env, since patterns always overshadow old vars
-renameEquation :: Status -> [Ident] -> Equation -> Err Equation
-renameEquation b vs (ps,t) = do
-  (ps',vs') <- liftM unzip $ mapM (renamePattern b) ps
-  t'        <- renameTerm b (concat vs' ++ vs) t
-  return (ps',t')
diff --git a/src-3.0/GF/Compile/NoParse.hs b/src-3.0/GF/Compile/NoParse.hs
deleted file mode 100644
index c8f828970..000000000
--- a/src-3.0/GF/Compile/NoParse.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : NoParse
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/14 16:03:41 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.1 $
---
--- Probabilistic abstract syntax. AR 30\/10\/2005
---
--- (c) Aarne Ranta 2005 under GNU GPL
---
--- Contents: decide what lin rules no parser is generated.
--- Usually a list of noparse idents from 'i -boparse=file'.
-
------------------------------------------------------------------------------
-
-module GF.Compile.NoParse (
-  NoParse             -- =  Ident -> Bool
- ,getNoparseFromFile  -- :: Opts -> IO NoParse
- ,doParseAll          -- :: NoParse
-  ) where
-
-import GF.Infra.Ident
-import GF.Data.Operations
-import GF.Infra.Option
-
-
-type NoParse = (Ident -> Bool)
-
-doParseAll :: NoParse
-doParseAll = const False
-
-getNoparseFromFile :: Options -> FilePath -> IO NoParse
-getNoparseFromFile opts file = do 
-  let f = maybe file id $ getOptVal opts noparseFile
-  s <- readFile f
-  let tree = buildTree $ flip zip (repeat ()) $ concat $ map getIgnores $ lines s
-  tree `seq` return $ igns tree
- where
-  igns tree i = isInBinTree i tree
-
--- where
-getIgnores s = case dropWhile (/="--#") (words s) of
-     _:"noparse":fs -> map identC fs
-     _ -> []
diff --git a/src-3.0/GF/Compile/Optimize.hs b/src-3.0/GF/Compile/Optimize.hs
deleted file mode 100644
index 8931cb6a2..000000000
--- a/src-3.0/GF/Compile/Optimize.hs
+++ /dev/null
@@ -1,300 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Optimize
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/16 13:56:13 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.18 $
---
--- Top-level partial evaluation for GF source modules.
------------------------------------------------------------------------------
-
-module GF.Compile.Optimize (optimizeModule) where
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Modules
-import GF.Grammar.PrGrammar
-import GF.Grammar.Macros
-import GF.Grammar.Lookup
-import GF.Grammar.Refresh
-import GF.Grammar.Compute
-import GF.Compile.BackOpt
-import GF.Compile.CheckGrammar
-import GF.Compile.Update
-import GF.Compile.Evaluate
-
-import GF.Data.Operations
-import GF.Infra.CheckM
-import GF.Infra.Option
-
-import Control.Monad
-import Data.List
-
-import Debug.Trace
-
-
--- conditional trace
-
-prtIf :: (Print a) => Bool -> a -> a
-prtIf b t = if b then trace (" " ++ prt t) t else t
-
--- experimental evaluation, option to import
-oEval = iOpt "eval"
-
--- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
--- only do this for resource: concrete is optimized in gfc form
-optimizeModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> 
-                  (Ident,SourceModInfo) -> Err ((Ident,SourceModInfo),EEnv)
-optimizeModule opts mse@(ms,eenv) mo@(_,mi) = case mi of
-  ModMod m0@(Module mt st fs me ops js) | 
-    st == MSComplete && isModRes m0 && not (oElem oEval oopts)-> do
-      (mo1,_) <- evalModule oopts mse mo
-      let 
-       mo2 = case optim of
-        "parametrize" -> shareModule paramOpt mo1  -- parametrization and sharing
-        "values"      -> shareModule valOpt mo1    -- tables as courses-of-values
-        "share"       -> shareModule shareOpt mo1  -- sharing of branches
-        "all"         -> shareModule allOpt mo1    -- first parametrize then values
-        "none"        -> mo1                       -- no optimization
-        _             -> mo1                       -- none; default for src
-      return (mo2,eenv)
-  _ -> evalModule oopts mse mo
- where
-   oopts = addOptions opts (iOpts (flagsModule mo))
-   optim = maybe "all" id $ getOptVal oopts useOptimizer
-
-evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> 
-               Err ((Ident,SourceModInfo),EEnv)
-evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
-
-  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
-    _ | isModRes m0 && not (oElem oEval oopts) -> do
-      let deps = allOperDependencies name js
-      ids <- topoSortOpers deps
-      MGrammar (mod' : _) <- foldM evalOp gr ids
-      return $ (mod',eenv)
-
-    MTConcrete a | oElem oEval oopts -> do
-      (js0,eenv') <- appEvalConcrete gr js eenv
-      js' <- mapMTree (evalCncInfo oopts gr name a) js0 ---- <- gr0 6/12/2005 
-      return $ ((name, ModMod (Module mt st fs me ops js')),eenv')
-
-    MTConcrete a -> do
-      js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
-      return $ ((name, ModMod (Module mt st fs me ops js')),eenv)
-
-    _ -> return $ ((name,mod),eenv)
-  _ -> return $ ((name,mod),eenv)
- where
-   gr0 = MGrammar $ ms
-   gr  = MGrammar $ (name,mod) : ms
-
-   evalOp g@(MGrammar ((_, ModMod m) : _)) i = do
-     info  <- lookupTree prt i $ jments m
-     info' <- evalResInfo oopts gr (i,info)
-     return $ updateRes g name i info'
-
--- | only operations need be compiled in a resource, and this is local to each
--- definition since the module is traversed in topological order
-evalResInfo :: Options -> SourceGrammar -> (Ident,Info) -> Err Info
-evalResInfo oopts gr (c,info) = case info of
-
-  ResOper pty pde -> eIn "operation" $ do
-    pde' <- case pde of
-       Yes de | optres -> liftM yes $ comp de 
-       _ -> return pde
-    return $ ResOper pty pde'
-
-  _ ->  return info
- where
-   comp = if optres then computeConcrete gr else computeConcreteRec gr
-   eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
-   optim = maybe "all" id $ getOptVal oopts useOptimizer
-   optres = case optim of
-     "noexpand" -> False
-     _ -> True
-
-
-evalCncInfo :: 
-  Options -> SourceGrammar -> Ident -> Ident -> (Ident,Info) -> Err (Ident,Info)
-evalCncInfo opts gr cnc abs (c,info) = do
-
- seq (prtIf (oElem beVerbose opts) c) $ return ()
-
- errIn ("optimizing" +++ prt c) $ case info of
-
-  CncCat ptyp pde ppr -> do
-    pde' <- case (ptyp,pde) of
-      (Yes typ, Yes de) -> 
-        liftM yes $ pEval ([(varStr, typeStr)], typ) de
-      (Yes typ, Nope)   -> 
-        liftM yes $ mkLinDefault gr typ >>= partEval noOptions gr ([(varStr, typeStr)],typ)
-      (May b, Nope) ->
-        return $ May b
-      _ -> return pde   -- indirection
-
-    ppr' <- liftM yes $ evalPrintname gr c ppr (yes $ K $ prt c)
-
-    return (c, CncCat ptyp pde' ppr')
-
-  CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr -> 
-       eIn ("linearization in type" +++ prt (mkProd (cont,val,[])) ++++ "of function") $ do
-    pde' <- case pde of
-      Yes de | notNewEval -> do
-        liftM yes $ pEval ty de
-
-      _ -> return pde
-    ppr' <-  liftM yes $ evalPrintname gr c ppr pde'
-    return $ (c, CncFun mt pde' ppr') -- only cat in type actually needed
-
-  _ ->  return (c,info)
- where
-   pEval = partEval opts gr
-   eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
-   notNewEval = not (oElem oEval opts)
-
--- | the main function for compiling linearizations
-partEval :: Options -> SourceGrammar -> (Context,Type) -> Term -> Err Term
-partEval opts gr (context, val) trm = errIn ("parteval" +++ prt_ trm) $ do
-  let vars  = map fst context
-      args  = map Vr vars
-      subst = [(v, Vr v) | v <- vars]
-      trm1  = mkApp trm args
-  trm3 <- if globalTable 
-             then etaExpand subst trm1 >>= outCase subst
-             else etaExpand subst trm1
-  return $ mkAbs vars trm3
-
- where 
-
-   globalTable = oElem showAll opts --- i -all
-
-   comp g t = {- refreshTerm t >>= -} computeTerm gr g t
-
-   etaExpand su t = do
-     t' <- comp su t 
-     case t' of
-       R _ | rightType t' -> comp su t' --- return t' wo noexpand...
-       _ -> recordExpand val t' >>= comp su
-   -- don't eta expand records of right length (correct by type checking)
-   rightType t = case (t,val) of
-     (R rs, RecType ts) -> length rs == length ts
-     _ -> False
-
-   outCase subst t = do
-     pts <- getParams context
-     let (args,ptyps) = unzip $ filter (flip occur t . fst) pts
-     if null args 
-       then return t 
-       else do 
-         let argtyp = RecType $ tuple2recordType ptyps
-         let pvars = map (Vr . zIdent . prt) args -- gets eliminated
-         patt <- term2patt $ R $ tuple2record $ pvars
-         let t' = replace (zip args pvars) t
-         t1 <- comp subst $ T (TTyped argtyp) [(patt, t')]
-         return $ S t1 $ R $ tuple2record args
-
-   --- notice: this assumes that all lin types follow the "old JFP style" 
-   getParams = liftM concat . mapM getParam 
-   getParam (argv,RecType rs) = return 
-     [(P (Vr argv) lab, ptyp) | (lab,ptyp) <- rs,  not (isLinLabel lab)] 
-   ---getParam (_,ty) | ty==typeStr = return [] --- in lindef 
-   getParam (av,ty) = 
-     Bad ("record type expected not" +++ prt ty +++ "for" +++ prt av) 
-     --- all lin types are rec types
-
-   replace :: [(Term,Term)] -> Term -> Term
-   replace reps trm = case trm of  
-     -- this is the important case
-     P _ _ -> maybe trm id $ lookup trm reps
-     _ -> composSafeOp (replace reps) trm
-
-   occur t trm = case trm of
-
-     -- this is the important case
-     P _ _   -> t == trm
-     S x y   -> occur t y || occur t x
-     App f x -> occur t x || occur t f
-     Abs _ f -> occur t f
-     R rs    -> any (occur t) (map (snd . snd) rs)
-     T _ cs  -> any (occur t) (map snd cs)
-     C x y   -> occur t x || occur t y
-     Glue x y -> occur t x || occur t y
-     ExtR x y -> occur t x || occur t y
-     FV ts   -> any (occur t) ts
-     V _ ts   -> any (occur t) ts
-     Let (_,(_,x)) y -> occur t x || occur t y
-     _ -> False
-
-
--- here we must be careful not to reduce
---   variants {{s = "Auto" ; g = N} ; {s = "Wagen" ; g = M}}
---   {s  = variants {"Auto" ; "Wagen"} ; g  = variants {N ; M}} ;
-
-recordExpand :: Type -> Term -> Err Term
-recordExpand typ trm = case unComputed typ of
-  RecType tys -> case trm of
-    FV rs -> return $ FV [R [assign lab (P r lab) | (lab,_) <- tys] | r <- rs]
-    _ -> return $ R [assign lab (P trm lab) | (lab,_) <- tys]
-  _ -> return trm
-
-
--- | auxiliaries for compiling the resource
-
-mkLinDefault :: SourceGrammar -> Type -> Err Term
-mkLinDefault gr typ = do
-  case unComputed typ of
-    RecType lts -> mapPairsM mkDefField lts >>= (return . Abs varStr . R . mkAssign)
-    _ -> prtBad "linearization type must be a record type, not" typ
- where
-   mkDefField typ = case unComputed typ of
-     Table p t  -> do
-       t' <- mkDefField t
-       let T _ cs = mkWildCases t'
-       return $ T (TWild p) cs 
-     Sort "Str" -> return $ Vr varStr
-     QC q p     -> lookupFirstTag gr q p
-     RecType r  -> do
-       let (ls,ts) = unzip r
-       ts' <- mapM mkDefField ts
-       return $ R $ [assign l t | (l,t) <- zip ls ts']
-     _ | isTypeInts typ -> return $ EInt 0 -- exists in all as first val
-     _ -> prtBad "linearization type field cannot be" typ
-
--- | Form the printname: if given, compute. If not, use the computed
--- lin for functions, cat name for cats (dispatch made in evalCncDef above).
---- We cannot use linearization at this stage, since we do not know the
---- defaults we would need for question marks - and we're not yet in canon.
-evalPrintname :: SourceGrammar -> Ident -> MPr -> Perh Term -> Err Term
-evalPrintname gr c ppr lin =
-  case ppr of
-    Yes pr -> comp pr
-    _ -> case lin of
-      Yes t -> return $ K $ clean $ prt $ oneBranch t ---- stringFromTerm
-      _ -> return $ K $ prt c ----
- where
-   comp = computeConcrete gr
-
-   oneBranch t = case t of
-     Abs _ b   -> oneBranch b
-     R   (r:_) -> oneBranch $ snd $ snd r
-     T _ (c:_) -> oneBranch $ snd c
-     V _ (c:_) -> oneBranch c
-     FV  (t:_) -> oneBranch t
-     C x y     -> C (oneBranch x) (oneBranch y)
-     S x _     -> oneBranch x
-     P x _     -> oneBranch x
-     Alts (d,_) -> oneBranch d
-     _ -> t
-
-  --- very unclean cleaner
-   clean s = case s of
-     '+':'+':' ':cs -> clean cs
-     '"':cs -> clean cs
-     c:cs -> c: clean cs
-     _ -> s
-
diff --git a/src-3.0/GF/Compile/PGrammar.hs b/src-3.0/GF/Compile/PGrammar.hs
deleted file mode 100644
index 521f616b5..000000000
--- a/src-3.0/GF/Compile/PGrammar.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : PGrammar
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/25 10:27:12 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.8 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Compile.PGrammar (pTerm, pTrm, pTrms,
-		 pMeta, pzIdent, 
-		 string2ident
-		) where
-
----import LexGF
-import GF.Source.ParGF
-import GF.Source.SourceToGrammar (transExp)
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import qualified GF.Canon.AbsGFC as A
-import qualified GF.Canon.GFC as G
-import GF.Compile.GetGrammar
-import GF.Grammar.Macros
-import GF.Grammar.MMacros
-
-import GF.Data.Operations
-import qualified Data.ByteString.Char8 as BS
-
-pTerm :: String -> Err Term
-pTerm s = do
-  e <- pExp $ myLexer (BS.pack s)
-  transExp e
-
-pTrm :: String -> Term
-pTrm = errVal (vr (zIdent "x")) . pTerm ---
-
-pTrms :: String -> [Term]
-pTrms = map pTrm . sep [] where
-  sep t cs = case cs of
-    ',' : cs2 -> reverse t : sep [] cs2
-    c   : cs2 -> sep (c:t) cs2
-    _         -> [reverse t]
-
-pTrm' :: String -> [Term]
-pTrm' = err (const []) singleton . pTerm
-
-pMeta :: String -> Integer
-pMeta _ = 0 ---
-
-pzIdent :: String -> Ident
-pzIdent = zIdent
-
-{-
-string2formsAndTerm :: String -> ([Term],Term)
-string2formsAndTerm s = case s of
-    '[':_:_ -> case span (/=']') s of  
-      (x,_:y) -> (pTrms (tail x), pTrm y)
-      _ -> ([],pTrm s)
-    _ -> ([], pTrm s)
--}
-
-string2ident :: String -> Err Ident
-string2ident s = return $ string2var s
-
-{-
--- reads the Haskell datatype
-readGrammar :: String -> Err GrammarST
-readGrammar s =  case [x | (x,t) <- reads s, ("","") <- lex t] of
-  [x] -> return x
-  []  -> Bad "no parse of Grammar"
-  _   -> Bad "ambiguous parse of Grammar"
--}
diff --git a/src-3.0/GF/Compile/PrOld.hs b/src-3.0/GF/Compile/PrOld.hs
deleted file mode 100644
index 29920fab6..000000000
--- a/src-3.0/GF/Compile/PrOld.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : PrOld
--- Maintainer  : GF
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:21:44 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.8 $
---
--- a hack to print gf2 into gf1 readable files
--- Works only for canonical grammars, printed into GFC. Otherwise we would have
--- problems with qualified names.
--- --- printnames are not preserved, nor are lindefs
------------------------------------------------------------------------------
-
-module GF.Compile.PrOld (printGrammarOld, stripTerm) where
-
-import GF.Grammar.PrGrammar
-import GF.Canon.CanonToGrammar
-import qualified GF.Canon.GFC as GFC
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Grammar.Macros
-import GF.Infra.Modules
-import qualified GF.Source.PrintGF as P
-import GF.Source.GrammarToSource
-
-import Data.List
-import GF.Data.Operations
-import GF.Infra.UseIO
-
-printGrammarOld :: GFC.CanonGrammar -> String
-printGrammarOld gr = err id id $ do
-  as0 <- mapM canon2sourceModule [im | im@(_,ModMod m) <- modules gr, isModAbs m]
-  cs0 <- mapM canon2sourceModule 
-           [im | im@(_,ModMod m) <- modules gr, isModCnc m || isModRes m]
-  as1 <- return $ concatMap stripInfo $ concatMap (tree2list . js . snd) as0
-  cs1 <- return $ concatMap stripInfo $ concatMap (tree2list . js . snd) cs0
-  return $ unlines $ map prj $ srt as1 ++ srt cs1
- where
-   js (ModMod m) = jments m
-   srt = sortBy (\ (i,_) (j,_) -> compare i j)
-   prj ii = P.printTree $ trAnyDef ii
-
-stripInfo :: (Ident,Info) -> [(Ident,Info)]
-stripInfo (c,i) = case i of
-  AbsCat   (Yes co) (Yes fs) -> rc $ AbsCat (Yes (stripContext co)) nope
-  AbsFun   (Yes ty) (Yes tr) -> rc $ AbsFun (Yes (stripTerm ty)) (Yes(stripTerm tr))
-  AbsFun   (Yes ty) _ -> rc $ AbsFun (Yes (stripTerm ty)) nope
-  ResParam (Yes (ps,m))       -> rc $ ResParam (Yes ([(c,stripContext co) | (c,co)<- ps],Nothing))
-  CncCat   (Yes ty) _ _ -> rc $
-    CncCat (Yes (stripTerm ty)) nope nope
-  CncFun   _ (Yes tr) _ -> rc $ CncFun Nothing (Yes (stripTerm tr)) nope
-  _ -> []
- where
-   rc j = [(c,j)]
-
-stripContext co = [(x, stripTerm t) | (x,t) <- co]
-
-stripTerm :: Term -> Term
-stripTerm t = case t of
-  Q _ c -> Vr c
-  QC _ c -> Vr c
-  T ti cs -> T ti' [(stripPattern p, stripTerm c) | (p,c) <- cs] where
-               ti' = case ti of
-                  TTyped ty -> TTyped $ stripTerm ty
-                  TComp ty -> TComp $ stripTerm ty
-                  TWild ty -> TWild $ stripTerm ty
-                  _ -> ti
-----  R [] -> EInt 8      --- GF 1.2 parser doesn't accept empty records 
-----  RecType [] -> Cn (zIdent "Int") ---
-  _ -> composSafeOp stripTerm t
-
-stripPattern p = case p of
-  PC c [] -> PV c
-  PP _ c [] -> PV c
-  PC c ps -> PC c (map stripPattern ps)
-  PP _ c ps -> PC c (map stripPattern ps)
-  PR lps -> PR [(l, stripPattern p) | (l,p) <- lps]
-  PT t p -> PT (stripTerm t) (stripPattern p)
-  _ -> p
-
diff --git a/src-3.0/GF/Compile/ShellState.hs b/src-3.0/GF/Compile/ShellState.hs
deleted file mode 100644
index 0e24da601..000000000
--- a/src-3.0/GF/Compile/ShellState.hs
+++ /dev/null
@@ -1,568 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : ShellState
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/14 16:03:41 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.53 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Compile.ShellState where
-
-import GF.Data.Operations
-import GF.Canon.GFC
-import GF.Canon.AbsGFC
-import GF.GFCC.CId
---import GF.GFCC.DataGFCC(mkGFCC)
-import GF.GFCC.Macros (lookFCFG)
-import GF.Canon.CanonToGFCC
-import GF.Grammar.Macros
-import GF.Grammar.MMacros
-
-import GF.Canon.Look
-import GF.Canon.Subexpressions
-import GF.Grammar.LookAbs
-import GF.Compile.ModDeps
-import GF.Compile.Evaluate
-import qualified GF.Infra.Modules as M
-import qualified GF.Grammar.Grammar as G
-import qualified GF.Grammar.PrGrammar as P
-import GF.CF.CF
-import GF.CF.CFIdent
-import GF.CF.CanonToCF
-import GF.UseGrammar.Morphology
-import GF.Probabilistic.Probabilistic
-import GF.Compile.NoParse
-import GF.Infra.Option
-import GF.Infra.Ident
-import GF.Infra.UseIO (justModuleName)
-import GF.System.Arch (ModTime)
-
-import qualified Transfer.InterpreterAPI as T
-
-import GF.Formalism.FCFG
-import qualified GF.OldParsing.ConvertGrammar as CnvOld -- OBSOLETE
-import qualified GF.Conversion.GFC as Cnv
-import qualified GF.Conversion.SimpleToFCFG as FCnv
-import qualified GF.Parsing.GFC as Prs
-
-import Control.Monad (mplus)
-import Data.List (nub,nubBy)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
-
-
--- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished
-
--- | multilingual state with grammars and options
-data ShellState = ShSt {
-  abstract   :: Maybe Ident ,        -- ^ pointer to actual abstract, if not empty st
-  concrete   :: Maybe Ident ,        -- ^ pointer to primary concrete
-  concretes  :: [((Ident,Ident),Bool)], -- ^ list of all concretes, and whether active
-  canModules :: CanonGrammar ,       -- ^ compiled abstracts and concretes
-  srcModules :: G.SourceGrammar ,    -- ^ saved resource modules
-  cfs        :: [(Ident,CF)] ,       -- ^ context-free grammars (small, no parameters, very over-generating)
-  abstracts  :: [(Ident,[Ident])],   -- ^ abstracts and their associated concretes
-  mcfgs      :: [(Ident, Cnv.MGrammar)], -- ^ MCFG, converted according to Ljunglöf (2004, ch 3)
-  fcfgs      :: [(Ident, FGrammar)], -- ^ FCFG, optimized MCFG by Krasimir Angelov
-  cfgs       :: [(Ident, Cnv.CGrammar)], -- ^ CFG, converted from mcfg 
-                                         -- (large, with parameters, no-so overgenerating)
-  pInfos     :: [(Ident, Prs.PInfo)], -- ^ parsing information (compiled mcfg&cfg grammars)
-  morphos    :: [(Ident,Morpho)],    -- ^ morphologies
-  treebanks  :: [(Ident,Treebank)],  -- ^ treebanks
-  probss     :: [(Ident,Probs)],     -- ^ probability distributions
-  gloptions  :: Options,             -- ^ global options
-  readFiles  :: [(String,(FilePath,ModTime))],-- ^ files read
-  absCats    :: [(G.Cat,(G.Context,
-                  [(G.Fun,G.Type)],
-                  [((G.Fun,Int),G.Type)]))],   -- ^ cats, (their contexts, 
-                                               -- functions to them,
-                                               -- functions on them)
-  statistics :: [Statistics],         -- ^ statistics on grammars
-  transfers  :: [(Ident,T.Env)],      -- ^ transfer modules
-  evalEnv    :: EEnv                  -- ^ evaluation environment
-  }                             
-
-type Treebank = Map.Map String [String] -- string, trees
-
-actualConcretes :: ShellState -> [((Ident,Ident),Bool)]
-actualConcretes sh = nub [((c,c),b) | 
-  Just a <- [abstract sh],
-  ((c,_),_) <- concretes sh, ----concretesOfAbstract sh a,
-  let b = True -----
-  ]
-
-concretesOfAbstract :: ShellState -> Ident -> [Ident]
-concretesOfAbstract sh a = [c | (b,cs) <- abstracts sh, b == a, c <- cs]
-
-data Statistics = 
-    StDepTypes Bool        -- ^ whether there are dependent types      
-  | StBoundVars [G.Cat]    -- ^ which categories have bound variables
-  ---                      -- etc
-   deriving (Eq,Ord)
-
-emptyShellState :: ShellState
-emptyShellState = ShSt {
-  abstract   = Nothing,
-  concrete   = Nothing,
-  concretes  = [],
-  canModules = M.emptyMGrammar,
-  srcModules = M.emptyMGrammar,
-  cfs        = [],
-  abstracts  = [],
-  mcfgs      = [],
-  fcfgs      = [],
-  cfgs       = [],
-  pInfos     = [],
-  morphos    = [],
-  treebanks  = [],
-  probss     = [],
-  gloptions  = noOptions,
-  readFiles  = [],
-  absCats    = [],
-  statistics = [],
-  transfers  = [],
-  evalEnv    = emptyEEnv
-  }
-
-optInitShellState :: Options -> ShellState
-optInitShellState os = addGlobalOptions os emptyShellState
-
-type Language = Ident
-
-language :: String -> Language
-language = identC
-
-prLanguage :: Language -> String
-prLanguage = prIdent
-
--- | grammar for one language in a state, comprising its abs and cnc
-data StateGrammar = StGr {
-  absId    :: Ident,
-  cncId    :: Ident,
-  grammar  :: CanonGrammar,
-  cf       :: CF,
-  mcfg     :: Cnv.MGrammar,
-  fcfg     :: FGrammar,
-  cfg      :: Cnv.CGrammar,
-  pInfo    :: Prs.PInfo,
-  morpho   :: Morpho,
-  probs    :: Probs,
-  loptions :: Options
-  }
-
-emptyStateGrammar :: StateGrammar
-emptyStateGrammar = StGr {
-  absId    = identC "#EMPTY", ---
-  cncId    = identC "#EMPTY", ---
-  grammar  = M.emptyMGrammar,
-  cf       = emptyCF,
-  mcfg     = [],
-  fcfg     = ([], Map.empty),
-  cfg      = [],
-  pInfo    = Prs.buildPInfo [] ([], Map.empty) [],
-  morpho   = emptyMorpho,
-  probs    = emptyProbs,
-  loptions = noOptions
-  }
-
--- analysing shell grammar into parts
-
-stateGrammarST    :: StateGrammar -> CanonGrammar
-stateCF           :: StateGrammar -> CF
-stateMCFG         :: StateGrammar -> Cnv.MGrammar
-stateFCFG         :: StateGrammar -> FGrammar
-stateCFG          :: StateGrammar -> Cnv.CGrammar
-statePInfo        :: StateGrammar -> Prs.PInfo
-stateMorpho       :: StateGrammar -> Morpho
-stateProbs        :: StateGrammar -> Probs
-stateOptions      :: StateGrammar -> Options
-stateGrammarWords :: StateGrammar -> [String]
-stateGrammarLang  :: StateGrammar -> (CanonGrammar, Ident)
-
-stateGrammarST = grammar
-stateCF        = cf
-stateMCFG      = mcfg
-stateFCFG      = fcfg
-stateCFG       = cfg
-statePInfo     = pInfo
-stateMorpho    = morpho
-stateProbs     = probs
-stateOptions   = loptions
-stateGrammarWords = allMorphoWords . stateMorpho
-stateGrammarLang st = (grammar st, cncId st)
-
----- this should be computed at compile time and stored
-stateHasHOAS :: StateGrammar -> Bool
-stateHasHOAS = hasHOAS . stateGrammarST
-
-cncModuleIdST :: StateGrammar -> CanonGrammar
-cncModuleIdST = stateGrammarST
-
--- | form a shell state from a canonical grammar
-grammar2shellState :: Options -> (CanonGrammar, G.SourceGrammar) -> Err ShellState 
-grammar2shellState opts (gr,sgr) = 
-  updateShellState opts doParseAll Nothing emptyShellState ((0,sgr,gr,emptyEEnv),[]) --- is 0 safe?
-
--- | update a shell state from a canonical grammar
-updateShellState :: Options -> NoParse -> Maybe Ident -> ShellState -> 
-   ((Int,G.SourceGrammar,CanonGrammar,EEnv),[(String,(FilePath,ModTime))]) ->
-   Err ShellState 
-updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do 
-  let cgr0 = M.updateMGrammar (canModules sh) gr
-
-  -- a0 = abstract of old state
-  -- a1 = abstract of compiled grammar
-
-  let a0 = abstract sh
-  a1 <- return $ case mcnc of
-    Just cnc -> err (const Nothing) Just $ M.abstractOfConcrete cgr0 cnc
-    _ -> M.greatestAbstract cgr0
-
-  -- abstr0 = a1 if it exists
-
-  let (abstr0,isNew) = case (a0,a1) of
-        (Just a,  Just b) | a /= b -> (a1, True)
-        (Nothing, Just _)          -> (a1, True)
-        _                          -> (a0, False)
-
-  let concrs0 = maybe [] (M.allConcretes cgr0) abstr0
-
-  let abstrs = nubBy (\ (x,_) (y,_) -> x == y) $ 
-               maybe id (\a -> ((a,concrs0):)) abstr0 $ abstracts sh
-               
-  let needed = nub $ concatMap (requiredCanModules (length abstrs == 1) cgr0) (maybe [] singleton abstr0 ++ concrs0)
-      purge  = nubBy (\x y -> fst x == fst y) . filter (\(m,mo) -> elem m needed && not (isIncompleteCanon (m,mo)))
-      
-  let cgr = M.MGrammar $ purge $ M.modules cgr0
-
-  let oldConcrs = map (snd . fst) (concretes sh)
-      newConcrs = maybe [] (M.allConcretes gr) abstr0
-      toRetain (c,v) = notElem c newConcrs
-  let complete m = case M.lookupModule gr m of
-        Ok mo -> not $ isIncompleteCanon (m,mo)
-        _ -> False
-        
-  let concrs = filter (\i -> complete i && elem i needed) $ nub $ newConcrs ++ oldConcrs
-      concr0 = ifNull Nothing (return . head) concrs
-      notInrts f = notElem f $ map fst rts
-      subcgr = unSubelimCanon cgr
-  cf's0 <- if (not (oElem (iOpt "docf") opts) &&       -- cf only built with -docf
-               (oElem noCF opts || not (hasHOAS cgr))) -- or HOAS, if not -nocf
-            then return $ map snd $ cfs sh
-            else mapM (canon2cf opts ign subcgr) newConcrs 
-  let cf's = zip newConcrs cf's0 ++ filter toRetain (cfs sh)
-
-  let morphs = [(c,mkMorpho subcgr c) | c <- newConcrs] ++ filter toRetain (morphos sh)
-  let probss = [] -----
-
-
-  let fromGFC       = snd . snd . Cnv.convertGFC opts
-      (mcfgs, cfgs) = unzip $ map (curry fromGFC cgr) concrs
-      gfcc          = canon2gfcc opts cgr ---- UTF8
-      fcfgs         = [(c,g) | c@(IC cn) <- concrs, Just g <- [lookFCFG gfcc (CId cn)]]
-      pInfos        = zipWith3 Prs.buildPInfo mcfgs (map snd fcfgs) cfgs
-      
-  let funs = funRulesOf cgr
-  let cats = allCatsOf cgr
-  let csi  = [(c,(co,
-                  [(fun,typ) | (fun,typ) <- funs, compatType tc typ], 
-                  funsOnTypeFs compatType funs tc))
-                                      | (c,co) <- cats, let tc = cat2val co c]
-  let deps = True ---- not $ null $ allDepCats cgr
-  let binds = [] ---- allCatsWithBind cgr 
-  let src = M.updateMGrammar (srcModules sh) sgr
-
-  return $ ShSt {
-    abstract   = abstr0, 
-    concrete   = concr0, 
-    concretes  = zip (zip concrs concrs) (repeat True),
-    canModules = cgr,
-    srcModules = src,
-    cfs        = cf's,
-    abstracts  = maybe [] (\a -> [(a,concrs)]) abstr0,
-    mcfgs      = zip concrs mcfgs,
-    fcfgs      = fcfgs,
-    cfgs       = zip concrs cfgs,
-    pInfos     = zip concrs pInfos,
-    morphos    = morphs,
-    treebanks  = treebanks sh,
-    probss     = zip concrs probss,
-    gloptions  = gloptions sh, --- opts, -- this would be command-line options
-    readFiles  = [ft | ft@(f,(_,_)) <- readFiles sh, notInrts f] ++ rts,
-    absCats    = csi,
-    statistics = [StDepTypes deps,StBoundVars binds],
-    transfers  = transfers sh,
-    evalEnv    = eenv
-    }            
-
-prShellStateInfo :: ShellState -> String
-prShellStateInfo sh = unlines [
-  "main abstract :    " +++ abstractName sh,
-  "main concrete :    " +++ maybe "(none)" P.prt (concrete sh),
-  "actual concretes : " +++ unwords (map (P.prt . fst . fst) (actualConcretes sh)),
-  "all abstracts :    " +++ unwords (map (P.prt . fst) (abstracts sh)),
-  "all concretes :    " +++ unwords (map (P.prt . fst . fst) (concretes sh)),
-  "canonical modules :" +++ unwords (map (P.prt .fst) (M.modules (canModules sh))),
-  "source modules :   " +++ unwords (map (P.prt .fst) (M.modules (srcModules sh))),
-  "global options :   " +++ prOpts (gloptions sh),
-  "transfer modules : " +++ unwords (map (P.prt . fst) (transfers sh)),
-  "treebanks :        " +++ unwords (map (P.prt . fst) (treebanks sh))
-  ]
-
-abstractName :: ShellState -> String
-abstractName sh = maybe "(none)" P.prt (abstract sh)
-
--- | throw away those abstracts that are not needed --- could be more aggressive
-filterAbstracts :: [Ident] -> CanonGrammar -> CanonGrammar
-filterAbstracts absts cgr = M.MGrammar (nubBy (\x y -> fst x == fst y) [m | m <- ms, needed m]) where
-  ms = M.modules cgr
-  needed (i,_) = elem i needs
-  needs   = [i | (i,M.ModMod m) <- ms, not (M.isModAbs m) || any (dep i) absts]
-  dep i a = elem i (ext mse a)
-  mse = [(i,me) | (i,M.ModMod m) <- ms, M.isModAbs m, me <- [M.extends m]]
-  ext es a = case lookup a es of
-    Just e -> a : concatMap (ext es) e  ---- FIX multiple exts
-    _ -> []
-
-purgeShellState :: ShellState -> ShellState
-purgeShellState sh = ShSt {
-  abstract   = abstr,
-  concrete   = concrete sh,
-  concretes  = concrs,
-  canModules = M.MGrammar $ filter complete $ purge $ M.modules $ canModules sh,
-  srcModules = M.emptyMGrammar,
-  cfs        = cfs sh,
-  abstracts  = maybe [] (\a -> [(a,map (snd . fst) concrs)]) abstr,
-  mcfgs      = mcfgs sh,
-  fcfgs      = fcfgs sh,
-  cfgs       = cfgs sh,
-  pInfos     = pInfos sh,
-  morphos    = morphos sh,
-  treebanks  = treebanks sh,
-  probss     = probss sh,
-  gloptions  = gloptions sh,
-  readFiles  = [],
-  absCats    = absCats sh,
-  statistics = statistics sh,
-  transfers  = transfers sh,
-  evalEnv    = emptyEEnv
-  }
- where
-   abstr = abstract sh
-   concrs = [((a,i),b) | ((a,i),b) <- concretes sh, elem i needed]
-   isSingle = length (abstracts sh) == 1
-   needed = nub $ concatMap (requiredCanModules isSingle (canModules sh)) acncs
-   purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
-   acncs = maybe [] singleton abstr ++ map (snd . fst) (actualConcretes sh)
-   complete = not . isIncompleteCanon
-
-changeMain :: Maybe Ident -> ShellState -> Err ShellState
-changeMain Nothing (ShSt _ _ cs ms ss cfs old_pis mcfgs fcfgs cfgs pinfos mos tbs pbs os rs acs s trs ee) = 
-  return (ShSt Nothing Nothing [] ms ss cfs old_pis mcfgs fcfgs cfgs pinfos mos tbs pbs os rs acs s trs ee)
-changeMain 
-  (Just c) st@(ShSt _ _ cs ms ss cfs old_pis mcfgs fcfgs cfgs pinfos mos tbs pbs os rs acs s trs ee) = 
-   case lookup c (M.modules ms) of 
-    Just _ -> do
-      a   <- M.abstractOfConcrete ms c
-      let cas = M.allConcretes ms a
-      let cs' = [((c,c),True) | c <- cas]
-      return (ShSt (Just a) (Just c) cs' ms ss cfs old_pis mcfgs fcfgs cfgs
-        pinfos mos tbs pbs os rs acs s trs ee) 
-    _ -> P.prtBad "The state has no concrete syntax named" c
-
--- | form just one state grammar, if unique, from a canonical grammar
-grammar2stateGrammar :: Options -> CanonGrammar -> Err StateGrammar 
-grammar2stateGrammar opts gr = do 
-  st    <- grammar2shellState opts (gr,M.emptyMGrammar)
-  concr <- maybeErr "no concrete syntax" $ concrete st 
-  return $ stateGrammarOfLang st concr
-
-resourceOfShellState :: ShellState -> Maybe Ident
-resourceOfShellState = M.greatestResource . srcModules
-
-qualifTop :: StateGrammar -> G.QIdent -> G.QIdent
-qualifTop gr (_,c) = (absId gr,c)
-
-stateGrammarOfLang :: ShellState -> Language -> StateGrammar
-stateGrammarOfLang = stateGrammarOfLangOpt True
-
-stateGrammarOfLangOpt :: Bool -> ShellState -> Language -> StateGrammar
-stateGrammarOfLangOpt purg st0 l = StGr {
-  absId    = err (const (identC "Abs")) id  $ M.abstractOfConcrete allCan l, ---
-  cncId    = l,
-  grammar  = allCan,
-  cf       = maybe emptyCF id (lookup l (cfs st)),
-  mcfg     = maybe [] id $ lookup l $ mcfgs st,
-  fcfg     = maybe ([],Map.empty) id $ lookup l $ fcfgs st,
-  cfg      = maybe [] id $ lookup l $ cfgs st,
-  pInfo    = maybe (Prs.buildPInfo [] ([],Map.empty) []) id $ lookup l $ pInfos st,
-  morpho   = maybe emptyMorpho id (lookup l (morphos st)),
-  probs    = maybe emptyProbs id (lookup l (probss st)),
-  loptions = errVal noOptions $ lookupOptionsCan allCan
-  }
- where
-   st = (if purg then purgeShellState else id) $ errVal st0 $ changeMain (Just l) st0
-   allCan = canModules st
-
-grammarOfLang :: ShellState -> Language -> CanonGrammar
-cfOfLang      :: ShellState -> Language -> CF
-morphoOfLang  :: ShellState -> Language -> Morpho
-probsOfLang   :: ShellState -> Language -> Probs
-optionsOfLang :: ShellState -> Language -> Options
-
-grammarOfLang st = stateGrammarST . stateGrammarOfLang st
-cfOfLang st      = stateCF        . stateGrammarOfLang st
-morphoOfLang st  = stateMorpho    . stateGrammarOfLang st
-probsOfLang st   = stateProbs     . stateGrammarOfLang st
-optionsOfLang st = stateOptions   . stateGrammarOfLang st
-
-removeLang :: Language -> ShellState -> ShellState
-removeLang lang st = purgeShellState $ st{concretes = concs1} where
-  concs1 = filter ((/=lang) . snd . fst) $ concretes st
-
--- | the last introduced grammar, stored in options, is the default for operations
-firstStateGrammar :: ShellState -> StateGrammar
-firstStateGrammar st = errVal (stateAbstractGrammar st) $ do
-  concr <- maybeErr "no concrete syntax" $ concrete st 
-  return $ stateGrammarOfLang st concr
-
-mkStateGrammar :: ShellState -> Language -> StateGrammar
-mkStateGrammar = stateGrammarOfLang
-
-stateAbstractGrammar :: ShellState -> StateGrammar
-stateAbstractGrammar st = StGr {
-  absId    = maybe (identC "Abs") id (abstract st), ---
-  cncId    = identC "#Cnc", ---
-  grammar  = canModules st, ---- only abstarct ones
-  cf       = emptyCF,
-  mcfg     = [],
-  fcfg     = ([],Map.empty),
-  cfg      = [],
-  pInfo    = Prs.buildPInfo [] ([],Map.empty) [],
-  morpho   = emptyMorpho,
-  probs    = emptyProbs,
-  loptions = gloptions st ----
-  }
-
-
--- analysing shell state into parts
-
-globalOptions                   :: ShellState -> Options
-allLanguages                    :: ShellState -> [Language]
-allTransfers                    :: ShellState -> [Ident]
-allCategories                   :: ShellState -> [G.Cat]
-allStateGrammars                :: ShellState -> [StateGrammar]
-allStateGrammarsWithNames       :: ShellState -> [(Language, StateGrammar)]
-allGrammarFileNames             :: ShellState -> [String]
-allActiveStateGrammarsWithNames :: ShellState -> [(Language, StateGrammar)]
-allActiveGrammars               :: ShellState -> [StateGrammar]
-
-globalOptions = gloptions
---allLanguages  = map (fst . fst) . concretes
-allLanguages  = map (snd . fst) . actualConcretes
-allTransfers  = map fst . transfers
-allCategories = map fst . allCatsOf . canModules
-
-allStateGrammars = map snd . allStateGrammarsWithNames
-
-allStateGrammarsWithNames st = 
-  [(c, mkStateGrammar st c) | ((c,_),_) <- actualConcretes st]
-
-allGrammarFileNames st = [prLanguage c ++ ".gf" | ((c,_),_) <- actualConcretes st]
-
-allActiveStateGrammarsWithNames st =   
-  [(c, mkStateGrammar st c) | ((c,_),True) <- concretes st] --- actual
-
-allActiveGrammars = map snd . allActiveStateGrammarsWithNames
-
-pathOfModule :: ShellState -> Ident -> FilePath
-pathOfModule sh m = maybe "module not found" fst $ lookup (P.prt m) $ readFiles sh
-
--- command-line option -lang=foo overrides the actual grammar in state
-grammarOfOptState :: Options -> ShellState -> StateGrammar
-grammarOfOptState opts st = 
-  maybe (firstStateGrammar st) (stateGrammarOfLang st . language) $ 
-                                               getOptVal opts useLanguage
-
-languageOfOptState :: Options -> ShellState -> Maybe Language
-languageOfOptState opts st = 
-  maybe (concrete st) (return . language) $ getOptVal opts useLanguage
-
--- | command-line option -cat=foo overrides the possible start cat of a grammar
-firstCatOpts :: Options -> StateGrammar -> CFCat
-firstCatOpts opts sgr = 
-  maybe (stateFirstCat sgr) (string2CFCat (P.prt (absId sgr))) $ 
-    getOptVal opts firstCat
-
--- | the first cat for random generation
-firstAbsCat :: Options -> StateGrammar -> G.QIdent
-firstAbsCat opts = cfCat2Cat . firstCatOpts opts
-
--- | Gets the start category for the grammar from the options.
---   If the startcat is not set in the options, we look
---   for a flag in the grammar. If there is no flag in the
---   grammar, S is returned.
-startCatStateOpts :: Options -> StateGrammar -> CFCat
-startCatStateOpts opts sgr = 
-    string2CFCat a (fromMaybe "S" (optsStartCat `mplus` grStartCat))
-  where optsStartCat = getOptVal opts gStartCat
-        grStartCat = getOptVal (stateOptions sgr) gStartCat
-        a = P.prt (absId sgr)
-
--- | a grammar can have start category as option startcat=foo ; default is S 
-stateFirstCat :: StateGrammar -> CFCat
-stateFirstCat = startCatStateOpts noOptions
-
-stateIsWord :: StateGrammar -> String -> Bool
-stateIsWord sg = isKnownWord (stateMorpho sg)
-
-addProbs :: (Ident,Probs) -> ShellState -> Err ShellState
-addProbs ip@(lang,probs) sh = do
-  let gr = grammarOfLang sh lang
-  probs' <- checkGrammarProbs gr probs
-  let pbs' = (lang,probs') : filter ((/= lang) . fst) (probss sh)
-  return $ sh{probss = pbs'}
-
-addTransfer :: (Ident,T.Env) -> ShellState -> ShellState
-addTransfer it@(i,_) sh = 
-  sh {transfers = it : filter ((/= i) . fst) (transfers sh)}
-
-addTreebanks :: [(Ident,Treebank)] -> ShellState -> ShellState
-addTreebanks its sh = sh {treebanks = its ++ treebanks sh}
-
-findTreebank :: ShellState -> Ident -> Err Treebank
-findTreebank sh i = maybeErr "no treebank found" $ lookup i $ treebanks sh
-
--- modify state
-
-type ShellStateOper = ShellState -> ShellState
-type ShellStateOperErr = ShellState -> Err ShellState
-
-reinitShellState :: ShellStateOper
-reinitShellState = const emptyShellState
-
-languageOn, languageOff :: Language -> ShellStateOper
-languageOn  = languageOnOff True
-languageOff = languageOnOff False
-
-languageOnOff :: Bool -> Language -> ShellStateOper
----                                         __________ this is OBSOLETE
-languageOnOff b lang sh = sh {concretes = cs'} where
-  cs' = [if lang==l then (lc,b) else i | i@(lc@(l,c),_) <- concretes sh]
-
-changeOptions :: (Options -> Options) -> ShellStateOper
----                                      __________ this is OBSOLETE
-changeOptions f sh = sh {gloptions = f (gloptions sh)}
-
-addGlobalOptions :: Options -> ShellStateOper
-addGlobalOptions = changeOptions . addOptions
-
-removeGlobalOptions :: Options -> ShellStateOper
-removeGlobalOptions = changeOptions . removeOptions
-
diff --git a/src-3.0/GF/Compile/Wordlist.hs b/src-3.0/GF/Compile/Wordlist.hs
deleted file mode 100644
index 3fbc066bd..000000000
--- a/src-3.0/GF/Compile/Wordlist.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Wordlist
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 
--- > CVS $Author: 
--- > CVS $Revision: 
---
--- Compile a gfwl file (multilingual word list) to an abstract + concretes
------------------------------------------------------------------------------
-
-module GF.Compile.Wordlist (mkWordlist) where
-
-import GF.Data.Operations
-import GF.Infra.UseIO
-import Data.List
-import Data.Char
-import System.FilePath
-
--- read File.gfwl, write File.gf (abstract) and a set of concretes
--- return the names of the concretes
-
-mkWordlist :: FilePath -> IO [FilePath]
-mkWordlist file = do
-  s <- readFileIf file
-  let abs = dropExtension file
-  let (cnchs,wlist) = pWordlist abs $ filter notComment $ lines s
-  let (gr,grs) = mkGrammars abs cnchs wlist
-  let cncfs = [cnc ++ ".gf" | (cnc,_) <- cnchs]
-  mapM_ (uncurry writeFile) $ (abs ++ ".gf",gr) : zip cncfs grs
-  putStrLn $ "wrote " ++ unwords ((abs ++ ".gf") : cncfs)
-  return cncfs
-
-{-
--- syntax of files, e.g.
-
-  # Svenska - Franska - Finska  -- names of concretes
- 
-  berg  - montagne - vuori      -- word entry
-
--- this creates:
-
-  cat S ; 
-  fun berg_S : S ; 
-  lin berg_S = {s = ["berg"]} ;
-  lin berg_S = {s = ["montagne"]} ;
-  lin berg_S = {s = ["vuori"]} ;
-
--- support for different categories to be elaborated. The syntax it
-
-  Verb . klättra - grimper / escalader - kiivetä / kiipeillä
-
--- notice that a word can have several alternative (separator /)
--- and that an alternative can consist of several words
--}
-
-type CncHeader = (String,String) -- module name, module header
-
-type Wordlist = [(String, [[String]])] -- cat, variants for each cnc
-
-
-pWordlist :: String -> [String] -> ([CncHeader],Wordlist)
-pWordlist abs ls = (headers,rules) where
-  (hs,rs) = span ((=="#") . take 1) ls
-  headers = map mkHeader $ chunks "-" $ filter (/="#") $ words $ concat hs
-  rules   = map (mkRule   . words) rs
-
-  mkHeader ws = case ws of
-    w:ws2 -> (w, unwords ("concrete":w:"of":abs:"=":ws2))
-  mkRule ws = case ws of
-    cat:".":vs -> (cat, mkWords vs)
-    _          -> ("S", mkWords ws)
-  mkWords = map (map unwords . chunks "/") . chunks "-"
-
-
-mkGrammars :: String -> [CncHeader] -> Wordlist -> (String,[String])
-mkGrammars ab hs wl = (abs,cncs) where
-  abs = unlines $ map unwords $
-    ["abstract",ab,"=","{"]:
-    cats ++
-    funs ++
-    [["}"]]
-
-  cncs = [unlines $ (h ++ " {") : map lin rs ++ ["}"] | ((_,h),rs) <- zip hs rss]
-
-  cats = [["cat",c,";"] | c <- nub $ map fst wl]
-  funs = [["fun", f , ":", c,";"] | (f,c,_) <- wlf]
-
-  wlf = [(ident f c, c, ws) | (c,ws@(f:_)) <- wl]
-
-  rss = [[(f, wss !! i) | (f,_,wss) <- wlf] | i <- [0..length hs - 1]]
-
-  lin (f,ss) = unwords ["lin", f, "=", "{s", "=", val ss, "}", ";"]
-
-  val ss = case ss of
-    [w] -> quote w
-    _   -> "variants {" ++ unwords (intersperse ";" (map quote ss)) ++ "}"
-
-  quote w = "[" ++ prQuotedString w ++ "]" 
-
-  ident f c = concat $ intersperse "_" $ words (head f) ++ [c]
-
-
-notComment s = not (all isSpace s) && take 2 s /= "--"
-