removed src for 2.9

4 files changed, 0 insertions, 818 deletions

diff --git a/src/GF/OldParsing/ConvertGFCtoMCFG/Coercions.hs b/src/GF/OldParsing/ConvertGFCtoMCFG/Coercions.hs
deleted file mode 100644
index 3ed6a3f48..000000000
--- a/src/GF/OldParsing/ConvertGFCtoMCFG/Coercions.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : ConvertGFCtoMCFG.Coercions
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:54 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.2 $
---
--- Adding coercion functions to a MCFG if necessary.
------------------------------------------------------------------------------
-
-
-module GF.OldParsing.ConvertGFCtoMCFG.Coercions (addCoercions) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
--- import PrintGFC
--- import qualified PrGrammar as PG
-
-import qualified GF.Infra.Ident as Ident
-import GF.OldParsing.Utilities
-import GF.OldParsing.GrammarTypes 
-import GF.OldParsing.MCFGrammar (Rule(..), Lin(..))
-import GF.Data.SortedList
-import Data.List (groupBy) -- , transpose)
-
-----------------------------------------------------------------------
-
-addCoercions :: MCFGrammar -> MCFGrammar
-addCoercions rules = coercions ++ rules
-    where (allHeads, allArgs) = unzip [ ((head, lbls), nubsort args) | 
-					Rule head args lins _ <- rules, 
-					let lbls = [ lbl | Lin lbl _ <- lins ] ]
-	  allHeadSet = nubsort allHeads
-	  allArgSet  = union   allArgs <\\> map fst allHeadSet
-	  coercions = tracePrt "#coercions total" (prt . length) $
-		      concat $
-		      tracePrt "#coercions per cat" (prtList . map length) $
-		      combineCoercions 
-		        (groupBy sameCatFst allHeadSet) 
-			(groupBy sameCat    allArgSet)
-	  sameCatFst a b = sameCat (fst a) (fst b)
-
-
-combineCoercions [] _ = []
-combineCoercions _ [] = []
-combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs) 
-    = case compare (mainCat $ fst $ head heads) (mainCat $ head args) of
-        LT -> combineCoercions allHeads  allArgs'
-	GT -> combineCoercions allHeads' allArgs
-	EQ -> makeCoercion heads args : combineCoercions allHeads allArgs
-
-
-makeCoercion heads args = [ Rule arg [head] lins coercionName |
-			    (head@(MCFCat _ headCns), lbls) <- heads, 
-			    let lins = [ Lin lbl [Cat (head, lbl, 0)] | lbl <- lbls ],
-			    arg@(MCFCat _ argCns) <- args,
-			    argCns `subset` headCns ]
-
-
-coercionName = Ident.IW
-
-mainCat (MCFCat c _) = c
-
-sameCat mc1 mc2 = mainCat mc1 == mainCat mc2
-
-
diff --git a/src/GF/OldParsing/ConvertGFCtoMCFG/Nondet.hs b/src/GF/OldParsing/ConvertGFCtoMCFG/Nondet.hs
deleted file mode 100644
index 7727aa15f..000000000
--- a/src/GF/OldParsing/ConvertGFCtoMCFG/Nondet.hs
+++ /dev/null
@@ -1,281 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : ConvertGFCtoMCFG.Nondet
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/06/17 14:15:18 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.3 $
---
--- Converting GFC grammars to MCFG grammars, nondeterministically.
---
--- the resulting grammars might be /very large/
---
--- the conversion is only equivalent if the GFC grammar has a context-free backbone.
--- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
------------------------------------------------------------------------------
-
-
-module GF.OldParsing.ConvertGFCtoMCFG.Nondet (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
--- import PrintGFC
--- import qualified PrGrammar as PG
-
-import Control.Monad
-import GF.Infra.Ident (Ident(..))
-import GF.Canon.AbsGFC
-import GF.Canon.GFC
-import GF.Canon.Look
-import GF.Data.Operations
-import qualified GF.Infra.Modules as M
-import GF.Canon.CMacros (defLinType)
-import GF.Canon.MkGFC (grammar2canon)
-import GF.OldParsing.Utilities
-import GF.OldParsing.GrammarTypes 
-import GF.OldParsing.MCFGrammar (Grammar, Rule(..), Lin(..))
-import GF.Data.SortedList
--- import Maybe (listToMaybe)
-import Data.List (groupBy) -- , transpose)
-
-import GF.Data.BacktrackM
-
-----------------------------------------------------------------------
-
-type Env  = (CanonGrammar, Ident)
-
-convertGrammar :: Env -- ^ the canonical grammar, together with the selected language
-	       -> MCFGrammar -- ^ the resulting MCF grammar
-convertGrammar gram = trace2 "language" (prt (snd gram)) $
-		      trace2 "modules" (prtSep " " modnames) $
-		      tracePrt "#mcf-rules total" (prt . length) $
-		      solutions conversion undefined
-    where Gr modules = grammar2canon (fst gram)
-	  modnames   = uncurry M.allExtends gram
-	  conversion = member modules >>= convertModule
-	  convertModule (Mod (MTCnc modname _) _ _ _ defs)
-	      | modname `elem` modnames = member defs >>= convertDef gram
-	  convertModule _ = failure
-
-convertDef :: Env -> Def -> CnvMonad MCFRule
-convertDef env (CncDFun fun (CIQ _ cat) args term _)
-    | trace2 "converting function" (prt fun) True
-    = do let iCat : iArgs = map initialMCat (cat : map catOfArg args)
-	 writeState (iCat, iArgs, [])
-	 convertTerm env cat term
-	 (newCat, newArgs, linRec) <- readState
-	 let newTerm = map (instLin newArgs) linRec
-	 return (Rule newCat newArgs newTerm fun)
-convertDef _ _ = failure
-
-instLin newArgs (Lin lbl lin) = Lin lbl (map instSym lin)
-    where instSym = mapSymbol instCat id
-	  instCat (_, lbl, arg) = (newArgs !! arg, lbl, arg)
-
-convertTerm :: Env -> Cat -> Term -> CnvMonad ()
-convertTerm env cat term = do rterm <- simplTerm env term
-			      let ctype = lookupCType env cat
-			      reduceT env ctype rterm emptyPath
-
-------------------------------------------------------------
-
-type CnvMonad a = BacktrackM CMRule a
-
-type CMRule = (MCFCat, [MCFCat], LinRec)
-type LinRec = [Lin Cat Path Tokn]
-
-initialMCat :: Cat -> MCFCat
-initialMCat cat = MCFCat cat []
-
-----------------------------------------------------------------------
-
-simplTerm :: Env -> Term -> CnvMonad STerm
-simplTerm env = simplifyTerm
- where
-  simplifyTerm :: Term -> CnvMonad STerm
-  simplifyTerm (Arg (A cat nr))  = return (SArg (fromInteger nr) cat emptyPath)
-  simplifyTerm (Par con terms)   = liftM (SCon con) $ mapM simplifyTerm terms
-  simplifyTerm (R record)        = liftM SRec       $ mapM simplifyAssign record
-  simplifyTerm (P term lbl)      = liftM (+. lbl)   $      simplifyTerm term
-  simplifyTerm (T ct table)      = liftM STbl $ sequence $ concatMap simplifyCase table
-  simplifyTerm (V ct terms)  
-      = liftM STbl $ sequence [ liftM ((,) pat) (simplifyTerm term) |
-				(pat, term) <- zip (groundTerms env ct) terms ]
-  simplifyTerm (S term sel)      
-      = do sterm <- simplifyTerm term
-	   ssel <- simplifyTerm sel
-	   case sterm of
-	     STbl table  -> do (pat, val) <- member table
-			       pat =?= ssel
-			       return val
-	     _ -> do sel' <- expandTerm env ssel
-		     return (sterm +! sel')
-  simplifyTerm (FV terms)        = liftM SVariants $ mapM simplifyTerm terms
-  simplifyTerm (term1 `C` term2) = liftM2 (SConcat) (simplifyTerm term1) (simplifyTerm term2)
-  simplifyTerm (K tokn)          = return $ SToken tokn
-  simplifyTerm (E)               = return $ SEmpty
-  simplifyTerm x                 = error $ "simplifyTerm: " ++ show x
--- error constructors:
---   (I CIdent) - from resource
---   (LI Ident) - pattern variable
---   (EInt Integer) - integer
-
-  simplifyAssign :: Assign -> CnvMonad (Label, STerm)
-  simplifyAssign (Ass lbl term) = liftM ((,) lbl) $ simplifyTerm term
-
-  simplifyCase :: Case -> [CnvMonad (STerm, STerm)]
-  simplifyCase (Cas pats term) = [ liftM2 (,) (simplifyPattern pat) (simplifyTerm term) |
-				 pat <- pats ]
-
-  simplifyPattern :: Patt -> CnvMonad STerm
-  simplifyPattern (PC con pats) = liftM (SCon con) $ mapM simplifyPattern pats
-  simplifyPattern (PW)          = return SWildcard
-  simplifyPattern (PR record)   = do record' <- mapM simplifyPattAssign record
-				     case filter (\row -> snd row /= SWildcard) record' of
-				       []       -> return SWildcard
-				       record'' -> return (SRec record')
-  simplifyPattern x = error $ "simplifyPattern: " ++ show x
--- error constructors:
---   (PV Ident) - pattern variable
-
-  simplifyPattAssign :: PattAssign -> CnvMonad (Label, STerm)
-  simplifyPattAssign (PAss lbl pat) = liftM ((,) lbl) $ simplifyPattern pat
-
-
-------------------------------------------------------------
--- reducing simplified terms, collecting mcf rules
-
-reduceT :: Env -> CType -> STerm -> Path -> CnvMonad ()
-reduceT env = reduce
- where
-  reduce :: CType -> STerm -> Path -> CnvMonad ()
-  reduce TStr   term path = updateLin (path, term)
-  reduce (Cn _) term path
-      = do pat <- expandTerm env term
-	   updateHead (path, pat)
-  reduce ctype (SVariants terms) path 
-      = do term <- member terms
-	   reduce ctype term path
-  reduce (RecType rtype) term path
-      = sequence_ [ reduce ctype (term +. lbl) (path ++. lbl) |
-		    Lbg lbl ctype <- rtype ]
-  reduce (Table _ ctype) (STbl table) path
-      = sequence_ [ reduce ctype term (path ++! pat) |
-		    (pat, term) <- table ]
-  reduce (Table ptype vtype) arg@(SArg _ _ _) path 
-      = sequence_ [ reduce vtype (arg +! pat) (path ++! pat) |
-		    pat <- groundTerms env ptype ]
-  reduce ctype term path = error ("reduce:\n  ctype = (" ++ show ctype ++ 
-				  ")\n  term = (" ++ show term ++ 
-				  ")\n  path = (" ++ show path ++ ")\n")
-
-
-------------------------------------------------------------
--- expanding a term to ground terms
-
-expandTerm :: Env -> STerm -> CnvMonad STerm
-expandTerm env arg@(SArg _ _ _) 
-    = do pat <- member $ groundTerms env $ cTypeForArg env arg
-	 pat =?= arg
-	 return pat
-expandTerm env (SCon con terms)  = liftM (SCon con) $ mapM (expandTerm env) terms
-expandTerm env (SRec record)     = liftM  SRec      $ mapM (expandAssign env) record
-expandTerm env (SVariants terms) = member terms >>= expandTerm env
-expandTerm env term = error $ "expandTerm: " ++ show term
-
-expandAssign :: Env -> (Label, STerm) -> CnvMonad (Label, STerm)
-expandAssign env (lbl, term)   = liftM ((,) lbl) $ expandTerm env term
-
-------------------------------------------------------------
--- unification of patterns and selection terms
-
-(=?=) :: STerm -> STerm -> CnvMonad ()
-SWildcard     =?= _                = return ()
-SRec precord  =?= arg@(SArg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
-						 (lbl, pat) <- precord ]
-pat           =?= SArg arg _ path  = updateArg arg (path, pat)
-SCon con pats =?= SCon con' terms  = do guard (con==con' && length pats==length terms)
-					sequence_ $ zipWith (=?=) pats terms
-SRec precord  =?= SRec record      = sequence_ [ maybe mzero (pat =?=) mterm |
-						 (lbl, pat) <- precord,
-						 let mterm = lookup lbl record ]
-pat =?= term = error $ "(=?=): " ++ show pat ++ " =?= " ++ show term
-
-
-------------------------------------------------------------
--- updating the mcf rule
-
-updateArg :: Int -> Constraint -> CnvMonad ()
-updateArg arg cn
-    = do (head, args, lins) <- readState 
-	 args' <- updateNth (addToMCFCat cn) arg args
-	 writeState (head, args', lins)
-
-updateHead :: Constraint -> CnvMonad ()
-updateHead cn
-    = do (head, args, lins) <- readState
-	 head' <- addToMCFCat cn head
-	 writeState (head', args, lins)
-
-updateLin :: Constraint -> CnvMonad ()
-updateLin (path, term) 
-    = do let newLins = term2lins term
-	 (head, args, lins) <- readState
-	 let lins' = lins ++ map (Lin path) newLins
-	 writeState (head, args, lins')
-
-term2lins :: STerm -> [[Symbol (Cat, Path, Int) Tokn]]
-term2lins (SArg arg cat path) = return [Cat (cat, path, arg)]
-term2lins (SToken str)        = return [Tok str]
-term2lins (SConcat t1 t2)     = liftM2 (++) (term2lins t1) (term2lins t2)
-term2lins (SEmpty)            = return []
-term2lins (SVariants terms)   = terms >>= term2lins
-term2lins term = error $ "term2lins: " ++ show term
-
-addToMCFCat :: Constraint -> MCFCat -> CnvMonad MCFCat
-addToMCFCat cn (MCFCat cat cns) = liftM (MCFCat cat) $ addConstraint cn cns
-
-addConstraint :: Constraint -> [Constraint] -> CnvMonad [Constraint]
-addConstraint cn0 (cn : cns)
-    | fst cn0 >  fst cn = liftM (cn:) (addConstraint cn0 cns)
-    | fst cn0 == fst cn = guard (snd cn0 == snd cn) >>
-			  return (cn : cns)
-addConstraint cn0 cns   = return (cn0 : cns)
-
-
-----------------------------------------------------------------------
--- utilities 
-
-updateNth :: Monad m => (a -> m a) -> Int -> [a] -> m [a]
-updateNth update 0 (a : as) = liftM (:as) (update a)
-updateNth update n (a : as) = liftM (a:)  (updateNth update (n-1) as)
-
-catOfArg (A aCat _) = aCat
-catOfArg (AB aCat _ _) = aCat
-
-lookupCType :: Env -> Cat -> CType
-lookupCType env cat = errVal defLinType $ 
-		      lookupLincat (fst env) (CIQ (snd env) cat)
-
-groundTerms :: Env -> CType -> [STerm]
-groundTerms env ctype = err error (map term2spattern) $
-			allParamValues (fst env) ctype
-
-cTypeForArg :: Env -> STerm -> CType
-cTypeForArg env (SArg nr cat (Path path))
-    = follow path $ lookupCType env cat
-    where follow [] ctype = ctype
-	  follow (Right pat : path) (Table _ ctype) = follow path ctype
-	  follow (Left lbl : path) (RecType rec)
-	      = case [ ctype | Lbg lbl' ctype <- rec, lbl == lbl' ] of
-		  [ctype] -> follow path ctype
-		  err     -> error $ "follow: " ++ show rec ++ " . " ++ show lbl ++ 
-			             " results in " ++ show err
-
-term2spattern (R rec)         = SRec [ (lbl, term2spattern term) | Ass lbl term <- rec ]
-term2spattern (Par con terms) = SCon con $ map term2spattern terms
-
diff --git a/src/GF/OldParsing/ConvertGFCtoMCFG/Old.hs b/src/GF/OldParsing/ConvertGFCtoMCFG/Old.hs
deleted file mode 100644
index 8b9b4a9ec..000000000
--- a/src/GF/OldParsing/ConvertGFCtoMCFG/Old.hs
+++ /dev/null
@@ -1,277 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : ConvertGFCtoMCFG.Old
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/06/17 14:15:18 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.3 $
---
--- Converting GFC grammars to MCFG grammars. (Old variant)
---
--- the resulting grammars might be /very large/
---
--- the conversion is only equivalent if the GFC grammar has a context-free backbone.
--- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
------------------------------------------------------------------------------
-
-
-module GF.OldParsing.ConvertGFCtoMCFG.Old (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
---import PrintGFC
-import qualified GF.Grammar.PrGrammar as PG
-
-import Control.Monad (liftM, liftM2, guard)
--- import Maybe (listToMaybe)
-import GF.Infra.Ident (Ident(..))
-import GF.Canon.AbsGFC
-import GF.Canon.GFC
-import GF.Canon.Look
-import GF.Data.Operations
-import qualified GF.Infra.Modules as M
-import GF.Canon.CMacros (defLinType)
-import GF.Canon.MkGFC (grammar2canon)
-import GF.OldParsing.Utilities
-import GF.OldParsing.GrammarTypes 
-import GF.OldParsing.MCFGrammar (Rule(..), Lin(..))
-import GF.Data.SortedList (nubsort, groupPairs)
-import Data.Maybe (listToMaybe)
-import Data.List (groupBy, transpose)
-
-----------------------------------------------------------------------
--- old style types
-
-data XMCFCat = XMCFCat Cat [(XPath, Term)] deriving (Eq, Ord, Show)
-type XMCFLabel = XPath
-
-cnvXMCFCat :: XMCFCat -> MCFCat
-cnvXMCFCat (XMCFCat cat constrs) = MCFCat cat [ (cnvXPath path, cnvTerm term) | 
-						(path, term) <- constrs ]
-
-cnvXMCFLabel :: XMCFLabel -> MCFLabel
-cnvXMCFLabel = cnvXPath
-
-cnvXMCFLin :: Lin XMCFCat XMCFLabel Tokn -> Lin MCFCat MCFLabel Tokn
-cnvXMCFLin (Lin lbl lin) = Lin (cnvXMCFLabel lbl) $
-			   map (mapSymbol cnvSym id) lin
-    where cnvSym (cat, lbl, nr) = (cnvXMCFCat cat, cnvXMCFLabel lbl, nr)
-
--- Term -> STerm
-
-cnvTerm (R rec) = SRec [ (lbl, cnvTerm term) | Ass lbl term <- rec ]
-cnvTerm (T _ tbl) = STbl [ (cnvPattern pat, cnvTerm term) | 
-			   Cas pats term <- tbl, pat <- pats ]
-cnvTerm (Par con terms) = SCon con $ map cnvTerm terms
-cnvTerm term
-    | isArgPath term = cnvArgPath term
-
-cnvPattern (PR rec) = SRec [ (lbl, cnvPattern term) | PAss lbl term <- rec ]
-cnvPattern (PC con pats) = SCon con $ map cnvPattern pats
-cnvPattern (PW) = SWildcard
-
-isArgPath (Arg _) = True
-isArgPath (P _ _) = True
-isArgPath (S _ _) = True
-isArgPath _ = False
-
-cnvArgPath (Arg (A cat nr)) = SArg (fromInteger nr) cat emptyPath
-cnvArgPath (term `P` lbl) = cnvArgPath term +. lbl
-cnvArgPath (term `S` sel) = cnvArgPath term +! cnvTerm sel
-
--- old style paths
-
-newtype XPath = XPath [Either Label Term] deriving (Eq, Ord, Show)
-
-cnvXPath :: XPath -> Path
-cnvXPath (XPath path) = Path (map (either Left (Right . cnvTerm)) (reverse path))
-
-emptyXPath :: XPath
-emptyXPath = XPath []
-
-(++..) :: XPath -> Label -> XPath 
-XPath path ++.. lbl = XPath (Left lbl : path)
-
-(++!!) :: XPath -> Term -> XPath 
-XPath path ++!! sel = XPath (Right sel : path)
-
-----------------------------------------------------------------------
-
--- | combining alg. 1 and alg. 2 from Ljunglöf's PhD thesis
-convertGrammar :: (CanonGrammar, Ident) -> MCFGrammar
-convertGrammar (gram, lng) = trace2 "language" (prt lng) $
-			     trace2 "modules" (prtSep " " modnames) $
-			     trace2 "#lin-terms" (prt (length cncdefs)) $
-			     tracePrt "#mcf-rules total" (prt.length) $
-			     concat $
-			     tracePrt "#mcf-rules per fun" 
-			     (\rs -> concat [" "++show n++"="++show (length r) | 
-					     (n, r) <- zip [1..] rs]) $
-			     map (convertDef gram lng) cncdefs
-    where Gr mods = grammar2canon gram
-	  cncdefs = [ def | Mod (MTCnc modname _) _ _ _ defs <- mods, 
-		      modname `elem` modnames, 
-		      def@(CncDFun _ _ _ _ _) <- defs ]
-	  modnames = M.allExtends gram lng
-
-
-convertDef :: CanonGrammar -> Ident -> Def -> [MCFRule]
-convertDef gram lng (CncDFun fun (CIQ _ cat) args term _)
-    = [ Rule (cnvXMCFCat newCat) (map cnvXMCFCat newArgs) (map cnvXMCFLin newTerm) fun |
-	let ctype     = lookupCType gram lng cat,
-	instArgs     <- mapM (enumerateInsts gram lng) args,
-	let instTerm  = substitutePaths gram lng instArgs term,
-	newCat       <- emcfCat gram lng cat instTerm,
-	newArgs      <- mapM (extractArg gram lng instArgs) args,
-	let newTerm   = concatMap (extractLin newArgs) $ strPaths gram lng ctype instTerm
-      ]
-
-
--- gammalt skräp:
--- mergeArgs = zipWith mergeRec
--- mergeRec (R r1) (R r2) = R (r1 ++ r2)
-
-extractArg :: CanonGrammar -> Ident -> [Term] -> ArgVar -> [XMCFCat]
-extractArg gram lng args (A cat nr) = emcfCat gram lng cat (args !!! nr)
-
-
-emcfCat :: CanonGrammar -> Ident -> Ident -> Term -> [XMCFCat]
-emcfCat gram lng cat = map (XMCFCat cat) . parPaths gram lng (lookupCType gram lng cat) 
-
-
-extractLin :: [XMCFCat] -> (XPath, Term) -> [Lin XMCFCat XMCFLabel Tokn]
-extractLin args (path, term) = map (Lin path) (convertLin term)
-    where convertLin (t1 `C` t2) = liftM2 (++) (convertLin t1) (convertLin t2)
-	  convertLin (E) = [[]]
-	  convertLin (K tok) = [[Tok tok]]
-	  convertLin (FV terms) = concatMap convertLin terms
-	  convertLin term = map (return . Cat) $ flattenTerm emptyXPath term
-	  flattenTerm path (Arg (A _ nr)) = [(args !!! nr, path, fromInteger nr)]
-	  flattenTerm path (term `P` lbl) = flattenTerm (path ++.. lbl) term
-	  flattenTerm path (term `S` sel) = flattenTerm (path ++!! sel) term
-	  flattenTerm path (FV terms)     = concatMap (flattenTerm path) terms
-	  flattenTerm path term = error $ "flattenTerm: \n  " ++ show path ++ "\n  " ++ prt term 
-
-
-enumerateInsts :: CanonGrammar -> Ident -> ArgVar -> [Term]
-enumerateInsts gram lng arg@(A argCat _) = enumerate (Arg arg) (lookupCType gram lng argCat)
-    where enumerate path (TStr) = [ path ]
-	  enumerate path (Cn con) = okError $ lookupParamValues gram con
-	  enumerate path (RecType r) 
-	      = map R $ sequence [ map (lbl `Ass`) $ 
-				   enumerate (path `P` lbl) ctype |
-				   lbl `Lbg` ctype <- r ]
-	  enumerate path (Table s t)
-	      = map (T s) $ sequence [ map ([term2pattern sel] `Cas`) $ 
-				       enumerate (path `S` sel) t |
-				       sel <- enumerate (error "enumerate") s ]
-
-
-
-termPaths :: CanonGrammar -> Ident -> CType -> Term -> [(XPath, (CType, Term))]
-termPaths gr l (TStr) term = [ (emptyXPath, (TStr, term)) ]
-termPaths gr l (RecType rtype) (R record) 
-    = [ (path ++.. lbl, value) |
-	lbl `Ass` term <- record,
-	let ctype = okError $ maybeErr "termPaths/record" $ lookupLabelling lbl rtype,
-	(path, value) <- termPaths gr l ctype term ]
-termPaths gr l (Table _ ctype) (T _ table)
-    = [ (path ++!! pattern2term pat, value) |
-	pats `Cas` term <- table, pat <- pats,
-	(path, value) <- termPaths gr l ctype term ]
-termPaths gr l (Table _ ctype) (V ptype table)
-    = [ (path ++!! pat, value) |
-	(pat, term) <- zip (okError $ allParamValues gr ptype) table,
-	(path, value) <- termPaths gr l ctype term ]
-termPaths gr l ctype (FV terms)
-    = concatMap (termPaths gr l ctype) terms
-termPaths gr l (Cn pc) term = [ (emptyXPath, (Cn pc, term)) ]
-
-{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
-{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
-[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
--}
-
-parPaths :: CanonGrammar -> Ident -> CType -> Term -> [[(XPath, Term)]]
-parPaths gr l ctype term = mapM (uncurry (map . (,))) (groupPairs paths)
-    where paths = nubsort [ (path, value) | (path, (Cn _, value)) <- termPaths gr l ctype term ]
-
-strPaths :: CanonGrammar -> Ident -> CType -> Term -> [(XPath, Term)]
-strPaths gr l ctype term = [ (path, evalFV values) | (path, values) <- groupPairs paths ]
-    where paths = nubsort [ (path, value) | (path, (TStr, value)) <- termPaths gr l ctype term ]
-
-
--- Substitute each instantiated parameter path for its instantiation
-substitutePaths :: CanonGrammar -> Ident -> [Term] -> Term -> Term
-substitutePaths gr l arguments trm  = subst trm
-    where subst (con `Par` terms) = con `Par` map subst terms
-	  subst (R record)        = R $ map substAss record
-	  subst (term `P` lbl)    = subst term `evalP` lbl
-	  subst (T ptype table)   = T ptype $ map substCas table
-	  subst (V ptype table)   = T ptype [ [term2pattern pat] `Cas` subst term | 
-					      (pat, term) <- zip (okError $ allParamValues gr ptype) table ]
-	  subst (term `S` select) = subst term `evalS` subst select
-	  subst (term `C` term')  = subst term `C` subst term'
-	  subst (FV terms)        = evalFV $ map subst terms
-	  subst (Arg (A _ arg))   = arguments !!! arg
-	  subst term              = term
-
-          substAss (l `Ass` term) = l `Ass` subst term
-	  substCas (p `Cas` term) = p `Cas` subst term
-
-
-evalP (R record) lbl = okError $ maybeErr errStr $ lookupAssign lbl record
-    where errStr = "evalP: " ++ prt (R record `P` lbl)
-evalP (FV terms) lbl = evalFV [ evalP term lbl | term <- terms ]
-evalP term       lbl = term `P` lbl
-
-evalS t@(T _ tbl) sel = maybe (t `S` sel) id $ lookupCase sel tbl
-evalS (FV terms)  sel = evalFV [ term `evalS` sel | term <- terms ]
-evalS term   (FV sels)= evalFV [ term `evalS` sel | sel <- sels ]
-evalS term        sel = term `S` sel
-
-evalFV terms0 = case nubsort (concatMap flattenFV terms0) of
-	          [term] -> term
-		  terms  -> FV terms
-    where flattenFV (FV ts) = ts
-	  flattenFV  t      = [t]
-
-
-----------------------------------------------------------------------
--- utilities 
-
--- lookup a CType for an Ident
-lookupCType :: CanonGrammar -> Ident -> Ident -> CType
-lookupCType gr lng c = errVal defLinType $ lookupLincat gr (CIQ lng c)
-
--- lookup a label in a (record / record ctype / table)
-lookupAssign    :: Label -> [Assign]    -> Maybe Term
-lookupLabelling :: Label -> [Labelling] -> Maybe CType
-lookupCase      :: Term  -> [Case]      -> Maybe Term
-
-lookupAssign    lbl rec  = listToMaybe [ term | lbl' `Ass` term <- rec, lbl == lbl' ] 
-lookupLabelling lbl rtyp = listToMaybe [ ctyp | lbl' `Lbg` ctyp <- rtyp, lbl == lbl' ]
-lookupCase      sel tbl  = listToMaybe [ term | pats `Cas` term <- tbl, sel `matchesPats` pats ]
-
-matchesPats :: Term -> [Patt] -> Bool
-matchesPats term patterns = or [ term == pattern2term pattern | pattern <- patterns ]
-
--- converting between patterns and terms
-pattern2term :: Patt -> Term
-term2pattern :: Term -> Patt
-
-pattern2term (con `PC` patterns) = con `Par` map pattern2term patterns
-pattern2term (PR record) = R [ lbl `Ass` pattern2term pattern | 
-			       lbl `PAss` pattern <- record ]
-
-term2pattern (con `Par` terms) = con `PC` map term2pattern terms
-term2pattern (R record) = PR [ lbl `PAss` term2pattern term |
-			       lbl `Ass` term <- record ]
-
--- list lookup for Integers instead of Ints
-(!!!) :: [a] -> Integer -> a
-xs !!! n = xs !! fromInteger n
diff --git a/src/GF/OldParsing/ConvertGFCtoMCFG/Strict.hs b/src/GF/OldParsing/ConvertGFCtoMCFG/Strict.hs
deleted file mode 100644
index d088bdebc..000000000
--- a/src/GF/OldParsing/ConvertGFCtoMCFG/Strict.hs
+++ /dev/null
@@ -1,189 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : ConvertGFCtoMCFG.Strict
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/06/17 14:15:18 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.3 $
---
--- Converting GFC grammars to MCFG grammars, nondeterministically.
---
--- the resulting grammars might be /very large/
---
--- the conversion is only equivalent if the GFC grammar has a context-free backbone.
--- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
------------------------------------------------------------------------------
-
-
-module GF.OldParsing.ConvertGFCtoMCFG.Strict (convertGrammar) where
-
-import GF.System.Tracing
--- import IOExts (unsafePerformIO)
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
--- import PrintGFC
--- import qualified PrGrammar as PG
-
-import Control.Monad
-import GF.Infra.Ident (Ident(..))
-import GF.Canon.AbsGFC
-import GF.Canon.GFC
-import GF.Canon.Look
-import GF.Data.Operations
-import qualified GF.Infra.Modules as M
-import GF.Canon.CMacros (defLinType)
-import GF.Canon.MkGFC (grammar2canon)
-import GF.OldParsing.Utilities
-import GF.OldParsing.GrammarTypes 
-import GF.OldParsing.MCFGrammar (Grammar, Rule(..), Lin(..))
-import GF.Data.SortedList
--- import Maybe (listToMaybe)
-import Data.List (groupBy) -- , transpose)
-
-import GF.Data.BacktrackM
-
-----------------------------------------------------------------------
-
-type Env  = (CanonGrammar, Ident)
-
-convertGrammar :: Env -- ^ the canonical grammar, together with the selected language
-	       -> MCFGrammar -- ^ the resulting MCF grammar
-convertGrammar gram = trace2 "language" (prt (snd gram)) $
-		      trace2 "modules" (prtSep " " modnames) $
-		      tracePrt "#mcf-rules total" (prt . length) $
-		      solutions conversion undefined
-    where Gr modules = grammar2canon (fst gram)
-	  modnames   = uncurry M.allExtends gram
-	  conversion = member modules >>= convertModule
-	  convertModule (Mod (MTCnc modname _) _ _ _ defs)
-	      | modname `elem` modnames = member defs >>= convertDef gram
-	  convertModule _ = failure
-
-convertDef :: Env -> Def -> CnvMonad MCFRule
-convertDef env (CncDFun fun (CIQ _ cat) args term _)
-    | trace2 "converting function" (prt fun) True
-    = do let ctype = lookupCType env cat
-	 instArgs <- mapM (enumerateArg env) args
-	 let instTerm = substitutePaths env instArgs term
-	 newCat <- emcfCat env cat instTerm
-	 newArgs <- mapM (extractArg env instArgs) args
-	 let newTerm = strPaths env ctype instTerm >>= extractLin newArgs
-	 return (Rule newCat newArgs newTerm fun)
-convertDef _ _ = failure
-
-------------------------------------------------------------
-
-type CnvMonad a = BacktrackM () a
-
-----------------------------------------------------------------------
--- strict conversion
-
-extractArg :: Env -> [STerm] -> ArgVar -> CnvMonad MCFCat
-extractArg env args (A cat nr) = emcfCat env cat (args !! fromInteger nr)
-
-emcfCat :: Env -> Cat -> STerm -> CnvMonad MCFCat
-emcfCat env cat term = member $ map (MCFCat cat) $ parPaths env (lookupCType env cat) term
-
-enumerateArg :: Env -> ArgVar -> CnvMonad STerm
-enumerateArg env (A cat nr) = let ctype = lookupCType env cat
-			      in enumerate (SArg (fromInteger nr) cat emptyPath) ctype
-    where enumerate arg (TStr) = return arg 
-	  enumerate arg ctype@(Cn _) = member $ groundTerms env ctype
-	  enumerate arg (RecType rtype) 
-	      = liftM SRec $ sequence [ liftM ((,) lbl) $ 
-					enumerate (arg +. lbl) ctype |
-					lbl `Lbg` ctype <- rtype ]
-	  enumerate arg (Table stype ctype)
-	      = do state <- readState
-		   liftM STbl $ sequence [ liftM ((,) sel) $ 
-					   enumerate (arg +! sel) ctype |
-					   sel <- solutions (enumerate err stype) state ]
-	      where err = error "enumerate: parameter type should not be string"
-
--- Substitute each instantiated parameter path for its instantiation
-substitutePaths :: Env -> [STerm] -> Term -> STerm
-substitutePaths env arguments trm  = subst trm
-    where subst (con `Par` terms) = con `SCon` map subst terms
-	  subst (R record)        = SRec [ (lbl, subst term) | lbl `Ass` term <- record ]
-	  subst (term `P` lbl)    = subst term +. lbl
-	  subst (T ptype table)   = STbl [ (pattern2sterm pat, subst term) | 
-					   pats `Cas` term <- table, pat <- pats ]
-	  subst (V ptype table)   = STbl [ (pat, subst term) | 
-					   (pat, term) <- zip (groundTerms env ptype) table ]
-	  subst (term `S` select) = subst term +! subst select
-	  subst (term `C` term')  = subst term `SConcat` subst term'
-	  subst (K str)           = SToken str
-	  subst (E)               = SEmpty
-	  subst (FV terms)        = evalFV $ map subst terms
-	  subst (Arg (A _ arg))   = arguments !! fromInteger arg
-
-
-termPaths :: Env -> CType -> STerm -> [(Path, (CType, STerm))]
-termPaths env (TStr) term = [ (emptyPath, (TStr, term)) ]
-termPaths env (RecType rtype) (SRec record) 
-    = [ (path ++. lbl, value) |
-	(lbl, term) <- record,
-	let ctype = lookupLabelling lbl rtype,
-	(path, value) <- termPaths env ctype term ]
-termPaths env (Table _ ctype) (STbl table)
-    = [ (path ++! pat, value) |
-	(pat, term) <- table,
-	(path, value) <- termPaths env ctype term ]
-termPaths env ctype (SVariants terms)
-    = terms >>= termPaths env ctype
-termPaths env (Cn pc) term = [ (emptyPath, (Cn pc, term)) ]
-
-{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
-{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
-[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
--}
-
-parPaths :: Env -> CType -> STerm -> [[(Path, STerm)]]
-parPaths env ctype term = mapM (uncurry (map . (,))) (groupPairs paths)
-    where paths = nubsort [ (path, value) | (path, (Cn _, value)) <- termPaths env ctype term ]
-
-strPaths :: Env -> CType -> STerm -> [(Path, STerm)]
-strPaths env ctype term = [ (path, evalFV values) | (path, values) <- groupPairs paths ]
-    where paths = nubsort [ (path, value) | (path, (TStr, value)) <- termPaths env ctype term ]
-
-extractLin :: [MCFCat] -> (Path, STerm) -> [Lin MCFCat MCFLabel Tokn]
-extractLin args (path, term) = map (Lin path) (convertLin term)
-    where convertLin (t1 `SConcat` t2) = liftM2 (++) (convertLin t1) (convertLin t2)
-	  convertLin (SEmpty) = [[]]
-	  convertLin (SToken tok) = [[Tok tok]]
-	  convertLin (SVariants terms) = concatMap convertLin terms
-	  convertLin (SArg nr _ path) = [[Cat (args !! nr, path, nr)]]
-
-evalFV terms0 = case nubsort (concatMap flattenFV terms0) of
-	          [term] -> term
-		  terms  -> SVariants terms
-    where flattenFV (SVariants ts) = ts
-	  flattenFV  t      = [t]
-
-----------------------------------------------------------------------
--- utilities 
-
-lookupCType :: Env -> Cat -> CType
-lookupCType env cat = errVal defLinType $ 
-		      lookupLincat (fst env) (CIQ (snd env) cat)
-
-lookupLabelling :: Label -> [Labelling] -> CType
-lookupLabelling lbl rtyp = case [ ctyp | lbl' `Lbg` ctyp <- rtyp, lbl == lbl' ] of
-			     [ctyp] -> ctyp
-			     err -> error $ "lookupLabelling:" ++ show err
-
-groundTerms :: Env -> CType -> [STerm]
-groundTerms env ctype = err error (map term2spattern) $
-			allParamValues (fst env) ctype
-
-term2spattern (R rec)         = SRec [ (lbl, term2spattern term) | Ass lbl term <- rec ]
-term2spattern (Par con terms) = SCon con $ map term2spattern terms
-
-pattern2sterm :: Patt -> STerm
-pattern2sterm (con `PC` patterns) = con `SCon` map pattern2sterm patterns
-pattern2sterm (PR record) = SRec [ (lbl, pattern2sterm pattern) | 
-				   lbl `PAss` pattern <- record ]
-