unlexer concat

3 files changed, 18 insertions, 29 deletions

diff --git a/src/GF/Compile/BackOpt.hs b/src/GF/Compile/BackOpt.hs
index 9d2e62796..d68b72635 100644
--- a/src/GF/Compile/BackOpt.hs
+++ b/src/GF/Compile/BackOpt.hs
@@ -17,6 +17,7 @@ module BackOpt (shareModule, OptSpec, shareOpt, paramOpt, valOpt, allOpt) where
 import Grammar
 import Ident
 import qualified Macros as C
+import PrGrammar (prt)
 import Operations
 import List
 import qualified Modules as M
@@ -38,16 +39,16 @@ shareModule opt (i,m) = case m of
     (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
   _ -> (i,m)
 
-shareInfo opt (c, CncCat ty (Yes t) m) = (c, CncCat ty (Yes (shareOptim opt t)) m)
-shareInfo opt (c, CncFun kxs (Yes t) m) = (c, CncFun kxs (Yes (shareOptim opt t)) m)
-shareInfo opt (c, ResOper ty (Yes t)) = (c, ResOper ty (Yes (shareOptim opt t)))
+shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (shareOptim opt c t)) m)
+shareInfo opt (c, CncFun kxs (Yes t) m) = (c,CncFun kxs (Yes (shareOptim opt c t)) m)
+shareInfo opt (c, ResOper ty (Yes t)) = (c,ResOper ty (Yes (shareOptim opt c t)))
 shareInfo _ i = i
 
 -- the function putting together optimizations
-shareOptim :: OptSpec -> Term -> Term
-shareOptim opt 
-  | doOptFactor opt && doOptValues opt = values . factor 0
-  | doOptFactor opt = share . factor 0
+shareOptim :: OptSpec -> Ident -> Term -> Term
+shareOptim opt c 
+  | doOptFactor opt && doOptValues opt = values . factor c 0
+  | doOptFactor opt = share . factor c 0
   | doOptValues opt = values    
   | otherwise = share
 
@@ -73,17 +74,17 @@ share t = case t of
 
 -- do even more: factor parametric branches
 
-factor :: Int -> Term -> Term
-factor i t = case t of
+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 (i+1) v) | (p, v) <- cs]
-  _ -> C.composSafeOp (factor i) t
+    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 i
+     let p   = qqIdent c i
          vs' = map (mkFun p) psvs
      in if   allEqs vs'
         then mkCase p vs' 
@@ -97,7 +98,7 @@ factor i t = case t of
 
 --- we hope this will be fresh and don't check... in GFC would be safe
 
-qqIdent i = identC ("q4q__" ++ show i)
+qqIdent c i = identC ("q_" ++ prt c ++ "__" ++ show i)
 
 
 --  we need to replace subterms
diff --git a/src/GF/Compile/MkResource.hs b/src/GF/Compile/MkResource.hs
index 1c0bdb21c..84c58fc0b 100644
--- a/src/GF/Compile/MkResource.hs
+++ b/src/GF/Compile/MkResource.hs
@@ -18,6 +18,7 @@ import Grammar
 import Ident
 import Modules
 import Macros
+import Lockfield
 import PrGrammar
 
 import Operations
@@ -118,19 +119,6 @@ mkResDefs hasT isC gr r a mext maext abs cnc = mapMTree (mkOne a maext) abs wher
     Q n c | n == a || [n] == mae -> return $ Q r c ---- FIX for non-singleton exts
     _ -> composOp (redirTyp always a mae) ty
 
-lockRecType :: Ident -> Type -> Err Type
-lockRecType c t = plusRecType t $ RecType [(lockLabel c,  RecType [])]
-
-unlockRecord :: Ident -> Term -> Err Term
-unlockRecord c ft = do
-  let (xs,t) = termFormCnc ft
-  t' <- plusRecord t $ R [(lockLabel c,  (Just (RecType []),R []))]
-  return $ mkAbs xs t'
-
-lockLabel :: Ident -> Label
-lockLabel c = LIdent $ "lock_" ++ prt c ----
-
-
 -- no reuse for functions of HO/dep types
 
 isHardType t = case t of
diff --git a/src/GF/Compile/ModDeps.hs b/src/GF/Compile/ModDeps.hs
index 10f2e012e..7e65239e4 100644
--- a/src/GF/Compile/ModDeps.hs
+++ b/src/GF/Compile/ModDeps.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Check correctness of module dependencies. Incomplete.
 -----------------------------------------------------------------------------
 
 module ModDeps where
@@ -81,8 +81,8 @@ moduleDeps ms = mapM deps ms where
   chDep it es ety os oty = do
     ests <- mapM (lookupModuleType gr) es
     testErr (all (compatMType ety) ests) "inappropriate extension module type" 
-    osts <- mapM (lookupModuleType gr . openedModule) os
-    testErr (all (compatOType oty) osts) "inappropriate open module type"
+----    osts <- mapM (lookupModuleType gr . openedModule) os
+----    testErr (all (compatOType oty) osts) "inappropriate open module type"
     let ab = case it of
                IdentM _ (MTConcrete a) -> [IdentM a MTAbstract]
                _ -> [] ----