removed src for 2.9

19 files changed, 0 insertions, 4289 deletions

diff --git a/src/GF/Grammar/AbsCompute.hs b/src/GF/Grammar/AbsCompute.hs
deleted file mode 100644
index 57e21f1dd..000000000
--- a/src/GF/Grammar/AbsCompute.hs
+++ /dev/null
@@ -1,145 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : AbsCompute
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/02 20:50:19 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.8 $
---
--- computation in abstract syntax w.r.t. explicit definitions.
---
--- old GF computation; to be updated
------------------------------------------------------------------------------
-
-module GF.Grammar.AbsCompute (LookDef,
-		   compute, 
-		   computeAbsTerm, 
-		   computeAbsTermIn, 
-		   beta
-		  ) where
-
-import GF.Data.Operations
-
-import GF.Grammar.Abstract
-import GF.Grammar.PrGrammar
-import GF.Grammar.LookAbs
-import GF.Grammar.Compute
-
-import Debug.Trace
-import Data.List(intersperse)
-import Control.Monad (liftM, liftM2)
-
--- for debugging
-tracd m t = t 
--- tracd = trace
-
-compute :: GFCGrammar -> Exp -> Err Exp
-compute = computeAbsTerm
-
-computeAbsTerm :: GFCGrammar -> Exp -> Err Exp
-computeAbsTerm gr = computeAbsTermIn (lookupAbsDef gr) []
-
--- | a hack to make compute work on source grammar as well
-type LookDef = Ident -> Ident -> Err (Maybe Term)
-
-computeAbsTermIn :: LookDef -> [Ident] -> Exp -> Err Exp
-computeAbsTermIn lookd xs e = errIn ("computing" +++ prt e) $ compt xs e where
-  compt vv t = case t of
---    Prod x a b  -> liftM2 (Prod x) (compt vv a) (compt (x:vv) b)
---    Abs x b     -> liftM  (Abs  x)              (compt (x:vv) b)
-    _ -> do
-      let t' = beta vv t
-      (yy,f,aa) <- termForm t'
-      let vv' = yy ++ vv
-      aa'    <- mapM (compt vv') aa
-      case look f of
-        Just (Eqs eqs) -> tracd ("\nmatching" +++ prt f) $ 
-                          case findMatch eqs aa' of
-          Ok (d,g) -> do
-            --- let (xs,ts) = unzip g
-            --- ts' <- alphaFreshAll vv' ts
-            let g' = g --- zip xs ts'
-            d' <- compt vv' $ substTerm vv' g' d
-            tracd ("by Egs:" +++ prt d') $ return $ mkAbs yy $ d'
-          _ -> tracd ("no match" +++ prt t') $ 
-               do
-            let v = mkApp f aa'
-            return $ mkAbs yy $ v
-        Just d -> tracd ("define" +++ prt t') $ do
-          da <- compt vv' $ mkApp d aa' 
-          return $ mkAbs yy $ da
-        _ -> do
-          let t2 = mkAbs yy $ mkApp f aa'
-          tracd ("not defined" +++ prt_ t2) $ return t2
-
-  look t = case t of
-     (Q m f) -> case lookd m f of
-       Ok (Just EData) -> Nothing  -- canonical --- should always be QC
-       Ok md -> md
-       _ -> Nothing
-     Eqs _ -> return t ---- for nested fn
-     _ -> Nothing
-
-beta :: [Ident] -> Exp -> Exp
-beta vv c = case c of
-  Let (x,(_,a)) b -> beta vv $ substTerm vv [(x,beta vv a)] (beta (x:vv) b) 
-  App f         a -> 
-    let (a',f') = (beta vv a, beta vv f) in 
-    case f' of
-      Abs x b -> beta vv $ substTerm vv [(x,a')] (beta (x:vv) b) 
-      _ ->               (if a'==a && f'==f then id else beta vv) $ App f' a'
-  Prod x a b      -> Prod x (beta vv a) (beta (x:vv) b)
-  Abs x b         -> Abs x (beta (x:vv) b)
-  _               -> c
-
--- special version of pattern matching, to deal with comp under lambda
-
-findMatch :: [([Patt],Term)] -> [Term] -> Err (Term, Substitution)
-findMatch cases terms = case cases of
-  [] -> Bad $"no applicable case for" +++ unwords (intersperse "," (map prt terms))
-  (patts,_):_ | length patts /= length terms -> 
-       Bad ("wrong number of args for patterns :" +++ 
-            unwords (map prt patts) +++ "cannot take" +++ unwords (map prt terms))
-  (patts,val):cc -> case mapM tryMatch (zip patts terms) of
-     Ok substs -> return (tracd ("value" +++ prt_ val) val, concat substs)
-     _         -> findMatch cc terms
-
-tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
-tryMatch (p,t) = do 
-  t' <- termForm t
-  trym p t'
- where
-
-  trym p t' = err (\s -> tracd s (Bad s)) (\t -> tracd (prtm p t) (return t)) $ ---- 
-              case (p,t') of
-    (PV IW, _) | notMeta t -> return [] -- optimization with wildcard
-    (PV x,  _) | notMeta t -> return [(x,t)]
-    (PString s, ([],K i,[])) | s==i -> return []
-    (PInt s, ([],EInt i,[])) | s==i -> return []
-    (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?
-    (PP q p pp, ([], QC r f, tt)) | 
-       p `eqStrIdent` f && length pp == length tt -> do
-         matches <- mapM tryMatch (zip pp tt)
-         return (concat matches)
-    (PP q p pp, ([], Q r f, tt)) | 
-       p `eqStrIdent` f && length pp == length tt -> do
-         matches <- mapM tryMatch (zip pp tt)
-         return (concat matches)
-    (PT _ p',_) -> trym p' t'
-    (_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
-    (PAs x p',_) -> do
-       subst <- trym p' t'
-       return $ (x,t) : subst
-    _ -> Bad ("no match in pattern" +++ prt p +++ "for" +++ prt t)
-
-  notMeta e = case e of
-    Meta _  -> False
-    App f a -> notMeta f &&  notMeta a  
-    Abs _ b -> notMeta b
-    _ -> True
-
-  prtm p g = 
-    prt p +++ ":" ++++ unwords ["  " ++ prt_ x +++ "=" +++ prt_ y +++ ";" | (x,y) <- g]
diff --git a/src/GF/Grammar/Abstract.hs b/src/GF/Grammar/Abstract.hs
deleted file mode 100644
index c03783a52..000000000
--- a/src/GF/Grammar/Abstract.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Abstract
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:18 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Grammar.Abstract (
-
-module GF.Grammar.Grammar,
-module GF.Grammar.Values,
-module GF.Grammar.Macros,
-module GF.Infra.Ident,
-module GF.Grammar.MMacros,
-module GF.Grammar.PrGrammar,
-
-Grammar
-
- ) where
-
-import GF.Grammar.Grammar
-import GF.Grammar.Values
-import GF.Grammar.Macros
-import GF.Infra.Ident
-import GF.Grammar.MMacros
-import GF.Grammar.PrGrammar
-
-type Grammar = SourceGrammar ---
-
-
-
diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs
deleted file mode 100644
index 530184c3e..000000000
--- a/src/GF/Grammar/AppPredefined.hs
+++ /dev/null
@@ -1,159 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : AppPredefined
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/06 14:21:34 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.13 $
---
--- Predefined function type signatures and definitions.
------------------------------------------------------------------------------
-
-module GF.Grammar.AppPredefined (isInPredefined, typPredefined, appPredefined
-		     ) where
-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Grammar.Macros
-import GF.Grammar.PrGrammar (prt,prt_,prtBad)
----- import PGrammar (pTrm)
-
--- predefined function type signatures and definitions. AR 12/3/2003.
-
-isInPredefined :: Ident -> Bool
-isInPredefined = err (const True) (const False) . typPredefined
-
-typPredefined :: Ident -> Err Type
-typPredefined c@(IC f) = case f of
-  "Int"    -> return typePType
-  "Float"  -> return typeType
-  "Error"  -> return typeType
-  "Ints"   -> return $ mkFunType [cnPredef "Int"] typePType
-  "PBool"  -> return typePType
-  "error"  -> return $ mkFunType [typeStr] (cnPredef "Error")  -- non-can. of empty set
-  "PFalse" -> return $ cnPredef "PBool"
-  "PTrue"  -> return $ cnPredef "PBool"
-  "dp"     -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
-  "drop"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
-  "eqInt"  -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
-  "lessInt"-> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
-  "eqStr"  -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
-  "length" -> return $ mkFunType [typeTok] (cnPredef "Int")
-  "occur"  -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
-  "occurs" -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
-  "plus"   -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int")
-----  "read"   -> (P : Type) -> Tok -> P
-  "show"   -> return $ mkProd -- (P : PType) -> P -> Tok
-    ([(zIdent "P",typePType),(wildIdent,Vr (zIdent "P"))],typeStr,[]) 
-  "toStr"  -> return $ mkProd -- (L : Type)  -> L -> Str
-    ([(zIdent "L",typeType),(wildIdent,Vr (zIdent "L"))],typeStr,[]) 
-  "mapStr" -> 
-    let ty = zIdent "L" in
-    return $ mkProd -- (L : Type)  -> (Str -> Str) -> L -> L
-    ([(ty,typeType),(wildIdent,mkFunType [typeStr] typeStr),(wildIdent,Vr ty)],Vr ty,[]) 
-  "take"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
-  "tk"     -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
-  _        -> prtBad "unknown in Predef:" c
-typPredefined c = prtBad "unknown in Predef:" c
-
-appPredefined :: Term -> Err (Term,Bool)
-appPredefined t = case t of
-
-  App f x0 -> do
-   (x,_) <- appPredefined x0
-   case f of
-    -- one-place functions
-    Q (IC "Predef") (IC f) -> case (f, x) of
-      ("length", K s) -> retb $ EInt $ toInteger $ length s
-      _ -> retb t ---- prtBad "cannot compute predefined" t
-
-    -- two-place functions
-    App (Q (IC "Predef") (IC f)) z0 -> do
-     (z,_) <- appPredefined z0
-     case (f, norm z, norm x) of
-      ("drop", EInt i, K s) -> retb $ K (drop (fi i) s)
-      ("take", EInt i, K s) -> retb $ K (take (fi i) s)
-      ("tk",   EInt i, K s) -> retb $ K (take (max 0 (length s - fi i)) s)
-      ("dp",   EInt i, K s) -> retb $ K (drop (max 0 (length s - fi i)) s)
-      ("eqStr",K s,    K t) -> retb $ if s == t then predefTrue else predefFalse
-      ("occur",K s,    K t) -> retb $ if substring s t then predefTrue else predefFalse
-      ("occurs",K s,   K t) -> retb $ if any (flip elem t) s then predefTrue else predefFalse
-      ("eqInt",EInt i, EInt j) -> retb $ if i==j then predefTrue else predefFalse
-      ("lessInt",EInt i, EInt j) -> retb $ if i<j then predefTrue else predefFalse
-      ("plus", EInt i, EInt j) -> retb $ EInt $ i+j
-      ("show", _, t) -> retb $ foldr C Empty $ map K $ words $ prt t
-      ("read", _, K s) -> retb $ str2tag s --- because of K, only works for atomic tags
-      ("toStr", _, t) -> trm2str t >>= retb
-
-      _ -> retb t ---- prtBad "cannot compute predefined" t
-
-    -- three-place functions
-    App (App (Q (IC "Predef") (IC f)) z0) y0 -> do
-     (y,_) <- appPredefined y0
-     (z,_) <- appPredefined z0
-     case (f, z, y, x) of
-      ("mapStr",ty,op,t) -> retf $ mapStr ty op t
-      _ -> retb t ---- prtBad "cannot compute predefined" t
-
-    _ -> retb t ---- prtBad "cannot compute predefined" t
-  _ -> retb t
-                  ---- should really check the absence of arg variables
- where
-   retb t = return (t,True)  -- no further computing needed
-   retf t = return (t,False) -- must be computed further
-   norm t = case t of
-     Empty -> K []
-     _ -> t
-   fi = fromInteger
-
--- read makes variables into constants
-
-str2tag :: String -> Term
-str2tag s = case s of
-----  '\'' : cs -> mkCn $ pTrm $ init cs
-  _ -> Cn $ IC s ---
- where
-   mkCn t = case t of
-     Vr i -> Cn i
-     App c a -> App (mkCn c) (mkCn a)
-     _ -> t
-
-
-predefTrue = Q (IC "Predef") (IC "PTrue")
-predefFalse = Q (IC "Predef") (IC "PFalse")
-
-substring :: String -> String -> Bool
-substring s t = case (s,t) of
-  (c:cs, d:ds) -> (c == d && substring cs ds) || substring s ds
-  ([],_) -> True
-  _ -> False
-
-trm2str :: Term -> Err Term
-trm2str t = case t of
-  R ((_,(_,s)):_) -> trm2str s
-  T _ ((_,s):_)   -> trm2str s
-  TSh _ ((_,s):_) -> trm2str s
-  V _ (s:_)       -> trm2str s
-  C _ _         -> return $ t
-  K _           -> return $ t
-  S c _         -> trm2str c
-  Empty         -> return $ t
-  _ -> prtBad "cannot get Str from term" t
-
--- simultaneous recursion on type and term: type arg is essential!
--- But simplify the task by assuming records are type-annotated
--- (this has been done in type checking)
-mapStr :: Type -> Term -> Term -> Term
-mapStr ty f t = case (ty,t) of
-  _ | elem ty [typeStr,typeTok] -> App f t
-  (_,        R ts)    -> R [(l,mapField v)   | (l,v) <- ts]
-  (Table a b,T ti cs) -> T ti [(p,mapStr b f v) | (p,v) <- cs]
-  _    -> t 
- where
-   mapField (mty,te) = case mty of
-     Just ty -> (mty,mapStr ty f te)
-     _ -> (mty,te)
diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs
deleted file mode 100644
index c76058cc2..000000000
--- a/src/GF/Grammar/Compute.hs
+++ /dev/null
@@ -1,426 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Compute
--- 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.Grammar.Compute (computeConcrete, computeTerm,computeConcreteRec) where
-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Data.Str
-import GF.Grammar.PrGrammar
-import GF.Infra.Modules
-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 Data.List (nub,intersperse)
-import Control.Monad (liftM2, liftM)
-
--- | computation of concrete syntax terms into normal form
--- used mainly for partial evaluation
-computeConcrete :: SourceGrammar -> Term -> Err Term
-computeConcrete    g t = {- refreshTerm t >>= -} computeTerm g [] t
-computeConcreteRec g t = {- refreshTerm t >>= -} computeTermOpt True g [] t
-
-computeTerm :: SourceGrammar -> Substitution -> Term -> Err Term
-computeTerm = computeTermOpt False
-
--- rec=True is used if it cannot be assumed that looked-up constants
--- have already been computed (mainly with -optimize=noexpand in .gfr)
-
-computeTermOpt :: Bool -> SourceGrammar -> Substitution -> Term -> Err Term
-computeTermOpt rec gr = comput True where
-
-   comput full g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging 
-              case t of
-
-     Q (IC "Predef") _ -> return t
-     Q p c -> look p c 
-
-     -- if computed do nothing
-     Computed t' -> return $ unComputed t'
-
-     Vr x -> do
-       t' <- maybe (prtBad ("no value given to variable") x) return $ lookup x g
-       case t' of 
-         _ | t == t' -> return t
-         _ -> comp g t'
-
-     -- Abs x@(IA _) b -> do 
-     Abs x b | full -> do 
-       let (xs,b1) = termFormCnc t   
-       b' <- comp ([(x,Vr x) | x <- xs] ++ g) b1
-       return $ mkAbs xs b'
-     --  b' <- comp (ext x (Vr x) g) b
-     --  return $ Abs x b'
-     Abs _ _ -> return t -- hnf
-
-     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'
-
-     -- beta-convert
-     App f a -> case appForm t of
-      (h,as) | length as > 1 -> do
-        h' <- hnf g h
-        as' <- mapM (comp g) as
-        case h' of
-          _ | not (null [() | FV _ <- as']) -> compApp g (mkApp h' as')
-          c@(QC _ _) -> do
-            return $ mkApp c as'
-          Q (IC "Predef") f -> do     
-            (t',b) <- appPredefined (mkApp h' as')
-            if b then return t' else comp g t'
-
-          Abs _ _ -> do
-            let (xs,b) = termFormCnc h'
-            let g' = (zip xs as') ++ g
-            let as2 = drop (length xs) as'
-            let xs2 = drop (length as') xs
-            b' <- comp g' (mkAbs xs2 b)
-            if null as2 then return b' else comp g (mkApp b' as2)
-
-          _ -> compApp g (mkApp h' as')
-      _ -> compApp g t
-
-     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 (prtBad "no value for label" l) (comp g . snd) $ 
-                    lookup l $ reverse r 
-
-         ExtR a (R b) ->                 
-           case comp g (P (R b) l) of
-             Ok v -> return v
-             _ -> comp g (P a l)
-
---- { - --- this is incorrect, since b can contain the proper value
-         ExtR (R a) b ->                 -- NOT POSSIBLE both a and b records!
-           case comp g (P (R a) l) of
-             Ok v -> return v
-             _ -> comp g (P b l)
---- - } ---
-
-         Alias _ _ r -> comp g (P r l)
-
-         S (T i cs) e -> prawitz g i (flip P l) cs e
-         S (V i cs) e -> prawitzV g i (flip P l) cs e
-
-         _   -> returnC $ P t' l
-
-     PI t l i -> comp g $ P t l -----
-
-     S t@(T ti cc) v -> do
-       v'     <- comp g v
-       case v' of
-         FV vs -> do
-           ts' <- mapM (comp g . S t) vs
-           return $ variants ts' 
-         _ -> case ti of
-{-
-           TComp _  -> do
-             case term2patt v' of
-               Ok p' -> case lookup p' cc of
-                 Just u -> comp g u
-                 _ -> do
-                   t' <- comp g t
-                   return $ S t' v' -- if v' is not canonical
-               _ -> do
-                  t' <- comp g t
-                  return $ S t' v'
--}
-           _ -> case matchPattern cc v' of
-             Ok (c,g') -> comp (g' ++ g) c
-             _ | isCan v' -> prtBad ("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'     <- case t of
---        T _ _ -> return t
---        V _ _ -> return t
-        _ -> comp g t
-
-      v'     <- comp g v
-
-      case v' of
-       FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants        
-       _ -> case t' of
-         FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
-
-         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
-
-         -- course-of-values table: look up by index, no pattern matching needed
-         V ptyp ts -> do
-           vs <- allParamValues gr ptyp
-           case lookup v' (zip vs [0 .. length vs - 1]) of
-             Just i -> comp g $ ts !! i
------             _ -> prtBad "selection" $ S t' v' -- debug
-             _ -> return $ S t' v' -- if v' is not canonical
-
-         T (TComp _) cs -> do
-           case term2patt v' of
-             Ok p' -> case lookup p' cs of
-               Just u -> comp g u
-               _ -> return $ S t' v' -- if v' is not canonical
-             _ -> return $ S t' v'
-
-         T _ cc -> case matchPattern cc v' of
-             Ok (c,g') -> comp (g' ++ g) c
-             _ | isCan v' -> prtBad ("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
-         S (V i cs) e -> prawitzV 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
-         (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
-
-         (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
-         (S (V i cs) e, s) -> prawitzV g i (flip Glue s) cs e
-         (s, S (V i cs) e) -> prawitzV 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' <- strsFromTerm ka
-----         (Alts _, K a) -> checks [do
-            x' <- 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
-           ]
-         (C u v,_) -> comp g $ C u (Glue v y)
-
-         _ -> 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 <- 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) -> plusRecord r' s'
-         (RecType rs, RecType ss) -> plusRecType r' s'
-         _ -> return $ ExtR r' s'
-
-     -- case-expand tables
-     -- if already expanded, don't expand again
-     T i@(TComp ty) 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 $ V ty (map snd 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 <- getTableType i
-       ptyp <- comp g pty0
-       case allParamValues gr ptyp of
-         Ok vs -> do
-
-           cs'  <- mapM (compBranchOpt g) cs
-           sts  <- mapM (matchPattern cs') vs 
-           ts   <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
-           ps   <- mapM term2patt vs
-           let ps' = ps --- PT ptyp (head ps) : tail ps
-----           return $ V ptyp ts -- to save space, just course of values
-           return $ T (TComp ptyp) (zip ps' ts)
-         _ -> do
-           cs' <- mapM (compBranch g) cs
-           return $ T i cs'  -- happens with variable types
-
-     Alias c a d -> do
-       d' <- comp g d
-       return $ Alias c a d'  -- alias only disappears in certain redexes
-
-     -- otherwise go ahead
-     _ -> composOp (comp g) t >>= returnC
-
-    where
-
-     compApp g (App f a) = do
-       f' <- hnf g f
-       a' <- comp g a
-       case (f',a') of
-         (Abs x b, FV as) -> 
-           mapM (\c -> comp (ext x c g) b) as >>= return . variants
-         (_, FV as)  -> mapM (\c -> comp g (App f' c)) as >>= return . variants
-         (FV fs, _)  -> mapM (\c -> comp g (App c a')) fs >>= return . variants
-         (Abs x b,_) -> comp (ext x a' g) b
-
-         (QC _ _,_)  -> returnC $ App f' a'
-
-         (Alias _ _ d, _) -> comp g (App d a')
-
-         (S (T i cs) e,_) -> prawitz g i (flip App a') cs e
-         (S (V i cs) e,_) -> prawitzV g i (flip App a') cs e
-
-	 _ -> do
-           (t',b) <- appPredefined (App f' a')
-           if b then return t' else comp g t'
-
-     hnf  = comput False
-     comp = comput True
-
-     look p c
-       | rec       = lookupResDef gr p c >>= comp []
-       | otherwise = lookupResDef gr p c
-
-{-
-     look p c = case lookupResDefKind gr p c of
-       Ok (t,_) | noExpand p || rec -> 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
--}
-
-     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
-       _ -> 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
-     prawitzV g i f cs e = do
-       cs' <- mapM (comp g) [(f v) | v <- cs]
-       return $ S (V i cs') e
-
--- | argument variables cannot be glued
-checkNoArgVars :: Term -> Err Term
-checkNoArgVars t = case t of
-  Vr (IA _)  -> Bad $ glueErrorMsg $ prt t 
-  Vr (IAV _) -> Bad $ glueErrorMsg $ prt t 
-  _ -> composOp checkNoArgVars t
-
-glueErrorMsg s = 
-  "Cannot glue (+) term with run-time variable" +++ s ++ "." ++++
-  "Use Prelude.bind instead."
diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
deleted file mode 100644
index 95fdce611..000000000
--- a/src/GF/Grammar/Grammar.hs
+++ /dev/null
@@ -1,244 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Grammar
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:20 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.8 $
---
--- GF source abstract syntax used internally in compilation.
---
--- AR 23\/1\/2000 -- 30\/5\/2001 -- 4\/5\/2003
------------------------------------------------------------------------------
-
-module GF.Grammar.Grammar (SourceGrammar,
-		SourceModInfo,
-		SourceModule,
-		SourceAbs,
-		SourceRes,
-		SourceCnc,
-		Info(..),
-                PValues,
-		Perh,
-		MPr,
-		Type,
-		Cat,
-		Fun,
-		QIdent,
-		Term(..),
-		Patt(..),
-		TInfo(..),
-		Label(..),
-		MetaSymb(..),
-		Decl,
-		Context,
-		Equation,
-		Labelling,
-		Assign,
-		Case,
-		Cases,
-		LocalDef,
-		Param,
-		Altern,
-		Substitution,
-		Branch(..),
-		Con,
-		Trm,
-		wildPatt,
-		varLabel
-	       ) where
-
-import GF.Data.Str
-import GF.Infra.Ident
-import GF.Infra.Option ---
-import GF.Infra.Modules
-
-import GF.Data.Operations
-
--- | grammar as presented to the compiler
-type SourceGrammar = MGrammar Ident Option Info
-
-type SourceModInfo = ModInfo Ident Option Info
-
-type SourceModule = (Ident, SourceModInfo)
-
-type SourceAbs = Module Ident Option Info
-type SourceRes = Module Ident Option Info
-type SourceCnc = Module Ident Option Info
-
--- this is created in CheckGrammar, and so are Val and PVal
-type PValues = [Term]
-
--- | the constructors are judgements in 
---
---   - abstract syntax (/ABS/)
--- 
---   - resource (/RES/)
---
---   - concrete syntax (/CNC/)
---
--- and indirection to module (/INDIR/)
-data Info =                  
--- judgements in abstract syntax
-   AbsCat   (Perh Context) (Perh [Term])   -- ^ (/ABS/) constructors; must be 'Id' or 'QId'
- | AbsFun   (Perh Type) (Perh Term)        -- ^ (/ABS/) 'Yes f' = canonical
- | AbsTrans Term                           -- ^ (/ABS/)
-
--- judgements in resource
- | ResParam (Perh ([Param],Maybe PValues)) -- ^ (/RES/)
- | ResValue (Perh (Type,Maybe Int))        -- ^ (/RES/) to mark parameter constructors for lookup
- | ResOper  (Perh Type) (Perh Term)        -- ^ (/RES/)
-
- | ResOverload [(Type,Term)]               -- ^ (/RES/)
-
--- judgements in concrete syntax
- | CncCat  (Perh Type) (Perh Term) MPr     -- ^ (/CNC/) lindef ini'zed, 
- | CncFun  (Maybe (Ident,(Context,Type))) (Perh Term) MPr  -- (/CNC/) type info added at 'TC'
-
--- indirection to module Ident
- | AnyInd Bool Ident                       -- ^ (/INDIR/) the 'Bool' says if canonical
-  deriving (Read, Show)
-
--- | to express indirection to other module
-type Perh a = Perhaps a Ident
-
--- | printname
-type MPr = Perhaps Term Ident
-
-type Type = Term
-type Cat  = QIdent
-type Fun  = QIdent
-
-type QIdent = (Ident,Ident)
-
-data Term =
-   Vr Ident             -- ^ variable
- | Cn Ident             -- ^ constant
- | Con Ident            -- ^ constructor
- | EData                -- ^ to mark in definition that a fun is a constructor
- | Sort String          -- ^ basic type
- | EInt Integer         -- ^ integer literal
- | EFloat Double        -- ^ floating point literal
- | K String             -- ^ string literal or token: @\"foo\"@
- | Empty                -- ^ the empty string @[]@
-
- | App Term Term        -- ^ application: @f a@
- | Abs Ident Term       -- ^ abstraction: @\x -> b@
- | Meta MetaSymb        -- ^ metavariable: @?i@ (only parsable: ? = ?0)
- | Prod Ident Term Term -- ^ function type: @(x : A) -> B@
- | Eqs [Equation]       -- ^ abstraction by cases: @fn {x y -> b ; z u -> c}@
-                        -- only used in internal representation
- | Typed Term Term      -- ^ type-annotated term
---
--- /below this, the constructors are only for concrete syntax/
- | Example Term String  -- ^ example-based term: @in M.C "foo"
- | RecType [Labelling]  -- ^ record type: @{ p : A ; ...}@
- | R [Assign]           -- ^ record:      @{ p = a ; ...}@
- | P Term Label         -- ^ projection:  @r.p@
- | PI Term Label Int    -- ^ index-annotated projection
- | ExtR Term Term       -- ^ extension:   @R ** {x : A}@ (both types and terms)
- 
- | Table Term Term      -- ^ table type:  @P => A@
- | T TInfo [Case]       -- ^ table:       @table {p => c ; ...}@
- | TSh TInfo [Cases]    -- ^ table with disjunctive patters (only back end opt)
- | V Type [Term]        -- ^ table given as course of values: @table T [c1 ; ... ; cn]@
- | S Term Term          -- ^ selection:   @t ! p@
- | Val Type Int         -- ^ parameter value number: @T # i#
-
- | Let LocalDef Term    -- ^ local definition: @let {t : T = a} in b@
-
- | Alias Ident Type Term  -- ^ constant and its definition, used in inlining
-
- | Q  Ident Ident        -- ^ qualified constant from a package
- | QC Ident Ident        -- ^ qualified constructor from a package
-
- | C Term Term    -- ^ concatenation: @s ++ t@
- | Glue Term Term -- ^ agglutination: @s + t@
-
- | EPatt Patt     -- ^ pattern (in macro definition): # p
- | EPattType Term -- ^ pattern type: pattern T
-
- | FV [Term]      -- ^ alternatives in free variation: @variants { s ; ... }@
-
- | Alts (Term, [(Term, Term)]) -- ^ alternatives by prefix: @pre {t ; s\/c ; ...}@
- | Strs [Term]                 -- ^ conditioning prefix strings: @strs {s ; ...}@
--- 
--- /below this, the last three constructors are obsolete/
- | LiT Ident      -- ^ linearization type
- | Ready Str      -- ^ result of compiling; not to be parsed ...
- | Computed Term  -- ^ result of computing: not to be reopened nor parsed
-
-  deriving (Read, Show, Eq, Ord)
-
-data Patt =
-   PC Ident [Patt]        -- ^ constructor pattern: @C p1 ... pn@    @C@ 
- | PP Ident Ident [Patt]  -- ^ package constructor pattern: @P.C p1 ... pn@    @P.C@ 
- | PV Ident               -- ^ variable pattern: @x@
- | PW                     -- ^ wild card pattern: @_@
- | PR [(Label,Patt)]      -- ^ record pattern: @{r = p ; ...}@  -- only concrete
- | PString String         -- ^ string literal pattern: @\"foo\"@  -- only abstract
- | PInt    Integer        -- ^ integer literal pattern: @12@    -- only abstract
- | PFloat Double          -- ^ float literal pattern: @1.2@    -- only abstract
- | PT Type Patt           -- ^ type-annotated pattern
-
- | PVal Type Int          -- ^ parameter value number: @T # i#
-
- | PAs Ident Patt         -- ^ as-pattern: x@p
-
- -- regular expression patterns
- | PNeg Patt              -- ^ negated pattern: -p
- | PAlt Patt Patt         -- ^ disjunctive pattern: p1 | p2
- | PSeq Patt Patt         -- ^ sequence of token parts: p + q
- | PRep Patt              -- ^ repetition of token part: p*
- | PChar                  -- ^ string of length one: ?
- | PChars [Char]          -- ^ character list: ["aeiou"]
- | PMacro Ident           -- #p
- | PM Ident Ident         -- #m.p
-
-  deriving (Read, Show, Eq, Ord)
-
--- | to guide computation and type checking of tables
-data TInfo = 
-   TRaw         -- ^ received from parser; can be anything
- | TTyped Type  -- ^ type annontated, but can be anything
- | TComp Type   -- ^ expanded
- | TWild Type   -- ^ just one wild card pattern, no need to expand 
-  deriving (Read, Show, Eq, Ord)
-
--- | record label
-data Label = 
-    LIdent String
-  | LVar Int
-   deriving (Read, Show, Eq, Ord)
-
-newtype MetaSymb = MetaSymb Int    deriving (Read, Show, Eq, Ord)
-
-type Decl     = (Ident,Term)  -- (x:A)  (_:A)  A
-type Context  = [Decl]        -- (x:A)(y:B)   (x,y:A)   (_,_:A)
-type Equation = ([Patt],Term) 
-
-type Labelling = (Label, Term) 
-type Assign = (Label, (Maybe Type, Term)) 
-type Case = (Patt, Term) 
-type Cases = ([Patt], Term) 
-type LocalDef = (Ident, (Maybe Type, Term))
-
-type Param = (Ident, Context) 
-type Altern = (Term, [(Term, Term)])
-
-type Substitution =  [(Ident, Term)]
-
--- | branches à la Alfa
-newtype Branch = Branch (Con,([Ident],Term)) deriving (Eq, Ord,Show,Read)
-type Con = Ident ---
-
-varLabel :: Int -> Label
-varLabel = LVar
-
-wildPatt :: Patt
-wildPatt = PV wildIdent
-
-type Trm = Term
diff --git a/src/GF/Grammar/Lockfield.hs b/src/GF/Grammar/Lockfield.hs
deleted file mode 100644
index 960b12983..000000000
--- a/src/GF/Grammar/Lockfield.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Lockfield
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/11 23:24:34 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.7 $
---
--- Creating and using lock fields in reused resource grammars.
---
--- AR 8\/2\/2005 detached from 'compile/MkResource'
------------------------------------------------------------------------------
-
-module GF.Grammar.Lockfield (lockRecType, unlockRecord, lockLabel, isLockLabel) where
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Grammar.Macros
-import GF.Grammar.PrGrammar
-
-import GF.Data.Operations
-
-lockRecType :: Ident -> Type -> Err Type
-lockRecType c t@(RecType rs) = 
-  let lab = lockLabel c in
-  return $ if elem lab (map fst rs) || elem (prt c) ["String","Int"]
-    then t --- don't add an extra copy of lock field, nor predef cats
-    else RecType (rs ++ [(lockLabel c,  RecType [])])
-lockRecType c t = plusRecType t $ RecType [(lockLabel c,  RecType [])]
-
-unlockRecord :: Ident -> Term -> Err Term
-unlockRecord c ft = do
-  let (xs,t) = termFormCnc ft
-  t' <- plusRecord t $ R [(lockLabel c,  (Just (RecType []),R []))]
-  return $ mkAbs xs t'
-
-lockLabel :: Ident -> Label
-lockLabel c = LIdent $ "lock_" ++ prt c ----
-
-isLockLabel :: Label -> Bool
-isLockLabel l = case l of
-  LIdent c -> take 5 c == "lock_"
-  _ -> False
diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
deleted file mode 100644
index 5bd4c1e41..000000000
--- a/src/GF/Grammar/LookAbs.hs
+++ /dev/null
@@ -1,196 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : LookAbs
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/28 16:42:48 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.14 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Grammar.LookAbs (GFCGrammar,
-		lookupAbsDef,
-		lookupFunType,
-		lookupCatContext,
-		lookupTransfer,
-		isPrimitiveFun,
-		lookupRef,
-		refsForType,
-		funRulesOf,
-		hasHOAS,
-		allCatsOf,
-		allBindCatsOf,
-		funsForType,
-		funsOnType,
-		funsOnTypeFs,
-		allDefs,
-		lookupFunTypeSrc,
-		lookupCatContextSrc
-	       ) where
-
-import GF.Data.Operations
-import qualified GF.Canon.GFC as C
-import GF.Grammar.Abstract
-import GF.Infra.Ident
-
-import GF.Infra.Modules
-
-import Data.List (nub)
-import Control.Monad
-
-type GFCGrammar = C.CanonGrammar
-
-lookupAbsDef :: GFCGrammar -> Ident -> Ident -> Err (Maybe Term)
-lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
-  mi   <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        C.AbsFun _ t  -> return $ return t
-        C.AnyInd _ n  -> lookupAbsDef gr n c
-        _ -> return Nothing
-    _ -> Bad $ prt m +++ "is not an abstract module"
-
-lookupFunType :: GFCGrammar -> Ident -> Ident -> Err Type
-lookupFunType gr m c = errIn ("looking up funtype of" +++ prt c +++ "in module" +++ prt m) $ do
-  mi   <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        C.AbsFun t _  -> return t
-        C.AnyInd _ n  -> lookupFunType gr n c
-        _ -> prtBad "cannot find type of" c
-    _ -> Bad $ prt m +++ "is not an abstract module"
-
-lookupCatContext :: GFCGrammar -> Ident -> Ident -> Err Context
-lookupCatContext gr m c = errIn ("looking up context of cat" +++ prt c) $ do
-  mi   <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        C.AbsCat co _ -> return co
-        C.AnyInd _ n  -> lookupCatContext gr n c
-        _ -> prtBad "unknown category" c
-    _ -> Bad $ prt m +++ "is not an abstract module"
-
--- | lookup for transfer function: transfer-module-name, category name
-lookupTransfer :: GFCGrammar -> Ident -> Ident -> Err Term
-lookupTransfer gr m c = errIn ("looking up transfer of cat" +++ prt c) $ do
-  mi   <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        C.AbsTrans t -> return t
-        C.AnyInd _ n  -> lookupTransfer gr n c
-        _ -> prtBad "cannot transfer function for" c
-    _ -> Bad $ prt m +++ "is not a transfer module"
-
-
--- | should be revised (20\/9\/2003)
-isPrimitiveFun :: GFCGrammar -> Fun -> Bool
-isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of
-  Ok (Just (Eqs [])) -> True  -- is canonical
-  Ok (Just _)        -> False -- has defining clauses
-  _                  -> True  -- has no definition
-
-
--- | looking up refinement terms
-lookupRef :: GFCGrammar -> Binds -> Term -> Err Val
-lookupRef gr binds at = case at of
-  Q m f  -> lookupFunType gr m f >>= return . vClos
-  Vr i   -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
-  EInt _ -> return valAbsInt
-  EFloat _ -> return valAbsFloat
-  K _    -> return valAbsString
-  _      -> prtBad "cannot refine with complex term" at ---
-
-refsForType :: (Val -> Type -> Bool) -> GFCGrammar -> Binds -> Val -> [(Term,(Val,Bool))]
-refsForType compat gr binds val =     
-    -- bound variables --- never recursive?
-    [(vr i, (t,False)) | (i,t) <- binds, Ok ty <- [val2exp t], compat val ty] ++
-    -- integer and string literals
-    [(EInt i, (val,False)) | val == valAbsInt, i <- [0,1,2,5,11,1978]] ++
-    [(EFloat i, (val,False)) | val == valAbsFloat, i <- [3.1415926]] ++
-    [(K s, (val,False)) | val == valAbsString, s <- ["foo", "NN", "x"]] ++
-    -- functions defined in the current abstract syntax
-    [(qq f, (vClos t,isRecursiveType t)) | (f,t) <- funsForType compat gr val]
-
-
-funRulesOf :: GFCGrammar -> [(Fun,Type)]
-funRulesOf gr = 
-----  funRulesForLiterals ++
-  [((i,f),typ) | (i, ModMod m) <- modules gr,
-                 mtype m == MTAbstract,
-                 (f, C.AbsFun typ _) <- tree2list (jments m)]
-
--- testing for higher-order abstract syntax
-hasHOAS :: GFCGrammar -> Bool
-hasHOAS gr = any isHigherOrderType [t | (_,t) <- funRulesOf gr] where
-
-allCatsOf :: GFCGrammar -> [(Cat,Context)]
-allCatsOf gr = 
-  [((i,c),cont) | (i, ModMod m) <- modules gr,
-                    isModAbs m,
-                    (c, C.AbsCat cont _) <- tree2list (jments m)]
-
-allBindCatsOf :: GFCGrammar -> [Cat]
-allBindCatsOf gr = 
-  nub [c | (i, ModMod m) <- modules gr,
-                    isModAbs m,
-                    (c, C.AbsFun typ _) <- tree2list (jments m),
-                    Ok (cont,_) <- [firstTypeForm typ],
-                    c <- concatMap fst $ errVal [] $ mapM (catSkeleton . snd) cont
-                    ]
-
-funsForType :: (Val -> Type -> Bool) -> GFCGrammar -> Val -> [(Fun,Type)]
-funsForType compat gr val = [(fun,typ) | (fun,typ) <- funRulesOf gr, 
-                                         compat val typ]
-
-funsOnType :: (Val -> Type -> Bool) -> GFCGrammar -> Val -> [((Fun,Int),Type)]
-funsOnType compat gr = funsOnTypeFs compat (funRulesOf gr)
-
-funsOnTypeFs :: (Val -> Type -> Bool) -> [(Fun,Type)] -> Val -> [((Fun,Int),Type)]
-funsOnTypeFs compat fs val = [((fun,i),typ) | 
-                                       (fun,typ) <- fs,
-                                        Ok (args,_,_) <- [typeForm typ],
-                                        (i,arg) <- zip [0..] (map snd args),
-                                        compat val arg]
-
-allDefs :: GFCGrammar -> [(Fun,Term)]
-allDefs gr = [((i,c),d) | (i, ModMod m) <- modules gr,
-                    isModAbs m,
-                    (c, C.AbsFun _ d) <- tree2list (jments m)]
-
--- | this is needed at compile time
-lookupFunTypeSrc :: Grammar -> Ident -> Ident -> Err Type
-lookupFunTypeSrc gr m c = do
-  mi   <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        AbsFun (Yes t) _  -> return t
-        AnyInd _ n  -> lookupFunTypeSrc gr n c
-        _ -> prtBad "cannot find type of" c
-    _ -> Bad $ prt m +++ "is not an abstract module"
-
--- | this is needed at compile time
-lookupCatContextSrc :: Grammar -> Ident -> Ident -> Err Context
-lookupCatContextSrc gr m c = do
-  mi   <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        AbsCat (Yes co) _ -> return co
-        AnyInd _ n  -> lookupCatContextSrc gr n c
-        _ -> prtBad "unknown category" c
-    _ -> Bad $ prt m +++ "is not an abstract module"
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
deleted file mode 100644
index 81a62decf..000000000
--- a/src/GF/Grammar/Lookup.hs
+++ /dev/null
@@ -1,275 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Lookup
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/27 13:21:53 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.15 $
---
--- Lookup in source (concrete and resource) when compiling.
---
--- lookup in resource and concrete in compiling; for abstract, use 'Look'
------------------------------------------------------------------------------
-
-module GF.Grammar.Lookup (
-               lookupResDef,
-               lookupResDefKind,
-	       lookupResType, 
-               lookupOverload,
-	       lookupParams, 
-	       lookupParamValues, 
-	       lookupFirstTag, 
-               lookupValueIndex,
-               lookupIndexValue,
-               allOrigInfos,
-	       allParamValues, 
-	       lookupAbsDef, 
-	       lookupLincat, 
-	       opersForType,
-               linTypeInt
-	      ) where
-
-import GF.Data.Operations
-import GF.Grammar.Abstract
-import GF.Infra.Modules
-import GF.Grammar.Lockfield
-
-import Data.List (nub,sortBy)
-import Control.Monad
-
--- whether lock fields are added in reuse
-lock c = lockRecType c -- return
-unlock c = unlockRecord c -- return
-
-lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term
-lookupResDef gr m c = liftM fst $ lookupResDefKind gr m c
-
--- 0 = oper, 1 = lin, 2 = canonical. v > 0 means: no need to be recomputed
-lookupResDefKind :: SourceGrammar -> Ident -> Ident -> Err (Term,Int)
-lookupResDefKind gr m c = look True m c where 
-  look isTop m c = do
-    mi   <- lookupModule gr m
-    case mi of
-      ModMod mo -> do
-        info <- lookupIdentInfo mo c
-        case info of
-          ResOper _ (Yes t) -> return (qualifAnnot m t, 0) 
-          ResOper _ Nope    -> return (Q m c, 0) ---- if isTop then lookExt m c 
-                                 ---- else prtBad "cannot find in exts" c 
-
-          CncCat (Yes ty) _ _ -> liftM (flip (,) 1) $ lock c ty
-          CncCat _ _ _        -> liftM (flip (,) 1) $ lock c defLinType
-          CncFun (Just (cat,_)) (Yes tr) _ -> liftM (flip (,) 1) $ unlock cat tr
-
-          CncFun _ (Yes tr) _ -> liftM (flip (,) 1) $ unlock c tr
-
-          AnyInd _ n        -> look False n c
-          ResParam _        -> return (QC m c,2)
-          ResValue _        -> return (QC m c,2)
-          _   -> Bad $ prt c +++ "is not defined in resource" +++ prt m
-      _ -> Bad $ prt m +++ "is not a resource"
-  lookExt m c =
-    checks ([look False n c | n <- allExtensions gr m] ++ [return (Q m c,3)])
-
-lookupResType :: SourceGrammar -> Ident -> Ident -> Err Type
-lookupResType gr m c = do
-  mi   <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        ResOper (Yes t) _ -> return $ qualifAnnot m t
-        ResOper (May n) _ -> lookupResType gr n c
-
-        -- used in reused concrete
-        CncCat _ _ _ -> return typeType
-        CncFun (Just (cat,(cont@(_:_),val))) _ _ -> do
-          val' <- lock cat val 
-          return $ mkProd (cont, val', [])
-        CncFun _ _ _      -> lookFunType m m c
-        AnyInd _ n        -> lookupResType gr n c
-        ResParam _        -> return $ typePType
-        ResValue (Yes (t,_))  -> return $ qualifAnnotPar m t
-        _   -> Bad $ prt c +++ "has no type defined in resource" +++ prt m
-    _ -> Bad $ prt m +++ "is not a resource"
-  where
-    lookFunType e m c = do
-          a  <- abstractOfConcrete gr m
-          lookFun e m c a
-    lookFun e m c a = do
-          mu <- lookupModMod gr a
-          info <- lookupIdentInfo mu c
-          case info of
-            AbsFun (Yes ty) _ -> return $ redirectTerm e ty 
-            AbsCat _ _ -> return typeType
-            AnyInd _ n -> lookFun e m c n
-            _ -> prtBad "cannot find type of reused function" c
-
-lookupOverload :: SourceGrammar -> Ident -> Ident -> Err [([Type],(Type,Term))]
-lookupOverload gr m c = do
-    mi   <- lookupModule gr m
-    case mi of
-      ModMod mo -> do
-        info <- lookupIdentInfo mo c
-        case info of
-          ResOverload tysts -> 
-            return [(map snd args,(val,tr)) | 
-                      (ty,tr) <- tysts, Ok (args,val) <- [typeFormCnc ty]]
-
-          AnyInd _ n  -> lookupOverload gr n c
-          _   -> Bad $ prt c +++ "is not an overloaded operation"
-      _ -> Bad $ prt m +++ "is not a resource"
-
-lookupOrigInfo :: SourceGrammar -> Ident -> Ident -> Err Info
-lookupOrigInfo gr m c = do
-    mi   <- lookupModule gr m
-    case mi of
-      ModMod mo -> do
-        info <- lookupIdentInfo mo c
-        case info of
-          AnyInd _ n  -> lookupOrigInfo gr n c
-          i   -> return i
-      _ -> Bad $ prt m +++ "is not run-time module"
-
-lookupParams :: SourceGrammar -> Ident -> Ident -> Err ([Param],Maybe PValues)
-lookupParams gr = look True where 
-  look isTop m c = do
-    mi   <- lookupModule gr m
-    case mi of
-      ModMod mo -> do
-        info <- lookupIdentInfo mo c
-        case info of
-          ResParam (Yes psm) -> return psm
-
-          AnyInd _ n        -> look False n c
-          _   -> Bad $ prt c +++ "has no parameters defined in resource" +++ prt m
-      _ -> Bad $ prt m +++ "is not a resource"
-  lookExt m c =
-    checks [look False n c | n <- allExtensions gr m]
-
-lookupParamValues :: SourceGrammar -> Ident -> Ident -> Err [Term]
-lookupParamValues gr m c = do
-  (ps,mpv) <- lookupParams gr m c
-  case mpv of
-    Just ts -> return ts
-    _ -> liftM concat $ mapM mkPar ps
- where
-   mkPar (f,co) = do
-     vs <- liftM combinations $ mapM (\ (_,ty) -> allParamValues gr ty) co
-     return $ map (mkApp (QC m f)) vs
-
-lookupFirstTag :: SourceGrammar -> Ident -> Ident -> Err Term
-lookupFirstTag gr m c = do
-  vs <- lookupParamValues gr m c
-  case vs of
-    v:_ -> return v
-    _ -> prtBad "no parameter values given to type" c
-
-lookupValueIndex :: SourceGrammar -> Type -> Term -> Err Term
-lookupValueIndex gr ty tr = do
-  ts <- allParamValues gr ty
-  case lookup tr $ zip ts [0..] of
-    Just i -> return $ Val ty i
-    _ -> Bad $ "no index for" +++ prt tr +++ "in" +++ prt ty
-
-lookupIndexValue :: SourceGrammar -> Type -> Int -> Err Term
-lookupIndexValue gr ty i = do
-  ts <- allParamValues gr ty
-  if i < length ts
-    then return $ ts !! i
-    else Bad $ "no value for index" +++ show i +++ "in" +++ prt ty
-
-allOrigInfos :: SourceGrammar -> Ident -> [(Ident,Info)]
-allOrigInfos gr m = errVal [] $ do
-  mi <- lookupModule gr m
-  case mi of
-    ModMod mo -> return [(c,i) | (c,_) <- tree2list (jments mo), Ok i <- [look c]]
- where
-   look = lookupOrigInfo gr m
-
-allParamValues :: SourceGrammar -> Type -> Err [Term]
-allParamValues cnc ptyp = case ptyp of
-     App (Q (IC "Predef") (IC "Ints")) (EInt n) -> 
-       return [EInt i | i <- [0..n]]
-     QC p c -> lookupParamValues cnc p c
-     Q  p c -> lookupParamValues cnc p c ----
-     RecType r -> do
-       let (ls,tys) = unzip $ sortByFst r
-       tss <- mapM allPV tys
-       return [R (zipAssign ls ts) | ts <- combinations tss]
-     _ -> prtBad "cannot find parameter values for" ptyp
-  where
-    allPV = allParamValues cnc
-    -- to normalize records and record types
-    sortByFst = sortBy (\ x y -> compare (fst x) (fst y))
-
-qualifAnnot :: Ident -> Term -> Term
-qualifAnnot _ = id
--- Using this we wouldn't have to annotate constants defined in a module itself.
--- But things are simpler if we do (cf. Zinc).
--- Change Rename.self2status to change this behaviour.
-
--- we need this for lookup in ResVal
-qualifAnnotPar m t = case t of
-  Cn c  -> Q m c
-  Con c -> QC m c
-  _ -> composSafeOp (qualifAnnotPar m) t
-
-lookupAbsDef :: SourceGrammar -> Ident -> Ident -> Err (Maybe Term)
-lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
-  mi   <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        AbsFun _ (Yes t)  -> return $ return t
-        AnyInd _ n  -> lookupAbsDef gr n c
-        _ -> return Nothing
-    _ -> Bad $ prt m +++ "is not an abstract module"
-
-linTypeInt :: Type
-linTypeInt = defLinType
----      let ints k = App (Q (IC "Predef") (IC "Ints")) (EInt k) in
----      RecType [
----        (LIdent "last",ints 9),(LIdent "s", typeStr), (LIdent "size",ints 1)]
-
-lookupLincat :: SourceGrammar -> Ident -> Ident -> Err Type
-lookupLincat gr m c | elem c [zIdent "Int"] = return linTypeInt
-lookupLincat gr m c | elem c [zIdent "String", zIdent "Float"] = 
-  return defLinType --- ad hoc; not needed?
-
-lookupLincat gr m c = do
-  mi <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
-      info <- lookupIdentInfo mo c
-      case info of
-        CncCat (Yes t) _ _ -> return t
-        AnyInd _ n         -> lookupLincat gr n c
-        _   -> Bad $ prt c +++ "has no linearization type in" +++ prt m
-    _ -> Bad $ prt m +++ "is not concrete"
-
-
--- The first type argument is uncomputed, usually a category symbol.
--- This is a hack to find implicit (= reused) opers.
-
-opersForType :: SourceGrammar -> Type -> Type -> [(QIdent,Term)]
-opersForType gr orig val = 
-  [((i,f),ty) | (i,m) <- allModMod gr, (f,ty) <- opers i m val] where
-    opers i m val = 
-      [(f,ty) |
-        (f,ResOper (Yes ty) _) <- tree2list $ jments m,
-        Ok valt <- [valTypeCnc ty],
-        elem valt [val,orig]
-        ] ++
-      let cat = err zIdent snd (valCat orig) in --- ignore module
-      [(f,ty) |
-        Ok a <- [abstractOfConcrete gr i >>= lookupModMod gr],
-        (f, AbsFun (Yes ty0) _) <- tree2list $ jments a,
-        let ty = redirectTerm i ty0,
-        Ok valt  <- [valCat ty],
-        cat == snd valt ---
-        ]
diff --git a/src/GF/Grammar/MMacros.hs b/src/GF/Grammar/MMacros.hs
deleted file mode 100644
index dd7331685..000000000
--- a/src/GF/Grammar/MMacros.hs
+++ /dev/null
@@ -1,341 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : MMacros
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/10 12:49:13 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.9 $
---
--- some more abstractions on grammars, esp. for Edit
------------------------------------------------------------------------------
-
-module GF.Grammar.MMacros where
-
-import GF.Data.Operations
-import GF.Data.Zipper
-
-import GF.Grammar.Grammar
-import GF.Grammar.PrGrammar
-import GF.Infra.Ident
-import GF.Grammar.Refresh
-import GF.Grammar.Values
-----import GrammarST
-import GF.Grammar.Macros
-
-import Control.Monad
-
-nodeTree :: Tree -> TrNode
-argsTree :: Tree -> [Tree]
-
-nodeTree (Tr (n,_)) = n
-argsTree (Tr (_,ts)) = ts
-
-isFocusNode    :: TrNode -> Bool
-bindsNode      :: TrNode -> Binds
-atomNode       :: TrNode -> Atom
-valNode        :: TrNode -> Val
-constrsNode    :: TrNode -> Constraints
-metaSubstsNode :: TrNode -> MetaSubst
-
-isFocusNode    (N (_,_,_,_,b)) = b
-bindsNode      (N (b,_,_,_,_)) = b
-atomNode       (N (_,a,_,_,_)) = a
-valNode        (N (_,_,v,_,_)) = v
-constrsNode    (N (_,_,_,(c,_),_)) = c
-metaSubstsNode (N (_,_,_,(_,m),_)) = m
-
-atomTree :: Tree -> Atom
-valTree  :: Tree -> Val
-
-atomTree = atomNode . nodeTree 
-valTree  = valNode  . nodeTree
-
-mkNode :: Binds -> Atom -> Val -> (Constraints, MetaSubst) -> TrNode
-mkNode binds atom vtyp cs = N (binds,atom,vtyp,cs,False)
-
-type Var = Ident
-type Meta = MetaSymb
-
-metasTree :: Tree ->  [Meta]
-metasTree = concatMap metasNode . scanTree where
-  metasNode n = [m | AtM m <- [atomNode n]] ++ map fst (metaSubstsNode n)
-
-varsTree :: Tree ->  [(Var,Val)]
-varsTree t = [(x,v) | N (_,AtV x,v,_,_) <- scanTree t]
-
-constrsTree :: Tree -> Constraints
-constrsTree = constrsNode . nodeTree
-
-allConstrsTree :: Tree -> Constraints
-allConstrsTree = concatMap constrsNode . scanTree
-
-changeConstrs :: (Constraints -> Constraints) -> TrNode -> TrNode
-changeConstrs f (N (b,a,v,(c,m),x)) = N (b,a,v,(f c, m),x)
-
-changeMetaSubst :: (MetaSubst -> MetaSubst) -> TrNode -> TrNode
-changeMetaSubst f (N (b,a,v,(c,m),x)) = N (b,a,v,(c, f m),x)
-
-changeAtom :: (Atom -> Atom) -> TrNode -> TrNode
-changeAtom f (N (b,a,v,(c,m),x)) = N (b,f a,v,(c, m),x)
-
--- * on the way to Edit
-
-uTree :: Tree
-uTree = Tr (uNode, []) -- unknown tree
-
-uNode :: TrNode
-uNode = mkNode [] uAtom uVal ([],[])
-
-
-uAtom :: Atom
-uAtom = AtM meta0
-
-mAtom :: Atom
-mAtom = AtM meta0
-
-uVal :: Val
-uVal = vClos uExp
-
-vClos :: Exp -> Val
-vClos = VClos []
-
-uExp :: Exp
-uExp = Meta meta0
-
-mExp, mExp0 :: Exp
-mExp  = Meta meta0
-mExp0 = mExp
-
-meta2exp :: MetaSymb -> Exp
-meta2exp = Meta
-
-atomC :: Fun -> Atom
-atomC = AtC
-
-funAtom :: Atom -> Err Fun
-funAtom a = case a of
-  AtC f -> return f
-  _ -> prtBad "not function head" a
-
-uBoundVar :: Ident
-uBoundVar = zIdent "#h" -- used for suppressed bindings
-
-atomIsMeta :: Atom -> Bool
-atomIsMeta atom = case atom of
-  AtM _ -> True
-  _   -> False
-
-getMetaAtom :: Atom -> Err Meta
-getMetaAtom a = case a of
-  AtM m -> return m
-  _ -> Bad "the active node is not meta"
-
-cat2val :: Context -> Cat -> Val
-cat2val cont cat = vClos $ mkApp (qq cat) [mkMeta i | i <- [1..length cont]]
-
-val2cat :: Val -> Err Cat
-val2cat v = val2exp v >>= valCat
-
-substTerm  :: [Ident] -> Substitution -> Term -> Term
-substTerm ss g c = case c of
-  Vr x        -> maybe c id $ lookup x g
-  App f a     -> App (substTerm ss g f) (substTerm ss g a)
-  Abs x b     -> let y = mkFreshVarX ss x in 
-                   Abs y (substTerm (y:ss) ((x, Vr y):g) b)
-  Prod x a b  -> let y = mkFreshVarX ss x in 
-                   Prod y (substTerm ss g a) (substTerm (y:ss) ((x,Vr y):g) b)
-  _           -> c
-
-metaSubstExp :: MetaSubst -> [(Meta,Exp)]
-metaSubstExp msubst = [(m, errVal (meta2exp m) (val2expSafe v)) | (m,v) <- msubst]
-
--- * belong here rather than to computation
-
-substitute :: [Var] -> Substitution -> Exp -> Err Exp
-substitute v s = return . substTerm v s
-
-alphaConv :: [Var] -> (Var,Var) -> Exp -> Err Exp ---
-alphaConv oldvars (x,x') = substitute (x:x':oldvars) [(x,Vr x')]
-
-alphaFresh :: [Var] -> Exp -> Err Exp
-alphaFresh vs = refreshTermN $ maxVarIndex vs
-
--- | done in a state monad
-alphaFreshAll :: [Var] -> [Exp] -> Err [Exp]
-alphaFreshAll vs = mapM $ alphaFresh vs 
-
--- | for display
-val2exp :: Val -> Err Exp
-val2exp = val2expP False 
-
--- | for type checking
-val2expSafe :: Val -> Err Exp
-val2expSafe = val2expP True  
-
-val2expP :: Bool -> Val -> Err Exp
-val2expP safe v = case v of
-
-  VClos g@(_:_) e@(Meta _) -> if safe 
-                              then prtBad "unsafe value substitution" v
-                              else substVal g e
-  VClos g e -> substVal g e
-  VApp f c  -> liftM2 App (val2expP safe f) (val2expP safe c)
-  VCn c     -> return $ qq c
-  VGen i x  -> if safe 
-               then prtBad "unsafe val2exp" v
-               else return $ vr $ x  --- in editing, no alpha conversions presentv
- where 
-   substVal g e = mapPairsM (val2expP safe) g >>= return . (\s -> substTerm [] s e)
-
-isConstVal :: Val -> Bool
-isConstVal v = case v of
-  VApp f c   -> isConstVal f && isConstVal c
-  VCn _      -> True
-  VClos [] e -> null $ freeVarsExp e  
-  _          -> False --- could be more liberal
-
-mkProdVal :: Binds -> Val -> Err Val ---
-mkProdVal bs v = do 
-  bs' <- mapPairsM val2exp bs
-  v'  <- val2exp v
-  return $ vClos $ foldr (uncurry Prod) v' bs'
-
-freeVarsExp :: Exp -> [Ident]
-freeVarsExp e = case e of
-  Vr x -> [x]
-  App f c -> freeVarsExp f ++ freeVarsExp c
-  Abs x b -> filter (/=x) (freeVarsExp b)
-  Prod x a b -> freeVarsExp a ++ filter (/=x) (freeVarsExp b)
-  _ -> [] --- thus applies to abstract syntax only
-
-ident2string :: Ident -> String
-ident2string = prIdent
-
-tree :: (TrNode,[Tree]) -> Tree
-tree = Tr
-
-eqCat :: Cat -> Cat -> Bool
-eqCat = (==)
-
-addBinds :: Binds -> Tree -> Tree
-addBinds b (Tr (N (b0,at,t,c,x),ts)) = Tr (N (b ++ b0,at,t,c,x),ts)
-
-bodyTree :: Tree -> Tree
-bodyTree (Tr (N (_,a,t,c,x),ts)) = Tr (N ([],a,t,c,x),ts)
-
-refreshMetas :: [Meta] -> Exp -> Exp
-refreshMetas metas = fst . rms minMeta where
-  rms meta trm = case trm of
-    Meta m  -> (Meta meta, nextMeta meta)
-    App f a -> let (f',msf) = rms meta f 
-                   (a',msa) = rms msf a
-               in (App f' a', msa)
-    Prod x a b -> 
-               let (a',msa) = rms meta a 
-                   (b',msb) = rms msa b
-               in (Prod x a' b', msb)
-    Abs x b -> let (b',msb) = rms meta b in (Abs x b', msb)
-    _       -> (trm,meta)
-  minMeta = int2meta $ 
-              if null metas then 0 else (maximum (map metaSymbInt metas) + 1)
-
-ref2exp :: [Var] -> Type -> Ref -> Err Exp
-ref2exp bounds typ ref = do
-  cont <- contextOfType typ
-  xx0  <- mapM (typeSkeleton . snd) cont
-  let (xxs,cs) = unzip [(length hs, c) | (hs,c) <- xx0]
-      args     = [mkAbs xs mExp | i <- xxs, let xs = mkFreshVars i bounds]
-  return $ mkApp ref args
-  -- no refreshment of metas
-  
--- | invariant: only 'Con' or 'Var'
-type Ref = Exp 
-
-fun2wrap :: [Var] -> ((Fun,Int),Type) -> Exp -> Err Exp
-fun2wrap oldvars ((fun,i),typ) exp = do
-  cont <- contextOfType typ
-  args <- mapM mkArg (zip [0..] (map snd cont))
-  return $ mkApp (qq fun) args
- where
-  mkArg (n,c) = do
-    cont <- contextOfType c
-    let vars = mkFreshVars (length cont) oldvars
-    return $ mkAbs vars $ if n==i then exp else mExp
-
--- | weak heuristics: sameness of value category
-compatType :: Val -> Type -> Bool
-compatType v t = errVal True $ do
-  cat1 <- val2cat v
-  cat2 <- valCat t
-  return $ cat1 == cat2
-
----
-
-mkJustProd :: Context -> Term -> Term
-mkJustProd cont typ = mkProd (cont,typ,[])
-
-int2var :: Int -> Ident
-int2var = zIdent . ('$':) . show
-
-meta0 :: Meta
-meta0 = int2meta 0
-
-termMeta0 :: Term
-termMeta0 = Meta meta0
-
-identVar :: Term -> Err Ident
-identVar (Vr x) = return x
-identVar _ = Bad "not a variable"
-
-
--- | light-weight rename for user interaction; also change names of internal vars
-qualifTerm :: Ident -> Term -> Term
-qualifTerm m  = qualif [] where
-  qualif xs t = case t of
-    Abs x b -> let x' = chV x in Abs x' $ qualif (x':xs) b
-    Prod x a b -> Prod x (qualif xs a) $ qualif (x:xs) b
-    Vr x -> let x' = chV x in if (elem x' xs) then (Vr x') else (Q m x) 
-    Cn c  -> Q m c
-    Con c -> QC m c
-    _ -> composSafeOp (qualif xs) t
-  chV x = string2var $ prIdent x
-    
-string2var :: String -> Ident
-string2var s = case s of
-  c:'_':i -> identV (readIntArg i,[c]) ---
-  _ -> zIdent s
-
--- | reindex variables so that they tell nesting depth level
-reindexTerm :: Term -> Term
-reindexTerm = qualif (0,[]) where
-  qualif dg@(d,g) t = case t of
-    Abs x b    -> let x' = ind x d in Abs x' $ qualif (d+1, (x,x'):g) b
-    Prod x a b -> let x' = ind x d in Prod x' (qualif dg a) $ qualif (d+1, (x,x'):g) b
-    Vr x       -> Vr $ look x g
-    _ -> composSafeOp (qualif dg) t
-  look x  = maybe x id . lookup x --- if x is not in scope it is unchanged
-  ind x d = identC $ prIdent x ++ "_" ++ show d
-
-
--- this method works for context-free abstract syntax
--- and is meant to be used in simple embedded GF applications
-
-exp2tree :: Exp -> Err Tree
-exp2tree e = do
-  (bs,f,xs) <- termForm e
-  cont <- case bs of
-    [] -> return []
-    _  -> prtBad "cannot convert bindings in" e
-  at <- case f of
-    Q  m c -> return $ AtC (m,c)
-    QC m c -> return $ AtC (m,c)
-    Meta m -> return $ AtM m
-    K s    -> return $ AtL s
-    EInt n -> return $ AtI n
-    EFloat n -> return $ AtF n
-    _ -> prtBad "cannot convert to atom" f
-  ts <- mapM exp2tree xs
-  return $ Tr (N (cont,at,uVal,([],[]),True),ts)
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
deleted file mode 100644
index 58c449901..000000000
--- a/src/GF/Grammar/Macros.hs
+++ /dev/null
@@ -1,817 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Macros
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/11 16:38:00 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.24 $
---
--- Macros for constructing and analysing source code terms.
---
--- operations on terms and types not involving lookup in or reference to grammars
---
--- AR 7\/12\/1999 - 9\/5\/2000 -- 4\/6\/2001
------------------------------------------------------------------------------
-
-module GF.Grammar.Macros where
-
-import GF.Data.Operations
-import GF.Data.Str
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Grammar.PrGrammar
-
-import Control.Monad (liftM, liftM2)
-import Data.Char (isDigit)
-
-firstTypeForm :: Type -> Err (Context, Type)
-firstTypeForm t = case t of
-  Prod x a b  -> do
-    (x', val) <- firstTypeForm b 
-    return ((x,a):x',val)
-  _ -> return ([],t)
-
-qTypeForm :: Type -> Err (Context, Cat, [Term])
-qTypeForm t = case t of
-  Prod x a b  -> do
-    (x', cat, args) <- qTypeForm b 
-    return ((x,a):x', cat, args)
-  App c a -> do
-    (_,cat, args) <- qTypeForm c
-    return ([],cat,args ++ [a])
-  Q m c ->
-    return ([],(m,c),[]) 
-  QC m c ->
-    return ([],(m,c),[]) 
-  _       -> 
-    prtBad "no normal form of type" t
-
-qq :: QIdent -> Term
-qq (m,c) = Q m c
-
-typeForm :: Type -> Err (Context, Cat, [Term])
-typeForm = qTypeForm ---- no need to distinguish any more
-
-cPredef :: Ident
-cPredef = identC "Predef"
-
-cnPredef :: String -> Term
-cnPredef f = Q cPredef (identC f)
-
-typeFormCnc :: Type -> Err (Context, Type)
-typeFormCnc t = case t of
-  Prod x a b  -> do
-    (x', v) <- typeFormCnc b 
-    return ((x,a):x',v)
-  _ -> return ([],t)
-
-valCat :: Type -> Err Cat
-valCat typ = 
-  do (_,cat,_) <- typeForm typ
-     return cat
-
-valType :: Type -> Err Type
-valType typ = 
-  do (_,cat,xx) <- typeForm typ --- not optimal to do in this way
-     return $ mkApp (qq cat) xx
-
-valTypeCnc :: Type -> Err Type
-valTypeCnc typ = 
-  do (_,ty) <- typeFormCnc typ
-     return ty
-
-typeRawSkeleton :: Type -> Err ([(Int,Type)],Type)
-typeRawSkeleton typ =
-  do (cont,typ) <- typeFormCnc typ
-     args <- mapM (typeRawSkeleton . snd) cont
-     return ([(length c, v) | (c,v) <- args], typ)
-
-type MCat = (Ident,Ident)
-
-sortMCat :: String -> MCat
-sortMCat s = (zIdent "_", zIdent s)
-
---- hack for Editing.actCat in empty state
-errorCat :: MCat
-errorCat = (zIdent "?", zIdent "?")
-
-getMCat :: Term -> Err MCat
-getMCat t = case t of
-  Q  m c -> return (m,c)
-  QC m c -> return (m,c)
-  Sort s -> return $ sortMCat s
-  App f _ -> getMCat f
-  _ -> prtBad "no qualified constant" t
-
-typeSkeleton :: Type -> Err ([(Int,MCat)],MCat)
-typeSkeleton typ = do
-  (cont,val) <- typeRawSkeleton typ
-  cont' <- mapPairsM getMCat cont
-  val'  <- getMCat val
-  return (cont',val')
-
-catSkeleton :: Type -> Err ([MCat],MCat)
-catSkeleton typ =
-  do (args,val) <- typeSkeleton typ
-     return (map snd args, val)
-
-funsToAndFrom :: Type -> (MCat, [(MCat,[Int])])
-funsToAndFrom t = errVal undefined $ do ---
-  (cs,v) <- catSkeleton t
-  let cis = zip cs [0..]
-  return $ (v, [(c,[i | (c',i) <- cis, c' == c]) | c <- cs])
-
-typeFormConcrete :: Type -> Err (Context, Type)
-typeFormConcrete t = case t of
-  Prod x a b  -> do 
-    (x', typ) <- typeFormConcrete b 
-    return ((x,a):x', typ)
-  _       -> return ([],t)
-
-isRecursiveType :: Type -> Bool
-isRecursiveType t = errVal False $ do
-  (cc,c) <- catSkeleton t -- thus recursivity on Cat level
-  return $ any (== c) cc
-
-isHigherOrderType :: Type -> Bool
-isHigherOrderType t = errVal True $ do  -- pessimistic choice
-  co <- contextOfType t
-  return $ not $ null [x | (x,Prod _ _ _) <- co]
-
-contextOfType :: Type -> Err Context
-contextOfType typ = case typ of
-  Prod x a b -> liftM ((x,a):) $ contextOfType b
-  _ -> return [] 
-
-unComputed :: Term -> Term
-unComputed t = case t of
-  Computed v -> unComputed v
-  _ -> t --- composSafeOp unComputed t
-
-
-{- 
---- defined (better) in compile/PrOld
-
-stripTerm :: Term -> Term
-stripTerm t = case t of
-  Q _ c  -> Cn c
-  QC _ c -> Cn c
-  T ti psts -> T ti [(stripPatt p, stripTerm v) | (p,v) <- psts]
-  _ -> composSafeOp stripTerm t
- where
-   stripPatt p = errVal p $ term2patt $ stripTerm $ patt2term p
--}
-
-computed :: Term -> Term
-computed = Computed
-
-termForm :: Term -> Err ([(Ident)], Term, [Term])
-termForm t = case t of
-   Abs x b  ->
-     do (x', fun, args) <- termForm b 
-        return (x:x', fun, args)
-   App c a ->
-     do (_,fun, args) <- termForm c
-        return ([],fun,args ++ [a]) 
-   _       -> 
-     return ([],t,[])
-
-termFormCnc :: Term -> ([(Ident)], Term)
-termFormCnc t = case t of
-   Abs x b  -> (x:xs, t') where (xs,t') = termFormCnc b 
-   _        -> ([],t)
-
-appForm :: Term -> (Term, [Term])
-appForm t = case t of
-  App c a -> (fun, args ++ [a]) where (fun, args) = appForm c
-  _       -> (t,[])
-
-varsOfType :: Type -> [Ident]
-varsOfType t = case t of
-  Prod x _ b -> x : varsOfType b
-  _ -> []
-
-mkProdSimple :: Context -> Term -> Term
-mkProdSimple c t = mkProd (c,t,[])
-
-mkProd :: (Context, Term, [Term]) -> Term
-mkProd ([],typ,args) = mkApp typ args
-mkProd ((x,a):dd, typ, args) = Prod x a (mkProd (dd, typ, args))
-
-mkTerm :: ([(Ident)], Term, [Term]) -> Term
-mkTerm (xx,t,aa) = mkAbs xx (mkApp t aa)
-
-mkApp :: Term -> [Term] -> Term
-mkApp = foldl App
-
-mkAbs :: [Ident] -> Term -> Term
-mkAbs xx t = foldr Abs t xx
-
-appCons :: Ident -> [Term] -> Term
-appCons = mkApp . Cn
-
-appc :: String -> [Term] -> Term
-appc = appCons . zIdent
-
-appqc :: String -> String -> [Term] -> Term
-appqc q c = mkApp (Q (zIdent q) (zIdent c))
-
-mkLet :: [LocalDef] -> Term -> Term
-mkLet defs t = foldr Let t defs
-
-mkLetUntyped :: Context -> Term -> Term
-mkLetUntyped defs = mkLet [(x,(Nothing,t)) | (x,t) <- defs]
-
-isVariable :: Term -> Bool
-isVariable (Vr _ ) = True
-isVariable _ = False
-
-eqIdent :: Ident -> Ident -> Bool
-eqIdent = (==)
-
-zIdent :: String -> Ident
-zIdent s = identC s
-
-uType :: Type
-uType = Cn (zIdent "UndefinedType")
-
-assign :: Label -> Term -> Assign
-assign l t = (l,(Nothing,t))
-
-assignT :: Label -> Type -> Term -> Assign
-assignT l a t = (l,(Just a,t))
-
-unzipR :: [Assign] -> ([Label],[Term])
-unzipR r = (ls, map snd ts) where (ls,ts) = unzip r
-
-mkAssign :: [(Label,Term)] -> [Assign]
-mkAssign lts = [assign l t | (l,t) <- lts]
-
-zipAssign :: [Label] -> [Term] -> [Assign]
-zipAssign ls ts = [assign l t | (l,t) <- zip ls ts]
-
-ident2label :: Ident -> Label
-ident2label c = LIdent (prIdent c)
-
-label2ident :: Label -> Ident
-label2ident = identC . prLabel
-
-prLabel :: Label -> String
-prLabel = prt
-
-mapAssignM :: Monad m => (Term -> m c) -> [Assign] -> m [(Label,(Maybe c,c))]
-mapAssignM f = mapM (\ (ls,tv) -> liftM ((,) ls) (g tv))
-  where g (t,v) = liftM2 (,) (maybe (return Nothing) (liftM Just . f) t) (f v)
-
-mkRecordN :: Int -> (Int -> Label) -> [Term] -> Term
-mkRecordN int lab typs = R [ assign (lab i) t | (i,t) <- zip [int..] typs]
-
-mkRecord :: (Int -> Label) -> [Term] -> Term
-mkRecord = mkRecordN 0
-
-mkRecTypeN :: Int -> (Int -> Label) -> [Type] -> Type
-mkRecTypeN int lab typs = RecType [ (lab i, t) | (i,t) <- zip [int..] typs]
-
-mkRecType :: (Int -> Label) -> [Type] -> Type
-mkRecType = mkRecTypeN 0
-
-record2subst :: Term -> Err Substitution
-record2subst t = case t of
-  R fs -> return [(zIdent x, t) | (LIdent x,(_,t)) <- fs]
-  _ -> prtBad "record expected, found" t
-
-typeType, typePType, typeStr, typeTok, typeStrs :: Term
-
-typeType  = srt "Type"
-typePType = srt "PType"
-typeStr   = srt "Str"
-typeTok   = srt "Tok"
-typeStrs  = srt "Strs"
-
-typeString, typeFloat, typeInt :: Term
-typeInts :: Integer -> Term
-
-typeString = constPredefRes "String"
-typeInt = constPredefRes "Int"
-typeFloat = constPredefRes "Float"
-typeInts i = App (constPredefRes "Ints") (EInt i)
-
-isTypeInts :: Term -> Bool
-isTypeInts ty = case ty of
-  App c _ -> c == constPredefRes "Ints"
-  _ -> False
-
-constPredefRes :: String -> Term
-constPredefRes s = Q (IC "Predef") (zIdent s)
-
-constPredefAbs :: String -> Term
-constPredefAbs s = Q (IC "Predef") (zIdent s)
-
-isPredefConstant :: Term -> Bool
-isPredefConstant t = case t of
-  Q (IC "Predef") _ -> True
-  Q (IC "PredefAbs") _ -> True
-  _ -> False
-
-isPredefAbsType :: Ident -> Bool
-isPredefAbsType c = elem c [zIdent "Int", zIdent "String"]
-
-mkSelects :: Term -> [Term] -> Term
-mkSelects t tt = foldl S t tt
-
-mkTable :: [Term] -> Term -> Term
-mkTable tt t = foldr Table t tt
-
-mkCTable :: [Ident] -> Term -> Term
-mkCTable ids v = foldr ccase v ids where 
-  ccase x t = T TRaw [(PV x,t)]
-
-mkDecl :: Term -> Decl
-mkDecl typ = (wildIdent, typ)
-
-eqStrIdent :: Ident -> Ident -> Bool
-eqStrIdent = (==)
-
-tupleLabel, linLabel :: Int -> Label
-tupleLabel i = LIdent $ "p" ++ show i
-linLabel i = LIdent $ "s" ++ show i
-
-theLinLabel :: Label
-theLinLabel = LIdent "s"
-
-tuple2record :: [Term] -> [Assign]
-tuple2record ts = [assign (tupleLabel i) t | (i,t) <- zip [1..] ts]
-
-tuple2recordType :: [Term] -> [Labelling]
-tuple2recordType ts = [(tupleLabel i, t) | (i,t) <- zip [1..] ts]
-
-tuple2recordPatt :: [Patt] -> [(Label,Patt)]
-tuple2recordPatt ts = [(tupleLabel i, t) | (i,t) <- zip [1..] ts]
-
-mkCases :: Ident -> Term -> Term
-mkCases x t = T TRaw [(PV x, t)]
-
-mkWildCases :: Term -> Term
-mkWildCases = mkCases wildIdent
-
-mkFunType :: [Type] -> Type -> Type
-mkFunType tt t = mkProd ([(wildIdent, ty) | ty <- tt], t, []) -- nondep prod
-
-plusRecType :: Type -> Type -> Err Type
-plusRecType t1 t2 = case (unComputed t1, unComputed t2) of
-  (RecType r1, RecType r2) -> case
-    filter (`elem` (map fst r1)) (map fst r2) of
-      [] -> return (RecType (r1 ++ r2))
-      ls -> Bad $ "clashing labels" +++ unwords (map prt ls)
-  _ -> Bad ("cannot add record types" +++ prt t1 +++ "and" +++ prt t2) 
-
-plusRecord :: Term -> Term -> Err Term
-plusRecord t1 t2 =
- case (t1,t2) of
-   (R r1, R r2 ) -> return (R ([(l,v) | -- overshadowing of old fields
-                              (l,v) <- r1, not (elem l (map fst r2)) ] ++ r2))
-   (_,    FV rs) -> mapM (plusRecord t1) rs >>= return . FV
-   (FV rs,_    ) -> mapM (`plusRecord` t2) rs >>= return . FV
-   _ -> Bad ("cannot add records" +++ prt t1 +++ "and" +++ prt t2)
-
--- | default linearization type
-defLinType :: Type
-defLinType = RecType [(LIdent "s",  typeStr)]
-
--- | refreshing variables
-varX :: Int -> Ident
-varX i = identV (i,"x")
-
--- | refreshing variables
-mkFreshVar :: [Ident] -> Ident
-mkFreshVar olds = varX (maxVarIndex olds + 1) 
-
--- | trying to preserve a given symbol
-mkFreshVarX :: [Ident] -> Ident -> Ident
-mkFreshVarX olds x = if (elem x olds) then (varX (maxVarIndex olds + 1)) else x
-
-maxVarIndex :: [Ident] -> Int
-maxVarIndex = maximum . ((-1):) . map varIndex
-
-mkFreshVars :: Int -> [Ident] -> [Ident] 
-mkFreshVars n olds = [varX (maxVarIndex olds + i) | i <- [1..n]]
-
--- | quick hack for refining with var in editor
-freshAsTerm :: String -> Term
-freshAsTerm s = Vr (varX (readIntArg s))
-
--- | create a terminal for concrete syntax
-string2term :: String -> Term
-string2term = K
-
-int2term :: Integer -> Term
-int2term = EInt
-
-float2term :: Double -> Term
-float2term = EFloat
-
--- | create a terminal from identifier
-ident2terminal :: Ident -> Term
-ident2terminal = K . prIdent
-
--- | create a constant
-string2CnTrm :: String -> Term
-string2CnTrm = Cn . zIdent
-
-symbolOfIdent :: Ident -> String
-symbolOfIdent = prIdent
-
-symid :: Ident -> String
-symid = symbolOfIdent
-
-vr :: Ident -> Term
-cn :: Ident -> Term
-srt :: String -> Term
-meta :: MetaSymb -> Term
-cnIC :: String -> Term
-
-vr = Vr
-cn = Cn
-srt = Sort
-meta = Meta
-cnIC = cn . IC
-
-justIdentOf :: Term -> Maybe Ident
-justIdentOf (Vr x) = Just x
-justIdentOf (Cn x) = Just x
-justIdentOf _ = Nothing
-
-isMeta :: Term -> Bool
-isMeta (Meta _) = True
-isMeta _ = False
-
-mkMeta :: Int -> Term
-mkMeta = Meta . MetaSymb
-
-nextMeta :: MetaSymb -> MetaSymb
-nextMeta = int2meta . succ . metaSymbInt
-
-int2meta :: Int -> MetaSymb
-int2meta = MetaSymb
-
-metaSymbInt :: MetaSymb -> Int
-metaSymbInt (MetaSymb k) = k
-
-freshMeta :: [MetaSymb] -> MetaSymb
-freshMeta ms = MetaSymb (minimum [n | n <- [0..length ms], 
-                                      notElem n (map metaSymbInt ms)])
-
-mkFreshMetasInTrm :: [MetaSymb] -> Trm -> Trm
-mkFreshMetasInTrm metas = fst . rms minMeta where
-  rms meta trm = case trm of
-    Meta m  -> (Meta (MetaSymb meta), meta + 1)
-    App f a -> let (f',msf) = rms meta f 
-                   (a',msa) = rms msf a
-               in (App f' a', msa)
-    Prod x a b -> 
-               let (a',msa) = rms meta a 
-                   (b',msb) = rms msa b
-               in (Prod x a' b', msb)
-    Abs x b -> let (b',msb) = rms meta b in (Abs x b', msb)
-    _       -> (trm,meta)
-  minMeta = if null metas then 0 else (maximum (map metaSymbInt metas) + 1)
-
--- | decides that a term has no metavariables
-isCompleteTerm :: Term -> Bool
-isCompleteTerm t = case t of
-  Meta _  -> False
-  Abs _ b -> isCompleteTerm b
-  App f a -> isCompleteTerm f && isCompleteTerm a
-  _       -> True 
-
-linTypeStr :: Type
-linTypeStr = mkRecType linLabel [typeStr] -- default lintype {s :: Str}
-
-linAsStr :: String -> Term
-linAsStr s = mkRecord linLabel [K s] -- default linearization {s = s}
-
-linDefStr :: Term
-linDefStr = Abs s (R [assign (linLabel 0) (Vr s)]) where s = zIdent "s"
-
-term2patt :: Term -> Err Patt
-term2patt trm = case termForm trm of
-  Ok ([], Vr x, []) -> return (PV x)
-  Ok ([], Val ty x, []) -> return (PVal ty x)
-  Ok ([], Con c, aa) -> do
-    aa' <- mapM term2patt aa
-    return (PC c aa')
-  Ok ([], QC p c, aa) -> do
-    aa' <- mapM term2patt aa
-    return (PP p c aa')
-
-  Ok ([], Q p c, []) -> do
-    return (PM p c)
-
-  Ok ([], R r, []) -> do
-    let (ll,aa) = unzipR r
-    aa' <- mapM term2patt aa
-    return (PR (zip ll aa'))
-  Ok ([],EInt i,[]) -> return $ PInt i
-  Ok ([],EFloat i,[]) -> return $ PFloat i
-  Ok ([],K s,   []) -> return $ PString s
-
---- encodings due to excessive use of term-patt convs. AR 7/1/2005
-  Ok ([], Cn (IC "@"), [Vr a,b]) -> do
-    b' <- term2patt b
-    return (PAs a b')
-  Ok ([], Cn (IC "-"), [a]) -> do
-    a' <- term2patt a
-    return (PNeg a')
-  Ok ([], Cn (IC "*"), [a]) -> do
-    a' <- term2patt a
-    return (PRep a')
-  Ok ([], Cn (IC "?"), []) -> do
-    return PChar
-  Ok ([], Cn (IC "[]"),[K s]) -> do
-    return $ PChars s
-  Ok ([], Cn (IC "+"), [a,b]) -> do
-    a' <- term2patt a
-    b' <- term2patt b
-    return (PSeq a' b')
-  Ok ([], Cn (IC "|"), [a,b]) -> do
-    a' <- term2patt a
-    b' <- term2patt b
-    return (PAlt a' b')
-
-  Ok ([], Cn c, []) -> do
-    return (PMacro c)
-
-  _ -> prtBad "no pattern corresponds to term" trm
-
-patt2term :: Patt -> Term
-patt2term pt = case pt of
-  PV x      -> Vr x
-  PW        -> Vr wildIdent             --- not parsable, should not occur
-  PVal t i  -> Val t i
-  PMacro c  -> Cn c
-  PM p c    -> Q p c
-
-  PC c pp   -> mkApp (Con c) (map patt2term pp)
-  PP p c pp -> mkApp (QC p c) (map patt2term pp)
-
-  PR r      -> R [assign l (patt2term p) | (l,p) <- r] 
-  PT _ p    -> patt2term p
-  PInt i    -> EInt i
-  PFloat i  -> EFloat i
-  PString s -> K s 
-
-  PAs x p   -> appc "@" [Vr x, patt2term p]            --- an encoding
-  PChar     -> appc "?" []                             --- an encoding
-  PChars s  -> appc "[]" [K s]                         --- an encoding
-  PSeq a b  -> appc "+" [(patt2term a), (patt2term b)] --- an encoding
-  PAlt a b  -> appc "|" [(patt2term a), (patt2term b)] --- an encoding
-  PRep a    -> appc "*" [(patt2term a)]                --- an encoding
-  PNeg a    -> appc "-" [(patt2term a)]                --- an encoding
-
-
-redirectTerm :: Ident -> Term -> Term
-redirectTerm n t = case t of
-  QC _ f -> QC n f
-  Q _ f  -> Q  n f
-  _ -> composSafeOp (redirectTerm n) t
-
--- | to gather s-fields; assumes term in normal form, preserves label
-allLinFields :: Term -> Err [[(Label,Term)]]
-allLinFields trm = case unComputed trm of
-----  R rs  -> return [[(l,t) | (l,(Just ty,t)) <- rs, isStrType ty]] -- good
-  R rs  -> return [[(l,t) | (l,(_,t)) <- rs, isLinLabel l]] ---- bad
-  FV ts -> do
-    lts <- mapM allLinFields ts
-    return $ concat lts
-  _ -> prtBad "fields can only be sought in a record not in" trm
-
--- | deprecated
-isLinLabel :: Label -> Bool
-isLinLabel l = case l of
-     LIdent ('s':cs) | all isDigit cs -> True
-     _ -> False
-
--- | to gather ultimate cases in a table; preserves pattern list
-allCaseValues :: Term -> [([Patt],Term)]
-allCaseValues trm = case unComputed trm of
-  T _ cs -> [(p:ps, t) | (p,t0) <- cs, (ps,t) <- allCaseValues t0]
-  _      -> [([],trm)]
-
--- | to gather all linearizations; assumes normal form, preserves label and args
-allLinValues :: Term -> Err [[(Label,[([Patt],Term)])]]
-allLinValues trm = do
-  lts <- allLinFields trm
-  mapM (mapPairsM (return . allCaseValues)) lts
-
--- | to mark str parts of fields in a record f by a function f
-markLinFields :: (Term -> Term) -> Term -> Term
-markLinFields f t = case t of
-    R r -> R $ map mkField r
-    _ -> t
- where
-  mkField (l,(_,t)) = if (isLinLabel l) then (assign l (mkTbl t)) else (assign l t)
-  mkTbl t = case t of
-    T i cs -> T i [(p, mkTbl v) | (p,v) <- cs]
-    _ -> f t
-
--- | to get a string from a term that represents a sequence of terminals
-strsFromTerm :: Term -> Err [Str]
-strsFromTerm t = case unComputed t of
-  K s   -> return [str s]
-  Empty -> return [str []]
-  C s t -> do
-    s' <- strsFromTerm s
-    t' <- strsFromTerm t
-    return [plusStr x y | x <- s', y <- t']
-  Glue s t -> do
-    s' <- strsFromTerm s
-    t' <- strsFromTerm t
-    return [glueStr x y | x <- s', y <- t']
-  Alts (d,vs) -> do
-    d0 <- strsFromTerm d
-    v0 <- mapM (strsFromTerm . fst) vs
-    c0 <- mapM (strsFromTerm . snd) vs
-    let vs' = zip v0 c0
-    return [strTok (str2strings def) vars | 
-              def  <- d0,
-              vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | 
-                                                          vv <- combinations v0]
-           ]
-  FV ts -> mapM strsFromTerm ts >>= return . concat
-  Strs ts -> mapM strsFromTerm ts >>= return . concat  
-  Ready ss -> return [ss]
-  Alias _ _ d -> strsFromTerm d --- should not be needed...
-  _ -> prtBad "cannot get Str from term" t
-
--- | to print an Str-denoting term as a string; if the term is of wrong type, the error msg
-stringFromTerm :: Term -> String
-stringFromTerm = err id (ifNull "" (sstr . head)) . strsFromTerm
-
-
--- | to define compositional term functions
-composSafeOp :: (Term -> Term) -> Term -> Term
-composSafeOp op trm = case composOp (mkMonadic op) trm of
-  Ok t -> t
-  _ -> error "the operation is safe isn't it ?"
- where
- mkMonadic f = return . f
-
--- | to define compositional term functions
-composOp :: Monad m => (Term -> m Term) -> Term -> m Term
-composOp co trm = 
- case trm of
-   App c a -> 
-     do c' <- co c
-        a' <- co a
-        return (App c' a')
-   Abs x b ->
-     do b' <- co b
-        return (Abs x b')
-   Prod x a b -> 
-     do a' <- co a
-        b' <- co b
-        return (Prod x a' b')
-   S c a -> 
-     do c' <- co c
-        a' <- co a
-        return (S c' a')
-   Table a c -> 
-     do a' <- co a
-        c' <- co c
-        return (Table a' c')
-   R r -> 
-     do r' <- mapAssignM co r
-        return (R r')
-   RecType r -> 
-     do r' <- mapPairListM (co . snd) r
-        return (RecType r')
-   P t i ->
-     do t' <- co t
-        return (P t' i)
-   PI t i j ->
-     do t' <- co t
-        return (PI t' i j)
-   ExtR a c -> 
-     do a' <- co a
-        c' <- co c
-        return (ExtR a' c')
-
-   T i cc -> 
-     do cc' <- mapPairListM (co . snd) cc
-        i'  <- changeTableType co i
-        return (T i' cc')
-
-   TSh i cc -> 
-     do cc' <- mapPairListM (co . snd) cc
-        i'  <- changeTableType co i
-        return (TSh i' cc')
-
-   Eqs cc -> 
-     do cc' <- mapPairListM (co . snd) cc
-        return (Eqs cc')
-
-   V ty vs ->
-     do ty' <- co ty
-        vs' <- mapM co vs
-        return (V ty' vs')
-
-   Val ty i ->
-     do ty' <- co ty
-        return (Val ty' i)
-
-   Let (x,(mt,a)) b -> 
-     do a'  <- co a
-        mt' <- case mt of
-                 Just t -> co t >>= (return . Just) 
-                 _ -> return mt
-        b'  <- co b
-        return (Let (x,(mt',a')) b')
-   Alias c ty d -> 
-     do v <- co d
-        ty' <- co ty
-        return $ Alias c ty' v
-   C s1 s2 -> 
-     do v1 <- co s1 
-        v2 <- co s2
-        return (C v1 v2)
-   Glue s1 s2 -> 
-     do v1 <- co s1
-        v2 <- co s2
-        return (Glue v1 v2)
-   Alts (t,aa) ->
-     do t' <- co t
-        aa' <- mapM (pairM co) aa
-        return (Alts (t',aa'))
-   FV ts -> mapM co ts >>= return . FV
-   Strs tt -> mapM co tt >>= return . Strs
-
-   EPattType ty -> 
-     do ty' <- co ty
-        return (EPattType ty')
-
-   _ -> return trm -- covers K, Vr, Cn, Sort, EPatt
-
-getTableType :: TInfo -> Err Type
-getTableType i = case i of
-  TTyped ty -> return ty
-  TComp ty  -> return ty
-  TWild ty  -> return ty
-  _ -> Bad "the table is untyped"
-
-changeTableType :: Monad m => (Type -> m Type) -> TInfo -> m TInfo
-changeTableType co i = case i of
-    TTyped ty -> co ty >>= return . TTyped
-    TComp ty  -> co ty >>= return . TComp
-    TWild ty  -> co ty >>= return . TWild
-    _ -> return i
-
-collectOp :: (Term -> [a]) -> Term -> [a]
-collectOp co trm = case trm of
-  App c a    -> co c ++ co a 
-  Abs _ b    -> co b
-  Prod _ a b -> co a ++ co b 
-  S c a      -> co c ++ co a
-  Table a c  -> co a ++ co c
-  ExtR a c   -> co a ++ co c
-  R r        -> concatMap (\ (_,(mt,a)) -> maybe [] co mt ++ co a) r 
-  RecType r  -> concatMap (co . snd) r 
-  P t i      -> co t
-  T _ cc     -> concatMap (co . snd) cc -- not from patterns --- nor from type annot
-  TSh _ cc   -> concatMap (co . snd) cc -- not from patterns --- nor from type annot
-  V _ cc     -> concatMap co         cc --- nor from type annot
-  Let (x,(mt,a)) b -> maybe [] co mt ++ co a ++ co b
-  C s1 s2    -> co s1 ++ co s2 
-  Glue s1 s2 -> co s1 ++ co s2 
-  Alts (t,aa) -> let (x,y) = unzip aa in co t ++ concatMap co (x ++ y)
-  FV ts      -> concatMap co ts
-  Strs tt    -> concatMap co tt
-  _ -> [] -- covers K, Vr, Cn, Sort, Ready
-
--- | to find the word items in a term
-wordsInTerm :: Term -> [String]
-wordsInTerm trm = filter (not . null) $ case trm of
-   K s     -> [s]
-   S c _   -> wo c
-   Alts (t,aa) -> wo t ++ concatMap (wo . fst) aa
-   Ready s -> allItems s
-   _       -> collectOp wo trm
- where wo = wordsInTerm
-
-noExist :: Term
-noExist = FV []
-
-defaultLinType :: Type
-defaultLinType = mkRecType linLabel [typeStr]
-
-metaTerms :: [Term]
-metaTerms = map (Meta . MetaSymb) [0..]
-
--- | from GF1, 20\/9\/2003
-isInOneType :: Type -> Bool
-isInOneType t = case t of
-  Prod _ a b -> a == b
-  _ -> False
-
diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs
deleted file mode 100644
index b96d35b93..000000000
--- a/src/GF/Grammar/PatternMatch.hs
+++ /dev/null
@@ -1,155 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : PatternMatch
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/12 12:38:29 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.7 $
---
--- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003
------------------------------------------------------------------------------
-
-module GF.Grammar.PatternMatch (matchPattern,
-		     testOvershadow, 
-		     findMatch
-		    ) where
-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Grammar.Macros
-import GF.Grammar.PrGrammar
-
-import Data.List
-import Control.Monad
-
-
-matchPattern :: [(Patt,Term)] -> Term -> Err (Term, Substitution)
-matchPattern pts term = 
-  if not (isInConstantForm term)
-    then prtBad "variables occur in" term
-  else 
-    errIn ("trying patterns" +++ unwords (intersperse "," (map (prt . fst) pts))) $
-    findMatch [([p],t) | (p,t) <- pts] [term]
-
-testOvershadow :: [Patt] -> [Term] -> Err [Patt]
-testOvershadow pts vs = do
-  let numpts = zip pts [0..]
-  let cases  = [(p,EInt i) | (p,i) <- numpts]
-  ts <- mapM (liftM fst . matchPattern cases) vs
-  return $ [p | (p,i) <- numpts, notElem i [i | EInt i <- ts] ]
-
-findMatch :: [([Patt],Term)] -> [Term] -> Err (Term, Substitution)
-findMatch cases terms = case cases of
-   [] -> Bad $"no applicable case for" +++ unwords (intersperse "," (map prt terms))
-   (patts,_):_ | length patts /= length terms -> 
-       Bad ("wrong number of args for patterns :" +++ 
-            unwords (map prt patts) +++ "cannot take" +++ unwords (map prt terms))
-   (patts,val):cc -> case mapM tryMatch (zip patts terms) of
-       Ok substs -> return (val, concat substs)
-       _         -> findMatch cc terms
-
-tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
-tryMatch (p,t) = do 
-  t' <- termForm t
-  trym p t'
- where
-  isInConstantFormt = True -- tested already
-  trym p t' =
-    case (p,t') of
-      (PVal _ i, (_,Val _ j,_)) 
-          | i == j -> return []
-          | otherwise -> Bad $ "no match of values"
-      (_,(x,Empty,y)) -> trym p (x,K [],y)   -- because "" = [""] = []
-      (PV IW, _) | isInConstantFormt -> return [] -- optimization with wildcard
-      (PV x,  _) | isInConstantFormt -> return [(x,t)]
-      (PString s, ([],K i,[])) | s==i -> return []
-      (PInt s, ([],EInt i,[])) | s==i -> return []
-      (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?
-      (PC p pp, ([], Con f, tt)) | 
-            p `eqStrIdent` f && length pp == length tt ->
-         do matches <- mapM tryMatch (zip pp tt)
-            return (concat matches)
-
-      (PP q p pp, ([], QC r f, tt)) | 
-            -- q `eqStrIdent` r &&  --- not for inherited AR 10/10/2005
-            p `eqStrIdent` f && length pp == length tt ->
-         do matches <- mapM tryMatch (zip pp tt)
-            return (concat matches)
-      ---- hack for AppPredef bug
-      (PP q p pp, ([], Q r f, tt)) | 
-            -- q `eqStrIdent` r && --- 
-            p `eqStrIdent` f && length pp == length tt ->
-         do matches <- mapM tryMatch (zip pp tt)
-            return (concat matches)
-
-      (PR r, ([],R r',[])) |
-            all (`elem` map fst r') (map fst r) ->
-         do matches <- mapM tryMatch 
-                            [(p,snd a) | (l,p) <- r, let Just a = lookup l r']
-            return (concat matches)
-      (PT _ p',_) -> trym p' t'
-      (_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
-
---      (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do
-
-      (PAs x p',_) -> do
-         subst <- trym p' t'
-         return $ (x,t) : subst
-
-      (PAlt p1 p2,_) -> checks [trym p1 t', trym p2 t']
-
-      (PNeg p',_) -> case tryMatch (p',t) of
-        Bad _ -> return []
-        _ -> prtBad "no match with negative pattern" p
-
-      (PSeq p1 p2, ([],K s, [])) -> do
-         let cuts = [splitAt n s | n <- [0 .. length s]] 
-         matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
-         return (concat matches)
-
-      (PRep p1, ([],K s, [])) -> checks [
-         trym (foldr (const (PSeq p1)) (PString "") 
-           [1..n]) t' | n <- [0 .. length s]
-        ] >>
-        return []
-
-      (PChar,  ([],K [_], [])) -> return []
-      (PChars cs, ([],K [c], [])) | elem c cs -> return []
-
-      _ -> prtBad "no match in case expr for" t
-  
-isInConstantForm :: Term -> Bool
-isInConstantForm trm = case trm of
-    Cn _     -> True
-    Con _    -> True
-    Q _ _    -> True
-    QC _ _   -> True
-    Abs _ _  -> True
-    App c a  -> isInConstantForm c && isInConstantForm a
-    R r      -> all (isInConstantForm . snd . snd) r
-    K _      -> True
-    Empty    -> True
-    Alias _ _ t -> isInConstantForm t
-    EInt _   -> True
-    _       -> False ---- isInArgVarForm trm
-
-varsOfPatt :: Patt -> [Ident]
-varsOfPatt p = case p of
-  PV x -> [x | not (isWildIdent x)]
-  PC _ ps -> concat $ map varsOfPatt ps
-  PP _ _ ps -> concat $ map varsOfPatt ps
-  PR r    -> concat $ map (varsOfPatt . snd) r
-  PT _ q -> varsOfPatt q
-  _ -> []
-
--- | to search matching parameter combinations in tables
-isMatchingForms :: [Patt] -> [Term] -> Bool
-isMatchingForms ps ts = all match (zip ps ts') where
-  match (PC c cs, (Cn d, ds)) = c == d && isMatchingForms cs ds
-  match _ = True
-  ts' = map appForm ts
-
diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs
deleted file mode 100644
index c3a21d1d6..000000000
--- a/src/GF/Grammar/PrGrammar.hs
+++ /dev/null
@@ -1,286 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : PrGrammar
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/04 11:45:38 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.16 $
---
--- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003
---
--- printing and prettyprinting class
---
--- 8\/1\/2004:
--- Usually followed principle: 'prt_' for displaying in the editor, 'prt'
--- in writing grammars to a file. For some constructs, e.g. 'prMarkedTree',
--- only the former is ever needed.
------------------------------------------------------------------------------
-
-module GF.Grammar.PrGrammar (Print(..),
-		  prtBad,
-		  prGrammar, prModule,
-		  prContext, prParam,
-		  prQIdent, prQIdent_,
-		  prRefinement, prTermOpt,
-		  prt_Tree, prMarkedTree, prTree,
-		  tree2string, prprTree,
-		  prConstrs, prConstraints, 
-		  prMetaSubst, prEnv, prMSubst, 
-		  prExp, prPatt, prOperSignature,
-                  lookupIdent, lookupIdentInfo
-		 ) where
-
-import GF.Data.Operations
-import GF.Data.Zipper
-import GF.Grammar.Grammar
-import GF.Infra.Modules
-import qualified GF.Source.PrintGF as P
-import qualified GF.Canon.PrintGFC as C
-import qualified GF.Canon.AbsGFC as A
-import GF.Grammar.Values
-import GF.Source.GrammarToSource
---- import GFC (CanonGrammar) --- cycle of modules
-
-import GF.Infra.Option
-import GF.Infra.Ident
-import GF.Data.Str
-
-import GF.Infra.CompactPrint
-
-import Data.List (intersperse)
-
-class Print a where
-  prt  :: a -> String
-  -- | printing with parentheses, if needed
-  prt2 :: a -> String
-  -- | pretty printing
-  prpr :: a -> [String]
-  -- | printing without ident qualifications
-  prt_ :: a -> String 
-  prt2 = prt
-  prt_ = prt
-  prpr = return . prt
-
--- 8/1/2004
---- Usually followed principle: prt_ for displaying in the editor, prt
---- in writing grammars to a file. For some constructs, e.g. prMarkedTree,
---- only the former is ever needed.
-
--- | to show terms etc in error messages
-prtBad :: Print a => String -> a -> Err b
-prtBad s a = Bad (s +++ prt a)
-
-pprintTree :: P.Print a => a -> String
-pprintTree = compactPrint . P.printTree
-
-prGrammar :: SourceGrammar -> String
-prGrammar = pprintTree . trGrammar
-
-prModule :: (Ident, SourceModInfo) -> String
-prModule  = pprintTree . trModule
-
-instance Print Term where
-  prt = pprintTree . trt
-  prt_ = prExp
-
-instance Print Ident where
-  prt = pprintTree . tri
-
-instance Print Patt where
-  prt = pprintTree . trp
-
-instance Print Label where
-  prt = pprintTree . trLabel
-
-instance Print MetaSymb where
-  prt (MetaSymb i) = "?" ++ show i
-
-prParam :: Param -> String
-prParam (c,co) = prt c +++ prContext co
-
-prContext :: Context -> String
-prContext co = unwords $ map prParenth [prt x +++ ":" +++ prt t | (x,t) <- co]
-
--- some GFC notions
-
-instance Print A.Exp where prt = C.printTree
-instance Print A.Term where prt = C.printTree
-instance Print A.Case where prt = C.printTree
-instance Print A.CType where prt = C.printTree
-instance Print A.Label where prt = C.printTree
-instance Print A.Module where prt = C.printTree
-instance Print A.Def where prt = C.printTree
-instance Print A.Canon where prt = C.printTree
-instance Print A.Sort where prt = C.printTree
-
-instance Print A.Atom where 
-  prt = C.printTree
-  prt_ (A.AC c) = prt_ c
-  prt_ (A.AD c) = prt_ c
-  prt_ a = prt a
-
-instance Print A.Patt where 
-  prt = C.printTree
-  prt_ = prPatt
-
-instance Print A.CIdent where 
-  prt = C.printTree
-  prt_ (A.CIQ _ c) = prt c
-
--- printing values and trees in editing
-
-instance Print a => Print (Tr a) where
-  prt (Tr (n, trees)) = prt n +++ unwords (map prt2 trees)
-  prt2 t@(Tr (_,args)) = if null args then prt t else prParenth (prt t)
-
--- | we cannot define the method prt_ in this way 
-prt_Tree :: Tree -> String
-prt_Tree = prt_ . tree2exp
-
-instance Print TrNode where
-  prt (N (bi,at,vt,(cs,ms),_)) = 
-    prBinds bi ++ 
-    prt at +++ ":" +++ prt vt 
-    +++ prConstraints cs +++ prMetaSubst ms
-  prt_ (N (bi,at,vt,(cs,ms),_)) = 
-    prBinds bi ++ 
-    prt_ at +++ ":" +++ prt_ vt 
-    +++ prConstraints cs +++ prMetaSubst ms
-
-prMarkedTree :: Tr (TrNode,Bool) -> [String]
-prMarkedTree = prf 1 where
-  prf ind t@(Tr (node, trees)) = 
-    prNode ind node : concatMap (prf (ind + 2)) trees
-  prNode ind node = case node of
-    (n, False) -> indent ind (prt_ n)
-    (n, _)     -> '*' : indent (ind - 1) (prt_ n)
-
-prTree :: Tree -> [String]
-prTree = prMarkedTree . mapTr (\n -> (n,False))
-
--- | a pretty-printer for parsable output
-tree2string :: Tree -> String
-tree2string = unlines . prprTree
-
-prprTree :: Tree -> [String]
-prprTree = prf False where
-  prf par t@(Tr (node, trees)) = 
-    parIf par (prn node : concat [prf (ifPar t) t | t <- trees])
-  prn (N (bi,at,_,_,_)) = prb bi ++ prt_ at
-  prb [] = ""
-  prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> "
-  parIf par (s:ss) = map (indent 2) $
-                         if par 
-                            then ('(':s) : ss ++ [")"] 
-                            else s:ss
-  ifPar (Tr (N ([],_,_,_,_), [])) = False
-  ifPar _ = True
-
-
--- auxiliaries
-
-prConstraints :: Constraints -> String
-prConstraints = concat . prConstrs
-
-prMetaSubst :: MetaSubst -> String
-prMetaSubst = concat . prMSubst
-  
-prEnv :: Env -> String
----- prEnv [] = prCurly "" ---- for debugging
-prEnv e = concatMap (\ (x,t) -> prCurly (prt x ++ ":=" ++ prt t)) e
-
-prConstrs :: Constraints -> [String]
-prConstrs = map (\ (v,w) -> prCurly (prt v ++ "<>" ++ prt w))
-
-prMSubst :: MetaSubst -> [String]
-prMSubst = map (\ (m,e) -> prCurly ("?" ++ show m ++ "=" ++ prt e))
-
-prBinds bi = if null bi 
-                then [] 
-                else "\\" ++ concat (intersperse "," (map prValDecl bi)) +++ "-> "
- where
-   prValDecl (x,t) = prParenth (prt_ x +++ ":" +++ prt_ t)
-
-instance Print Val where
-  prt (VGen i x) = prt x ++ "{-" ++ show i ++ "-}" ---- latter part for debugging
-  prt (VApp u v) = prt u +++ prv1 v
-  prt (VCn mc) = prQIdent_ mc
-  prt (VClos env e) = case e of
-    Meta _ -> prt_ e ++ prEnv env
-    _      -> prt_ e ---- ++ prEnv env ---- for debugging
-  prt VType = "Type"
- 
-prv1 v = case v of
-  VApp _ _  -> prParenth $ prt v
-  VClos _ _ -> prParenth $ prt v
-  _ -> prt v
-
-instance Print Atom where
-  prt (AtC f) = prQIdent f
-  prt (AtM i) = prt i
-  prt (AtV i) = prt i
-  prt (AtL s) = prQuotedString s
-  prt (AtI i) = show i
-  prt (AtF i) = show i
-  prt_ (AtC (_,f)) = prt f 
-  prt_ a = prt a
-
-prQIdent :: QIdent -> String
-prQIdent (m,f) = prt m ++ "." ++ prt f
-
-prQIdent_ :: QIdent -> String
-prQIdent_ (_,f) = prt f
-
--- | print terms without qualifications
-prExp :: Term -> String
-prExp e = case e of
-  App f a    -> pr1 f +++ pr2 a
-  Abs x b    -> "\\" ++ prt x +++ "->" +++ prExp b
-  Prod x a b -> "(\\" ++ prt x +++ ":" +++ prExp a ++ ")" +++ "->" +++ prExp b
-  Q _ c      -> prt c
-  QC _ c     -> prt c  
-  _ -> prt e
- where
-   pr1 e = case e of
-     Abs _ _    -> prParenth $ prExp e
-     Prod _ _ _ -> prParenth $ prExp e
-     _ -> prExp e
-   pr2 e = case e of
-     App _ _ -> prParenth $ prExp e
-     _ -> pr1 e
-
-prPatt :: A.Patt -> String
-prPatt p = case p of
-  A.PC c ps -> prt_ c +++ unwords (map pr1 ps)
-  _ -> prt p --- PR
- where
-   pr1 p = case p of
-     A.PC _ (_:_) -> prParenth $ prPatt p
-     _ -> prPatt p
-
--- | option @-strip@ strips qualifications
-prTermOpt :: Options -> Term -> String
-prTermOpt opts = if oElem nostripQualif opts then prt else prExp
-
--- | to get rid of brackets in the editor
-prRefinement :: Term -> String
-prRefinement t = case t of
-    Q m c  -> prQIdent (m,c)
-    QC m c -> prQIdent (m,c)
-    _ -> prt t
-
-prOperSignature :: (QIdent,Type) -> String
-prOperSignature (f, t) = prQIdent f +++ ":" +++ prt t
-
--- to look up a constant etc in a search tree
-
-lookupIdent :: Ident -> BinTree Ident b -> Err b
-lookupIdent c t = case lookupTree prt c t of
-  Ok v -> return v
-  _ -> prtBad "unknown identifier" c
-
-lookupIdentInfo :: Module Ident f a -> Ident -> Err a
-lookupIdentInfo mo i = lookupIdent i (jments mo)
diff --git a/src/GF/Grammar/Refresh.hs b/src/GF/Grammar/Refresh.hs
deleted file mode 100644
index bc77c1837..000000000
--- a/src/GF/Grammar/Refresh.hs
+++ /dev/null
@@ -1,133 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Refresh
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:27 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.6 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Grammar.Refresh (refreshTerm, refreshTermN,
-		refreshModule
-	       ) where
-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Modules
-import GF.Grammar.Macros
-import Control.Monad
-
-refreshTerm :: Term -> Err Term
-refreshTerm = refreshTermN 0
-
-refreshTermN :: Int -> Term -> Err Term
-refreshTermN i e = liftM snd $ refreshTermKN i e
-
-refreshTermKN :: Int -> Term -> Err (Int,Term)
-refreshTermKN i e = liftM (\ (t,(_,i)) -> (i,t)) $ 
-                    appSTM (refresh e) (initIdStateN i)
-
-refresh :: Term -> STM IdState Term
-refresh e = case e of
-
-  Vr x    -> liftM  Vr  (lookVar x)
-  Abs x b -> liftM2 Abs (refVarPlus x)  (refresh b)
-
-  Prod x a b -> do
-    a'  <- refresh a
-    x'  <- refVar  x
-    b'  <- refresh b
-    return $ Prod x' a' b'
-
-  Let (x,(mt,a)) b -> do
-    a'  <- refresh a
-    mt' <- case mt of
-             Just t -> refresh t >>= (return . Just) 
-             _ -> return mt
-    x'  <- refVar x
-    b'  <- refresh b
-    return (Let (x',(mt',a')) b')
-
-  R r  -> liftM R $ refreshRecord r
-
-  ExtR r s -> liftM2 ExtR (refresh r)  (refresh s)
-  
-  T i cc -> liftM2 T (refreshTInfo i) (mapM refreshCase cc)
-
-  _ -> composOp refresh e
-
-refreshCase :: (Patt,Term) -> STM IdState (Patt,Term)
-refreshCase (p,t) = liftM2 (,) (refreshPatt p) (refresh t)
-
-refreshPatt p = case p of
-  PV x    -> liftM PV     (refVar x)
-  PC c ps -> liftM (PC c) (mapM refreshPatt ps)
-  PP q c ps -> liftM (PP q c) (mapM refreshPatt ps)
-  PR r    -> liftM PR     (mapPairsM refreshPatt r)
-  PT t p' -> liftM2 PT    (refresh t) (refreshPatt p')
-
-  PAs x p'   -> liftM2 PAs     (refVar x) (refreshPatt p')
-
-  PSeq p' q' -> liftM2 PSeq    (refreshPatt p') (refreshPatt q')
-  PAlt p' q' -> liftM2 PAlt    (refreshPatt p') (refreshPatt q')
-  PRep p'    -> liftM  PRep    (refreshPatt p')
-  PNeg p'    -> liftM  PNeg    (refreshPatt p')
-
-  _ -> return p
-
-refreshRecord r = case r of
-  [] -> return r
-  (x,(mt,a)):b -> do
-    a'  <- refresh a
-    mt' <- case mt of
-             Just t -> refresh t >>= (return . Just) 
-             _ -> return mt
-    b'  <- refreshRecord b
-    return $ (x,(mt',a')) : b'
-
-refreshTInfo i = case i of
-  TTyped t -> liftM TTyped $ refresh t
-  TComp t -> liftM TComp $ refresh t
-  TWild t -> liftM TWild $ refresh t
-  _ -> return i
-
--- for abstract syntax
-
-refreshEquation :: Equation -> Err ([Patt],Term)
-refreshEquation pst = err Bad (return . fst) (appSTM (refr pst) initIdState) where
-  refr (ps,t) = liftM2 (,) (mapM refreshPatt ps) (refresh t)
-
--- for concrete and resource in grammar, before optimizing
-
-refreshGrammar :: SourceGrammar -> Err SourceGrammar
-refreshGrammar = liftM (MGrammar . snd) . foldM refreshModule (0,[]) . modules
-
-refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule])
-refreshModule (k,ms) mi@(i,m) = case m of
-    ModMod mo@(Module mt fs st me ops js) | (isModCnc mo || isModRes mo) -> do
-      (k',js') <- foldM refreshRes (k,[]) $ tree2list js
-      return (k', (i, ModMod(Module mt fs st me ops (buildTree js'))) : ms)
-    _ -> return (k, mi:ms)
- where
-  refreshRes (k,cs) ci@(c,info) = case info of
-    ResOper ptyp (Yes trm) -> do   ---- refresh ptyp
-      (k',trm') <- refreshTermKN k trm
-      return $ (k', (c, ResOper ptyp (Yes trm')):cs)
-    ResOverload tyts -> do
-      (k',tyts') <- liftM (\ (t,(_,i)) -> (i,t)) $ 
-                    appSTM (mapPairsM refresh tyts) (initIdStateN k)
-      return $ (k', (c, ResOverload tyts'):cs)
-    CncCat mt (Yes trm) pn -> do   ---- refresh mt, pn
-      (k',trm') <- refreshTermKN k trm
-      return $ (k', (c, CncCat mt (Yes trm') pn):cs)
-    CncFun mt (Yes trm) pn -> do   ---- refresh pn
-      (k',trm') <- refreshTermKN k trm
-      return $ (k', (c, CncFun mt (Yes trm') pn):cs)
-    _ -> return (k, ci:cs)
-
diff --git a/src/GF/Grammar/ReservedWords.hs b/src/GF/Grammar/ReservedWords.hs
deleted file mode 100644
index b440141d6..000000000
--- a/src/GF/Grammar/ReservedWords.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : ReservedWords
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:28 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
---
--- reserved words of GF. (c) Aarne Ranta 19\/3\/2002 under Gnu GPL.
--- modified by Markus Forsberg 9\/4. 
--- modified by AR 12\/6\/2003 for GF2 and GFC
------------------------------------------------------------------------------
-
-module GF.Grammar.ReservedWords (isResWord, isResWordGFC) where
-
-import Data.List
-
-
-isResWord :: String -> Bool
-isResWord s = isInTree s resWordTree
-
-resWordTree :: BTree
-resWordTree = 
---  mapTree fst $ sorted2tree $ flip zip (repeat ()) $ sort allReservedWords
---  nowadays obtained from LexGF.hs
-    B "let" (B "data" (B "Type" (B "Str" (B "PType" (B "Lin" N N) N) (B "Tok" (B "Strs" N N) N)) (B "cat" (B "case" (B "abstract" N N) N) (B "concrete" N N))) (B "in" (B "fn" (B "flags" (B "def" N N) N) (B "grammar" (B "fun" N N) N)) (B "instance" (B "incomplete" (B "include" N N) N) (B "interface" N N)))) (B "pre" (B "open" (B "lindef" (B "lincat" (B "lin" N N) N) (B "of" (B "lintype" N N) N)) (B "param" (B "out" (B "oper" N N) N) (B "pattern" N N))) (B "transfer" (B "reuse" (B "resource" (B "printname" N N) N) (B "table" (B "strs" N N) N)) (B "where" (B "variants" (B "union" N N) N) (B "with" N N))))
-
-isResWordGFC :: String -> Bool
-isResWordGFC s = isInTree s $
-  B "of" (B "fun" (B "concrete" (B "cat" (B "abstract" N N) N) (B "flags" N N)) (B "lin" (B "in" N N) (B "lincat" N N))) (B "resource" (B "param" (B "oper" (B "open" N N) N) (B "pre" N N)) (B "table" (B "strs" N N) (B "variants" N N)))
-
-data BTree = N | B String BTree BTree deriving (Show)
-
-isInTree :: String -> BTree -> Bool
-isInTree x tree = case tree of
- N -> False
- B a left right 
-   | x < a  -> isInTree x left
-   | x > a  -> isInTree x right
-   | x == a -> True
-
diff --git a/src/GF/Grammar/SGrammar.hs b/src/GF/Grammar/SGrammar.hs
deleted file mode 100644
index e0c001b6b..000000000
--- a/src/GF/Grammar/SGrammar.hs
+++ /dev/null
@@ -1,169 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : SGrammar
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
---
--- A simple format for context-free abstract syntax used e.g. in
--- generation. AR 31\/3\/2006
---
--- (c) Aarne Ranta 2004 under GNU GPL
---
--- Purpose: to generate corpora. We use simple types and don't
--- guarantee the correctness of bindings\/dependences.
------------------------------------------------------------------------------
-
-module GF.Grammar.SGrammar where
-
-import GF.Canon.GFC
-import GF.Grammar.LookAbs
-import GF.Grammar.PrGrammar
-import GF.Grammar.Macros
-import GF.Grammar.Values
-import GF.Grammar.Grammar
-import GF.Infra.Ident (Ident)
-
-import GF.Data.Operations
-import GF.Data.Zipper
-import GF.Infra.Option
-
-import Data.List
-
--- (c) Aarne Ranta 2006 under GNU GPL
-
-
-type SGrammar = BinTree SCat [SRule]
-type SIdent = String
-type SRule = (SFun,SType)
-type SType = ([SCat],SCat)
-type SCat = SIdent
-type SFun = (Double,SIdent)
-
-allRules gr = concat [rs  | (c,rs) <- tree2list gr]
-
-data STree = 
-    SApp (SFun,[STree]) 
-  | SMeta SCat
-  | SString String
-  | SInt Integer
-  | SFloat Double
-   deriving (Show,Eq)
-
-depth :: STree -> Int
-depth t = case t of
-  SApp (_,ts@(_:_)) -> maximum (map depth ts) + 1
-  _ -> 1
-
-type Probs = BinTree Ident Double
-
-emptyProbs :: Probs
-emptyProbs = emptyBinTree
-
-prProbs :: Probs -> String
-prProbs = unlines . map pr . tree2list where
-  pr (f,p) = prt f ++ "\t" ++ show p
-
-------------------------------------------
--- translate grammar to simpler form and generated trees back
-
-gr2sgr :: Options -> Probs -> GFCGrammar -> SGrammar
-gr2sgr opts probs gr = buildTree [(c,norm (noexp c rs)) | rs@((_,(_,c)):_) <- rules] where
-  noe = maybe [] (chunks ',') $ getOptVal opts (aOpt "noexpand")
-  only = maybe [] (chunks ',') $ getOptVal opts (aOpt "doexpand")
-  un  = getOptInt opts (aOpt "atoms")
-  rules =
-     prune $
-       groupBy (\x y -> scat x == scat y) $
-        sortBy (\x y -> compare (scat x) (scat y)) $
-          [(trId f, ty') | (f,ty) <- funRulesOf gr, ty' <- trTy ty]
-  trId (_,f) = let f' = prt f in case lookupTree prt f probs of
-    Ok p -> (p,f')
-    _ -> (2.0, f')
-  trTy ty = case catSkeleton ty of
-    Ok (mcs,mc) -> [(map trCat mcs, trCat mc)]
-    _ -> []
-  trCat (m,c) = prt c ---
-  scat (_,(_,c)) = c
-
-  prune rs = maybe rs (\n -> map (onlyAtoms n) rs) $ un
-
-  norm = fillProb
-
-  onlyAtoms n rs = 
-    let (rs1,rs2) = partition atom rs 
-    in take n rs1 ++ rs2
-  atom = null . fst . snd
-
-  noexp c rs 
-    | null only = if elem c noe then [((2.0,'?':c),([],c))] else rs
-    | otherwise = if elem c only then rs else [((2.0,'?':c),([],c))]
-
--- for cases where explicit probability is not given (encoded as
--- p > 1) divide the remaining mass by the number of such cases
-
-fillProb :: [SRule] -> [SRule]
-fillProb rs = [((defa p,f),ty) | ((p,f),ty) <- rs] where
-  defa p = if p > 1.0 then def else p
-  def = (1 - sum given) / genericLength nope 
-  (nope,given) = partition (> 1.0) [p | ((p,_),_) <- rs]
-
--- str2tr :: STree -> Exp
-str2tr t = case t of
-  SApp ((_,'?':c),[]) -> mkMeta 0 -- from noexpand=c
-  SApp ((_,f),ts) -> mkApp (trId f) (map str2tr ts) 
-  SMeta _     -> mkMeta 0
-  SString s   -> K s
-  SInt i      -> EInt i
-  SFloat i    -> EFloat i
- where
-   trId = cn . zIdent
-
--- tr2str :: Tree -> STree
-tr2str (Tr (N (_,at,val,_,_),ts)) = case (at,val) of
-  (AtC (_,f), _)         -> SApp ((2.0,prt_ f),map tr2str ts)
-  (AtM _,     v)         -> SMeta (catOf v)
-  (AtL s,     _)         -> SString s
-  (AtI i,     _)         -> SInt i
-  (AtF i,     _)         -> SFloat i
-  _ -> SMeta "FAILED_TO_GENERATE" ---- err monad!
- where
-   catOf v = case v of
-     VApp w _  -> catOf w
-     VCn (_,c) -> prt_ c
-     _ -> "FAILED_TO_GENERATE_FROM_META"
-
-
-------------------------------------------
--- to test
-
-prSTree t = case t of
-  SApp ((_,f),ts) -> f ++ concat (map pr1 ts)
-  SMeta c -> '?':c
-  SString s -> prQuotedString s
-  SInt i -> show i 
-  SFloat i -> show i 
- where
-  pr1 t@(SApp (_,ts)) = ' ' : (if null ts then id else prParenth) (prSTree t)
-  pr1 t = prSTree t
-
-pSRule :: String -> SRule
-pSRule s = case words s of
-  f : _ : cs -> ((2.0,f),(init cs', last cs')) 
-    where cs' = [cs !! i | i <- [0,2..length cs - 1]]
-  _ -> error $ "not a rule" +++ s
-
-exSgr = map pSRule [
-   "Pred   : NP -> VP -> S"
-  ,"Compl  : TV -> NP -> VP" 
-  ,"PredVV : VV -> VP -> VP"
-  ,"DefCN  : CN -> NP"
-  ,"ModCN  : AP -> CN -> CN" 
-  ,"john   : NP"
-  ,"walk   : VP"
-  ,"love   : TV"
-  ,"try    : VV"
-  ,"girl   : CN"
-  ,"big    : AP"
-  ]
diff --git a/src/GF/Grammar/TC.hs b/src/GF/Grammar/TC.hs
deleted file mode 100644
index be52d1889..000000000
--- a/src/GF/Grammar/TC.hs
+++ /dev/null
@@ -1,299 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : TC
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/02 20:50:19 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.11 $
---
--- Thierry Coquand's type checking algorithm that creates a trace
------------------------------------------------------------------------------
-
-module GF.Grammar.TC (AExp(..),
-	   Theory,
-	   checkExp,
-	   inferExp,
-           checkEqs,
-	   eqVal,
-	   whnf
-	  ) where
-
-import GF.Data.Operations
-import GF.Grammar.Abstract
-import GF.Grammar.AbsCompute
-
-import Control.Monad
-import Data.List (sortBy)
-
-data AExp =
-     AVr   Ident Val 
-   | ACn   QIdent Val
-   | AType 
-   | AInt  Integer 
-   | AFloat Double
-   | AStr  String
-   | AMeta MetaSymb Val
-   | AApp  AExp AExp Val 
-   | AAbs  Ident Val AExp 
-   | AProd Ident AExp AExp 
-   | AEqs  [([Exp],AExp)] --- not used
-   | AData Val
-  deriving (Eq,Show)
-
-type Theory = QIdent -> Err Val
-
-lookupConst :: Theory -> QIdent -> Err Val
-lookupConst th f = th f
-
-lookupVar :: Env -> Ident -> Err Val
-lookupVar g x = maybe (prtBad "unknown variable" x) return $ lookup x ((IW,uVal):g)
--- wild card IW: no error produced, ?0 instead.
-
-type TCEnv = (Int,Env,Env)
-
-emptyTCEnv :: TCEnv
-emptyTCEnv = (0,[],[])
-
-whnf :: Val -> Err Val
-whnf v = ---- errIn ("whnf" +++ prt v) $ ---- debug
-         case v of
-  VApp u w -> do
-    u' <- whnf u 
-    w' <- whnf w
-    app u' w'
-  VClos env e -> eval env e
-  _ -> return v
-
-app :: Val -> Val -> Err Val
-app u v = case u of
-  VClos env (Abs x e) -> eval ((x,v):env) e
-  _ -> return $ VApp u v
-  
-eval :: Env -> Exp -> Err Val
-eval env e = ---- errIn ("eval" +++ prt e +++ "in" +++ prEnv env) $ 
-             case e of
-  Vr x    -> lookupVar env x
-  Q m c   -> return $ VCn (m,c)
-  QC m c  -> return $ VCn (m,c) ---- == Q ?
-  Sort c  -> return $ VType --- the only sort is Type
-  App f a -> join $ liftM2 app (eval env f) (eval env a)
-  _ -> return $ VClos env e
-
-eqVal :: Int -> Val -> Val -> Err [(Val,Val)]
-eqVal k u1 u2 = ---- errIn (prt u1 +++ "<>" +++ prBracket (show k) +++ prt u2) $ 
-                do
-  w1 <- whnf u1
-  w2 <- whnf u2 
-  let v = VGen k
-  case (w1,w2) of
-    (VApp f1 a1, VApp f2 a2) -> liftM2 (++) (eqVal k f1 f2) (eqVal k a1 a2)
-    (VClos env1 (Abs x1 e1), VClos env2 (Abs x2 e2)) ->
-      eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2)
-    (VClos env1 (Prod x1 a1 e1), VClos env2 (Prod x2 a2 e2)) ->
-      liftM2 (++) 
-        (eqVal k     (VClos env1          a1) (VClos env2          a2))
-        (eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2))
-    (VGen i _, VGen j _) -> return [(w1,w2) | i /= j]
-    (VCn (_, i), VCn (_,j)) -> return [(w1,w2) | i /= j] 
-    --- thus ignore qualifications; valid because inheritance cannot
-    --- be qualified. Simplifies annotation. AR 17/3/2005 
-    _ -> return [(w1,w2) | w1 /= w2]
--- invariant: constraints are in whnf
-
-checkType :: Theory -> TCEnv -> Exp -> Err (AExp,[(Val,Val)])
-checkType th tenv e = checkExp th tenv e vType
-
-checkExp :: Theory -> TCEnv -> Exp -> Val -> Err (AExp, [(Val,Val)])
-checkExp th tenv@(k,rho,gamma) e ty = do
-  typ <- whnf ty
-  let v = VGen k
-  case e of
-    Meta m -> return $ (AMeta m typ,[])
-    EData -> return $ (AData typ,[])
-
-    Abs x t -> case typ of
-      VClos env (Prod y a b) -> do
-	a' <- whnf $ VClos env a ---
-	(t',cs) <- checkExp th 
-                           (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b)
-	return (AAbs x a' t', cs)
-      _ -> prtBad ("function type expected for" +++ prt e +++ "instead of") typ
-
--- {- --- to get deprec when checkEqs works (15/9/2005)
-    Eqs es -> do
-      bcs <- mapM (\b -> checkBranch th tenv b typ) es
-      let (bs,css) = unzip bcs
-      return (AEqs bs, concat css) 
--- - }
-    Prod x a b -> do
-      testErr (typ == vType) "expected Type"
-      (a',csa) <- checkType th tenv a
-      (b',csb) <- checkType th (k+1, (x,v x):rho, (x,VClos rho a):gamma) b
-      return (AProd x a' b', csa ++ csb)
-
-    _ -> checkInferExp th tenv e typ
-
-checkInferExp :: Theory -> TCEnv -> Exp -> Val -> Err (AExp, [(Val,Val)])
-checkInferExp th tenv@(k,_,_) e typ = do
-  (e',w,cs1) <- inferExp th tenv e
-  cs2 <- eqVal k w typ
-  return (e',cs1 ++ cs2)
-      
-inferExp :: Theory -> TCEnv -> Exp -> Err (AExp, Val, [(Val,Val)])
-inferExp th tenv@(k,rho,gamma) e = case e of
-   Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x
-   Q m c 
-    | m == cPredefAbs && (elem c (map identC ["Int","String","Float"])) ->
-                                       return (ACn (m,c) vType, vType, [])
-    | otherwise -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c)
-   QC m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) ----
-   EInt i -> return (AInt i, valAbsInt, [])
-   EFloat i -> return (AFloat i, valAbsFloat, [])
-   K i -> return (AStr i, valAbsString, [])
-   Sort _ -> return (AType, vType, [])
-   App f t -> do
-    (f',w,csf) <- inferExp th tenv f 
-    typ <- whnf w
-    case typ of
-      VClos env (Prod x a b) -> do
-        (a',csa) <- checkExp th tenv t (VClos env a)
-	b' <- whnf $ VClos ((x,VClos rho t):env) b
-	return $ (AApp f' a' b', b', csf ++ csa)
-      _ -> prtBad ("Prod expected for function" +++ prt f +++ "instead of") typ
-   _ -> prtBad "cannot infer type of expression" e
- where
-   predefAbs c s = case c of
-     IC "Int" -> return $ const $ Q cPredefAbs cInt
-     IC "Float" -> return $ const $ Q cPredefAbs cFloat
-     IC "String" -> return $ const $ Q cPredefAbs cString
-     _ -> Bad s
-
-checkEqs :: Theory -> TCEnv -> (Fun,Trm) -> Val -> Err [(Val,Val)]
-checkEqs th tenv@(k,rho,gamma) (fun@(m,f),def) val = case def of
-  Eqs es -> liftM concat $ mapM checkBranch es
-  _      -> liftM snd $ checkExp th tenv def val
- where
-  checkBranch (ps,df) = 
-   let
-      (ps',_,vars) = foldr p2t ([],0,[]) ps
-      fps        = mkApp (Q m f) ps'
-   in errIn ("branch" +++ prt fps) $ do
-    (aexp, typ, cs1) <- inferExp th tenv fps
-    let
-      bds = binds vars aexp 
-      tenv' = (k, rho, bds ++ gamma) 
-    (_,cs2)  <- errIn (show bds) $ checkExp th tenv' df typ
-    return $ (cs1 ++ cs2)
-  p2t p (ps,i,g) = case p of
-     PW      -> (meta (MetaSymb i) : ps, i+1,        g) 
-     PV IW   -> (meta (MetaSymb i) : ps, i+1,        g) 
-     PV x    -> (meta (MetaSymb i) : ps, i+1,upd x i g)
-     PString s -> (            K s : ps, i,          g)
-     PInt n -> (EInt n : ps, i, g)
-     PFloat n -> (EFloat n : ps, i, g)
-     PP m c xs -> (mkApp (qq (m,c)) xss : ps, i', g') 
-                    where (xss,i',g') = foldr p2t ([],i,g) xs
-     _ -> error $ "undefined p2t case" +++ prt p +++ "in checkBranch"
-  upd x i g = (x,i) : g --- to annotate pattern variables: treat as metas
-  
-  -- notice: in vars, the sequence 0.. is sorted. In subst aexp, all
-  -- this occurs and nothing else.
-  binds vars aexp = [(x,v) | ((x,_),v) <- zip vars metas] where
-    metas = map snd $ sortBy (\ (x,_) (y,_) -> compare x y) $ subst aexp
-  subst aexp = case aexp of
-   AMeta (MetaSymb i) v -> [(i,v)]
-   AApp  c a _ -> subst c ++ subst a
-   _ -> [] -- never matter in patterns
-
-checkBranch :: Theory -> TCEnv -> Equation -> Val -> Err (([Exp],AExp),[(Val,Val)])
-checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $ 
-                                  chB tenv' ps' ty 
- where 
-
-  (ps',_,rho2,k') = ps2ts k ps
-  tenv' = (k, rho2++rho, gamma) ---- k' ?
-  (k,rho,gamma) = tenv
-
-  chB tenv@(k,rho,gamma) ps ty = case ps of
-    p:ps2 -> do
-      typ <- whnf ty
-      case typ of
-        VClos env (Prod y a b) -> do
-	  a' <- whnf $ VClos env a
-          (p', sigma, binds, cs1) <- checkP tenv p y a'
-          let tenv' = (length binds, sigma ++ rho, binds ++ gamma)
-          ((ps',exp),cs2) <- chB tenv' ps2 (VClos ((y,p'):env) b)
-	  return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt
-        _ -> prtBad ("Product expected for definiens" +++prt t +++ "instead of") typ
-    [] -> do
-      (e,cs) <- checkExp th tenv t ty
-      return (([],e),cs)
-  checkP env@(k,rho,gamma) t x a = do
-     (delta,cs) <- checkPatt th env t a
-     let sigma = [(x, VGen i x) | ((x,_),i) <- zip delta [k..]]
-     return (VClos sigma t, sigma, delta, cs)
-
-  ps2ts k = foldr p2t ([],0,[],k) 
-  p2t p (ps,i,g,k) = case p of
-     PW      -> (meta (MetaSymb i) : ps, i+1,g,k) 
-     PV IW   -> (meta (MetaSymb i) : ps, i+1,g,k) 
-     PV x    -> (vr x   : ps, i, upd x k g,k+1)
-     PString s -> (K s : ps, i, g, k)
-     PInt n -> (EInt n : ps, i, g, k)
-     PFloat n -> (EFloat n : ps, i, g, k)
-     PP m c xs -> (mkApp (qq (m,c)) xss : ps, j, g',k') 
-                    where (xss,j,g',k') = foldr p2t ([],i,g,k) xs
-     _ -> error $ "undefined p2t case" +++ prt p +++ "in checkBranch"
-
-  upd x k g = (x, VGen k x) : g --- hack to recognize pattern variables
-
-
-checkPatt :: Theory -> TCEnv -> Exp -> Val -> Err (Binds,[(Val,Val)])
-checkPatt th tenv exp val = do
-  (aexp,_,cs) <- checkExpP tenv exp val
-  let binds = extrBinds aexp
-  return (binds,cs)
- where
-   extrBinds aexp = case aexp of
-     AVr i v    -> [(i,v)]
-     AApp f a _ -> extrBinds f ++ extrBinds a
-     _ -> [] -- no other cases are possible
-
---- ad hoc, to find types of variables
-   checkExpP tenv@(k,rho,gamma) exp val = case exp of
-     Meta m -> return $ (AMeta m val, val, [])
-     Vr x   -> return $ (AVr   x val, val, [])
-     EInt i -> return (AInt i, valAbsInt, [])
-     EFloat i -> return (AFloat i, valAbsFloat, [])
-     K s    -> return (AStr s, valAbsString, [])
-
-     Q m c  -> do
-       typ <- lookupConst th (m,c)
-       return $ (ACn (m,c) typ, typ, [])
-     QC m c  -> do
-       typ <- lookupConst th (m,c)
-       return $ (ACn (m,c) typ, typ, []) ----
-     App f t -> do
-       (f',w,csf) <- checkExpP tenv f val
-       typ <- whnf w
-       case typ of
-         VClos env (Prod x a b) -> do
-           (a',_,csa) <- checkExpP tenv t (VClos env a)
-	   b' <- whnf $ VClos ((x,VClos rho t):env) b
-	   return $ (AApp f' a' b', b', csf ++ csa)
-         _ -> prtBad ("Prod expected for function" +++ prt f +++ "instead of") typ
-     _ -> prtBad "cannot typecheck pattern" exp
-
--- auxiliaries
-
-noConstr :: Err Val -> Err (Val,[(Val,Val)])
-noConstr er = er >>= (\v -> return (v,[]))
-
-mkAnnot :: (Val -> AExp) -> Err (Val,[(Val,Val)]) -> Err (AExp,Val,[(Val,Val)])
-mkAnnot a ti = do
-  (v,cs) <- ti
-  return (a v, v, cs)
-
diff --git a/src/GF/Grammar/TypeCheck.hs b/src/GF/Grammar/TypeCheck.hs
deleted file mode 100644
index 97b7ff243..000000000
--- a/src/GF/Grammar/TypeCheck.hs
+++ /dev/null
@@ -1,311 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : TypeCheck
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/15 16:22:02 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.16 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Grammar.TypeCheck (-- * top-level type checking functions; TC should not be called directly.
-		  annotate, annotateIn,
-		  justTypeCheck, checkIfValidExp,
-		  reduceConstraints, 
-		  splitConstraints,
-		  possibleConstraints,
-		  reduceConstraintsNode,
-		  performMetaSubstNode,
-		  -- * some top-level batch-mode checkers for the compiler
-		  justTypeCheckSrc,
-		  grammar2theorySrc,
-		  checkContext,
-		  checkTyp,
-		  checkEquation,
-		  checkConstrs,
-		  editAsTermCommand,
-		  exp2termCommand,
-		  exp2termlistCommand,
-		  tree2termlistCommand
-		 ) where
-
-import GF.Data.Operations
-import GF.Data.Zipper
-
-import GF.Grammar.Abstract
-import GF.Grammar.AbsCompute
-import GF.Grammar.Refresh
-import GF.Grammar.LookAbs
-import qualified GF.Grammar.Lookup as Lookup ---
-
-import GF.Grammar.TC
-
-import GF.Grammar.Unify ---
-
-import Control.Monad (foldM, liftM, liftM2)
-import Data.List (nub) ---
-
--- top-level type checking functions; TC should not be called directly.
-
-annotate :: GFCGrammar -> Exp -> Err Tree
-annotate gr exp = annotateIn gr [] exp Nothing 
-
--- | type check in empty context, return a list of constraints
-justTypeCheck :: GFCGrammar -> Exp -> Val -> Err Constraints
-justTypeCheck gr e v = do
-  (_,constrs0) <- checkExp (grammar2theory gr) (initTCEnv []) e v
-  constrs1     <- reduceConstraints (lookupAbsDef gr) 0 constrs0
-  return $ fst $ splitConstraints gr constrs1
-
--- | type check in empty context, return the expression itself if valid
-checkIfValidExp :: GFCGrammar -> Exp -> Err Exp
-checkIfValidExp gr e = do
-  (_,_,constrs0) <- inferExp (grammar2theory gr) (initTCEnv []) e
-  constrs1       <- reduceConstraints (lookupAbsDef gr) 0 constrs0
-  ifNull (return e) (Bad  . unwords . prConstrs) constrs1
-
-annotateIn :: GFCGrammar -> Binds -> Exp -> Maybe Val -> Err Tree
-annotateIn gr gamma exp = maybe (infer exp) (check exp) where
-  infer e = do 
-    (a,_,cs) <- inferExp theory env e
-    aexp2treeC (a,cs)
-  check e v = do
-    (a,cs) <- checkExp theory env e v
-    aexp2treeC (a,cs)
-  env = initTCEnv gamma
-  theory = grammar2theory gr 
-  aexp2treeC (a,c) = do
-    c' <- reduceConstraints (lookupAbsDef gr) (length gamma) c
-    aexp2tree (a,c')
-
--- | invariant way of creating TCEnv from context
-initTCEnv gamma = 
-  (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma) 
-
--- | process constraints after eqVal by computing by defs
-reduceConstraints :: LookDef -> Int -> Constraints -> Err Constraints
-reduceConstraints look i = liftM concat . mapM redOne where
-  redOne (u,v) = do
-    u' <- computeVal look u
-    v' <- computeVal look v
-    eqVal i u' v' 
-
-computeVal :: LookDef -> Val -> Err Val
-computeVal look v = case v of
-  VClos g@(_:_) e -> do
-    e' <- compt (map fst g) e          --- bindings of g in e?
-    whnf $ VClos g e'
-{- ----
-  _ -> do            ---- how to compute a Val, really??
-    e  <- val2exp v
-    e' <- compt [] e
-    whnf $ vClos e'
--}
-  VApp f c -> liftM2 VApp (compv f) (compv c) >>= whnf
-  _ -> whnf v
- where
-   compt = computeAbsTermIn look
-   compv = computeVal look
-
--- | take apart constraints that have the form (? <> t), usable as solutions
-splitConstraints :: GFCGrammar -> Constraints -> (Constraints,MetaSubst)
-splitConstraints gr = splitConstraintsGen (lookupAbsDef gr)
-
-splitConstraintsSrc :: Grammar -> Constraints -> (Constraints,MetaSubst)
-splitConstraintsSrc gr = splitConstraintsGen (Lookup.lookupAbsDef gr)
-
-splitConstraintsGen :: LookDef -> Constraints -> (Constraints,MetaSubst)
-splitConstraintsGen look cs = csmsu where
-
-  csmsu       = (nub [(a,b) | (a,b) <- csf1,a /= b],msf1)
-  (csf1,msf1) = unif (csf,msf)  -- alternative: filter first
-  (csf,msf)   = foldr mkOne ([],[]) cs
-
-  csmsf     = foldr mkOne ([],msu) csu
-  (csu,msu) = unif (cs1,[])    -- alternative: unify first
-
-  cs1 = errVal cs $ reduceConstraints look 0 cs
-
-  mkOne (u,v) = case (u,v) of
-    (VClos g (Meta m), v) | null g -> sub m v
-    (v, VClos g (Meta m)) | null g -> sub m v
-    -- do nothing if meta has nonempty closure; null g || isConstVal v WAS WRONG
-    c -> con c
-  con c (cs,ms) = (c:cs,ms)
-  sub m v (cs,ms) = (cs,(m,v):ms)
-
-  unifo = id -- alternative: don't use unification
-
-  unif cm@(cs,ms) = errVal cm $ do --- alternative: use unification  
-    (cs',ms') <- unifyVal cs
-    return (cs', ms' ++ ms)
-
-performMetaSubstNode :: MetaSubst -> TrNode -> TrNode
-performMetaSubstNode subst n@(N (b,a,v,(c,m),s)) = let
-  v' = metaSubstVal v
-  b' = [(x,metaSubstVal v) | (x,v) <- b]
-  c' = [(u',v') | (u,v) <- c, 
-                  let (u',v') = (metaSubstVal u, metaSubstVal v), u' /= v']
-  in N (b',a,v',(c',m),s)
- where
-   metaSubstVal u = errVal u $ whnf $ case u of
-     VApp  f a -> VApp  (metaSubstVal f) (metaSubstVal a)
-     VClos g e -> VClos [(x,metaSubstVal v) | (x,v) <- g] (metaSubstExp e)
-     _ -> u
-   metaSubstExp e = case e of
-     Meta m -> errVal e $ maybe (return e) val2expSafe $ lookup m subst
-     _ -> composSafeOp metaSubstExp e
-
-reduceConstraintsNode :: GFCGrammar -> TrNode -> TrNode
-reduceConstraintsNode gr = changeConstrs red where
-  red cs = errVal cs $ reduceConstraints (lookupAbsDef gr) 0 cs
-
--- | weak heuristic to narrow down menus; not used for TC. 15\/11\/2001.
--- the age-old method from GF 0.9
-possibleConstraints :: GFCGrammar -> Constraints -> Bool
-possibleConstraints gr = and . map (possibleConstraint gr)
-
-possibleConstraint :: GFCGrammar -> (Val,Val) -> Bool
-possibleConstraint gr (u,v) = errVal True $ do
-    u' <- val2exp u >>= compute gr
-    v' <- val2exp v >>= compute gr
-    return $ cts u' v'
- where
-  cts t u = isUnknown t || isUnknown u || case (t,u) of
-    (Q m c,      Q n d)      -> c == d || notCan (m,c) || notCan (n,d)
-    (QC m c,     QC n d)     -> c == d
-    (App f a,    App g b)    -> cts f g && cts a b
-    (Abs x b,    Abs y c)    -> cts b c
-    (Prod x a f, Prod y b g) -> cts a b && cts f g
-    (_         , _)          -> False
-
-  isUnknown t = case t of
-    Vr _ -> True
-    Meta _ -> True
-    _ -> False
-
-  notCan = not . isPrimitiveFun gr
-
--- interface to TC type checker
-
-type2val :: Type -> Val
-type2val = VClos []
-
-aexp2tree :: (AExp,[(Val,Val)]) -> Err Tree
-aexp2tree (aexp,cs) = do
-  (bi,at,vt,ts) <- treeForm aexp
-  ts' <- mapM aexp2tree [(t,[]) | t <- ts]
-  return $ Tr (N (bi,at,vt,(cs,[]),False),ts')
- where
-  treeForm a = case a of
-     AAbs x v b  -> do
-       (bi, at, vt, args) <- treeForm b
-       v' <- whnf v ---- should not be needed...
-       return ((x,v') : bi, at, vt, args)
-     AApp c a v -> do
-       (_,at,_,args) <- treeForm c
-       v' <- whnf v ---- 
-       return ([],at,v',args ++ [a]) 
-     AVr x v -> do
-       v' <- whnf v ---- 
-       return ([],AtV x,v',[])
-     ACn c v -> do
-       v' <- whnf v ---- 
-       return ([],AtC c,v',[])
-     AInt i -> do
-       return ([],AtI i,valAbsInt,[])
-     AFloat i -> do
-       return ([],AtF i,valAbsFloat,[])
-     AStr s -> do
-       return ([],AtL s,valAbsString,[])
-     AMeta m v -> do
-       v' <- whnf v ---- 
-       return ([],AtM m,v',[])
-     _ -> Bad "illegal tree" -- AProd
-
-grammar2theory :: GFCGrammar -> Theory
-grammar2theory gr (m,f) = case lookupFunType gr m f of
-  Ok t -> return $ type2val t
-  Bad s -> case lookupCatContext gr m f of
-    Ok cont -> return $ cont2val cont
-    _ -> Bad s
-
-cont2exp :: Context -> Exp
-cont2exp c = mkProd (c, eType, []) -- to check a context
-
-cont2val :: Context -> Val
-cont2val = type2val . cont2exp
-
--- some top-level batch-mode checkers for the compiler
-
-justTypeCheckSrc :: Grammar -> Exp -> Val -> Err Constraints
-justTypeCheckSrc gr e v = do
-  (_,constrs0) <- checkExp (grammar2theorySrc gr) (initTCEnv []) e v
-  return $ filter notJustMeta constrs0
-----  return $ fst $ splitConstraintsSrc gr constrs0
----- this change was to force proper tc of abstract modules. 
----- May not be quite right. AR 13/9/2005 
-
-notJustMeta (c,k) = case (c,k) of
-     (VClos g1 (Meta m1), VClos g2 (Meta m2)) -> False
-     _ -> True
-
-grammar2theorySrc :: Grammar -> Theory
-grammar2theorySrc gr (m,f) = case lookupFunTypeSrc gr m f of
-  Ok t -> return $ type2val t
-  Bad s -> case lookupCatContextSrc gr m f of
-    Ok cont -> return $ cont2val cont
-    _ -> Bad s
-
-checkContext :: Grammar -> Context -> [String]
-checkContext st = checkTyp st . cont2exp
-
-checkTyp :: Grammar -> Type -> [String]
-checkTyp gr typ = err singleton prConstrs $ justTypeCheckSrc gr typ vType
-
-checkEquation :: Grammar -> Fun -> Trm -> [String]
-checkEquation gr (m,fun) def = err singleton id $ do
-  typ  <- lookupFunTypeSrc gr m fun
-----  cs   <- checkEqs (grammar2theorySrc gr) (initTCEnv []) ((m,fun),def) (vClos typ)
-  cs   <- justTypeCheckSrc gr def (vClos typ)
-  let cs1 = filter notJustMeta cs ----- filter (not . possibleConstraint gr) cs ----
-  return $ ifNull [] (singleton . prConstraints) cs1
-
-checkConstrs :: Grammar -> Cat -> [Ident] -> [String]
-checkConstrs gr cat _ = [] ---- check constructors!
-
-
-
-
-
- 
-{- ----
-err singleton concat . mapM checkOne where
-  checkOne con = do
-    typ   <- lookupFunType gr con
-    typ'  <- computeAbsTerm gr typ
-    vcat  <- valCat typ'
-    return $ if (cat == vcat) then [] else ["wrong type in constructor" +++ prt con]
--}
-
-editAsTermCommand :: GFCGrammar -> (Loc TrNode -> Err (Loc TrNode)) -> Exp -> [Exp]
-editAsTermCommand gr c e = err (const []) singleton $ do
-  t  <- annotate gr $ refreshMetas [] e
-  t' <- c $ tree2loc t
-  return $ tree2exp $ loc2tree t'
-
-exp2termCommand :: GFCGrammar -> (Exp -> Err Exp) -> Tree -> Err Tree
-exp2termCommand gr f t = errIn ("modifying term" +++ prt t) $ do
-  let exp = tree2exp t
-  exp2 <- f exp
-  annotate gr exp2
-
-exp2termlistCommand :: GFCGrammar -> (Exp -> [Exp]) -> Tree -> [Tree]
-exp2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f . tree2exp
-
-tree2termlistCommand :: GFCGrammar -> (Tree -> [Exp]) -> Tree -> [Tree]
-tree2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f 
diff --git a/src/GF/Grammar/Unify.hs b/src/GF/Grammar/Unify.hs
deleted file mode 100644
index 588c1b306..000000000
--- a/src/GF/Grammar/Unify.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Unify
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:31 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
---
--- (c) Petri Mäenpää & Aarne Ranta, 1998--2001
---
--- brute-force adaptation of the old-GF program AR 21\/12\/2001 ---
--- the only use is in 'TypeCheck.splitConstraints'
------------------------------------------------------------------------------
-
-module GF.Grammar.Unify (unifyVal) where
-
-import GF.Grammar.Abstract
-
-import GF.Data.Operations
-
-import Data.List (partition)
-
-unifyVal :: Constraints -> Err (Constraints,MetaSubst)
-unifyVal cs0 = do
-  let (cs1,cs2) = partition notSolvable cs0 
-  let (us,vs) = unzip cs1
-  us' <- mapM val2exp us
-  vs' <- mapM val2exp vs
-  let (ms,cs) = unifyAll (zip us' vs') []
-  return (cs1 ++ [(VClos [] t, VClos [] u) | (t,u) <- cs], 
-          [(m,          VClos [] t) | (m,t) <- ms])
- where
-   notSolvable (v,w) = case (v,w) of -- don't consider nonempty closures
-     (VClos (_:_) _,_) -> True
-     (_,VClos (_:_) _) -> True
-     _ -> False
-
-type Unifier = [(MetaSymb, Trm)]
-type Constrs = [(Trm, Trm)]
-
-unifyAll :: Constrs -> Unifier -> (Unifier,Constrs)
-unifyAll [] g = (g, [])
-unifyAll ((a@(s, t)) : l) g =
-  let (g1, c) = unifyAll l g
-  in case unify s t g1 of
-       Ok g2  -> (g2, c)
-       _      -> (g1, a : c)
-
-unify :: Trm -> Trm -> Unifier -> Err Unifier
-unify e1 e2 g = 
- case (e1, e2) of 
-  (Meta s, t) -> do
-     tg <- subst_all g t
-     let sg = maybe e1 id (lookup s g)
-     if (sg == Meta s) then extend g s tg else unify sg tg g 
-  (t, Meta s) -> unify e2 e1 g
-  (Q _ a, Q _ b) | (a == b)      -> return g ---- qualif?
-  (QC _ a, QC _ b) | (a == b)    -> return g ----
-  (Vr x, Vr y) | (x == y)        -> return g 
-  (Abs x b, Abs y c)               -> do let c' = substTerm [x] [(y,Vr x)] c 
-                                         unify b c' g
-  (App c a, App d b)            -> case unify c d g of 
-                                     Ok g1 -> unify a b g1 
-                                     _       -> prtBad "fail unify" e1
-  _                             -> prtBad "fail unify" e1
-
-extend :: Unifier -> MetaSymb -> Trm -> Err Unifier
-extend g s t | (t == Meta s) = return g  
-             | occCheck s t  = prtBad "occurs check" t
-             | True          = return ((s, t) : g) 
-
-subst_all :: Unifier -> Trm -> Err Trm
-subst_all s u =
- case (s,u) of
-  ([], t)  -> return t
-  (a : l, t) -> do
-     t' <- (subst_all l t) --- successive substs - why ?
-     return $ substMetas [a] t'
-
-substMetas :: [(MetaSymb,Trm)] -> Trm -> Trm
-substMetas subst trm = case trm of
-   Meta x -> case lookup x subst of
-     Just t -> t
-     _ -> trm
-   _ -> composSafeOp (substMetas subst) trm
-
-occCheck :: MetaSymb -> Trm -> Bool
-occCheck s u = case u of
-    Meta v  -> s == v
-    App c a -> occCheck s c || occCheck s a
-    Abs x b -> occCheck s b
-    _       -> False
-
diff --git a/src/GF/Grammar/Values.hs b/src/GF/Grammar/Values.hs
deleted file mode 100644
index 6e029d98b..000000000
--- a/src/GF/Grammar/Values.hs
+++ /dev/null
@@ -1,109 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Values
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:32 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.7 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Grammar.Values (-- * values used in TC type checking
-	       Exp, Val(..), Env,
-	       -- * annotated tree used in editing
-	       Tree, TrNode(..), Atom(..), Binds, Constraints, MetaSubst,
-	       -- * for TC
-	       valAbsInt, valAbsFloat, valAbsString, vType,
-	       isPredefCat,
-	       cType, cPredefAbs, cInt, cFloat, cString,
-	       eType, tree2exp, loc2treeFocus
-	      ) where
-
-import GF.Data.Operations
-import GF.Data.Zipper
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-
--- values used in TC type checking
-
-type Exp = Term
-
-data Val = VGen Int Ident | VApp Val Val | VCn QIdent | VType | VClos Env Exp 
-  deriving (Eq,Show)
-
-type Env = [(Ident,Val)]
-
--- annotated tree used in editing
-
-type Tree = Tr TrNode
-
-newtype TrNode = N (Binds,Atom,Val,(Constraints,MetaSubst),Bool) 
-  deriving (Eq,Show)
-
-data Atom = 
-  AtC Fun | AtM MetaSymb | AtV Ident | AtL String | AtI Integer | AtF Double
-  deriving (Eq,Show)
-
-type Binds = [(Ident,Val)]
-type Constraints = [(Val,Val)]
-type MetaSubst = [(MetaSymb,Val)]
-
--- for TC
-
-valAbsInt :: Val
-valAbsInt = VCn (cPredefAbs, cInt)
-
-valAbsFloat :: Val
-valAbsFloat = VCn (cPredefAbs, cFloat)
-
-valAbsString :: Val
-valAbsString = VCn (cPredefAbs, cString)
-
-vType :: Val
-vType = VType
-
-cType :: Ident
-cType = identC "Type" --- #0
-
-cPredefAbs :: Ident
-cPredefAbs = identC "PredefAbs"
-
-cInt :: Ident
-cInt = identC "Int"
-
-cFloat :: Ident
-cFloat = identC "Float"
-
-cString :: Ident
-cString = identC "String"
-
-isPredefCat :: Ident -> Bool
-isPredefCat c = elem c [cInt,cString,cFloat]
-
-eType :: Exp
-eType = Sort "Type"
-
-tree2exp :: Tree -> Exp
-tree2exp (Tr (N (bi,at,_,_,_),ts)) = foldr Abs (foldl App at' ts') bi' where
-  at' = case at of
-    AtC (m,c) -> Q m c
-    AtV i -> Vr i
-    AtM m -> Meta m
-    AtL s -> K s
-    AtI s -> EInt s
-    AtF s -> EFloat s
-  bi' = map fst bi
-  ts' = map tree2exp ts
-
-loc2treeFocus :: Loc TrNode -> Tree
-loc2treeFocus (Loc (Tr (a,ts),p)) = 
-  loc2tree (Loc (Tr (mark a, map (mapTr nomark) ts), mapPath nomark p)) 
- where 
-   (mark, nomark) = (\(N (a,b,c,d,_)) -> N(a,b,c,d,True), 
-                     \(N (a,b,c,d,_)) -> N(a,b,c,d,False))
-