diff --git a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
deleted file mode 100644
index 929e30ce1..000000000
--- a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
+++ /dev/null
@@ -1,531 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GF.Compile.Concrete.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.Compile.Compute.ConcreteLazy ({-computeConcrete, computeTerm,checkPredefError-}) where
-{-
-import GF.Grammar.Grammar
-import GF.Data.Operations
-import GF.Infra.Ident
---import GF.Infra.Option
-import GF.Data.Str
---import GF.Grammar.ShowTerm
-import GF.Grammar.Printer
-import GF.Grammar.Predef
-import GF.Grammar.Macros
-import GF.Grammar.Lookup
---import GF.Compile.Refresh
-import GF.Grammar.PatternMatch
-import GF.Grammar.Lockfield (isLockLabel,unlockRecord) ----
-
-import GF.Compile.Compute.AppPredefined
-
-import Data.List (nub) --intersperse
---import Control.Monad (liftM2, liftM)
-import Control.Monad.Identity
-import GF.Text.Pretty
-
-----import Debug.Trace
-
---type Comp a = Err a -- makes computations (hyper)strict
---errr = id
-
-type Comp a = Identity a -- inherit Haskell's laziness
-errr = err runtime_error return -- convert interpreter error to run-time error
-no_error = err fail return -- failure caused by interpreter/type checker bug (?)
-runtime_error = return . Error -- run-time error term
-
--- | 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
-
-computeTerm :: SourceGrammar -> Substitution -> Term -> Err Term
-computeTerm gr g = return . runIdentity . computeTermOpt gr g
-
-computeTermOpt :: SourceGrammar -> Substitution -> Term -> Comp Term
-computeTermOpt gr = comput True where
-
-   -- full = True means full evaluation under Abs
-   comput full g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging 
-    --trace ("comput "++show (map fst g)++" "++take 65 (show t)) $
-    case t of
-
-     Q (p,c) | p == cPredef -> return t    -- qualified constant
-             | otherwise    -> look (p,c) 
-
-     Vr x -> do  -- local variable
-       t' <- maybe (fail (render (text "no value given to variable" <+> ppIdent x))) 
-             return $ lookup x g
-       case t' of 
-         _ | t == t' -> return t
-         _ -> comp g t' --- why compute again? AR 25/8/2011
-
-     -- Abs x@(IA _) b -> do 
-     Abs _ _ _ | full -> do   -- \xs -> b
-       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,(ty,a)) b -> do  -- let x : ty = a in b
-       a' <- comp g a
-       comp (ext x a' g) b
-
-{- -- trying to prevent Let expansion with non-evaluated exps. AR 19/8/2011
-     Let (x,(ty,a)) b -> do
-       a' <- comp g a
-       let ea' = checkNoArgVars a'
-       case ea' of
-         Ok v -> comp (ext x v g) b
-         _ -> return $ Let (x,(ty,a')) b
--}
-
-     Prod b x a t -> do  -- (x : a) -> t ; b for hiding
-       a' <- comp g a
-       t' <- comp (ext x (Vr x) g) t
-       return $ Prod b x a' t'
-
-     -- beta-convert: simultaneous for as many arguments as possible
-     App f a -> case appForm t of   -- (f a) --> (h as)
-      (h,as) | length as > 1 -> do
-        h' <- hnf g h
-        as' <- mapM (comp g) as
-        case h' of
-          Error{} -> return h'
-          _ | not (null [() | FV _ <- as']) -> compApp g (mkApp h' as')
-          c@(QC _) -> do
-            return $ mkApp c as'
-          Q (mod,f) | mod == cPredef ->
-            case appPredefined (mkApp h' as') of
-              Ok (t',b) -> if b then return t' else comp g t'
-              Bad s -> runtime_error s
-
-          Abs _ _ _ -> do
-            let (xs,b) = termFormCnc h'
-            let g' = (zip (map snd 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 []  -- t.lock_C
-     ---- a workaround 18/2/2005: take this away and find the reason
-     ---- why earlier compilation destroys the lock field
-
-
-     P t l  -> do     -- t.l
-       t' <- comp g t
-       case t' of
-         Error{} -> return t'
-         FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . variants -- (r| r').l
-         R r   -> project l r --{...}.l
-
-         ExtR a (R b) ->    -- (a ** {...}).l             
-           maybe (comp g (P a l)) (comp g) (try_project l b)
-
---- { - --- this is incorrect, since b can contain the proper value
-         ExtR (R a) b ->                 -- NOT POSSIBLE both a and b records!
-           maybe (comp g (P b l)) (comp g) (try_project l a)
---- - } ---
-
-         S (T i cs) e -> prawitz  g i (flip P l) cs e  -- ((table i branches) ! e).l
-         S (V i cs) e -> prawitzV g i (flip P l) cs e  -- ((table i values) ! e).l
-
-         _   -> returnC $ P t' l
-
-     S t v -> do         -- t ! v
-       t' <- compTable g t
-       v' <- comp g v
-       t1 <- case t' of
-----           V (RecType fs) _         -> uncurrySelect g fs t' v'
-----           T (TComp (RecType fs)) _ -> uncurrySelect g fs t' v'
-           _ -> return $ S t' v'
-       compSelect g t1
-
-     -- normalize away empty tokens
-     K "" -> return Empty  -- []
-
-     -- glue if you can
-     Glue x0 y0 -> do  -- x0 + y0
-       x <- comp g x0
-       y <- comp g y0
-       case (x,y) of
-         (Error{},_)       -> return x
-         (_,Error{})       -> return y
-         (FV ks,_)         -> do                               -- (k|k') + y
-           kys <- mapM (comp g . flip Glue y) ks
-           return $ variants kys
-         (_,FV ks)         -> do                               -- x + (k|k')
-           xks <- mapM (comp g . Glue x) ks
-           return $ variants xks
-
-         (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e   -- (table cs ! e) + s
-         (s, S (T i cs) e) -> prawitz g i (Glue s) cs e        -- s + (table cs ! e)
-         (S (V i cs) e, s) -> prawitzV g i (flip Glue s) cs e  -- same with values
-         (s, S (V i cs) e) -> prawitzV g i (Glue s) cs e
-         (_,Empty)         -> return x                         -- x + []
-         (Empty,_)         -> return y
-         (K a, K b)        -> return $ K (a ++ b)              -- "foo" + "bar"
-         (_, Alts d vs)    -> do                               -- x + pre {...}
-----         (K a, Alts (d,vs)) -> do
-            let glx = Glue x
-            comp g $ Alts (glx d) [(glx v,c) | (v,c) <- vs]
-         (Alts _ _, ka) -> errr $ checks [do                          -- pre {...} + ka
-            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)    -- (u ++ v) + y
-         (_,C u v) -> comp g $ C (Glue x u) v    -- x ++ (u ++ v)
-
-         _ -> do
-           mapM_ checkNoArgVars [x,y]
-           r <- composOp (comp g) t
-           returnC r
-
-     Alts d aa -> do   -- pre {...}
-       d' <- comp g d
-       aa' <- mapM (compInAlts g) aa
-       returnC (Alts d' aa')
-
-     -- remove empty
-     C a b    -> do    -- a ++ b
-       a0 <- comp g a
-       b0 <- comp g b
-       let (a',b') = strForm (C a0 b0)
-       case (a',b') of
-         (Error{},_) -> return a'
-         (_,Error{}) -> return b'
-
-         (Alts _ _, K d) -> errr $ checks [do                      -- pre {...} ++ "d"
-            as <- strsFromTerm a' -- this may fail when compiling opers
-            return $ variants [
-              foldr1 C (map K (str2strings (plusStr v (str d)))) | v <- as]
-            ,
-            return $ C a' b'
-           ]
-         (Alts _ _, C (K d) e) -> errr $ checks [do                -- pre {...} ++ ("d" ++ e)
-            as <- strsFromTerm a' -- this may fail when compiling opers
-            return $ C (variants [
-              foldr1 C (map K (str2strings (plusStr v (str d)))) | v <- as]) e
-            ,
-            return $ C a' b'
-           ]
-
-         (Empty,_) -> returnC b'        -- [] ++ b'
-         (_,Empty) -> returnC a'        -- a' ++ []
-         _     -> returnC $ C a' b'
-
-     -- reduce free variation as much as you can
-     FV ts -> mapM (comp g) ts >>= returnC . variants   -- variants {...}
-
-     -- merge record extensions if you can
-     ExtR r s -> do                                     -- r ** s
-       r' <- comp g r
-       s' <- comp g s
-       case (r',s') of
-         (Error{},_) -> return r'
-         (_,Error{}) -> return s'
-         (R rs, R ss) -> errr $ plusRecord r' s'
-         (RecType rs, RecType ss) -> errr $ plusRecType r' s'
-         _ -> return $ ExtR r' s'
-
-     ELin c r -> do                                     -- lin c r
-       r' <- comp g r
-       unlockRecord c r'
-
-     T _ _ -> compTable g t         -- table { ... p => t ... }
-     V _ _ -> compTable g t         -- table [ ... v ... ]
-
-     -- otherwise go ahead
-     _ -> composOp (comp g) t >>= returnC
-
-    where
-     --{...}.l
-     project l = maybe (fail_project l) (comp g) . try_project l
-     try_project l = fmap snd . lookup l
-     fail_project l = fail (render (text "no value for label" <+> ppLabel l))
-
-     compApp g (App f a) = do    -- (f a)
-       f' <- hnf g f
-       a' <- comp g a
-       case (f',a') of
-         (Error{},_) -> return f'
-         (Abs _ x b, FV as) ->   -- (\x -> b) (variants {...})
-           liftM variants $ mapM (\c -> comp (ext x c g) b) as
-         (_, FV as)  -> liftM variants $ mapM (\c -> comp g (App f' c)) as
-         (FV fs, _)  -> liftM variants $ mapM (\c -> comp g (App c a')) fs
-         (Abs _ x b,_) -> comp (ext x a' g) b  -- (\x -> b) a -- normal beta conv.
-
-         (QC _,_)  -> returnC $ App f' a'  -- (C a') -- constructor application
-
-         (S (T i cs) e,_) -> prawitz g i (flip App a') cs e  -- (table cs ! e) a'
-         (S (V i cs) e,_) -> prawitzV g i (flip App a') cs e
-
-	 _ -> case appPredefined (App f' a') of
-                Ok (t',b) -> if b then return t' else comp g t'
-                Bad s -> runtime_error s
-
-     hnf, comp :: Substitution -> Term -> Comp Term
-     hnf  = comput False
-     comp = comput True
-
-     look c = errr (lookupResDef gr c)
-     {- -- This seems to loop in the greek example:
-     look c = --trace ("look "++show c) $
-              optcomp =<< errr (lookupResDef gr c)
-       where
-         optcomp t = if t==Q c
-                     then --trace "looking up undefined oper" $
-                          return t
-                     else comp [] t -- g or []?
-     -}          
-
-     ext x a g = (x,a):g  -- extend environment with new variable and its value
-
-     returnC = return --- . computed
-
-     variants ts = case nub ts of
-       [t] -> t
-       ts  -> FV ts
-
-     isCan v = case v of    -- is canonical (and should be matched by a pattern)
-       Con _    -> True
-       QC _     -> True
-       App f a  -> isCan f && isCan a
-       R rs     -> all (isCan . snd . snd) rs
-       _        -> False
-
-     compPatternMacro p = case p of
-       PM c -> case look c of
-         Identity (EPatt p') -> compPatternMacro p'
-      -- _ -> fail (render (text "pattern expected as value of" $$ nest 2 (ppPatt Unqualified 0 p)))
-       PAs x p -> do
-         p' <- compPatternMacro p
-         return $ PAs x p'
-       PAlt p q -> do
-         p' <- compPatternMacro p
-         q' <- compPatternMacro q
-         return $ PAlt p' q'
-       PSeq p q -> do
-         p' <- compPatternMacro p
-         q' <- compPatternMacro q
-         return $ PSeq p' q'
-       PRep p -> do
-         p' <- compPatternMacro p
-         return $ PRep p'
-       PNeg p -> do
-         p' <- compPatternMacro p
-         return $ PNeg p'
-       PR rs -> do
-         rs' <- mapPairsM compPatternMacro rs
-         return $ PR rs'
-
-       _ -> return p
-
-     compSelect g (S t' v') = case v' of  -- t' ! v'
-       FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants    
-
-----       S (T i cs) e -> prawitz g i (S t') cs e  -- AR 8/7/2010 sometimes better
-----       S (V i cs) e -> prawitzV g i (S t') cs e -- sometimes much worse 
-
-    
-       _ -> case t' of
-         Error{} -> return t'
-         FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
-
-         T _ [(PW,c)] -> comp g c           -- (\\_ => c) ! v'
-         T _ [(PT _ PW,c)] -> comp g c      -- (\\(_ : typ) => c) ! v'
-
-         T _ [(PV z,c)] -> comp (ext z v' g) c        -- (\\z => c) ! v'
-         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                      -- (table [...ts...]) ! v'
-             vs <- no_error $ allParamValues gr ptyp
-             case lookupR v' (zip vs [0 .. length vs - 1]) of
-               Just i -> comp g $ ts !! i
-               _ -> return $ S t' v' -- if v' is not canonical
-         T _ cc -> do                         -- (table {...cc...}) ! v'
-           case matchPattern cc v' of
-             Ok (c,g') -> comp (g' ++ g) c
-             _ | isCan v' -> fail (render (text "missing case" <+> ppTerm Unqualified 0 v' <+> text "in" <+> ppTerm Unqualified 0 t))
-             _ -> return $ S t' v' -- if v' is not canonical
-
-         S (T i cs) e -> prawitz g i (flip S v') cs e  -- (table {...cs...} ! e) ! v'
-         S (V i cs) e -> prawitzV g i (flip S v') cs e
-         _    -> returnC $ S t' v'
-
-     --- needed to match records with and without type information
-     ---- todo: eliminate linear search in a list of records!
-     lookupR v vs = case v of
-       R rs -> lookup ([(x,y) | (x,(_,y)) <- rs]) 
-                                [([(x,y) | (x,(_,y)) <- rs],v) | (R rs,v) <- vs]
-       _ -> lookup v vs
-
-     -- case-expand tables: branches for every value of argument type
-     -- if already expanded, don't expand again
-     compTable g t = case t of
-         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'
-         V ty cs -> do
-           ty' <- comp g ty
-           -- if there are no variables, don't even go inside
-           cs' <- if (null g) then return cs else mapM (comp g) cs
-           return $ V ty' cs'
-
-         T i cs -> do
-           pty0 <- errr $ getTableType i
-           ptyp <- comp g pty0
-           case allParamValues gr ptyp of
-             Ok vs0 -> do
-               let vs = vs0 ---- [Val v ptyp i | (v,i) <- zip vs0 [0..]]
-               ps0  <- mapM (compPatternMacro . fst) cs
-               cs'  <- mapM (compBranchOpt g) (zip ps0 (map snd cs))
-               sts  <- no_error $ mapM (matchPattern cs') vs 
-               ts   <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
-               ps   <- no_error $ 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
-               ps0  <- mapM (compPatternMacro . fst) cs
-
-               cs'  <- mapM (compBranch g) (zip ps0 (map snd cs))
------               cs'  <- return (zip ps0 (map snd cs)) --- probably right AR 22/8/2011 but can leave uninstantiated variables :-(
-
-----               cs' <- mapM (compBranch g) cs
-               return $ T i cs'  -- happens with variable types
-         _ -> comp g t
-
-     compBranch g (p,v) = do  -- compute a branch in a table
-       let g' = contP p ++ g  -- add the pattern's variables to environment
-       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
-
-     -- collect the context of variables of a pattern
-     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
-
-     compInAlts g (v,c) = do
-       v' <- comp g v
-       c' <- comp g c
-       c2 <- case c' of
-         EPatt p -> liftM Strs $ getPatts p
-         _ -> return c'
-       return (v',c2)
-      where
-       getPatts p = case p of
-         PAlt a b  -> liftM2 (++) (getPatts a) (getPatts b)
-         PString s -> return [K s]
-         PSeq a b  -> do
-           as <- getPatts a
-           bs <- getPatts b
-           return [K (s ++ t) | K s <- as, K t <- bs]
-         _ -> fail (render (text "not valid pattern in pre expression" <+> ppPatt Unqualified 0 p))
-
-     strForm s = case s of
-       C (C a b) c -> let (a1,a2) = strForm a in (a1, ccStr a2 (ccStr b c))
-       C a b -> (a,b)
-       _ -> (s,Empty)
-
-     ccStr a b = case (a,b) of
-       (Empty,_) -> b
-       (_,Empty) -> a
-       _ -> C a b
-
-{- ----
-     uncurrySelect g fs t v = do
-       ts <- mapM (allParamValues gr . snd) fs
-       vs <- mapM (comp g) [P v r | r <- map fst fs]
-       return $ reorderSelect t fs ts vs
-
-     reorderSelect t fs pss vs = case (t,fs,pss,vs) of
-       (V _ ts, f:fs1, ps:pss1, v:vs1) -> 
-         S (V (snd f) 
-             [reorderSelect (V (RecType fs1) t) fs1 pss1 vs1 | 
-               t <- segments (length ts `div` length ps) ts]) v 
-       (T (TComp _) cs, f:fs1, ps:pss1, v:vs1) -> 
-         S (T (TComp (snd f)) 
-             [(p,reorderSelect (T (TComp (RecType fs1)) c) fs1 pss1 vs1) | 
-               (ep,c) <- zip ps (segments (length cs `div` length ps) cs),
-               let Ok p = term2patt ep]) v 
-       _ -> t
-
-     segments i xs = 
-       let (x0,xs1) = splitAt i xs in x0 : takeWhile (not . null) (segments i xs1)
--}
-
-
--- | argument variables cannot be glued
-checkNoArgVars :: Term -> Comp Term
-checkNoArgVars t = case t of
-  Vr x | isArgIdent x -> fail $ glueErrorMsg $ ppTerm Unqualified 0 t
-  _ -> composOp checkNoArgVars t
-
-glueErrorMsg s = 
-  render (text "Cannot glue (+) term with run-time variable" <+> s <> char '.' $$
-          text "Use Prelude.bind instead.")
-
-getArgType t = case t of
-  V ty _ -> return ty
-  T (TComp ty) _ -> return ty
-  _ -> fail (render (text "cannot get argument type of table" $$ nest 2 (ppTerm Unqualified 0 t)))
-  
-{-
--- Old
-checkPredefError sgr t = case t of
-  App (Q (mod,f)) s | mod == cPredef && f == cError -> fail $ showTerm sgr TermPrintOne Unqualified s
-  _ -> composOp (checkPredefError sgr) t
-  
-predef_error s = App (Q (cPredef,cError)) (K s)
--}
--}
diff --git a/src/compiler/GF/Compile/Compute/ConcreteStrict.hs b/src/compiler/GF/Compile/Compute/ConcreteStrict.hs
deleted file mode 100644
index df343adec..000000000
--- a/src/compiler/GF/Compile/Compute/ConcreteStrict.hs
+++ /dev/null
@@ -1,494 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GF.Compile.Concrete.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.Compile.Compute.ConcreteStrict (computeConcrete, computeTerm,computeConcreteRec,checkPredefError) where
-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Option
---import GF.Infra.Modules
-import GF.Data.Str
-import GF.Grammar.ShowTerm
-import GF.Grammar.Printer
-import GF.Grammar.Predef
-import GF.Grammar.Macros
-import GF.Grammar.Lookup
---import GF.Compile.Refresh
-import GF.Grammar.PatternMatch
-import GF.Grammar.Lockfield (isLockLabel,unlockRecord) ----
-
-import GF.Compile.Compute.AppPredefined
-
-import Data.List (nub,intersperse)
-import Control.Monad (liftM2, liftM)
-import GF.Text.Pretty
-
-----import Debug.Trace
-
--- | 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
-
--- False means: no evaluation under Abs
-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
-
-   -- full = True means full evaluation under Abs
-   comput full g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging 
-              case t of
-
-     Q (p,c) | p == cPredef -> return t    -- qualified constant
-             | otherwise    -> look (p,c) 
-
-     Vr x -> do  -- local variable
-       t' <- maybe (Bad (render (text "no value given to variable" <+> ppIdent x))) 
-             return $ lookup x g
-       case t' of 
-         _ | t == t' -> return t
-         _ -> comp g t' --- why compute again? AR 25/8/2011
-
-     -- Abs x@(IA _) b -> do 
-     Abs _ _ _ | full -> do   -- \xs -> b
-       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,(ty,a)) b -> do  -- let x : ty = a in b
-       a' <- comp g a
-       comp (ext x a' g) b
-
-{- -- trying to prevent Let expansion with non-evaluated exps. AR 19/8/2011
-     Let (x,(ty,a)) b -> do
-       a' <- comp g a
-       let ea' = checkNoArgVars a'
-       case ea' of
-         Ok v -> comp (ext x v g) b
-         _ -> return $ Let (x,(ty,a')) b
--}
-
-     Prod b x a t -> do  -- (x : a) -> t ; b for hiding
-       a' <- comp g a
-       t' <- comp (ext x (Vr x) g) t
-       return $ Prod b x a' t'
-
-     -- beta-convert: simultaneous for as many arguments as possible
-     App f a -> case appForm t of   -- (f a) --> (h as)
-      (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 (mod,f) | mod == cPredef -> 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 (map snd 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 []  -- t.lock_C
-     ---- a workaround 18/2/2005: take this away and find the reason
-     ---- why earlier compilation destroys the lock field
-
-
-     P t l  -> do     -- t.l
-       t' <- comp g t
-       case t' of
-         FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . variants -- (r| r').l
-         R r   -> maybe (Bad (render (text "no value for label" <+> ppLabel l))) --{...}.l
-                    (comp g . snd) $ 
-                    lookup l $ reverse r 
-
-         ExtR a (R b) ->    -- (a ** {...}).l             
-           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)
---- - } ---
-
-         S (T i cs) e -> prawitz  g i (flip P l) cs e  -- ((table i branches) ! e).l
-         S (V i cs) e -> prawitzV g i (flip P l) cs e  -- ((table i values) ! e).l
-
-         _   -> returnC $ P t' l
-
-     S t v -> do         -- t ! v
-       t' <- compTable g t
-       v' <- comp g v
-       t1 <- case t' of
-----           V (RecType fs) _         -> uncurrySelect g fs t' v'
-----           T (TComp (RecType fs)) _ -> uncurrySelect g fs t' v'
-           _ -> return $ S t' v'
-       compSelect g t1
-
-     -- normalize away empty tokens
-     K "" -> return Empty  -- []
-
-     -- glue if you can
-     Glue x0 y0 -> do  -- x0 + y0
-       x <- comp g x0
-       y <- comp g y0
-       case (x,y) of
-         (FV ks,_)         -> do                               -- (k|k') + y
-           kys <- mapM (comp g . flip Glue y) ks
-           return $ variants kys
-         (_,FV ks)         -> do                               -- x + (k|k')
-           xks <- mapM (comp g . Glue x) ks
-           return $ variants xks
-
-         (S (T i cs) e, s) -> prawitz g i (flip Glue s) cs e   -- (table cs ! e) + s
-         (s, S (T i cs) e) -> prawitz g i (Glue s) cs e        -- s + (table cs ! e)
-         (S (V i cs) e, s) -> prawitzV g i (flip Glue s) cs e  -- same with values
-         (s, S (V i cs) e) -> prawitzV g i (Glue s) cs e
-         (_,Empty)         -> return x                         -- x + []
-         (Empty,_)         -> return y
-         (K a, K b)        -> return $ K (a ++ b)              -- "foo" + "bar"
-         (_, Alts d vs)    -> do                               -- x + pre {...}
-----         (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                          -- pre {...} + ka
-            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)  -- (u ++ v) + y
-
-         _ -> do
-           mapM_ checkNoArgVars [x,y]
-           r <- composOp (comp g) t
-           returnC r
-
-     Alts d aa -> do   -- pre {...}
-       d' <- comp g d
-       aa' <- mapM (compInAlts g) aa
-       returnC (Alts d' aa')
-
-     -- remove empty
-     C a b    -> do    -- a ++ b
-       a' <- comp g a
-       b' <- comp g b
-       case (a',b') of
-         (Alts _ _, K d) -> checks [do                      -- pre {...} ++ "d"
-            as <- strsFromTerm a' -- this may fail when compiling opers
-            return $ variants [
-              foldr1 C (map K (str2strings (plusStr v (str d)))) | v <- as]
-            ,
-            return $ C a' b'
-           ]
-         (Alts _ _, C (K d) e) -> checks [do                -- pre {...} ++ ("d" ++ e)
-            as <- strsFromTerm a' -- this may fail when compiling opers
-            return $ C (variants [
-              foldr1 C (map K (str2strings (plusStr v (str d)))) | v <- as]) e
-            ,
-            return $ C a' b'
-           ]
-         (Empty,_) -> returnC b'        -- [] ++ b'
-         (_,Empty) -> returnC a'        -- a' ++ []
-         _     -> returnC $ C a' b'
-
-     -- reduce free variation as much as you can
-     FV ts -> mapM (comp g) ts >>= returnC . variants   -- variants {...}
-
-     -- merge record extensions if you can
-     ExtR r s -> do                                     -- r ** s
-       r' <- comp g r
-       s' <- comp g s
-       case (r',s') of
-         (R rs, R ss) -> plusRecord r' s'
-         (RecType rs, RecType ss) -> plusRecType r' s'
-         _ -> return $ ExtR r' s'
-
-     ELin c r -> do                                     -- lin c r
-       r' <- comp g r
-       unlockRecord c r'
-
-     T _ _ -> compTable g t         -- table { ... p => t ... }
-     V _ _ -> compTable g t         -- table [ ... v ... ]
-
-     -- otherwise go ahead
-     _ -> composOp (comp g) t >>= returnC
-
-    where
-
-     compApp g (App f a) = do    -- (f a)
-       f' <- hnf g f
-       a' <- comp g a
-       case (f',a') of
-         (Abs _ x b, FV as) ->   -- (\x -> b) (variants {...})
-           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  -- (\x -> b) a -- normal beta conv.
-
-         (QC _,_)  -> returnC $ App f' a'  -- (C a') -- constructor application
-
-         (S (T i cs) e,_) -> prawitz g i (flip App a') cs e  -- (table cs ! e) a'
-         (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 c
-       | rec       = lookupResDef gr c >>= comp []
-       | otherwise = lookupResDef gr c
-
-     ext x a g = (x,a):g  -- extend environment with new variable and its value
-
-     returnC = return --- . computed
-
-     variants ts = case nub ts of
-       [t] -> t
-       ts  -> FV ts
-
-     isCan v = case v of    -- is canonical (and should be matched by a pattern)
-       Con _    -> True
-       QC _     -> True
-       App f a  -> isCan f && isCan a
-       R rs     -> all (isCan . snd . snd) rs
-       _        -> False
-
-     compPatternMacro p = case p of
-       PM c -> case look c of
-         Ok (EPatt p') -> compPatternMacro p'
-         _ -> Bad (render (text "pattern expected as value of" $$ nest 2 (ppPatt Unqualified 0 p)))
-       PAs x p -> do
-         p' <- compPatternMacro p
-         return $ PAs x p'
-       PAlt p q -> do
-         p' <- compPatternMacro p
-         q' <- compPatternMacro q
-         return $ PAlt p' q'
-       PSeq p q -> do
-         p' <- compPatternMacro p
-         q' <- compPatternMacro q
-         return $ PSeq p' q'
-       PRep p -> do
-         p' <- compPatternMacro p
-         return $ PRep p'
-       PNeg p -> do
-         p' <- compPatternMacro p
-         return $ PNeg p'
-       PR rs -> do
-         rs' <- mapPairsM compPatternMacro rs
-         return $ PR rs'
-
-       _ -> return p
-
-     compSelect g (S t' v') = case v' of  -- t' ! v'
-       FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants    
-
-----       S (T i cs) e -> prawitz g i (S t') cs e  -- AR 8/7/2010 sometimes better
-----       S (V i cs) e -> prawitzV g i (S t') cs e -- sometimes much worse 
-
-    
-       _ -> case t' of
-         FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants
-
-         T _ [(PW,c)] -> comp g c           -- (\\_ => c) ! v'
-         T _ [(PT _ PW,c)] -> comp g c      -- (\\(_ : typ) => c) ! v'
-
-         T _ [(PV z,c)] -> comp (ext z v' g) c        -- (\\z => c) ! v'
-         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                      -- (table [...ts...]) ! v'
-             vs <- allParamValues gr ptyp
-             case lookupR v' (zip vs [0 .. length vs - 1]) of
-               Just i -> comp g $ ts !! i
-               _ -> return $ S t' v' -- if v' is not canonical
-         T _ cc -> do                         -- (table {...cc...}) ! v'
-           case matchPattern cc v' of
-             Ok (c,g') -> comp (g' ++ g) c
-             _ | isCan v' -> Bad (render (text "missing case" <+> ppTerm Unqualified 0 v' <+> text "in" <+> ppTerm Unqualified 0 t))
-             _ -> return $ S t' v' -- if v' is not canonical
-
-         S (T i cs) e -> prawitz g i (flip S v') cs e  -- (table {...cs...} ! e) ! v'
-         S (V i cs) e -> prawitzV g i (flip S v') cs e
-         _    -> returnC $ S t' v'
-
-     --- needed to match records with and without type information
-     ---- todo: eliminate linear search in a list of records!
-     lookupR v vs = case v of
-       R rs -> lookup ([(x,y) | (x,(_,y)) <- rs]) 
-                                [([(x,y) | (x,(_,y)) <- rs],v) | (R rs,v) <- vs]
-       _ -> lookup v vs
-
-     -- case-expand tables: branches for every value of argument type
-     -- if already expanded, don't expand again
-     compTable g t = case t of
-         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'
-         V ty cs -> do
-           ty' <- comp g ty
-           -- if there are no variables, don't even go inside
-           cs' <- if (null g) then return cs else mapM (comp g) cs
-           return $ V ty' cs'
-
-         T i cs -> do
-           pty0 <- getTableType i
-           ptyp <- comp g pty0
-           case allParamValues gr ptyp of
-             Ok vs0 -> do
-               let vs = vs0 ---- [Val v ptyp i | (v,i) <- zip vs0 [0..]]
-               ps0  <- mapM (compPatternMacro . fst) cs
-               cs'  <- mapM (compBranchOpt g) (zip ps0 (map snd 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
-               ps0  <- mapM (compPatternMacro . fst) cs
-
-               cs'  <- mapM (compBranch g) (zip ps0 (map snd cs))
------               cs'  <- return (zip ps0 (map snd cs)) --- probably right AR 22/8/2011 but can leave uninstantiated variables :-(
-
-----               cs' <- mapM (compBranch g) cs
-               return $ T i cs'  -- happens with variable types
-         _ -> comp g t
-
-     compBranch g (p,v) = do  -- compute a branch in a table
-       let g' = contP p ++ g  -- add the pattern's variables to environment
-       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
-
-     -- collect the context of variables of a pattern
-     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
-
-     compInAlts g (v,c) = do
-       v' <- comp g v
-       c' <- comp g c
-       c2 <- case c' of
-         EPatt p -> liftM Strs $ getPatts p
-         _ -> return c'
-       return (v',c2)
-      where
-       getPatts p = case p of
-         PAlt a b  -> liftM2 (++) (getPatts a) (getPatts b)
-         PString s -> return [K s]
-         PSeq a b  -> do
-           as <- getPatts a
-           bs <- getPatts b
-           return [K (s ++ t) | K s <- as, K t <- bs]
-         _ -> fail (render (text "not valid pattern in pre expression" <+> ppPatt Unqualified 0 p))
-
-{- ----
-     uncurrySelect g fs t v = do
-       ts <- mapM (allParamValues gr . snd) fs
-       vs <- mapM (comp g) [P v r | r <- map fst fs]
-       return $ reorderSelect t fs ts vs
-
-     reorderSelect t fs pss vs = case (t,fs,pss,vs) of
-       (V _ ts, f:fs1, ps:pss1, v:vs1) -> 
-         S (V (snd f) 
-             [reorderSelect (V (RecType fs1) t) fs1 pss1 vs1 | 
-               t <- segments (length ts `div` length ps) ts]) v 
-       (T (TComp _) cs, f:fs1, ps:pss1, v:vs1) -> 
-         S (T (TComp (snd f)) 
-             [(p,reorderSelect (T (TComp (RecType fs1)) c) fs1 pss1 vs1) | 
-               (ep,c) <- zip ps (segments (length cs `div` length ps) cs),
-               let Ok p = term2patt ep]) v 
-       _ -> t
-
-     segments i xs = 
-       let (x0,xs1) = splitAt i xs in x0 : takeWhile (not . null) (segments i xs1)
--}
-
-
--- | argument variables cannot be glued
-checkNoArgVars :: Term -> Err Term
-checkNoArgVars t = case t of
-  Vr (IA _ _)    -> Bad $ glueErrorMsg $ ppTerm Unqualified 0 t 
-  Vr (IAV _ _ _) -> Bad $ glueErrorMsg $ ppTerm Unqualified 0 t 
-  _ -> composOp checkNoArgVars t
-
-glueErrorMsg s = 
-  render (text "Cannot glue (+) term with run-time variable" <+> s <> char '.' $$
-          text "Use Prelude.bind instead.")
-
-getArgType t = case t of
-  V ty _ -> return ty
-  T (TComp ty) _ -> return ty
-  _ -> Bad (render (text "cannot get argument type of table" $$ nest 2 (ppTerm Unqualified 0 t)))
-
-
-checkPredefError :: SourceGrammar -> Term -> Err Term
-checkPredefError sgr t = case t of
-  App (Q (mod,f)) s | mod == cPredef && f == cError -> Bad $ showTerm sgr TermPrintOne Unqualified s
-  _ -> composOp (checkPredefError sgr) t
-  
diff --git a/src/compiler/GF/Compile/Refresh.hs b/src/compiler/GF/Compile/Refresh.hs
deleted file mode 100644
index 999d8b083..000000000
--- a/src/compiler/GF/Compile/Refresh.hs
+++ /dev/null
@@ -1,153 +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.Compile.Refresh ({-refreshTermN, refreshTerm,
-		refreshModule-}
-	       ) where
-{-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-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 b x t -> liftM2 (Abs b) (refVarPlus x)  (refresh t)
-
-  Prod b x a t -> do
-    a'  <- refresh a
-    x'  <- refVar  x
-    t'  <- refresh t
-    return $ Prod b x' a' t'
-
-  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)
-
-  App f a -> liftM2 App (inBlockSTM (refresh f)) (refresh a)
-
-  _ -> 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 c ps -> liftM (PP 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,SourceGrammar) -> SourceModule -> Err (Int,[SourceModule])
-refreshModule (k,sgr) mi@(i,mo)
-  | isModCnc mo || isModRes mo = do
-      (k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo
-      return (k', (i,mo{jments=buildTree js'}) : modules sgr)
-  | otherwise = return (k, mi:modules sgr)
- where
-  refreshRes (k,cs) ci@(c,info) = case info of
-    ResOper ptyp (Just (L loc trm)) -> do   ---- refresh ptyp
-      (k',trm') <- refreshTermKN k trm
-      return $ (k', (c, ResOper ptyp (Just (L loc trm'))):cs)
-    ResOverload os tyts -> do
-      (k',tyts') <- liftM (\ (t,(_,i)) -> (i,t)) $ 
-                    appSTM (mapPairsM (\(L loc t) -> liftM (L loc) (refresh t)) tyts) (initIdStateN k)
-      return $ (k', (c, ResOverload os tyts'):cs)
-    CncCat mt md mr mn mpmcfg-> do
-      (k,md) <- case md of
-                  Just (L loc trm) -> do (k,trm) <- refreshTermKN k trm
-                                         return (k,Just (L loc trm))
-                  Nothing          -> return (k,Nothing)
-      (k,mr) <- case mr of
-                  Just (L loc trm) -> do (k,trm) <- refreshTermKN k trm
-                                         return (k,Just (L loc trm))
-                  Nothing          -> return (k,Nothing)
-      return (k, (c, CncCat mt md mr mn mpmcfg):cs)
-    CncFun mt (Just (L loc trm)) mn mpmcfg -> do   ---- refresh pn
-      (k',trm') <- refreshTermKN k trm
-      return $ (k', (c, CncFun mt (Just (L loc trm')) mn mpmcfg):cs)
-    _ -> return (k, ci:cs)
-
-
--- running monad and returning to initial state
-
-inBlockSTM :: STM s a -> STM s a
-inBlockSTM mo = do
-  s <- readSTM
-  v <- mo
-  writeSTM s
-  return v
-
-
--}
\ No newline at end of file
diff --git a/src/compiler/GF/Compile/SubExOpt.hs b/src/compiler/GF/Compile/SubExOpt.hs
index 4c056f479..56e41d55c 100644
--- a/src/compiler/GF/Compile/SubExOpt.hs
+++ b/src/compiler/GF/Compile/SubExOpt.hs
@@ -24,29 +24,29 @@
 module GF.Compile.SubExOpt (subexpModule,unsubexpModule) where 
 
 import GF.Grammar.Grammar
-import GF.Grammar.Lookup
+import GF.Grammar.Lookup(lookupResDef)
 import GF.Infra.Ident
 import qualified GF.Grammar.Macros as C
-import GF.Data.Operations
+import GF.Data.ErrM(fromErr)
 
-import Control.Monad
+import Control.Monad.State.Strict(State,evalState,get,put)
 import Data.Map (Map)
 import qualified Data.Map as Map
 
 
-subexpModule :: SourceModule -> SourceModule
-subexpModule (n,mo) = errVal (n,mo) $ do
-  let ljs = tree2list (jments mo)
-  (tree,_) <- appSTM (getSubtermsMod n ljs) (Map.empty,0)
-  js2 <- liftM buildTree $ addSubexpConsts n tree $ ljs
-  return (n,mo{jments=js2})
+--subexpModule :: SourceModule -> SourceModule
+subexpModule (n,mo) =
+  let ljs = Map.toList (jments mo)
+      tree = evalState (getSubtermsMod n ljs) (Map.empty,0)
+      js2 = Map.fromList $ addSubexpConsts n tree $ ljs
+  in (n,mo{jments=js2})
 
-unsubexpModule :: SourceModule -> SourceModule
+--unsubexpModule :: SourceModule -> SourceModule
 unsubexpModule sm@(i,mo)
   | hasSub ljs = (i,mo{jments=rebuild (map unparInfo ljs)})
   | otherwise  = sm
   where
-    ljs = tree2list (jments mo) 
+    ljs = Map.toList (jments mo) 
 
     -- perform this iff the module has opers
     hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
@@ -57,33 +57,33 @@ unsubexpModule sm@(i,mo)
       _ -> [(c,info)]
     unparTerm t = case t of
       Q (m,c) | isOperIdent c -> --- name convention of subexp opers
-        errVal t $ liftM unparTerm $ lookupResDef gr (m,c)
+        fromErr t $ fmap unparTerm $ lookupResDef gr (m,c)
       _ -> C.composSafeOp unparTerm t
     gr = mGrammar [sm]
-    rebuild = buildTree . concat
+    rebuild = Map.fromList . concat
 
 -- implementation
 
 type TermList = Map Term (Int,Int) -- number of occs, id
-type TermM a = STM (TermList,Int) a
+type TermM a = State (TermList,Int) a
 
 addSubexpConsts :: 
-  Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)]
+  Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> [(Ident,Info)]
 addSubexpConsts mo tree lins = do
   let opers = [oper id trm | (trm,(_,id)) <- list]
-  mapM mkOne $ opers ++ lins
+  map mkOne $ opers ++ lins
  where
    mkOne (f,def) = case def of
-     CncFun xs (Just (L loc trm)) pn pf -> do
-       trm' <- recomp f trm
-       return (f,CncFun xs (Just (L loc trm')) pn pf)
-     ResOper ty (Just (L loc trm)) -> do
-       trm' <- recomp f trm
-       return (f,ResOper ty (Just (L loc trm')))
-     _ -> return (f,def)
+     CncFun xs (Just (L loc trm)) pn pf ->
+       let trm' = recomp f trm
+       in (f,CncFun xs (Just (L loc trm')) pn pf)
+     ResOper ty (Just (L loc trm)) ->
+       let trm' = recomp f trm
+       in (f,ResOper ty (Just (L loc trm')))
+     _ -> (f,def)
    recomp f t = case Map.lookup t tree of
-     Just (_,id) | operIdent id /= f -> return $ Q (mo, operIdent id)
-     _ -> C.composOp (recomp f) t
+     Just (_,id) | operIdent id /= f -> Q (mo, operIdent id)
+     _ -> C.composSafeOp (recomp f) t
 
    list = Map.toList tree
 
@@ -93,7 +93,7 @@ addSubexpConsts mo tree lins = do
 getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int))
 getSubtermsMod mo js = do
   mapM (getInfo (collectSubterms mo)) js
-  (tree0,_) <- readSTM
+  (tree0,_) <- get
   return $ Map.filter (\ (nu,_) -> nu > 1) tree0
  where
    getInfo get fi@(f,i) = case i of
@@ -123,12 +123,12 @@ collectSubterms mo t = case t of
  where
    collect = collectSubterms mo
    add t = do
-     (ts,i) <- readSTM
+     (ts,i) <- get
      let 
        ((count,id),next) = case Map.lookup t ts of
          Just (nu,id) -> ((nu+1,id), i)
          _ ->            ((1,   i ), i+1)
-     writeSTM (Map.insert t (count,id) ts, next)
+     put (Map.insert t (count,id) ts, next)
      return t --- only because of composOp
 
 operIdent :: Int -> Ident
diff --git a/src/compiler/GF/CompileInParallel.hs b/src/compiler/GF/CompileInParallel.hs
index e9047b4e7..b0a69019e 100644
--- a/src/compiler/GF/CompileInParallel.hs
+++ b/src/compiler/GF/CompileInParallel.hs
@@ -66,7 +66,7 @@ batchCompile1 lib_dir (opts,filepaths) =
      let rel = relativeTo lib_dir cwd
          prelude_dir = lib_dir</>"prelude"
          gfoDir = flag optGFODir opts
-     maybe (return ()) (D.createDirectoryIfMissing True) gfoDir
+     maybe done (D.createDirectoryIfMissing True) gfoDir
 {-
      liftIO $ writeFile (maybe "" id gfoDir</>"paths")
                         (unlines . map (unwords . map rel) . nub $ map snd filepaths)
@@ -213,14 +213,14 @@ instance (Functor m,Monad m) => Applicative (CollectOutput m) where
   (<*>) = ap
 
 instance Monad m => Monad (CollectOutput m) where
-  return x = CO (return (return (),x))
+  return x = CO (return (done,x))
   CO m >>= f = CO $ do (o1,x) <- m
                        let CO m2 = f x
                        (o2,y) <- m2
                        return (o1>>o2,y)
 instance MonadIO m => MonadIO (CollectOutput m) where
   liftIO io = CO $ do x <- liftIO io
-                      return (return (),x)
+                      return (done,x)
 
 instance Output m => Output (CollectOutput m) where
   ePutStr   s = CO (return (ePutStr s,()))
diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs
index 8c68f013a..17ef93935 100644
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -21,7 +21,7 @@ import GF.Grammar.Binary(decodeModule,encodeModule)
 import GF.Infra.Option
 import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,MonadIO(..),Output(..),putPointE)
 import GF.Infra.CheckM(runCheck')
-import GF.Data.Operations(ErrorMonad,liftErr,(+++))
+import GF.Data.Operations(ErrorMonad,liftErr,(+++),done)
 
 import GF.System.Directory(doesFileExist,getCurrentDirectory,renameFile)
 import qualified Data.Map as Map
@@ -62,7 +62,7 @@ reuseGFO opts srcgr file =
 
      if flag optTagsOnly opts
        then writeTags opts srcgr (gf2gftags opts file) sm1
-       else return ()
+       else done
 
      return (Just file,sm)
 
@@ -132,7 +132,7 @@ compileSourceModule opts cwd mb_gfFile gr =
            idump opts pass (dump out)
            return (ret out)
 
-    maybeM f = maybe (return ()) f
+    maybeM f = maybe done f
 
 
 --writeGFO :: Options -> FilePath -> SourceModule -> IOE ()
@@ -151,12 +151,12 @@ writeGFO opts file mo =
 --intermOut :: Options -> Dump -> Doc -> IOE ()
 intermOut opts d doc
   | dump opts d = ePutStrLn (render ("\n\n--#" <+> show d $$ doc))
-  | otherwise   = return ()
+  | otherwise   = done
 
 idump opts pass = intermOut opts (Dump pass) . ppModule Internal
 
 warnOut opts warnings
-  | null warnings = return ()
+  | null warnings = done
   | otherwise     = do ePutStr "\ESC[34m";ePutStr ws;ePutStrLn "\ESC[m"
   where
     ws = if flag optVerbosity opts == Normal
diff --git a/src/compiler/GF/Data/ErrM.hs b/src/compiler/GF/Data/ErrM.hs
index d687a70a5..033c1efac 100644
--- a/src/compiler/GF/Data/ErrM.hs
+++ b/src/compiler/GF/Data/ErrM.hs
@@ -12,15 +12,25 @@
 -- hack for BNFC generated files. AR 21/9/2003
 -----------------------------------------------------------------------------
 
-module GF.Data.ErrM (Err(..)) where
+module GF.Data.ErrM where
 
 import Control.Monad (MonadPlus(..),ap)
 import Control.Applicative
 
--- | like @Maybe@ type with error msgs
+-- | Like 'Maybe' type with error msgs
 data Err a = Ok a | Bad String
   deriving (Read, Show, Eq)
 
+-- | Analogue of 'maybe'
+err :: (String -> b) -> (a -> b) -> Err a -> b 
+err d f e = case e of
+  Ok a -> f a
+  Bad s -> d s
+
+-- | Analogue of 'fromMaybe'
+fromErr :: a -> Err a -> a
+fromErr a = err (const a) id
+
 instance Monad Err where
   return      = Ok
   fail        = Bad
diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs
index 69b089623..6d93fec92 100644
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -18,20 +18,20 @@ module GF.Data.Operations (-- ** Misc functions
 		   ifNull,
 
 		   -- ** The Error monad
-		   Err(..), err, maybeErr, testErr, errVal, errIn, 
+		   Err(..), err, maybeErr, testErr, fromErr, errIn, 
 		   lookupErr,
+
+                   --- ** Monadic operations on lists and pairs
 		   mapPairListM, mapPairsM, pairM,
-		   singleton, --mapsErr, mapsErrTree,
 		   
 		   -- ** Checking
 		   checkUnique, unifyMaybeBy, unifyMaybe,
 
 		   -- ** Binary search trees; now with FiniteMap
-		   BinTree, emptyBinTree, isInBinTree, justLookupTree,
+		   BinTree, emptyBinTree, isInBinTree, --justLookupTree,
 		   lookupTree, --lookupTreeMany,
                    lookupTreeManyAll, updateTree,
 		   buildTree, filterBinTree,
-		   --sorted2tree,
                    mapTree, --mapMTree,
                    tree2list,
  
@@ -43,7 +43,7 @@ module GF.Data.Operations (-- ** Misc functions
 		   numberedParagraphs, prConjList, prIfEmpty, wrapLines,
 
 		   -- ** Extra
-		   combinations,
+		   combinations, done, readIntArg, --singleton,
 
 		   -- ** Topological sorting with test of cyclicity
 		   topoTest, topoTest2,
@@ -52,13 +52,13 @@ module GF.Data.Operations (-- ** Misc functions
 		   iterFix,
 
 		   -- ** Chop into separator-separated parts
-		   chunks, readIntArg, 
-
+		   chunks,
+{-
 		   -- ** State monad with error; from Agda 6\/11\/2001
-		   STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM, done,
-
+		   STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM,
+-}
 		   -- ** Error monad class
-		   ErrorMonad(..), checkAgain, checks, allChecks, doUntil,
+		   ErrorMonad(..), checks, allChecks, doUntil, --checkAgain,
                    liftErr
                 
 		  ) where
@@ -67,8 +67,8 @@ import Data.Char (isSpace, toUpper, isSpace, isDigit)
 import Data.List (nub, partition, (\\))
 import qualified Data.Map as Map
 import Data.Map (Map)
-import Control.Applicative(Applicative(..))
-import Control.Monad (liftM,liftM2,ap)
+--import Control.Applicative(Applicative(..))
+import Control.Monad (liftM,liftM2) --,ap
 
 import GF.Data.ErrM
 import GF.Data.Relation
@@ -83,21 +83,12 @@ ifNull b f xs = if null xs then b else f xs
 
 -- the Error monad
 
--- | analogue of @maybe@
-err :: (String -> b) -> (a -> b) -> Err a -> b 
-err d f e = case e of
-  Ok a -> f a
-  Bad s -> d s
-
--- | add msg s to @Maybe@ failures
+-- | Add msg s to 'Maybe' failures
 maybeErr :: ErrorMonad m => String -> Maybe a -> m a
 maybeErr s = maybe (raise s) return
 
 testErr :: ErrorMonad m => Bool -> String -> m ()
-testErr cond msg = if cond then return () else raise msg
-
-errVal :: a -> Err a -> a
-errVal a = err (const a) id
+testErr cond msg = if cond then done else raise msg
 
 errIn :: ErrorMonad m => String -> m a -> m a
 errIn msg m = handle m (\s -> raise (s ++++ "OCCURRED IN" ++++ msg))
@@ -111,12 +102,9 @@ mapPairListM f xys = mapM (\ p@(x,_) -> liftM ((,) x) (f p)) xys
 mapPairsM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
 mapPairsM f xys = mapM (\ (x,y) -> liftM ((,) x) (f y)) xys
 
-pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c)
+pairM :: Monad m => (b -> m c) -> (b,b) -> m (c,c)
 pairM op (t1,t2) = liftM2 (,) (op t1) (op t2)
 
-singleton :: a -> [a]
-singleton = (:[])
-
 -- checking
 
 checkUnique :: (Show a, Eq a) => [a] -> [String]
@@ -144,21 +132,14 @@ emptyBinTree = Map.empty
 
 isInBinTree :: (Ord a) => a -> BinTree a b -> Bool
 isInBinTree = Map.member
-
-justLookupTree :: (Monad m,Ord a) => a -> BinTree a b -> m b
-justLookupTree = lookupTree (const [])
-
-lookupTree :: (Monad m,Ord a) => (a -> String) -> a -> BinTree a b -> m b
-lookupTree pr x tree = case Map.lookup x tree of
-  Just y -> return y
-  _ -> fail ("no occurrence of element" +++ pr x)
 {-
-lookupTreeMany :: Ord a => (a -> String) -> [BinTree a b] -> a -> Err b
-lookupTreeMany pr (t:ts) x = case lookupTree pr x t of
-  Ok v -> return v
-  _ -> lookupTreeMany pr ts x
-lookupTreeMany pr [] x = Bad $ "failed to find" +++ pr x
+justLookupTree :: (ErrorMonad m,Ord a) => a -> BinTree a b -> m b
+justLookupTree = lookupTree (const [])
 -}
+lookupTree :: (ErrorMonad m,Ord a) => (a -> String) -> a -> BinTree a b -> m b
+lookupTree pr x = maybeErr no . Map.lookup x
+  where no = "no occurrence of element" +++ pr x
+
 lookupTreeManyAll :: Ord a => (a -> String) -> [BinTree a b] -> a -> [b]
 lookupTreeManyAll pr (t:ts) x = case lookupTree pr x t of
   Ok v -> v : lookupTreeManyAll pr ts x
@@ -170,16 +151,10 @@ updateTree (a,b) = Map.insert a b
 
 buildTree :: (Ord a) => [(a,b)] -> BinTree a b
 buildTree = Map.fromList
-{-
-sorted2tree :: Ord a => [(a,b)] -> BinTree a b
-sorted2tree = Map.fromAscList
--}
+
 mapTree :: ((a,b) -> c) -> BinTree a b -> BinTree a c
 mapTree f = Map.mapWithKey (\k v -> f (k,v))
-{-
-mapMTree :: (Ord a,Monad m) => ((a,b) -> m c) -> BinTree a b -> m (BinTree a c)
-mapMTree f t = liftM Map.fromList $ sequence [liftM ((,) k) (f (k,x)) | (k,x) <- Map.toList t]
--}
+
 filterBinTree :: Ord a => (a -> b -> Bool) -> BinTree a b -> BinTree a b
 filterBinTree = Map.filterWithKey
 
@@ -269,13 +244,19 @@ wrapLines n s@(c:cs) =
 
 --- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
 
--- | 'combinations' is the same as @sequence@!!!
+-- | 'combinations' is the same as 'sequence'!!!
 -- peb 30\/5-04
 combinations :: [[a]] -> [[a]]
 combinations t = case t of 
   []    -> [[]]
   aa:uu -> [a:u | a <- aa, u <- combinations uu]
 
+{-
+-- | 'singleton' is the same as 'return'!!!
+singleton :: a -> [a]
+singleton = (:[])
+-}
+
 -- | topological sorting with test of cyclicity
 topoTest :: Ord a => [(a,[a])] -> Either [a] [[a]]
 topoTest = topologicalSort . mkRel'
@@ -315,7 +296,7 @@ chunks sep ws = case span (/= sep) ws of
 readIntArg :: String -> Int
 readIntArg n = if (not (null n) && all isDigit n) then read n else 0
 
-
+{-
 -- state monad with error; from Agda 6/11/2001
 
 newtype STM s a = STM (s -> Err (a,s)) 
@@ -350,7 +331,7 @@ updateSTM f = stmr (\s -> ((),f s))
 
 writeSTM :: s -> STM s ()
 writeSTM s = stmr (const ((),s))
-
+-}
 done :: Monad m => m ()
 done = return ()
 
@@ -366,28 +347,13 @@ instance ErrorMonad Err where
   handle (Bad i) f  = f i
 
 liftErr e = err raise return e
-
+{-
 instance ErrorMonad (STM s) where
   raise msg = STM (\s -> raise msg)
   handle (STM f) g = STM (\s -> (f s) 
                                 `handle` (\e -> let STM g' = (g e) in
                                                     g' s))
-{-
--- error recovery with multiple reporting AR 30/5/2008
-mapsErr :: (a -> Err b) -> [a] -> Err [b]
 
-mapsErr f = seqs . map f where
-  seqs es = case es of
-    Ok v : ms -> case seqs ms of
-      Ok vs -> return (v : vs)
-      b     -> b
-    Bad s : ms -> case seqs ms of
-      Ok vs  -> Bad s
-      Bad ss -> Bad (s +++++ ss)
-    [] -> return []
-
-mapsErrTree :: (Ord a) => ((a,b) -> Err (a,c)) -> BinTree a b -> Err (BinTree a c)
-mapsErrTree f t =  mapsErr f (tree2list t) >>= return . sorted2tree
 -}
 
 -- | if the first check fails try another one
diff --git a/src/compiler/GF/Grammar/Analyse.hs b/src/compiler/GF/Grammar/Analyse.hs
index 023b76ad3..adab6fcf5 100644
--- a/src/compiler/GF/Grammar/Analyse.hs
+++ b/src/compiler/GF/Grammar/Analyse.hs
@@ -46,7 +46,7 @@ constantDeps :: SourceGrammar -> QIdent -> Err [QIdent]
 constantDeps sgr f = return $ nub $ iterFix more start where
   start = constants f
   more  = concatMap constants
-  constants c = (c :) $ errVal [] $ do
+  constants c = (c :) $ fromErr [] $ do
     ts  <- termsOfConstant sgr c
     return $ concatMap constantsInTerm ts
 
diff --git a/src/compiler/GF/Grammar/Lookup.hs b/src/compiler/GF/Grammar/Lookup.hs
index da75267de..e5ead0f13 100644
--- a/src/compiler/GF/Grammar/Lookup.hs
+++ b/src/compiler/GF/Grammar/Lookup.hs
@@ -123,7 +123,7 @@ lookupOrigInfo gr (m,c) = do
     i           -> return (m,i)
 
 allOrigInfos :: SourceGrammar -> Ident -> [(QIdent,Info)]
-allOrigInfos gr m = errVal [] $ do
+allOrigInfos gr m = fromErr [] $ do
   mo <- lookupModule gr m
   return [((m,c),i) | (c,_) <- tree2list (jments mo), Ok (m,i) <- [lookupOrigInfo gr (m,c)]]
 
diff --git a/src/compiler/GF/Grammar/MMacros.hs b/src/compiler/GF/Grammar/MMacros.hs
index 66d8a857f..30271a2d5 100644
--- a/src/compiler/GF/Grammar/MMacros.hs
+++ b/src/compiler/GF/Grammar/MMacros.hs
@@ -151,7 +151,7 @@ substTerm ss g c = case c of
   _           -> c
 
 metaSubstExp :: MetaSubst -> [(MetaId,Exp)]
-metaSubstExp msubst = [(m, errVal (meta2exp m) (val2expSafe v)) | (m,v) <- msubst]
+metaSubstExp msubst = [(m, fromErr (meta2exp m) (val2expSafe v)) | (m,v) <- msubst]
 
 -- ** belong here rather than to computation
 
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index f5ddb7ae0..66ef50ce9 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -91,7 +91,7 @@ isRecursiveType t =
   in any (== c) cc
 
 isHigherOrderType :: Type -> Bool
-isHigherOrderType t = errVal True $ do  -- pessimistic choice
+isHigherOrderType t = fromErr True $ do  -- pessimistic choice
   co <- contextOfType t
   return $ not $ null [x | (_,x,Prod _ _ _ _) <- co]
 
diff --git a/src/compiler/GF/Infra/Ident.hs b/src/compiler/GF/Infra/Ident.hs
index 3c5402985..71e86fb37 100644
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -138,70 +138,3 @@ wild = Id (pack "_")
 varIndex :: Ident -> Int
 varIndex (IV _ n) = n
 varIndex _ = -1 --- other than IV should not count
-
-{-
--- * Refreshing identifiers
-
-type IdState = ([(Ident,Ident)],Int) 
-
-initIdStateN :: Int -> IdState
-initIdStateN i = ([],i)
-
-initIdState :: IdState
-initIdState = initIdStateN 0
-
-lookVar :: Ident -> STM IdState Ident
-lookVar a@(IA _ _) = return a
-lookVar x = do
-  (sys,_) <- readSTM
-  stm (\s -> maybe (Bad ("cannot find" +++ show x +++ prParenth (show sys))) 
-                   return $ 
-             lookup x sys >>= (\y -> return (y,s)))
-
-refVar :: Ident -> STM IdState Ident
-----refVar IW = return IW --- no update of wildcard
-refVar x = do
-  (_,m) <- readSTM
-  let x' = IV (ident2raw x) m
-  updateSTM (\(sys,mx) -> ((x, x'):sys, mx + 1))
-  return x'
-
-refVarPlus :: Ident -> STM IdState Ident
-----refVarPlus IW = refVar (identC "h")
-refVarPlus x = refVar x
--}
-
-{-
-------------------------------
--- to test
-
-refreshExp :: Exp -> Err Exp
-refreshExp e = err Bad (return . fst) (appSTM (refresh e) initState)
-
-refresh :: Exp -> STM State Exp
-refresh e = case e of
-  Atom x  -> lookVar x >>= return . Atom
-  App f a -> liftM2 App (refresh f) (refresh a)
-  Abs x b -> liftM2 Abs (refVar x)  (refresh b)
-  Fun xs a b -> do
-    a'  <- refresh a
-    xs' <- mapM refVar xs
-    b'  <- refresh b
-    return $ Fun xs' a' b'
-
-data Exp =
-   Atom Ident
- | App Exp Exp
- | Abs Ident Exp
- | Fun [Ident] Exp Exp
-  deriving Show
-
-exp1 = Abs (IC "y") (Atom (IC "y"))
-exp2 = Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "y")))
-exp3 = Abs (IC "y") (Abs (IC "z") (App (Atom (IC "y")) (Atom (IC "z"))))
-exp4 = Abs (IC "y") (Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "z"))))
-exp5 = Abs (IC "y") (Abs (IC "y") (App (Atom (IC "y")) (Atom (IC "y"))))
-exp6 = Abs (IC "y") (Fun [IC "x", IC "y"] (Atom (IC "y")) (Atom (IC "y")))
-exp7 = Abs (IL "8") (Atom (IC "y"))
-
--}
diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs
index 18bee2e49..2af5b092b 100644
--- a/src/compiler/GF/Interactive.hs
+++ b/src/compiler/GF/Interactive.hs
@@ -8,7 +8,7 @@ import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,emptyCommandE
 import GF.Command.Commands(flags,options)
 import GF.Command.Abstract
 import GF.Command.Parse(readCommandLine,pCommand)
-import GF.Data.Operations (Err(..),chunks,err,raise)
+import GF.Data.Operations (Err(..),chunks,err,raise,done)
 import GF.Grammar hiding (Ident,isPrefixOf)
 import GF.Grammar.Analyse
 import GF.Grammar.Parser (runP, pExp)
@@ -83,7 +83,7 @@ mainServerGFI opts files =
 
 -- | Read end execute commands until it is time to quit
 loop :: Options -> GFEnv -> IO ()
-loop opts gfenv = maybe (return ()) (loop opts) =<< readAndExecute1 opts gfenv
+loop opts gfenv = maybe done (loop opts) =<< readAndExecute1 opts gfenv
 
 -- | Read and execute one command, returning Just an updated environment for
 -- | the next command, or Nothing when it is time to quit
@@ -363,7 +363,7 @@ importInEnv gfenv opts files
            pgf1 <- importGrammar pgf0 opts' files
            if (verbAtLeast opts Normal)
              then putStrLnFlush $ unwords $ "\nLanguages:" : map showCId (languages pgf1)
-             else return ()
+             else done
            return $ gfenv { commandenv = mkCommandEnv pgf1 }
 
 tryGetLine = do