diff --git a/GF.cabal b/GF.cabal
index 656f900c5..2137f2113 100644
--- a/GF.cabal
+++ b/GF.cabal
@@ -139,7 +139,6 @@ executable gf
     GF.Compile.Update
     GF.Compile.CheckGrammar
     GF.Compile.Refresh
-    GF.Compile.BackOpt
     GF.Compile.Rename
     GF.Compile.ReadFiles
     GF.Compile.GrammarToGFCC
@@ -150,7 +149,7 @@ executable gf
     GF.Compile.Abstract.TypeCheck
     GF.Compile.Abstract.Compute
     GF.Compile.Optimize
-    GF.Compile.OptimizeGF
+    GF.Compile.SubExOpt
     GF.Compile.OptimizeGFCC
     GF.Compile.ModDeps
     GF.Compile.GetGrammar
diff --git a/src/GF/Compile.hs b/src/GF/Compile.hs
index 33f5e44ea..e0c60178e 100644
--- a/src/GF/Compile.hs
+++ b/src/GF/Compile.hs
@@ -5,7 +5,7 @@ import GF.Compile.GetGrammar
 import GF.Compile.Rename
 import GF.Compile.CheckGrammar
 import GF.Compile.Optimize
-import GF.Compile.OptimizeGF
+import GF.Compile.SubExOpt
 import GF.Compile.OptimizeGFCC
 import GF.Compile.GrammarToGFCC
 import GF.Compile.ReadFiles
@@ -183,10 +183,8 @@ compileOne opts env@(_,srcgr,_) file = do
        intermOut opts DumpSource (ppModule Qualified sm0)
 
        (k',sm)  <- compileSourceModule opts env sm0
-       let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str
-       cm  <- putPointE Verbose opts "  generating code... " $ generateModuleCode opts gfo sm1
-          -- sm is optimized before generation, but not in the env
-       extendCompileEnvInt env k' (Just gfo) sm1
+       putPointE Verbose opts "  generating code... " $ generateModuleCode opts gfo sm
+       extendCompileEnvInt env k' (Just gfo) sm
   where
    isConcr (_,m) = isModCnc m && mstatus m /= MSIncomplete
 
diff --git a/src/GF/Compile/BackOpt.hs b/src/GF/Compile/BackOpt.hs
deleted file mode 100644
index 70dbcc9ba..000000000
--- a/src/GF/Compile/BackOpt.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : BackOpt
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:21:33 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.6 $
---
--- Optimizations on GF source code: sharing, parametrization, value sets.
---
--- optimization: sharing branches in tables. AR 25\/4\/2003.
--- following advice of Josef Svenningsson
------------------------------------------------------------------------------
-
-module GF.Compile.BackOpt (shareModule) where
-
-import GF.Grammar.Grammar
-import GF.Infra.Ident
-import GF.Infra.Option
-import qualified GF.Grammar.Macros as C
-import GF.Data.Operations
-import Data.List
-import qualified GF.Infra.Modules as M
-import qualified Data.ByteString.Char8 as BS
-
-import Data.Set (Set)
-import qualified Data.Set as Set
-
-shareModule :: Options -> SourceModule -> SourceModule
-shareModule opts (i,mo) = (i,M.replaceJudgements mo (mapTree (shareInfo optim) (M.jments mo)))
-  where
-    optim = flag optOptimizations opts
-
-type OptSpec = Set Optimization
-
-shareInfo :: OptSpec -> (Ident, Info) -> Info
-shareInfo opt (c, CncCat ty (Just t) m) = CncCat ty (Just (shareOptim opt c t)) m
-shareInfo opt (c, CncFun kxs (Just t) m) = CncFun kxs (Just (shareOptim opt c t)) m
-shareInfo opt (c, ResOper ty (Just t)) = ResOper ty (Just (shareOptim opt c t))
-shareInfo _ (_,i) = i
-
--- the function putting together optimizations
-shareOptim :: OptSpec -> Ident -> Term -> Term
-shareOptim opt c =   (if OptValues      `Set.member` opt then values     else id)
-                   . (if OptParametrize `Set.member` opt then factor c 0 else id)
-
--- do even more: factor parametric branches
-
-factor :: Ident -> Int -> Term -> Term
-factor c i t = case t of
-  T _ [_] -> t
-  T _ []  -> t
-  T (TComp ty) cs -> 
-    T (TTyped ty) $ factors i [(p, factor c (i+1) v) | (p, v) <- cs]
-  _ -> C.composSafeOp (factor c i) t
- where
-
-   factors i psvs =   -- we know psvs has at least 2 elements
-     let p   = qqIdent c i
-         vs' = map (mkFun p) psvs
-     in if   allEqs vs'
-        then mkCase p vs' 
-        else psvs
-
-   mkFun p (patt, val) = replace (C.patt2term patt) (Vr p) val
-
-   allEqs (v:vs) = all (==v) vs
-
-   mkCase p (v:_) = [(PV p, v)]
-
---- we hope this will be fresh and don't check... in GFC would be safe
-
-qqIdent c i = identC (BS.pack ("q_" ++ showIdent c ++ "__" ++ show i))
-
-
---  we need to replace subterms
-
-replace :: Term -> Term -> Term -> Term
-replace old new trm = case trm of
-  
-  -- these are the important cases, since they can correspond to patterns  
-  QC _ _   | trm == old -> new
-  App t ts | trm == old -> new
-  App t ts              -> App (repl t) (repl ts)
-  R _ | isRec && trm == old -> new
-  _ -> C.composSafeOp repl trm
- where
-   repl = replace old new
-   isRec = case trm of
-     R _ -> True
-     _ -> False
-
--- It is very important that this is performed only after case
--- expansion since otherwise the order and number of values can
--- be incorrect. Guaranteed by the TComp flag.
-
-values :: Term -> Term
-values t = case t of
-  T ty [(ps,t)]   -> T ty [(ps,values t)] -- don't destroy parametrization
-  T (TComp ty) cs -> V ty [values t | (_, t) <- cs]
-  _ -> C.composSafeOp values t
diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs
index a022d4f43..fb92ef74c 100644
--- a/src/GF/Compile/GrammarToGFCC.hs
+++ b/src/GF/Compile/GrammarToGFCC.hs
@@ -2,7 +2,6 @@
 module GF.Compile.GrammarToGFCC (mkCanon2gfcc,addParsers) where
 
 import GF.Compile.Export
-import GF.Compile.OptimizeGF (unshareModule)
 import qualified GF.Compile.GenerateFCFG  as FCFG
 import qualified GF.Compile.GeneratePMCFG as PMCFG
 
@@ -298,8 +297,8 @@ canon2canon opts abs cg0 =
   j2j cg (f,j) = 
     let debug = if verbAtLeast opts Verbose then trace ("+ " ++ showIdent f) else id in
     case j of
-      CncFun x (Just tr) z -> CncFun x (Just (debug (t2t tr))) z
-      CncCat (Just ty) (Just x) y -> CncCat (Just (ty2ty ty)) (Just (t2t x)) y
+      CncFun x (Just tr) z -> CncFun x (Just (debug (t2t (unfactor cg0 tr)))) z
+      CncCat (Just ty) (Just x) y -> CncCat (Just (ty2ty ty)) (Just (t2t (unfactor cg0 x))) y
       _ -> j
    where
       cg1 = cg
@@ -307,6 +306,17 @@ canon2canon opts abs cg0 =
       ty2ty = type2type cg1 pv
       pv@(labels,untyps,typs) = trs $ paramValues cg1
 
+      unfactor :: SourceGrammar -> Term -> Term
+      unfactor gr t = case t of
+        T (TTyped ty) [(PV x,u)] -> V ty [restore x v (unfac u) | v <- vals ty]
+        _ -> GM.composSafeOp unfac t
+       where
+         unfac = unfactor gr
+         vals  = err error id . Look.allParamValues gr
+         restore x u t = case t of
+           Vr y | y == x -> u
+           _ -> GM.composSafeOp (restore x u) t
+
     -- flatten record arguments of param constructors
   p2p (f,j) = case j of
       ResParam (Just ps) (Just vs) -> 
@@ -334,7 +344,7 @@ canon2canon opts abs cg0 =
 
 purgeGrammar :: Ident -> SourceGrammar -> SourceGrammar
 purgeGrammar abstr gr = 
-  (M.MGrammar . list . map unopt . filter complete . purge . M.modules) gr 
+  (M.MGrammar . list . filter complete . purge . M.modules) gr 
  where
   list ms = traceD (render (text "MODULES" <+> hsep (punctuate comma (map (ppIdent . fst) ms)))) ms
   purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
@@ -342,7 +352,6 @@ purgeGrammar abstr gr =
   acncs = abstr : M.allConcretes gr abstr
   isSingle = True
   complete (i,m) = M.isCompleteModule m --- not . isIncompleteCanon
-  unopt = unshareModule gr -- subexp elim undone when compiled
 
 type ParamEnv =
   (Map.Map (Ident,[Label]) (Type,Integer), -- numbered labels
diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs
index ed7384e89..2c556b36f 100644
--- a/src/GF/Compile/Optimize.hs
+++ b/src/GF/Compile/Optimize.hs
@@ -24,7 +24,6 @@ import GF.Grammar.Lookup
 import GF.Grammar.Predef
 import GF.Compile.Refresh
 import GF.Compile.Concrete.Compute
-import GF.Compile.BackOpt
 import GF.Compile.CheckGrammar
 import GF.Compile.Update
 
@@ -37,6 +36,7 @@ import Data.List
 import qualified Data.Set as Set
 import Text.PrettyPrint
 import Debug.Trace
+import qualified Data.ByteString.Char8 as BS
 
 
 -- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
@@ -46,7 +46,7 @@ optimizeModule opts ms m@(name,mi)
   | mstatus mi == MSComplete = do
       ids <- topoSortJments m
       mi <- foldM updateEvalInfo mi ids
-      return (shareModule oopts (name,mi))
+      return (name,mi)
   | otherwise = return m
  where
    oopts = opts `addOptions` flagsModule m
@@ -64,10 +64,13 @@ evalInfo opts ms m c info = do
 
   CncCat ptyp pde ppr -> do
     pde' <- case (ptyp,pde) of
-      (Just typ, Just de) -> 
-        liftM Just $ partEval opts gr ([(Explicit, varStr, typeStr)], typ) de
-      (Just typ, Nothing) -> 
-        liftM Just $ mkLinDefault gr typ >>= partEval noOptions gr ([(Explicit, varStr, typeStr)],typ)
+      (Just typ, Just de) -> do
+        de <- partEval opts gr ([(Explicit, varStr, typeStr)], typ) de
+        return (Just (factor param c 0 de))
+      (Just typ, Nothing) -> do
+        de <- mkLinDefault gr typ
+        de <- partEval opts gr ([(Explicit, varStr, typeStr)], typ) de
+        return (Just (factor param c 0 de))
       _ -> return pde   -- indirection
 
     ppr' <- liftM Just $ evalPrintname gr c ppr (Just $ K $ showIdent c)
@@ -77,7 +80,8 @@ evalInfo opts ms m c info = do
   CncFun (mt@(Just (_,cont,val))) pde ppr -> --trace (prt c) $
        eIn (text "linearization in type" <+> ppTerm Unqualified 0 (mkProd cont val []) $$ text "of function") $ do
     pde' <- case pde of
-      Just de -> liftM Just $ partEval opts gr (cont,val) de
+      Just de -> do de <- partEval opts gr (cont,val) de
+                    return (Just (factor param c 0 de))
       Nothing -> return pde
     ppr' <-  liftM Just $ evalPrintname gr c ppr pde'
     return $ CncFun mt pde' ppr' -- only cat in type actually needed
@@ -85,7 +89,8 @@ evalInfo opts ms m c info = do
   ResOper pty pde 
     | OptExpand `Set.member` optim -> do
          pde' <- case pde of
-                   Just de -> liftM Just $ computeConcrete gr de 
+                   Just de -> do de <- computeConcrete gr de
+                                 return (Just (factor param c 0 de))
                    Nothing -> return Nothing
          return $ ResOper pty pde'
 
@@ -93,6 +98,7 @@ evalInfo opts ms m c info = do
  where
    gr = MGrammar (m : ms)
    optim = flag optOptimizations opts
+   param = OptParametrize `Set.member` optim
    eIn cat = errIn (render (text "Error optimizing" <+> cat <+> ppIdent c <+> colon))
 
 -- | the main function for compiling linearizations
@@ -132,17 +138,13 @@ recordExpand typ trm = case typ of
 -- | auxiliaries for compiling the resource
 
 mkLinDefault :: SourceGrammar -> Type -> Err Term
-mkLinDefault gr typ = do
-  case typ of
-    RecType lts -> mapPairsM mkDefField lts >>= (return . Abs Explicit varStr . R . mkAssign)
-    _ -> liftM (Abs Explicit varStr) $ mkDefField typ
-----    _ -> prtBad "linearization type must be a record type, not" typ
+mkLinDefault gr typ = liftM (Abs Explicit varStr) $ mkDefField typ
  where
    mkDefField typ = case typ of
      Table p t  -> do
        t' <- mkDefField t
        let T _ cs = mkWildCases t'
-       return $ T (TWild p) cs 
+       return $ T (TWild p) cs
      Sort s | s == cStr -> return $ Vr varStr
      QC q p             -> do vs <- lookupParamValues gr q p
                               case vs of
@@ -150,8 +152,8 @@ mkLinDefault gr typ = do
                                 _   -> Bad (render (text "no parameter values given to type" <+> ppIdent p))
      RecType r  -> do
        let (ls,ts) = unzip r
-       ts' <- mapM mkDefField ts
-       return $ R $ [assign l t | (l,t) <- zip ls ts']
+       ts <- mapM mkDefField ts
+       return $ R (zipWith assign ls ts)
      _ | Just _ <- isTypeInts typ -> return $ EInt 0 -- exists in all as first val
      _ -> Bad (render (text "linearization type field cannot be" <+> ppTerm Unqualified 0 typ))
 
@@ -188,3 +190,39 @@ evalPrintname gr c ppr lin =
      c:cs -> c: clean cs
      _ -> s
 
+
+-- do even more: factor parametric branches
+
+factor :: Bool -> Ident -> Int -> Term -> Term
+factor param c i t =
+  case t of
+    T (TComp ty) cs -> factors ty [(p, factor param c (i+1) v) | (p, v) <- cs]
+    _               -> composSafeOp (factor param c i) t
+  where
+    factors ty pvs0  
+                 | not param = V ty (map snd pvs0)
+    factors ty []            = V ty []
+    factors ty pvs0@[(p,v)]  = V ty [v]
+    factors ty pvs0@(pv:pvs) =
+      let t  = mkFun pv
+          ts = map mkFun pvs
+      in if all (==t) ts
+           then T (TTyped ty) (mkCases t)
+           else V ty (map snd pvs0)
+
+    --- we hope this will be fresh and don't check... in GFC would be safe
+    qvar = identC (BS.pack ("q_" ++ showIdent c ++ "__" ++ show i))
+
+    mkFun (patt, val) = replace (patt2term patt) (Vr qvar) val
+    mkCases t = [(PV qvar, t)]
+
+--  we need to replace subterms
+replace :: Term -> Term -> Term -> Term
+replace old new trm =
+  case trm of
+    -- these are the important cases, since they can correspond to patterns  
+    QC _ _   | trm == old -> new
+    App _ _  | trm == old -> new
+    R _      | trm == old -> new
+    App x y               -> App (replace old new x) (replace old new y)
+    _                     -> composSafeOp (replace old new) trm
diff --git a/src/GF/Compile/OptimizeGF.hs b/src/GF/Compile/OptimizeGF.hs
deleted file mode 100644
index d68ede00b..000000000
--- a/src/GF/Compile/OptimizeGF.hs
+++ /dev/null
@@ -1,270 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : OptimizeGF
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:21:33 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.6 $
---
--- Optimizations on GF source code: sharing, parametrization, value sets.
---
--- optimization: sharing branches in tables. AR 25\/4\/2003.
--- following advice of Josef Svenningsson
------------------------------------------------------------------------------
-
-module GF.Compile.OptimizeGF (
-  optModule,unshareModule,unsubexpModule,unoptModule,subexpModule,shareModule
-  ) where 
-
-import GF.Grammar.Grammar
-import GF.Grammar.Lookup
-import GF.Infra.Ident
-import qualified GF.Grammar.Macros as C
-import qualified GF.Infra.Modules as M
-import GF.Data.Operations
-
-import Control.Monad
-import Data.Map (Map)
-import qualified Data.Map as Map
-import qualified Data.ByteString.Char8 as BS
-import Data.List
-
-optModule :: SourceModule -> SourceModule
-optModule = subexpModule . shareModule
-
-shareModule = processModule optim
-
-unoptModule :: SourceGrammar -> SourceModule -> SourceModule
-unoptModule gr = unshareModule gr . unsubexpModule
-
-unshareModule :: SourceGrammar -> SourceModule -> SourceModule
-unshareModule gr = processModule (const (unoptim gr))
-
-processModule :: (Ident -> Term -> Term) -> SourceModule -> SourceModule
-processModule opt (i,mo) = (i,M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo)))
-
-shareInfo :: (Ident -> Term -> Term) -> (Ident,Info) -> Info
-shareInfo opt (c, CncCat ty (Just t) m) = CncCat ty (Just (opt c t)) m
-shareInfo opt (c, CncFun kxs (Just t) m) = CncFun kxs (Just (opt c t)) m
-shareInfo opt (c, ResOper ty (Just t)) = ResOper ty (Just (opt c t))
-shareInfo _ (_,i) = i
-
--- the function putting together optimizations
-optim :: Ident -> Term -> Term
-optim c = values . factor c 0
-
--- we need no counter to create new variable names, since variables are 
--- local to tables (only true in GFC) ---
-
--- factor parametric branches
-
-factor :: Ident -> Int -> Term -> Term
-factor c i t = case t of
-  T _ [_] -> t
-  T _ []  -> t
-  T (TComp ty) cs -> 
-    T (TTyped ty) $ factors i [(p, factor c (i+1) v) | (p, v) <- cs]
-  _ -> C.composSafeOp (factor c i) t
- where
-
-   factors i psvs =   -- we know psvs has at least 2 elements
-     let p   = qqIdent c i
-         vs' = map (mkFun p) psvs
-     in if   allEqs vs'
-        then mkCase p vs' 
-        else psvs
-
-   mkFun p (patt, val) = replace (C.patt2term patt) (Vr p) val
-
-   allEqs (v:vs) = all (==v) vs
-
-   mkCase p (v:_) = [(PV p, v)]
-
---- we hope this will be fresh and don't check... in GFC would be safe
-
-qqIdent c i = identC (BS.pack ("q_" ++ showIdent c ++ "__" ++ show i))
-
-
---  we need to replace subterms
-
-replace :: Term -> Term -> Term -> Term
-replace old new trm = case trm of
-  
-  -- these are the important cases, since they can correspond to patterns  
-  QC _ _   | trm == old -> new
-  App t ts | trm == old -> new
-  App t ts              -> App (repl t) (repl ts)
-  R _ | isRec && trm == old -> new
-  _ -> C.composSafeOp repl trm
- where
-   repl = replace old new
-   isRec = case trm of
-     R _ -> True
-     _ -> False
-
--- It is very important that this is performed only after case
--- expansion since otherwise the order and number of values can
--- be incorrect. Guaranteed by the TComp flag.
-
-values :: Term -> Term
-values t = case t of
-  T ty [(ps,t)]    -> T ty [(ps,values t)] -- don't destroy parametrization
-  T (TComp ty)  cs -> V ty [values t | (_, t) <- cs]
-  T (TTyped ty) cs -> V ty [values t | (_, t) <- cs] 
-        ---- why are these left?
-        ---- printing with GrammarToSource does not preserve the distinction
-  _ -> C.composSafeOp values t
-
-
--- to undo the effect of factorization
-
-unoptim :: SourceGrammar -> Term -> Term
-unoptim gr = unfactor gr
-
-unfactor :: SourceGrammar -> Term -> Term
-unfactor gr t = case t of
-  T (TTyped ty) [(PV x,u)] -> V ty [restore x v (unfac u) | v <- vals ty]
-  _ -> C.composSafeOp unfac t
- where
-   unfac = unfactor gr
-   vals  = err error id . allParamValues gr
-   restore x u t = case t of
-     Vr y | y == x -> u
-     _ -> C.composSafeOp (restore x u) t
-
-
-----------------------------------------------------------------------
-
-{-
-This module implements a simple common subexpression elimination
- for gfc grammars, to factor out shared subterms in lin rules.
-It works in three phases: 
-
-  (1) collectSubterms collects recursively all subterms of forms table and (P x..y)
-      from lin definitions (experience shows that only these forms
-      tend to get shared) and counts how many times they occur
-  (2) addSubexpConsts takes those subterms t that occur more than once
-      and creates definitions of form "oper A''n = t" where n is a
-      fresh number; notice that we assume no ids of this form are in
-      scope otherwise
-  (3) elimSubtermsMod goes through lins and the created opers by replacing largest
-      possible subterms by the newly created identifiers
-
-The optimization is invoked in gf by the flag i -subs.
-
-If an application does not support GFC opers, the effect of this
-optimization can be undone by the function unSubelimCanon.
-
-The function unSubelimCanon can be used to diagnostisize how much
-cse is possible in the grammar. It is used by the flag pg -printer=subs.
-
--}
-
-subexpModule :: SourceModule -> SourceModule
-subexpModule (n,mo) = errVal (n,mo) $ do
-  let ljs = tree2list (M.jments mo)
-  (tree,_) <- appSTM (getSubtermsMod n ljs) (Map.empty,0)
-  js2 <- liftM buildTree $ addSubexpConsts n tree $ ljs
-  return (n,M.replaceJudgements mo js2)
-
-unsubexpModule :: SourceModule -> SourceModule
-unsubexpModule sm@(i,mo)
-  | hasSub ljs = (i,M.replaceJudgements mo (rebuild (map unparInfo ljs)))
-  | otherwise  = sm
-  where
-    ljs = tree2list (M.jments mo) 
-
-    -- perform this iff the module has opers
-    hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
-    unparInfo (c,info) = case info of
-      CncFun xs (Just t) m -> [(c, CncFun xs (Just (unparTerm t)) m)]
-      ResOper (Just (EInt 8)) _ -> [] -- subexp-generated opers
-      ResOper pty (Just t) -> [(c, ResOper pty (Just (unparTerm t)))]
-      _ -> [(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 
-      _ -> C.composSafeOp unparTerm t
-    gr = M.MGrammar [sm] 
-    rebuild = buildTree . concat
-
--- implementation
-
-type TermList = Map Term (Int,Int) -- number of occs, id
-type TermM a = STM (TermList,Int) a
-
-addSubexpConsts :: 
-  Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)]
-addSubexpConsts mo tree lins = do
-  let opers = [oper id trm | (trm,(_,id)) <- list]
-  mapM mkOne $ opers ++ lins
- where
-
-   mkOne (f,def) = case def of
-     CncFun xs (Just trm) pn -> do
-       trm' <- recomp f trm
-       return (f,CncFun xs (Just trm') pn)
-     ResOper ty (Just trm) -> do
-       trm' <- recomp f trm
-       return (f,ResOper ty (Just trm'))
-     _ -> return (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
-
-   list = Map.toList tree
-
-   oper id trm = (operIdent id, ResOper (Just (EInt 8)) (Just trm)) 
-   --- impossible type encoding generated opers
-
-getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int))
-getSubtermsMod mo js = do
-  mapM (getInfo (collectSubterms mo)) js
-  (tree0,_) <- readSTM
-  return $ Map.filter (\ (nu,_) -> nu > 1) tree0
- where
-   getInfo get fi@(f,i) = case i of
-     CncFun xs (Just trm) pn -> do
-       get trm
-       return $ fi
-     ResOper ty (Just trm) -> do
-       get trm
-       return $ fi
-     _ -> return fi
-
-collectSubterms :: Ident -> Term -> TermM Term
-collectSubterms mo t = case t of
-  App f a -> do
-    collect f
-    collect a
-    add t 
-  T ty cs -> do
-    let (_,ts) = unzip cs
-    mapM collect ts
-    add t
-  V ty ts -> do
-    mapM collect ts
-    add t
-----  K (KP _ _)  -> add t
-  _ -> C.composOp (collectSubterms mo) t
- where
-   collect = collectSubterms mo
-   add t = do
-     (ts,i) <- readSTM
-     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)
-     return t --- only because of composOp
-
-operIdent :: Int -> Ident
-operIdent i = identC (operPrefix `BS.append` (BS.pack (show i))) ---
-
-isOperIdent :: Ident -> Bool
-isOperIdent id = BS.isPrefixOf operPrefix (ident2bs id)
-
-operPrefix = BS.pack ("A''")
diff --git a/src/GF/Compile/SubExOpt.hs b/src/GF/Compile/SubExOpt.hs
new file mode 100644
index 000000000..c7dbb5d3d
--- /dev/null
+++ b/src/GF/Compile/SubExOpt.hs
@@ -0,0 +1,142 @@
+----------------------------------------------------------------------
+-- |
+-- Module      : SubExOpt
+-- Maintainer  : AR
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- This module implements a simple common subexpression elimination
+-- for .gfo grammars, to factor out shared subterms in lin rules.
+-- It works in three phases: 
+-- 
+--   (1) collectSubterms collects recursively all subterms of forms table and (P x..y)
+--       from lin definitions (experience shows that only these forms
+--       tend to get shared) and counts how many times they occur
+--   (2) addSubexpConsts takes those subterms t that occur more than once
+--       and creates definitions of form "oper A''n = t" where n is a
+--       fresh number; notice that we assume no ids of this form are in
+--       scope otherwise
+--   (3) elimSubtermsMod goes through lins and the created opers by replacing largest
+--       possible subterms by the newly created identifiers
+-- 
+-----------------------------------------------------------------------------
+
+module GF.Compile.SubExOpt (subexpModule,unsubexpModule) where 
+
+import GF.Grammar.Grammar
+import GF.Grammar.Lookup
+import GF.Infra.Ident
+import qualified GF.Grammar.Macros as C
+import qualified GF.Infra.Modules as M
+import GF.Data.Operations
+
+import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.ByteString.Char8 as BS
+import Data.List
+
+subexpModule :: SourceModule -> SourceModule
+subexpModule (n,mo) = errVal (n,mo) $ do
+  let ljs = tree2list (M.jments mo)
+  (tree,_) <- appSTM (getSubtermsMod n ljs) (Map.empty,0)
+  js2 <- liftM buildTree $ addSubexpConsts n tree $ ljs
+  return (n,M.replaceJudgements mo js2)
+
+unsubexpModule :: SourceModule -> SourceModule
+unsubexpModule sm@(i,mo)
+  | hasSub ljs = (i,M.replaceJudgements mo (rebuild (map unparInfo ljs)))
+  | otherwise  = sm
+  where
+    ljs = tree2list (M.jments mo) 
+
+    -- perform this iff the module has opers
+    hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
+    unparInfo (c,info) = case info of
+      CncFun xs (Just t) m -> [(c, CncFun xs (Just (unparTerm t)) m)]
+      ResOper (Just (EInt 8)) _ -> [] -- subexp-generated opers
+      ResOper pty (Just t) -> [(c, ResOper pty (Just (unparTerm t)))]
+      _ -> [(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 
+      _ -> C.composSafeOp unparTerm t
+    gr = M.MGrammar [sm] 
+    rebuild = buildTree . concat
+
+-- implementation
+
+type TermList = Map Term (Int,Int) -- number of occs, id
+type TermM a = STM (TermList,Int) a
+
+addSubexpConsts :: 
+  Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> Err [(Ident,Info)]
+addSubexpConsts mo tree lins = do
+  let opers = [oper id trm | (trm,(_,id)) <- list]
+  mapM mkOne $ opers ++ lins
+ where
+   mkOne (f,def) = case def of
+     CncFun xs (Just trm) pn -> do
+       trm' <- recomp f trm
+       return (f,CncFun xs (Just trm') pn)
+     ResOper ty (Just trm) -> do
+       trm' <- recomp f trm
+       return (f,ResOper ty (Just trm'))
+     _ -> return (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
+
+   list = Map.toList tree
+
+   oper id trm = (operIdent id, ResOper (Just (EInt 8)) (Just trm)) 
+   --- impossible type encoding generated opers
+
+getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int))
+getSubtermsMod mo js = do
+  mapM (getInfo (collectSubterms mo)) js
+  (tree0,_) <- readSTM
+  return $ Map.filter (\ (nu,_) -> nu > 1) tree0
+ where
+   getInfo get fi@(f,i) = case i of
+     CncFun xs (Just trm) pn -> do
+       get trm
+       return $ fi
+     ResOper ty (Just trm) -> do
+       get trm
+       return $ fi
+     _ -> return fi
+
+collectSubterms :: Ident -> Term -> TermM Term
+collectSubterms mo t = case t of
+  App f a -> do
+    collect f
+    collect a
+    add t 
+  T ty cs -> do
+    let (_,ts) = unzip cs
+    mapM collect ts
+    add t
+  V ty ts -> do
+    mapM collect ts
+    add t
+----  K (KP _ _)  -> add t
+  _ -> C.composOp (collectSubterms mo) t
+ where
+   collect = collectSubterms mo
+   add t = do
+     (ts,i) <- readSTM
+     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)
+     return t --- only because of composOp
+
+operIdent :: Int -> Ident
+operIdent i = identC (operPrefix `BS.append` (BS.pack (show i))) ---
+
+isOperIdent :: Ident -> Bool
+isOperIdent id = BS.isPrefixOf operPrefix (ident2bs id)
+
+operPrefix = BS.pack ("A''")
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index 2963da609..dc15d1929 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -109,7 +109,7 @@ data SISRFormat =
   | SISR_1_0
  deriving (Show,Eq,Ord)
 
-data Optimization = OptStem | OptCSE | OptExpand | OptParametrize | OptValues
+data Optimization = OptStem | OptCSE | OptExpand | OptParametrize
   deriving (Show,Eq,Ord)
 
 data CFGTransform = CFGNoLR 
@@ -268,7 +268,7 @@ defaultFlags = Flags {
       optResName         = Nothing,
       optPreprocessors   = [],
       optEncoding        = ISO_8859_1,
-      optOptimizations   = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues],
+      optOptimizations   = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize],
       optCFGTransforms   = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter, 
                                          CFGTopDownFilter, CFGMergeIdentical],
       optLibraryPath     = [],
@@ -474,12 +474,15 @@ instance Read OutputFormat where
 
 optimizationPackages :: [(String, Set Optimization)]
 optimizationPackages = 
-    [("all_subs",    Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]), -- deprecated
-     ("all",         Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize,OptValues]),
-     ("values",      Set.fromList [OptStem,OptCSE,OptExpand,OptValues]),
+    [("all",         Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),
+     ("values",      Set.fromList [OptStem,OptCSE,OptExpand]),
+     ("noexpand",    Set.fromList [OptStem,OptCSE]),
+     
+     -- deprecated
+     ("all_subs",    Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),
      ("parametrize", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),
-     ("none",        Set.fromList [OptStem,OptCSE,OptExpand]),
-     ("noexpand",    Set.fromList [OptStem,OptCSE])]
+     ("none",        Set.fromList [OptStem,OptCSE,OptExpand])
+    ]
 
 cfgTransformNames :: [(String, CFGTransform)]
 cfgTransformNames =