removed src for 2.9

17 files changed, 0 insertions, 2345 deletions

diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs
deleted file mode 100644
index 354bdea65..000000000
--- a/src/GF/Conversion/GFC.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/01 09:53:18 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.14 $
---
--- All conversions from GFC 
------------------------------------------------------------------------------
-
-module GF.Conversion.GFC
-    (module GF.Conversion.GFC,
-     SGrammar, EGrammar, MGrammar, CGrammar) where
-
-import GF.Infra.Option
-import GF.Canon.GFC (CanonGrammar)
-import GF.Infra.Ident (Ident, identC)
-import qualified GF.Infra.Modules as M
-
-import GF.Formalism.GCFG (Rule(..), Abstract(..))
-import GF.Formalism.SimpleGFC (decl2cat)
-import GF.Formalism.CFG (CFRule(..))
-import GF.Formalism.Utilities (symbol, name2fun)
-import GF.Conversion.Types
-
-import qualified GF.Conversion.GFCtoSimple as G2S
-import qualified GF.Conversion.SimpleToFinite as S2Fin
-import qualified GF.Conversion.RemoveSingletons as RemSing
-import qualified GF.Conversion.RemoveErasing as RemEra
-import qualified GF.Conversion.RemoveEpsilon as RemEps
-import qualified GF.Conversion.SimpleToMCFG as S2M
-import qualified GF.Conversion.MCFGtoCFG as M2C
-
-import GF.Infra.Print
-
-import GF.System.Tracing
-
-----------------------------------------------------------------------
--- * GFC -> MCFG & CFG, using options to decide which conversion is used
-
-convertGFC :: Options -> (CanonGrammar, Ident)
-           -> (SGrammar, (EGrammar, (MGrammar, CGrammar)))
-convertGFC opts = \g -> let s = g2s g
-                            e = s2e s 
-                            m = e2m e
-                        in trace2 "Options" (show opts) (s, (e, (m, e2c e)))
-    where e2c = M2C.convertGrammar
-	  e2m = case getOptVal opts firstCat of
-		  Just cat -> flip erasing [identC cat]
-		  Nothing  -> flip erasing []
-	  s2e = case getOptVal opts gfcConversion of
-		  Just "strict"            -> strict
-		  Just "finite-strict"     -> strict
-		  Just "epsilon"           -> epsilon . nondet
-		  _                        -> nondet
-	  g2s = case getOptVal opts gfcConversion of
-		  Just "finite"            -> finite . simple
-		  Just "finite2"           -> finite . finite . simple
-		  Just "finite3"           -> finite . finite . finite . simple
-		  Just "singletons"        -> single . simple
-		  Just "finite-singletons" -> single . finite . simple
-		  Just "finite-strict"     -> finite . simple
-		  _                        -> simple
-
-          simple  = G2S.convertGrammar
-          strict  = S2M.convertGrammarStrict
-          nondet  = S2M.convertGrammarNondet
-          epsilon = RemEps.convertGrammar
-          finite  = S2Fin.convertGrammar
-          single  = RemSing.convertGrammar
-          erasing = RemEra.convertGrammar
-
-gfc2simple :: Options -> (CanonGrammar, Ident) -> SGrammar
-gfc2simple opts = fst . convertGFC opts 
-
-gfc2mcfg :: Options -> (CanonGrammar, Ident) -> MGrammar
-gfc2mcfg opts g = mcfg
-  where
-    (mcfg, _) = snd (snd (convertGFC opts g))
-
-gfc2cfg :: Options -> (CanonGrammar, Ident) -> CGrammar
-gfc2cfg opts g = cfg
-  where
-    (_, cfg) = snd (snd (convertGFC opts g))
-
-
-----------------------------------------------------------------------
--- * single step conversions
-
-{-
-gfc2simple :: (CanonGrammar, Ident) -> SGrammar
-gfc2simple = G2S.convertGrammar
-
-simple2finite :: SGrammar -> SGrammar
-simple2finite = S2Fin.convertGrammar
-
-removeSingletons :: SGrammar -> SGrammar
-removeSingletons = RemSing.convertGrammar
-
-simple2mcfg_nondet :: SGrammar -> EGrammar
-simple2mcfg_nondet = 
-
-simple2mcfg_strict :: SGrammar -> EGrammar
-simple2mcfg_strict = S2M.convertGrammarStrict
-
-mcfg2cfg :: EGrammar -> CGrammar
-mcfg2cfg = M2C.convertGrammar
-
-removeErasing :: EGrammar -> [SCat] -> MGrammar
-removeErasing = RemEra.convertGrammar 
-
-removeEpsilon :: EGrammar -> EGrammar
-removeEpsilon = RemEps.convertGrammar 
--}
-
-----------------------------------------------------------------------
--- * converting to some obscure formats
-
-gfc2abstract :: (CanonGrammar, Ident) -> [Abstract SCat Fun]
-gfc2abstract gr = [ Abs (decl2cat decl) (map decl2cat decls) (name2fun name) |
-		    Rule (Abs decl decls name) _ <- G2S.convertGrammar gr ]
-
-abstract2skvatt :: [Abstract SCat Fun] -> String
-abstract2skvatt gr = skvatt_hdr ++ concatMap abs2pl gr
-    where abs2pl (Abs cat [] fun) = prtQuoted cat ++ " ---> " ++ 
-				    "\"" ++ prt fun ++ "\".\n"
-	  abs2pl (Abs cat cats fun) =
-	      prtQuoted cat ++ " ---> " ++
-	      "\"(" ++ prt fun ++ "\"" ++
-	      prtBefore ", \" \", " (map prtQuoted cats) ++ ", \")\".\n"
-
-cfg2skvatt :: CGrammar -> String
-cfg2skvatt gr = skvatt_hdr ++ concatMap cfg2pl gr
-    where cfg2pl (CFRule cat syms _name) =
-	      prtQuoted cat ++ " ---> " ++
-	      if null syms then "\"\".\n" else
-	      prtSep ", " (map (symbol prtQuoted prTok) syms) ++ ".\n"
-	  prTok tok = "\"" ++ tok ++ " \""
-
-skvatt_hdr = ":- use_module(library(skvatt)).\n" ++ 
-	     ":- use_module(library(utils), [repeat/1]).\n" ++
-	     "corpus(File, StartCat, Depth, Size) :- \n" ++
-	     "        set_flag(gendepth, Depth),\n" ++ 
-	     "        tell(File), repeat(Size),\n" ++
-	     "        generate_words(StartCat, String), format('~s~n~n', [String]),\n" ++
-	     "        write(user_error, '.'),\n" ++ 
-	     "        fail ; told.\n\n"
-
-prtQuoted :: Print a => a -> String
-prtQuoted a = "'" ++ prt a ++ "'"
-
-
-
-
diff --git a/src/GF/Conversion/GFCtoSimple.hs b/src/GF/Conversion/GFCtoSimple.hs
deleted file mode 100644
index b6a34a8ce..000000000
--- a/src/GF/Conversion/GFCtoSimple.hs
+++ /dev/null
@@ -1,175 +0,0 @@
----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/07 11:24:51 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.15 $
---
--- Converting GFC to SimpleGFC
---
--- the conversion might fail if the GFC grammar has dependent or higher-order types,
--- or if the grammar contains bound pattern variables
--- (use -optimize=values/share/none when importing)
---
--- TODO: lift all functions to the 'Err' monad
------------------------------------------------------------------------------
-
-module GF.Conversion.GFCtoSimple
-    (convertGrammar) where
-
-import qualified GF.Canon.AbsGFC as A
-import qualified GF.Infra.Ident as I
-import GF.Formalism.GCFG
-import GF.Formalism.SimpleGFC 
-import GF.Formalism.Utilities
-import GF.Conversion.Types
-
-import GF.UseGrammar.Linear (expandLinTables)
-import GF.Canon.GFC (CanonGrammar)
-import GF.Canon.MkGFC (grammar2canon)
-import GF.Canon.Subexpressions (unSubelimCanon)
-import qualified GF.Canon.Look as Look (lookupLin, allParamValues, lookupLincat)
-import qualified GF.Canon.CMacros as CMacros (defLinType)
-import GF.Data.Operations (err, errVal)
---import qualified Modules as M
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-----------------------------------------------------------------------
-
-type Env = (CanonGrammar, I.Ident)
-
-convertGrammar :: Env -> SGrammar
-convertGrammar (g,i) = trace2 "GFCtoSimple - concrete language" (prt (snd gram)) $
-		        tracePrt "GFCtoSimple - simpleGFC rules" (prt . length) $
-		         [ convertAbsFun gram fun typing |
-			  A.Mod (A.MTAbs modname) _ _ _ defs <- modules,
-			  A.AbsDFun fun typing _ <- defs ]
-    where A.Gr modules = grammar2canon (fst gram)
-          gram = (unSubelimCanon g,i)
-
-convertAbsFun :: Env -> I.Ident -> A.Exp -> SRule
-convertAbsFun gram fun typing = -- trace2 "GFCtoSimple - converting function" (prt fun) $
-                                Rule abs cnc
-    where abs = convertAbstract [] fun typing
-	  cnc = convertConcrete gram abs
-
-----------------------------------------------------------------------
--- abstract definitions
-
-convertAbstract :: [SDecl] -> Fun -> A.Exp -> Abstract SDecl Name
-convertAbstract env fun (A.EProd x a b) 
-    = convertAbstract (convertAbsType x' [] a : env) fun b
-    where x' = if x==I.identC "h_" then anyVar else x
-convertAbstract env fun a 
-    = Abs (convertAbsType anyVar [] a) (reverse env) name
-    where name = Name fun [ Unify [n] | n <- [0 .. length env-1] ]
-
-convertAbsType :: Var -> [FOType SCat] -> A.Exp -> SDecl
-convertAbsType x args (A.EProd _ a b) = convertAbsType x (convertType [] a : args) b
-convertAbsType x args a = Decl x (reverse args ::--> convertType [] a)
-
-convertType :: [TTerm] -> A.Exp -> FOType SCat
-convertType args (A.EApp a b) = convertType (convertExp [] b : args) a
-convertType args (A.EAtom at) = convertCat at ::@ reverse args
-convertType args (A.EProd _ _ b) = convertType args b ---- AR 7/10 workaround
-convertType args exp          = error $ "GFCtoSimple.convertType: " ++ prt exp
-
-{- Exp from GF/Canon/GFC.cf:
-EApp.   Exp1 ::= Exp1 Exp2 ;
-EProd.  Exp  ::= "(" Ident ":" Exp ")" "->" Exp ;
-EAbs.   Exp  ::= "\\" Ident "->" Exp ;
-EAtom.  Exp2 ::= Atom ;
-EData.  Exp2 ::= "data" ;
--}
-
-convertExp :: [TTerm] -> A.Exp -> TTerm
-convertExp args (A.EAtom at) = convertAtom args at
-convertExp args (A.EApp a b) = convertExp (convertExp [] b : args) a
-convertExp args exp          = error $ "GFCtoSimple.convertExp: " ++ prt exp
-
-convertAtom :: [TTerm] -> A.Atom -> TTerm
-convertAtom args (A.AC con) = con :@ reverse args
--- A.AD: is this correct???
-convertAtom args (A.AD con) = con :@ args
-convertAtom []   (A.AV var) = TVar var
-convertAtom args atom       = error $ "GFCtoSimple.convertAtom: " ++ prt args ++ " " ++ show atom
-
-convertCat :: A.Atom -> SCat
-convertCat (A.AC (A.CIQ _ cat)) = cat
-convertCat atom                 = error $ "GFCtoSimple.convertCat: " ++ show atom
-
-----------------------------------------------------------------------
--- concrete definitions
-
-convertConcrete :: Env -> Abstract SDecl Name -> Concrete SLinType (Maybe STerm)
-convertConcrete gram (Abs decl args name) = Cnc ltyp largs term
-    where term = fmap (convertTerm gram . expandTerm gram) $ lookupLin gram $ name2fun name
-	  ltyp : largs = map (convertCType gram . lookupCType gram) (decl : args)
-
-expandTerm :: Env -> A.Term -> A.Term
-expandTerm gram term = -- tracePrt "expanded term" prt $
-		       err error id $ expandLinTables (fst gram) $
-		       -- tracePrt "initial term" prt $ 
-		       term
-
-convertCType :: Env -> A.CType -> SLinType
-convertCType gram (A.RecType rec) = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
-convertCType gram (A.Table pt vt) = TblT (enumerateTerms Nothing (convertCType gram pt)) (convertCType gram vt)
-convertCType gram ct@(A.Cn con)   = ConT $ map (convertTerm gram) $ groundTerms gram ct
-convertCType gram (A.TStr)        = StrT
-convertCType gram (A.TInts n)     = error "GFCtoSimple.convertCType: cannot handle 'TInts' constructor"
-
-convertTerm :: Env -> A.Term -> STerm
-convertTerm gram (A.Arg arg)       = convertArgVar arg
-convertTerm gram (A.Par con terms) = con :^ map (convertTerm gram) terms
--- convertTerm gram (A.LI var)        = Var var
-convertTerm gram (A.R rec)         = Rec [ (lbl, convertTerm gram term) | A.Ass lbl term <- rec ]
-convertTerm gram (A.P term lbl)    = convertTerm gram term +. lbl
-convertTerm gram (A.V ctype terms) = Tbl [ (convertTerm gram pat, convertTerm gram term) |
-					  (pat, term) <- zip (groundTerms gram ctype) terms ]
-convertTerm gram (A.T ctype tbl)   = Tbl [ (convertPatt pat, convertTerm gram term) |
-					   A.Cas pats term <- tbl, pat <- pats ]
-convertTerm gram (A.S term sel)    = convertTerm gram term :! convertTerm gram sel
-convertTerm gram (A.C term1 term2) = convertTerm gram term1 ?++ convertTerm gram term2
-convertTerm gram (A.FV terms)      = variants (map (convertTerm gram) terms)
-convertTerm gram (A.E)             = Empty
-convertTerm gram (A.K (A.KS tok))  = Token tok
--- 'pre' tokens are converted to variants (over-generating):
-convertTerm gram (A.K (A.KP strs vars))
-                                   = variants $ map conc $ strs : [ vs | A.Var vs _ <- vars ]
-    where conc [] = Empty
-	  conc ts = foldr1 (?++) $ map Token ts
-convertTerm gram (A.I con)         = error "GFCtoSimple.convertTerm: cannot handle 'I' constructor"
-convertTerm gram (A.EInt int)      = error "GFCtoSimple.convertTerm: cannot handle 'EInt' constructor"
-
-convertArgVar :: A.ArgVar -> STerm
-convertArgVar (A.A cat nr)           = Arg (fromInteger nr) cat emptyPath
-convertArgVar (A.AB cat bindings nr) = Arg (fromInteger nr) cat emptyPath
-
-convertPatt (A.PC con pats) = con :^ map convertPatt pats
--- convertPatt (A.PV x)        = Var x
--- convertPatt (A.PW)          = Wildcard
-convertPatt (A.PR rec)      = Rec [ (lbl, convertPatt pat) | A.PAss lbl pat <- rec ]
-convertPatt (A.PI n)        = error "GFCtoSimple.convertPatt: cannot handle 'PI' constructor"
-convertPatt p               = error $ "GFCtoSimple.convertPatt: cannot handle " ++ show p
-
-----------------------------------------------------------------------
-
-lookupLin :: Env -> Fun -> Maybe A.Term
-lookupLin gram fun = err fail Just $
-		     Look.lookupLin (fst gram) (A.CIQ (snd gram) fun)
-
-lookupCType :: Env -> SDecl -> A.CType
-lookupCType env decl
-    = errVal CMacros.defLinType $ 
-      Look.lookupLincat (fst env) (A.CIQ (snd env) (decl2cat decl))
-
-groundTerms :: Env -> A.CType -> [A.Term]
-groundTerms gram ctype = err error id $
-			 Look.allParamValues (fst gram) ctype
-
diff --git a/src/GF/Conversion/Haskell.hs b/src/GF/Conversion/Haskell.hs
deleted file mode 100644
index abe651e1e..000000000
--- a/src/GF/Conversion/Haskell.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/08/11 14:11:46 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
---
--- Converting/Printing different grammar formalisms in Haskell-readable format
------------------------------------------------------------------------------
-
-
-module GF.Conversion.Haskell where
-
-import GF.Formalism.GCFG
-import GF.Formalism.SimpleGFC
-import GF.Formalism.MCFG
-import GF.Formalism.CFG
-import GF.Formalism.Utilities
-import GF.Conversion.Types
-import GF.Data.Operations ((++++), (+++++))
-import GF.Infra.Print
-
-import Data.List (intersperse)
-
--- | SimpleGFC to Haskell
-prtSGrammar :: SGrammar -> String
-prtSGrammar rules = "-- Simple GFC grammar as a Haskell file" ++++
-                    "-- Autogenerated from the Grammatical Framework" +++++
-                    "import GF.Formalism.GCFG" ++++
-                    "import GF.Formalism.SimpleGFC" ++++
-                    "import GF.Formalism.Utilities" ++++
-                    "import GF.Canon.AbsGFC (CIdent(..), Label(..))" ++++
-                    "import GF.Infra.Ident (Ident(..))" +++++
-                    "grammar :: SimpleGrammar Ident (NameProfile Ident) String" ++++
-                    "grammar = \n\t[ " ++ 
-                    concat (intersperse "\n\t, " (map show rules)) ++ "\n\t]\n\n"
-
--- | MCFG to Haskell
-prtMGrammar :: MGrammar -> String
-prtMGrammar rules = "-- Multiple context-free grammar as a Haskell file" ++++
-		    "-- Autogenerated from the Grammatical Framework" +++++
-		    "import GF.Formalism.GCFG" ++++
-		    "import GF.Formalism.MCFG" ++++
-                    "import GF.Formalism.Utilities" +++++
-                    "grammar :: MCFGrammar String (NameProfile String) String String" ++++
-		    "grammar = \n\t[ " ++ 
-		    concat (intersperse "\n\t, " (map prtMRule rules)) ++ "\n\t]\n\n" 
-    where prtMRule (Rule (Abs cat cats (Name fun profiles)) (Cnc lcat lcats lins)) 
-	      = show (Rule (Abs (prt cat) (map prt cats) (Name (prt fun) (map cnvProfile profiles)))
-		           (Cnc (map prt lcat) (map (map prt) lcats) (map cnvLin lins)))
-	  cnvLin (Lin lbl syms) = Lin (prt lbl) (map (mapSymbol prtMArg id) syms)
-	  prtMArg  (cat, lbl, nr) = (prt cat, prt lbl, nr)
-
--- | CFG to Haskell
-prtCGrammar :: CGrammar -> String
-prtCGrammar rules = "-- Context-free grammar as a Haskell file" ++++
-		    "-- autogenerated from the Grammatical Framework" +++++
-		    "import GF.Formalism.CFG" ++++ 
-                    "import GF.Formalism.Utilities" ++++
-                    "\ngrammar :: CFGrammar String (NameProfile String) String" ++++
-		    "grammar = \n\t[ " ++ 
-		    concat (intersperse "\n\t, " (map prtCRule rules)) ++ "\n\t]\n\n" 
-    where prtCRule (CFRule cat syms (Name fun profiles)) 
-	      = show (CFRule (prt cat) (map (mapSymbol prt id) syms) 
-	                     (Name (prt fun) (map cnvProfile profiles)))
-
-cnvProfile (Unify args) = Unify args
-cnvProfile (Constant forest) = Constant (fmap prt forest)
diff --git a/src/GF/Conversion/MCFGtoCFG.hs b/src/GF/Conversion/MCFGtoCFG.hs
deleted file mode 100644
index a58c31d37..000000000
--- a/src/GF/Conversion/MCFGtoCFG.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/09 09:28:43 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
---
--- Converting MCFG grammars to (possibly overgenerating) CFG
------------------------------------------------------------------------------
-
-
-module GF.Conversion.MCFGtoCFG
-    (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import Control.Monad
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG
-import GF.Formalism.MCFG
-import GF.Formalism.CFG
-import GF.Conversion.Types
-
-----------------------------------------------------------------------
--- * converting (possibly erasing) MCFG grammars
-
-convertGrammar :: EGrammar -> CGrammar
-convertGrammar gram = tracePrt "MCFGtoCFG - context-free rules" (prt.length) $
-		       concatMap convertRule gram
-
-convertRule :: ERule -> [CRule]
-convertRule (Rule (Abs cat args (Name fun mprofile)) (Cnc _ _ record)) 
-    = [ CFRule (CCat cat lbl) rhs (Name fun profile) |
-	Lin lbl lin <- record,
-	let rhs = map (mapSymbol convertArg id) lin,
-	let cprofile = map (Unify . argPlaces lin) [0 .. length args-1],
-	let profile = mprofile `composeProfiles` cprofile
-      ]
-
-convertArg :: (ECat, ELabel, Int) -> CCat
-convertArg (cat, lbl, _) = CCat cat lbl
-
-argPlaces :: [Symbol (cat, lbl, Int) tok] -> Int -> [Int]
-argPlaces lin nr  = [ place | (nr', place) <- zip linArgs [0..], nr == nr' ]
-    where linArgs = [ nr' | (_, _, nr') <- filterCats lin ]
-
-
-
-
diff --git a/src/GF/Conversion/MCFGtoFCFG.hs b/src/GF/Conversion/MCFGtoFCFG.hs
deleted file mode 100644
index 70aa4644d..000000000
--- a/src/GF/Conversion/MCFGtoFCFG.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/09 09:28:43 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
---
--- Converting MCFG grammars to equivalent optimized FCFG
------------------------------------------------------------------------------
-
-
-module GF.Conversion.MCFGtoFCFG
-    (convertGrammar) where
-
-import Control.Monad
-import List (elemIndex)
-import Array
-
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG
-import GF.Formalism.MCFG
-import GF.Formalism.FCFG
-import GF.Conversion.Types
-import GF.Data.SortedList (nubsort)
-
-import GF.Infra.Print
-
-----------------------------------------------------------------------
--- * converting MCFG to optimized FCFG
-
-convertGrammar :: MGrammar -> FGrammar
-convertGrammar gram = [ FRule (Abs (fcat cat) (map fcat cats) name) (fcnc cnc) |
-                        Rule (Abs cat cats name) cnc <- gram ]
-    where mcats = nubsort [ mc | Rule (Abs mcat mcats _) _ <- gram, mc <- mcat:mcats ]
-
-          fcat mcat@(MCat (ECat scat ecns) mlbls) 
-              = case elemIndex mcat mcats of
-                  Just catid -> FCat catid scat mlbls ecns
-                  Nothing -> error ("MCFGtoFCFG.fcat " ++ prt mcat)
-
-          fcnc (Cnc  _ arglbls lins) = listArray (0, length lins-1) (map flin lins)
-              where flin (Lin _ syms) = listArray (0, length syms-1) (map fsym syms)
-                    fsym (Tok tok) = FSymTok tok
-                    fsym (Cat (cat,lbl,arg)) = FSymCat (fcat cat) (flbl arg lbl) arg
-                    flbl arg lbl = case elemIndex lbl (arglbls !! arg) of
-                                     Just lblid -> lblid
-                                     Nothing -> error ("MCFGtoFCFG.flbl " ++ prt arg ++ " " ++ prt lbl)
- 
diff --git a/src/GF/Conversion/Prolog.hs b/src/GF/Conversion/Prolog.hs
deleted file mode 100644
index b930cb476..000000000
--- a/src/GF/Conversion/Prolog.hs
+++ /dev/null
@@ -1,205 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/14 09:51:18 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
---
--- Converting/Printing different grammar formalisms in Prolog-readable format
------------------------------------------------------------------------------
-
-
-module GF.Conversion.Prolog (prtSGrammar, prtSMulti, prtSHeader, prtSRule,
-                             prtMGrammar, prtMMulti, prtMHeader, prtMRule,
-                             prtCGrammar, prtCMulti, prtCHeader, prtCRule) where
-
-import GF.Formalism.GCFG
-import GF.Formalism.SimpleGFC
-import GF.Formalism.MCFG
-import GF.Formalism.CFG
-import GF.Formalism.Utilities
-import GF.Conversion.Types
-import qualified GF.Conversion.GFC as Cnv
-
-import GF.Data.Operations ((++++), (+++++))
-import GF.Infra.Print
-import qualified GF.Infra.Modules as Mod
-import qualified GF.Infra.Option as Option
-import GF.Data.Operations (okError)
-import GF.Canon.AbsGFC (Flag(..))
-import GF.Canon.GFC (CanonGrammar)
-import GF.Infra.Ident (Ident(..))
-
-import Data.Maybe (maybeToList, listToMaybe)
-import Data.Char (isLower, isAlphaNum)
-
-import GF.System.Tracing
-
-----------------------------------------------------------------------
--- | printing multiple languages at the same time
-
-prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
-prtSMulti = prtMulti prtSHeader prtSRule Cnv.gfc2simple "gfc_"
-prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg "mcfg_"
-prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg "cfg_"
-
--- code and ideas stolen from GF.CFGM.PrintCFGrammar
-
-prtMulti prtHeader prtRule conversion prefix opts gr
-    = prtHeader ++++ unlines
-      [ "\n\n" ++ prtLine ++++
-        "%% Language module: " ++ prtQ langmod +++++
-        unlines (map (prtRule langmod) rules) |
-        lang <- maybe [] (Mod.allConcretes gr) (Mod.greatestAbstract gr),
-        let Mod.ModMod (Mod.Module{Mod.flags=fs}) = okError (Mod.lookupModule gr lang),
-        let cnvopts = Option.Opts $ map Option.gfcConversion $ getFlag fs "conversion",
-        let rules = conversion cnvopts (gr, lang),
-        let langmod = (let IC lg = lang in prefix ++ lg) ]
-
-getFlag :: [Flag] -> String -> [String]
-getFlag fs x = [v | Flg (IC k) (IC v) <- fs, k == x]
-
-----------------------------------------------------------------------
--- | SimpleGFC to Prolog
---
--- assumes that the profiles in the Simple GFC names are trivial
-prtSGrammar :: SGrammar -> String
-prtSGrammar rules = prtSHeader +++++ unlines (map (prtSRule "") rules)
-
-prtSHeader :: String
-prtSHeader = prtLine ++++
-             "%% Simple GFC grammar in Prolog-readable format" ++++
-             "%% Autogenerated from the Grammatical Framework" +++++
-             "%% The following predicate is defined:" ++++
-             "%% \t rule(Fun, Cat, c(Cat,...), LinTerm)"
-
-prtSRule :: String -> SRule -> String
-prtSRule lang (Rule (Abs cat cats (Name fun _prof)) (Cnc _ _ mterm)) 
-    = (if null lang then "" else prtQ lang ++ " : ") ++ 
-      prtFunctor "rule" [plfun, plcat, plcats, plcnc] ++ "."
-    where plfun  = prtQ fun
-          plcat  = prtSDecl cat
-          plcats = prtFunctor "c" (map prtSDecl cats) 
-	  plcnc  = "\n\t" ++ prtSTerm (maybe Empty id mterm)
-
-prtSTerm (Arg n c p)    = prtFunctor "arg" [prtQ c, prt (n+1), prtSPath p]
--- prtSTerm (c :^ [])   = prtQ c
-prtSTerm (c :^ ts)      = prtOper "^" (prtQ c) (prtPList (map prtSTerm ts))
-prtSTerm (Rec rec)      = prtFunctor "rec" [prtPList [ prtOper "=" (prtQ l) (prtSTerm t) | (l, t) <- rec ]]
-prtSTerm (Tbl tbl)      = prtFunctor "tbl" [prtPList [ prtOper "=" (prtSTerm p) (prtSTerm t) | (p, t) <- tbl ]]
-prtSTerm (Variants ts)  = prtFunctor "variants" [prtPList (map prtSTerm ts)]
-prtSTerm (t1 :++ t2)    = prtOper "+" (prtSTerm t1) (prtSTerm t2)
-prtSTerm (Token t)      = prtFunctor "tok" [prtQ t]
-prtSTerm (Empty)        = "empty"
-prtSTerm (term :. lbl)  = prtOper "*" (prtSTerm term) (prtQ lbl)
-prtSTerm (term :! sel)  = prtOper "/" (prtSTerm term) (prtSTerm sel)
--- prtSTerm (Wildcard)  = "wildcard"
--- prtSTerm (Var var)   = prtFunctor "var" [prtQ var]
-
-prtSPath (Path path) = prtPList (map (either prtQ prtSTerm) path)
-
-prtSDecl (Decl var typ) | var == anyVar = prtSAbsType typ
-                        | otherwise     = "_" ++ prtVar var ++ ":" ++ prtSAbsType typ
-
-
-prtSAbsType ([]   ::--> typ) = prtSFOType typ
-prtSAbsType (args ::--> typ) = prtOper ":->" (prtPList (map prtSFOType args)) (prtSFOType typ)
-
-prtSFOType (cat ::@ args) = prtFunctor (prtQ cat) (map prtSTTerm args)
-
-prtSTTerm (con :@ args) = prtFunctor (prtQ con) (map prtSTTerm args)
-prtSTTerm (TVar var)    = "_" ++ prtVar var
-
-----------------------------------------------------------------------
--- | MCFG to Prolog
-prtMGrammar :: MGrammar -> String
-prtMGrammar rules = prtMHeader +++++ unlines (map (prtMRule "") rules)
-
-prtMHeader :: String
-prtMHeader = prtLine ++++
-             "%% Multiple context-free grammar in Prolog-readable format" ++++
-             "%% Autogenerated from the Grammatical Framework" +++++
-             "%% The following predicate is defined:" ++++
-             "%% \t rule(Profile, Cat, c(Cat,...), [Lbl=Symbols,...])" 
-
-prtMRule :: String -> MRule -> String
-prtMRule lang (Rule (Abs cat cats name) (Cnc _lcat _lcats lins)) 
-    = (if null lang then "" else prtQ lang ++ " : ") ++ 
-      prtFunctor "rule" [plname, plcat, plcats, pllins] ++ "."
-    where plname = prtName name
-          plcat  = prtQ cat
-          plcats = prtFunctor "c" (map prtQ cats) 
-          pllins = "\n\t[ " ++ prtSep "\n\t, " (map prtMLin lins) ++ " ]"
-
-prtMLin (Lin lbl lin) = prtOper "=" (prtQ lbl) (prtPList (map prtMSymbol lin))
-
-prtMSymbol (Cat (cat, lbl, nr)) = prtFunctor "arg" [prtQ cat, show (nr+1), prtQ lbl]
-prtMSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
-
-----------------------------------------------------------------------
--- | CFG to Prolog
-prtCGrammar :: CGrammar -> String
-prtCGrammar rules = prtCHeader +++++ unlines (map (prtCRule "") rules)
-
-prtCHeader :: String
-prtCHeader = prtLine ++++
-             "%% Context-free grammar in Prolog-readable format" ++++
-             "%% Autogenerated from the Grammatical Framework" +++++
-             "%% The following predicate is defined:" ++++
-             "%% \t rule(Profile, Cat, [Symbol,...])"
-
-prtCRule :: String -> CRule -> String
-prtCRule lang (CFRule cat syms name)
-    = (if null lang then "" else prtQ lang ++ " : ") ++ 
-      prtFunctor "cfgrule" [plname, plcat, plsyms] ++ "."
-    where plname = prtName name
-          plcat  = prtQ cat
-          plsyms = prtPList (map prtCSymbol syms) 
-
-prtCSymbol (Cat cat) = prtFunctor "cat" [prtQ cat]
-prtCSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
-
-----------------------------------------------------------------------
--- profiles, quoted strings and more
-
-prtFunctor f xs = f ++ if null xs then "" else "(" ++ prtSep ", " xs ++ ")"
-prtPList     xs = "[" ++ prtSep ", " xs ++ "]"
-prtOper   f x y = "(" ++ x ++ " " ++ f ++ " " ++ y ++ ")"
-
-prtName name@(Name fun profiles)
-    | name == coercionName = "1"
-    | and (zipWith (==) profiles (map (Unify . return) [0..])) = prtQ fun
-    | otherwise = prtFunctor (prtQ fun) (map prtProfile profiles) 
-
-prtProfile (Unify []) = " ? "
-prtProfile (Unify args) = foldr1 (prtOper "=") (map (show . succ) args)
-prtProfile (Constant forest) = prtForest forest
-
-prtForest (FMeta) = " ? "
-prtForest (FNode fun [fs]) = prtFunctor (prtQ fun) (map prtForest fs)
-prtForest (FNode fun fss) = prtPList [ prtFunctor (prtQ fun) (map prtForest fs) |
-                                       fs <- fss ]
-
-prtQ atom = prtQStr (prt atom)
-
-prtQStr atom@(x:xs) 
-    | isLower x && all isAlphaNumUnder xs = atom
-    where isAlphaNumUnder '_' = True
-          isAlphaNumUnder x = isAlphaNum x
-prtQStr atom =  "'" ++ concatMap esc (prt atom) ++ "'"
-    where esc '\'' = "\\'"
-          esc '\n' = "\\n"
-          esc '\t' = "\\t"
-          esc c = [c]
-
-prtVar var = reprime (prt var)
-    where reprime "" = ""
-          reprime ('\'' : cs) = "_0" ++ reprime cs
-          reprime (c:cs) = c : reprime cs
-
-prtLine = replicate 70 '%'
-
-
diff --git a/src/GF/Conversion/RemoveEpsilon.hs b/src/GF/Conversion/RemoveEpsilon.hs
deleted file mode 100644
index 0e5dafb38..000000000
--- a/src/GF/Conversion/RemoveEpsilon.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/30 08:11:32 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
---
--- Removing epsilon linearizations from MCF grammars
------------------------------------------------------------------------------
-
-
-module GF.Conversion.RemoveEpsilon where
---    (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import Control.Monad
-import Data.List (mapAccumL)
-import Data.Maybe (mapMaybe)
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG
-import GF.Formalism.MCFG
-import GF.Conversion.Types
-import GF.Data.Assoc
-import GF.Data.SortedList
-import GF.Data.GeneralDeduction
-
-convertGrammar :: EGrammar -> EGrammar
-convertGrammar grammar = trace2 "RemoveEpsilon: initialEmpties" (prt initialEmpties) $
-			 trace2 "RemoveEpsilon: emptyCats" (prt emptyCats) $
-			 grammar 
-    where initialEmpties  = nubsort [ (cat, lbl)  | 
-				      Rule (Abs cat _ _) (Cnc _ _ lins) <- grammar,
-				      Lin lbl [] <- lins ]
-	  emptyCats       = limitEmpties initialEmpties
-	  limitEmpties es = if es==es' then es else limitEmpties es'
-	      where es'   = nubsort [ (cat, lbl) | Rule (Abs cat _ _) (Cnc _ _ lins) <- grammar, 
-				      Lin lbl rhs <- lins,
-				      all (symbol (\(c,l,n) -> (c,l) `elem` es) (const False)) rhs ]
-
-
-
diff --git a/src/GF/Conversion/RemoveErasing.hs b/src/GF/Conversion/RemoveErasing.hs
deleted file mode 100644
index 1dc2560fc..000000000
--- a/src/GF/Conversion/RemoveErasing.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/09 09:28:44 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
---
--- Removing erasingness from MCFG grammars (as in Ljunglöf 2004, sec 4.5.1)
------------------------------------------------------------------------------
-
-
-module GF.Conversion.RemoveErasing
-    (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import Control.Monad 
-import Data.List (mapAccumL)
-import Data.Maybe (mapMaybe)
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG
-import GF.Formalism.MCFG
-import GF.Conversion.Types
-import GF.Data.Assoc
-import GF.Data.SortedList
-import GF.Data.GeneralDeduction
-
-convertGrammar :: EGrammar -> [SCat] -> MGrammar
-convertGrammar grammar starts = newGrammar
-    where newGrammar  = tracePrt "RemoveErasing - nonerasing rules" (prt . length) $
-			[ rule | NR rule <- chartLookup finalChart True ]
-	  finalChart  = tracePrt "RemoveErasing - nonerasing cats" 
-			(prt . length . flip chartLookup False) $
-			buildChart keyof [newRules rulesByCat] $
-			tracePrt "RemoveErasing - initial ne-cats" (prt . length) $
-			initialCats
-	  initialCats = trace2 "RemoveErasing - starting categories" (prt starts) $
-			if null starts 
-			  then trace2 "RemoveErasing" "initialCatsBU" $
-			       initialCatsBU rulesByCat
-			  else trace2 "RemoveErasing" ("initialCatsTD: " ++ prt starts) $
-			       initialCatsTD rulesByCat starts
-	  rulesByCat  = trace2 "RemoveErasing - erasing rules" (prt $ length grammar) $
-			accumAssoc id [ (cat, rule) | rule@(Rule (Abs cat _ _) _) <- grammar ]
-
-data Item r c = NR r | NC c deriving (Eq, Ord, Show)
-
-keyof (NR _) = True
-keyof (NC _) = False
-
-newRules grammar chart (NR (Rule (Abs _ cats _) _))
-    = [ NC cat | cat@(MCat _ lbls) <- cats, not (null lbls) ]
-newRules grammar chart (NC newCat@(MCat cat lbls))
-    = do Rule (Abs _ args (Name fun profile)) (Cnc _ _ lins0) <- grammar ? cat
-
-         lins <- selectLins lins0 lbls 
-	 -- let lins = [ lin | lin@(Lin lbl _) <- lins0, 
-	 -- 	      lbl `elem` lbls ]
-
-	 let argsInLin = listAssoc $
-			 map (\((n,c),l) -> (n, MCat c l)) $
-			 groupPairs $ nubsort $
-			 [ ((nr, cat), lbl) | 
-			   Lin _ lin <- lins, 
-			   Cat (cat, lbl, nr) <- lin ] 
-
-	     newArgs = mapMaybe (lookupAssoc argsInLin) [0 .. length args-1]
-	     argLbls = [ lbls | MCat _ lbls <- newArgs ]
-
-	     newLins = [ Lin lbl newLin | Lin lbl lin <- lins,
-			 let newLin = map (mapSymbol cnvCat id) lin ]
-	     cnvCat (cat, lbl, nr) = (mcat, lbl, nr')
-		 where Just mcat = lookupAssoc argsInLin nr
-		       Unify [nr'] = newProfile !! nr
-	     nonEmptyCat (Cat (MCat _ [], _, _)) = False
-	     nonEmptyCat _ = True
-
-	     newProfile = snd $ mapAccumL accumProf 0 $
-			  map (lookupAssoc argsInLin) [0 .. length args-1]
-	     accumProf nr = maybe (nr, Unify []) $ const (nr+1, Unify [nr])
-	     newName = -- tracePrt "newName" (prtNewName profile newProfile) $
-                       Name fun (profile `composeProfiles` newProfile)
-
-         guard $ all (not . null) argLbls
-	 return $ NR (Rule (Abs newCat newArgs newName) (Cnc lbls argLbls newLins))
-
-selectLins lins0 = mapM selectLbl
-    where selectLbl lbl = [ lin | lin@(Lin lbl' _) <- lins0, lbl == lbl' ] 
-
-
-prtNewName :: [Profile (SyntaxForest Fun)] -> [Profile (SyntaxForest Fun)] -> Name -> String
-prtNewName p p' n = prt p ++ " .o. " ++ prt p' ++ " : " ++ prt n
-
-
-initialCatsTD grammar starts =
-    [ cat | cat@(NC (MCat (ECat start _) _)) <- initialCatsBU grammar,
-      start `elem` starts ]
-
-initialCatsBU grammar 
-    = [ NC (MCat cat [lbl]) | (cat, rules) <- aAssocs grammar, 
-	let Rule _ (Cnc lbls _ _) = head rules,
-	lbl <- lbls ]
-
-
-
-
-
-
-
diff --git a/src/GF/Conversion/RemoveSingletons.hs b/src/GF/Conversion/RemoveSingletons.hs
deleted file mode 100644
index 4b9992a4d..000000000
--- a/src/GF/Conversion/RemoveSingletons.hs
+++ /dev/null
@@ -1,82 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/11 10:28:16 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
---
--- Instantiating all types which only have one single element.
---
--- Should be merged into 'GF.Conversion.FiniteToSimple'
------------------------------------------------------------------------------
-
-module GF.Conversion.RemoveSingletons where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG
-import GF.Formalism.SimpleGFC
-import GF.Conversion.Types
-
-import GF.Data.SortedList
-import GF.Data.Assoc
-
-import Data.List (mapAccumL)
-
-convertGrammar :: SGrammar -> SGrammar
-convertGrammar grammar = if singles == emptyAssoc then grammar
-			 else tracePrt "RemoveSingletons - non-singleton rules" (prt . length) $
-			      map (convertRule singles) grammar
-    where singles = calcSingletons grammar
-
-convertRule :: Assoc SCat (SyntaxForest Fun, Maybe STerm) -> SRule -> SRule
-convertRule singles rule@(Rule (Abs _ decls _) _)
-    = if all (Nothing ==) singleArgs then rule
-      else instantiateSingles singleArgs rule
-    where singleArgs = map (lookupAssoc singles . decl2cat) decls
-
-instantiateSingles :: [Maybe (SyntaxForest Fun, Maybe STerm)] -> SRule -> SRule
-instantiateSingles singleArgs (Rule (Abs decl decls (Name fun profile)) (Cnc lcat lcats lterm))
-    = Rule (Abs decl decls' (Name fun profile')) (Cnc lcat lcats' lterm')
-    where (decls', lcats') = unzip [ (d, l) | (Nothing, d, l) <- zip3 singleArgs decls lcats ]
-	  profile'  = map (fmap fst) exProfile `composeProfiles` profile
-	  newArgs   = map (fmap snd) exProfile
-	  lterm'    = fmap (instantiateLin newArgs) lterm
-	  exProfile = snd $ mapAccumL mkProfile 0 singleArgs
-	  mkProfile nr (Just trm) = (nr, Constant trm)
-	  mkProfile nr (Nothing)  = (nr+1, Unify [nr])
-
-instantiateLin :: [Profile (Maybe STerm)] -> STerm -> STerm
-instantiateLin newArgs = inst
-    where inst (Arg nr cat path) 
-	      = case newArgs !! nr of
-		  Unify [nr']          -> Arg nr' cat path
-		  Constant (Just term) -> termFollowPath path term
-		  Constant Nothing     -> error "RemoveSingletons.instantiateLin: This should not happen (argument has no linearization)"
-	  inst (cn :^ terms) = cn :^ map inst terms
-	  inst (Rec rec)     = Rec [ (lbl, inst term) | (lbl, term) <- rec ]
-	  inst (term :. lbl) = inst term +. lbl
-	  inst (Tbl tbl)     = Tbl [ (pat, inst term) | (pat, term) <- tbl ]
-	  inst (term :! sel) = inst term +! inst sel
-	  inst (Variants ts) = variants (map inst ts)
-	  inst (t1 :++ t2)   = inst t1 ?++ inst t2
-	  inst term          = term
-
-----------------------------------------------------------------------
-
-calcSingletons :: SGrammar -> Assoc SCat (SyntaxForest Fun, Maybe STerm)
-calcSingletons rules = listAssoc singleCats
-    where singleCats = tracePrt "RemoveSingletons - singleton cats" (prtSep " ") $
-		       [ (cat, (constantNameToForest name, lin)) | 
-			 (cat, [([], name, lin)]) <- rulesByCat ]
-	  rulesByCat = groupPairs $ nubsort
-		       [ (decl2cat cat, (args, name, lin)) | 
-			 Rule (Abs cat args name) (Cnc _ _ lin) <- rules ]
-
-
-
diff --git a/src/GF/Conversion/SimpleToFCFG.hs b/src/GF/Conversion/SimpleToFCFG.hs
deleted file mode 100644
index 4ff5781f9..000000000
--- a/src/GF/Conversion/SimpleToFCFG.hs
+++ /dev/null
@@ -1,536 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : Krasimir Angelov
--- Stability   : (stable)
--- Portability : (portable)
---
--- Converting SimpleGFC grammars to fast nonerasing MCFG grammar.
---
--- the resulting grammars might be /very large/
---
--- the conversion is only equivalent if the GFC grammar has a context-free backbone.
------------------------------------------------------------------------------
-
-
-module GF.Conversion.SimpleToFCFG
-    (convertConcrete) where
-
-import GF.Infra.PrintClass
-
-import Control.Monad
-
-import GF.Formalism.Utilities
-import GF.Formalism.FCFG
-
-import GF.GFCC.Macros --hiding (prt)
-import GF.GFCC.DataGFCC
-import GF.GFCC.CId
-
-import GF.Data.BacktrackM
-import GF.Data.SortedList
-import GF.Data.Utilities (updateNthM, sortNub)
-
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import qualified Data.List as List
-import Data.Array
-import Data.Maybe
-
-----------------------------------------------------------------------
--- main conversion function
-
-convertConcrete :: Abstr -> Concr -> FGrammar
-convertConcrete abs cnc = fixHoasFuns $ convert abs_defs' conc' cats'
-       where abs_defs = Map.assocs (funs abs)
-             conc = Map.union (opers cnc) (lins cnc) -- "union big+small most efficient"
-             cats = lincats cnc
-             (abs_defs',conc',cats') = expandHOAS abs_defs conc cats
-
-expandHOAS :: [(CId,(Type,Exp))] -> TermMap -> TermMap -> ([(CId,(Type,Exp))],TermMap,TermMap)
-expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns, 
-                                Map.unions [lins, hoLins, varLins], 
-                                Map.unions [lincats, hoLincats, varLincat])
-    where
-      -- replace higher-order fun argument types with new categories
-      funs' = [(f,(fixType ty,e)) | (f,(ty,e)) <- funs]
-          where
-            fixType :: Type -> Type
-            fixType ty = let (ats,rt) = typeSkeleton ty in cftype (map catName ats) rt
-
-      hoTypes :: [(Int,CId)]
-      hoTypes = sortNub [(n,c) | (_,(ty,_)) <- funs, (n,c) <- fst (typeSkeleton ty), n > 0]
-      hoCats = sortNub (map snd hoTypes)
-      -- for each Cat with N bindings, we add a new category _NCat
-      -- each new category contains a single function __NCat : Cat -> _Var -> ... -> _Var -> _NCat
-      hoFuns = [(funName ty,(cftype (c : replicate n varCat) (catName ty),EEq [])) | ty@(n,c) <- hoTypes]
-      -- lincats for the new categories
-      hoLincats = Map.fromList [(catName ty, modifyRec (++ replicate n (S [])) (lincatOf c)) | ty@(n,c) <- hoTypes]
-      -- linearizations of the new functions, lin __NCat v_0 ... v_n-1 x = { s1 = x.s1; ...; sk = x.sk; $0 = v_0.s ...
-      hoLins = Map.fromList [ (funName ty, mkLin c n) | ty@(n,c) <- hoTypes]
-          where mkLin c n = modifyRec (\fs -> [P (V 0) (C j) | j <- [0..length fs-1]] ++ [P (V i) (C 0) | i <- [1..n]]) (lincatOf c)
-      -- for each Cat, we a add a fun _Var_Cat : _Var -> Cat
-      varFuns = [(varFunName cat, (cftype [varCat] cat,EEq [])) | cat <- hoCats]
-      -- linearizations of the _Var_Cat functions
-      varLins = Map.fromList [(varFunName cat, R [P (V 0) (C 0)]) | cat <- hoCats]
-      -- lincat for the _Var category
-      varLincat = Map.singleton varCat (R [S []])
-
-      lincatOf c = fromMaybe (error $ "No lincat for " ++ prt c) $ Map.lookup c lincats
-
-      modifyRec :: ([Term] -> [Term]) -> Term -> Term
-      modifyRec f (R xs) = R (f xs)
-      modifyRec _ t = error $ "Not a record: " ++ show t
-
-      varCat = CId "_Var"
-
-      catName :: (Int,CId) -> CId
-      catName (0,c) = c
-      catName (n,CId c) = CId ("_" ++ show n ++ c)
-
-      funName :: (Int,CId) -> CId
-      funName (n,CId c) = CId ("__" ++ show n ++ c)
-
-      varFunName :: CId -> CId
-      varFunName (CId c) = CId ("_Var_" ++ c)
-
--- replaces __NCat with _B and _Var_Cat with _.
--- the temporary names are just there to avoid name collisions.
-fixHoasFuns :: FGrammar -> FGrammar
-fixHoasFuns (rs, cs) = ([FRule (fixName n) args cat lins | FRule n args cat lins <- rs], cs)
-  where fixName (Name (CId ('_':'_':_)) p) = Name (CId "_B") p
-        fixName (Name (CId n) p) | "_Var_" `List.isPrefixOf` n = Name wildCId p
-        fixName n = n
-
-convert :: [(CId,(Type,Exp))] -> TermMap -> TermMap -> FGrammar
-convert abs_defs cnc_defs cat_defs = getFGrammar (loop frulesEnv)
-      where
-        srules = [
-          (XRule id args res (map findLinType args) (findLinType res) term) | 
-            (id, (ty,_)) <- abs_defs, let (args,res) = catSkeleton ty, 
-            term <- Map.lookup id cnc_defs]
-        
-        findLinType id = fromMaybe (error $ "No lincat for " ++ show id) (Map.lookup id cat_defs)
-
-        (xrulesMap,frulesEnv) = List.foldl' helper (Map.empty,emptyFRulesEnv) srules
-           where
-	     helper (xrulesMap,frulesEnv) rule@(XRule id abs_args abs_res cnc_args cnc_res term) = 
-	       let xrulesMap' = Map.insertWith (++) abs_res [rule] xrulesMap
-	           frulesEnv' = List.foldl' (\env selector -> convertRule cnc_defs selector rule env)
-	                                    frulesEnv
-	                                    (mkSingletonSelectors cnc_defs cnc_res)
-               in xrulesMap' `seq` frulesEnv' `seq` (xrulesMap',frulesEnv')
-
-        loop frulesEnv =
-          let (todo, frulesEnv') = takeToDoRules xrulesMap frulesEnv
-          in case todo of
-               [] -> frulesEnv'
-               _  -> loop $! List.foldl' (\env (srules,selector) -> 
-                             List.foldl' (\env srule             -> convertRule cnc_defs selector srule env) env srules) frulesEnv' todo
-
-convertRule :: TermMap -> TermSelector -> XRule -> FRulesEnv -> FRulesEnv
-convertRule cnc_defs selector (XRule fun args cat ctypes ctype term) frulesEnv =
-  foldBM addRule
-         frulesEnv
-         (convertTerm cnc_defs selector term [([],[])])
-         (protoFCat cat, map (\scat -> (protoFCat scat,[])) args, ctype, ctypes)
-  where
-    addRule linRec (newCat', newArgs', _, _) env0 =
-      let (env1, newCat)          = genFCatHead env0 newCat'
-          (env2, newArgs,idxArgs) = foldr (\((xcat@(PFCat cat rcs tcs),xpaths),ctype,idx) (env,args,all_args) ->
-                                       let xargs          = xcat:[PFCat cat [path] tcs | path <- reverse xpaths]
-                                           (env1, xargs1) = List.mapAccumL (genFCatArg cnc_defs ctype) env xargs
-                                       in case xcat of
-                                            PFCat _ [] _ -> (env ,        args,                       all_args)
-                                            _            -> (env1,xargs1++args,(idx,zip xargs1 xargs):all_args)) (env1,[],[]) (zip3 newArgs' ctypes [0..])
-
-          newLinRec = listArray (0,length linRec-1) [translateLin idxArgs path linRec | path <- case newCat' of {PFCat _ rcs _ -> rcs}]
-
-          (_,newProfile) = List.mapAccumL accumProf 0 newArgs'
-            where
-              accumProf nr (PFCat _ [] _,_     ) = (nr,       Unify []          )
-              accumProf nr (_           ,xpaths) = (nr+cnt+1, Unify [nr..nr+cnt])
-                where cnt = length xpaths
-
-          rule = FRule (Name fun newProfile) newArgs newCat newLinRec
-      in addFRule env2 rule
-
-translateLin idxArgs lbl' []                    = array (0,-1) []
-translateLin idxArgs lbl' ((lbl,syms) : lins)
-  | lbl' == lbl = listArray (0,length syms-1) (map instSym syms)
-  | otherwise   = translateLin idxArgs lbl' lins
-  where
-    instSym = symbol (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok
-    instCat lbl nr xnr nr' ((idx,xargs):idxArgs)
-      | nr == idx = let (fcat, PFCat _ rcs _) = xargs !! xnr
-                    in FSymCat fcat (index lbl rcs 0) (nr'+xnr)
-      | otherwise = instCat lbl nr xnr (nr'+length xargs) idxArgs
-
-    index lbl' (lbl:lbls) idx
-      | lbl' == lbl = idx
-      | otherwise   = index lbl' lbls $! (idx+1)
-
-
-----------------------------------------------------------------------
--- term conversion
-
-type CnvMonad a = BacktrackM Env a
-
-type Env     = (ProtoFCat, [(ProtoFCat,[FPath])], Term, [Term])
-type LinRec  = [(FPath, [Symbol (FPath, FIndex, Int) FToken])]
-
-type TermMap = Map.Map CId Term
-
-convertTerm :: TermMap -> TermSelector -> Term -> LinRec -> CnvMonad LinRec
-convertTerm cnc_defs selector (V nr)       ((lbl_path,lin) : lins) = convertArg selector nr []    lbl_path lin lins
-convertTerm cnc_defs selector (C nr)       ((lbl_path,lin) : lins) = convertCon selector nr       lbl_path lin lins
-convertTerm cnc_defs selector (R record)   ((lbl_path,lin) : lins) = convertRec cnc_defs selector 0 record lbl_path lin lins
-
-convertTerm cnc_defs selector (P term sel)                   lins  = do nr <- evalTerm cnc_defs [] sel
-                                                                        convertTerm cnc_defs (TuplePrj nr selector) term lins
-convertTerm cnc_defs selector (FV vars)                      lins  = do term <- member vars
-                                                                        convertTerm cnc_defs selector term lins
-convertTerm cnc_defs selector (S ts)       ((lbl_path,lin) : lins) = do projectHead lbl_path
-                                                                        foldM (\lins t -> convertTerm cnc_defs selector t lins) ((lbl_path,lin) : lins) (reverse ts)
-convertTerm cnc_defs selector (K (KS str)) ((lbl_path,lin) : lins) = 
-  do projectHead lbl_path
-     return ((lbl_path,Tok str : lin) : lins)
-convertTerm cnc_defs selector (K (KP strs vars))((lbl_path,lin) : lins) = 
-  do projectHead lbl_path
-     toks <- member (strs:[strs' | Var strs' _ <- vars])
-     return ((lbl_path, map Tok toks ++ lin) : lins)
-convertTerm cnc_defs selector (RP _ term)                    lins  = convertTerm cnc_defs selector term lins
-convertTerm cnc_defs selector (F id)                         lins  = do term <- Map.lookup id cnc_defs
-                                                                        convertTerm cnc_defs selector term lins
-convertTerm cnc_defs selector (W s t)     ((lbl_path,lin) : lins) = do
-  ss <- case t of
-    R ss -> return ss
-    F f -> do
-      t <- Map.lookup f cnc_defs 
-      case t of
-        R ss -> return ss
-  convertRec cnc_defs selector 0 [K (KS (s ++ s1)) | K (KS s1) <- ss] lbl_path lin lins
-convertTerm cnc_defs selector x lins  = error ("convertTerm ("++show x++")")
-
-
-convertArg (TupleSel record)  nr path lbl_path lin lins =
-  foldM (\lins (lbl,  selector) -> convertArg selector nr (lbl:path)  (lbl:lbl_path) lin lins) lins record
-convertArg (TuplePrj lbl selector) nr path lbl_path lin lins = 
-  convertArg selector nr (lbl:path) lbl_path lin lins
-convertArg (ConSel indices) nr path lbl_path lin lins = do
-  index <- member indices
-  restrictHead lbl_path index
-  restrictArg nr path index
-  return lins
-convertArg StrSel nr path lbl_path lin lins = do
-  projectHead lbl_path
-  xnr <- projectArg nr path
-  return ((lbl_path, GF.Formalism.Utilities.Cat (path, nr, xnr) : lin) : lins)
-
-convertCon (ConSel indices) index lbl_path lin lins = do
-  guard (index `elem` indices)
-  restrictHead lbl_path index
-  return lins
-convertCon x _ _ _ _ = error $ "SimpleToFCFG,convertCon: " ++ show x
-
-convertRec cnc_defs selector                   index []           lbl_path lin lins = return lins
-convertRec cnc_defs selector@(TupleSel fields) index (val:record) lbl_path lin lins = select fields
-  where
-    select []                          = convertRec cnc_defs selector (index+1) record lbl_path lin lins
-    select ((index',sub_sel) : fields)
-      | index == index'                = do lins <- convertTerm cnc_defs sub_sel val ((index:lbl_path,lin) : lins)
-                                            convertRec cnc_defs selector (index+1) record lbl_path lin lins
-      | otherwise                      = select fields
-convertRec cnc_defs (TuplePrj index' sub_sel) index record lbl_path lin lins = do
-  convertTerm cnc_defs sub_sel (record !! (index'-index)) ((lbl_path,lin) : lins)
-
-
-------------------------------------------------------------
--- eval a term to ground terms
-
-evalTerm :: TermMap -> FPath -> Term -> CnvMonad FIndex
-evalTerm cnc_defs path (V nr)       = do term <- readArgCType nr
-                                         unifyPType nr (reverse path) (selectTerm path term)
-evalTerm cnc_defs path (C nr)       = return nr
-evalTerm cnc_defs path (R record)   = case path of
-                                        (index:path) -> evalTerm cnc_defs path (record !! index)
-evalTerm cnc_defs path (P term sel) = do index <- evalTerm cnc_defs [] sel
-                                         evalTerm cnc_defs (index:path) term
-evalTerm cnc_defs path (FV terms)   = member terms >>= evalTerm cnc_defs path
-evalTerm cnc_defs path (RP alias _) = evalTerm cnc_defs path alias
-evalTerm cnc_defs path (F id)       = do term <- Map.lookup id cnc_defs
-                                         evalTerm cnc_defs path term
-evalTerm cnc_defs path x = error ("evalTerm ("++show x++")")
-
-unifyPType :: FIndex -> FPath -> Term -> CnvMonad FIndex
-unifyPType nr path (C max_index) =
-    do (_, args, _, _) <- readState
-       let (PFCat _ _ tcs,_) = args !! nr
-       case lookup path tcs of
-         Just index -> return index
-         Nothing    -> do index <- member [0..max_index]
-		          restrictArg nr path index
-		          return index
-unifyPType nr path (RP alias _) = unifyPType nr path alias
-
-unifyPType nr path t = error $ "unifyPType " ++ show t ---- AR 2/10/2007
-
-selectTerm :: FPath -> Term -> Term
-selectTerm []           term        = term
-selectTerm (index:path) (R  record) = selectTerm path (record !! index)
-selectTerm path         (RP _ term) = selectTerm path term
-
-
-----------------------------------------------------------------------
--- FRulesEnv
-
-data FRulesEnv = FRulesEnv {-# UNPACK #-} !Int FCatSet [FRule]
-type FCatSet   = Map.Map CId (Map.Map [FPath] (Map.Map [(FPath,FIndex)] (Either FCat FCat)))
-
-data ProtoFCat = PFCat CId [FPath] [(FPath,FIndex)]
-
-protoFCat :: CId -> ProtoFCat
-protoFCat cat = PFCat cat [] []
-
-emptyFRulesEnv = FRulesEnv 0 (ins fcatString (CId "String") [[0]] [] $
-                              ins fcatInt    (CId "Int")    [[0]] [] $
-                              ins fcatFloat  (CId "Float")  [[0]] [] $
-                              ins fcatVar    (CId "_Var")   [[0]] [] $
-                              Map.empty) []
-  where
-    ins fcat cat rcs tcs fcatSet =
-      Map.insertWith (\_ -> Map.insertWith (\_ -> Map.insert tcs right_fcat) rcs tmap_s) cat rmap_s fcatSet
-      where
-        right_fcat = Right fcat
-        tmap_s = Map.singleton tcs right_fcat
-        rmap_s = Map.singleton rcs tmap_s
-
-addFRule :: FRulesEnv -> FRule -> FRulesEnv
-addFRule (FRulesEnv last_id fcatSet rules) rule = FRulesEnv last_id fcatSet (rule:rules)
-
-getFGrammar :: FRulesEnv -> FGrammar
-getFGrammar (FRulesEnv last_id fcatSet rules) = (rules, Map.map getFCatList fcatSet)
-  where
-    getFCatList rcs = Map.fold (\tcs lst -> Map.fold (\x lst -> either id id x : lst) lst tcs) [] rcs
-
-genFCatHead :: FRulesEnv -> ProtoFCat -> (FRulesEnv, FCat)
-genFCatHead env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs tcs) =
-  case Map.lookup cat fcatSet >>= Map.lookup rcs >>= Map.lookup tcs of
-    Just (Left  fcat) -> (FRulesEnv last_id (ins fcat) rules, fcat)
-    Just (Right fcat) -> (env, fcat)
-    Nothing           -> let fcat = last_id+1
-                         in (FRulesEnv fcat (ins fcat) rules, fcat)
-  where
-    ins fcat = Map.insertWith (\_ -> Map.insertWith (\_ -> Map.insert tcs right_fcat) rcs tmap_s) cat rmap_s fcatSet
-      where
-        right_fcat = Right fcat
-        tmap_s = Map.singleton tcs right_fcat
-        rmap_s = Map.singleton rcs tmap_s
-
-genFCatArg :: TermMap -> Term -> FRulesEnv -> ProtoFCat -> (FRulesEnv, FCat)
-genFCatArg cnc_defs ctype env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs tcs) =
-  case Map.lookup cat fcatSet >>= Map.lookup rcs of
-    Just tmap -> case Map.lookup tcs tmap of
-                   Just (Left  fcat) -> (env,   fcat)
-                   Just (Right fcat) -> (env,   fcat)
-                   Nothing           -> ins tmap
-    Nothing   -> ins Map.empty
-  where
-    ins tmap =
-      let fcat = last_id+1
-          (either_fcat,last_id1,tmap1,rules1)
-                  = foldBM (\tcs st (either_fcat,last_id,tmap,rules) ->
-                                   let (last_id1,tmap1,fcat_arg) = addArg tcs last_id tmap
-                                       rule = FRule (Name (CId "_") [Unify [0]]) [fcat_arg] fcat
-                                                    (listArray (0,length rcs-1) [listArray (0,0) [FSymCat fcat_arg lbl 0] | lbl <- [0..length rcs-1]])
-                                   in if st
-                                        then (Right fcat, last_id1,tmap1,rule:rules)
-                                        else (either_fcat,last_id, tmap,      rules))
-                           (Left fcat,fcat,Map.insert tcs either_fcat tmap,rules)
-                           (gen_tcs ctype [] [])
-                           False
-          rmap1 = Map.singleton rcs tmap1
-      in (FRulesEnv last_id1 (Map.insertWith (\_ -> Map.insert rcs tmap1) cat rmap1 fcatSet) rules1, fcat)
-      where
-        addArg tcs last_id tmap =
-	  case Map.lookup tcs tmap of
-	    Just (Left  fcat) -> (last_id, tmap, fcat)
-	    Just (Right fcat) -> (last_id, tmap, fcat)
-	    Nothing           -> let fcat = last_id+1
-                                 in (fcat, Map.insert tcs (Left fcat) tmap, fcat)
-
-    gen_tcs :: Term -> FPath -> [(FPath,FIndex)] -> BacktrackM Bool [(FPath,FIndex)]
-    gen_tcs (R record)    path acc = foldM (\acc (label,ctype) -> gen_tcs ctype (label:path) acc) acc (zip [0..] record)
-    gen_tcs (S _)         path acc = return acc
-    gen_tcs (RP _ term)   path acc = gen_tcs term path acc
-    gen_tcs (C max_index) path acc =
-      case List.lookup path tcs of
-        Just index -> return $! addConstraint path index acc
-        Nothing    -> do writeState True
-                         index <- member [0..max_index]
-                         return $! addConstraint path index acc
-      where
-        addConstraint path0 index0 (c@(path,index) : cs)
-	  | path0 > path = c:addConstraint path0 index0 cs
-        addConstraint path0 index0 cs  = (path0,index0) : cs
-    gen_tcs (F id)        path acc = case Map.lookup id cnc_defs of
-                                        Just term -> gen_tcs term path acc
-                                        Nothing   -> error ("unknown identifier: "++prt id)
-
-
-
-------------------------------------------------------------
--- TODO queue organization
-
-type XRulesMap = Map.Map CId [XRule]
-data XRule     = XRule CId     {- function -}
-                       [CId]   {- argument types -}
-                       CId     {- result   type  -}
-                       [Term]  {- argument lin-types representation -}
-                       Term    {- result   lin-type  representation -}
-                       Term    {- body -}
-
-takeToDoRules :: XRulesMap -> FRulesEnv -> ([([XRule], TermSelector)], FRulesEnv)
-takeToDoRules xrulesMap (FRulesEnv last_id fcatSet rules) = (todo,FRulesEnv last_id fcatSet' rules)
-  where
-    (todo,fcatSet') =
-          Map.mapAccumWithKey (\todo cat rmap ->
-                let (todo1,rmap1) = Map.mapAccumWithKey (\todo rcs tmap -> 
-                                          let (tcss,tmap') = Map.mapAccumWithKey (\tcss tcs either_xcat ->
-                                                                   case either_xcat of
-                                                                     Left  xcat -> (tcs:tcss,Right xcat)
-                                                                     Right xcat -> (    tcss,either_xcat)) [] tmap
-                                          in case tcss of
-                                               [] -> (                               todo,tmap )
-                                               _  -> ((srules,mkSelector rcs tcss) : todo,tmap')) todo rmap
-                    mb_srules   = Map.lookup cat xrulesMap
-                    Just srules = mb_srules
-
-                in case mb_srules of
-                     Just srules -> (todo1,rmap1)
-                     Nothing     -> (todo ,rmap1)) [] fcatSet
-
-
-------------------------------------------------------------
--- The TermSelector
-
-data TermSelector
-  = TupleSel [(FIndex, TermSelector)]
-  | TuplePrj   FIndex  TermSelector
-  | ConSel   [FIndex]
-  | StrSel
-  deriving Show
-
-mkSingletonSelectors :: TermMap 
-                     -> Term               -- ^ Type representation term
-                     -> [TermSelector]     -- ^ list of selectors containing just one string field
-mkSingletonSelectors cnc_defs term = sels0
-  where
-    (sels0,tcss0) = loop [] ([],[]) term
-
-    loop path st          (R record) = List.foldl' (\st (index,term) -> loop (index:path) st term) st (zip [0..] record)
-    loop path st          (RP _ t)   = loop path st t
-    loop path (sels,tcss) (C i)      = (                          sels,map ((,) path) [0..i] : tcss)
-    loop path (sels,tcss) (S _)      = (mkSelector [path] tcss0 : sels,                        tcss)
-    loop path (sels,tcss) (F id)     = case Map.lookup id cnc_defs of
-                                         Just term -> loop path (sels,tcss) term
-                                         Nothing   -> error ("unknown identifier: "++prt id)
-
-mkSelector :: [FPath] -> [[(FPath,FIndex)]] -> TermSelector
-mkSelector rcs tcss =
-  List.foldl' addRestriction (case xs of
-                                (path:xs) -> List.foldl' addProjection (path2selector StrSel path) xs) ys
-  where
-    xs = [ reverse path       |               path       <- rcs]
-    ys = [(reverse path,term) | tcs <- tcss, (path,term) <- tcs]
-    
-    addRestriction :: TermSelector -> (FPath,FIndex) -> TermSelector
-    addRestriction (ConSel indices)  ([]          ,n_index) = ConSel (add indices)
-      where
-        add []                      = [n_index]
-        add (index':indices)
-          | n_index == index'       = index':    indices
-          | otherwise               = index':add indices
-    addRestriction (TupleSel fields) (index : path,n_index) = TupleSel (add fields)
-      where
-        add []                      = [(index,path2selector (ConSel [n_index]) path)]
-        add (field@(index',sub_sel):fields)
-          | index == index'         = (index',addRestriction sub_sel (path,n_index)):fields
-          | otherwise               = field : add fields
-
-    addProjection :: TermSelector -> FPath -> TermSelector
-    addProjection StrSel            []             = StrSel
-    addProjection (TupleSel fields) (index : path) = TupleSel (add fields)
-      where
-        add []                      = [(index,path2selector StrSel path)]
-        add (field@(index',sub_sel):fields)
-          | index == index'         = (index',addProjection sub_sel path):fields
-          | otherwise               = field : add fields
-    
-    path2selector base []             = base
-    path2selector base (index : path) = TupleSel [(index,path2selector base path)]
-
-------------------------------------------------------------
--- updating the MCF rule
-
-readArgCType :: FIndex -> CnvMonad Term
-readArgCType nr = do (_, _, _, ctypes) <- readState
-		     return (ctypes !! nr)
-
-restrictArg :: FIndex -> FPath -> FIndex -> CnvMonad ()
-restrictArg nr path index = do
-  (head, args, ctype, ctypes) <- readState 
-  args' <- updateNthM (\(xcat,xs) -> do xcat <- restrictProtoFCat path index xcat
-                                        return (xcat,xs)                         ) nr args
-  writeState (head, args', ctype, ctypes)
-
-projectArg :: FIndex -> FPath -> CnvMonad Int
-projectArg nr path = do
-  (head, args, ctype, ctypes) <- readState
-  (xnr,args') <- updateArgs nr args
-  writeState (head, args', ctype, ctypes)
-  return xnr
-  where
-    updateArgs :: FIndex -> [(ProtoFCat,[FPath])] -> CnvMonad (Int,[(ProtoFCat,[FPath])])
-    updateArgs 0 ((a@(PFCat _ rcs _),xpaths) : as)
-      | path `elem` rcs = return (length xpaths+1,(a,path:xpaths):as)
-      | otherwise       = do a <- projectProtoFCat path a
-                             return (0,(a,xpaths):as)
-    updateArgs n (a : as) = do
-      (xnr,as) <- updateArgs (n-1) as
-      return (xnr,a:as)
-
-readHeadCType :: CnvMonad Term
-readHeadCType = do (_, _, ctype, _) <- readState
-		   return ctype
-
-restrictHead :: FPath -> FIndex -> CnvMonad ()
-restrictHead path term
-    = do (head, args, ctype, ctypes) <- readState
-	 head' <- restrictProtoFCat path term head
-	 writeState (head', args, ctype, ctypes)
-
-projectHead :: FPath -> CnvMonad ()
-projectHead path
-    = do (head, args, ctype, ctypes) <- readState
-	 head' <- projectProtoFCat path head
-	 writeState (head', args, ctype, ctypes)
-
-restrictProtoFCat :: FPath -> FIndex -> ProtoFCat -> CnvMonad ProtoFCat
-restrictProtoFCat path0 index0 (PFCat cat rcs tcs) = do
-  tcs <- addConstraint tcs
-  return (PFCat cat rcs tcs)
-  where
-    addConstraint (c@(path,index) : cs)
-        | path0 >  path = liftM (c:) (addConstraint cs)
-        | path0 == path = guard (index0 == index) >>
-                          return (c : cs)
-    addConstraint cs    = return ((path0,index0) : cs)
-
-projectProtoFCat :: FPath -> ProtoFCat -> CnvMonad ProtoFCat
-projectProtoFCat path0 (PFCat cat rcs tcs) = do
-  return (PFCat cat (addConstraint rcs) tcs)
-  where
-    addConstraint (path : rcs)
-        | path0 >  path = path  : addConstraint rcs
-        | path0 == path = path  : rcs
-    addConstraint rcs   = path0 : rcs
diff --git a/src/GF/Conversion/SimpleToFinite.hs b/src/GF/Conversion/SimpleToFinite.hs
deleted file mode 100644
index bbd3ae355..000000000
--- a/src/GF/Conversion/SimpleToFinite.hs
+++ /dev/null
@@ -1,178 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/01 09:53:19 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.7 $
---
--- Calculating the finiteness of each type in a grammar
------------------------------------------------------------------------------
-
-module GF.Conversion.SimpleToFinite
-    (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import GF.Formalism.GCFG
-import GF.Formalism.SimpleGFC
-import GF.Formalism.Utilities 
-import GF.Conversion.Types
-
-import GF.Data.SortedList
-import GF.Data.Assoc
-import GF.Data.BacktrackM
-import GF.Data.Utilities (lookupList)
-
-import GF.Infra.Ident (Ident(..))
-
-type CnvMonad a = BacktrackM () a
-
-convertGrammar :: SGrammar -> SGrammar
-convertGrammar rules = tracePrt "SimpleToFinie - nr. 'finite' rules" (prt . length) $
-		       solutions cnvMonad ()
-    where split = calcSplitable rules
-	  cnvMonad = member rules >>= convertRule split
-
-convertRule :: Splitable -> SRule -> CnvMonad SRule
-convertRule split (Rule abs cnc) 
-    = do newAbs <- convertAbstract split abs
-	 return $ Rule newAbs cnc
-
-{-
--- old code
-convertAbstract :: Splitable -> Abstract SDecl Name
-		-> CnvMonad (Abstract SDecl Name)
-convertAbstract split (Abs decl decls name)
-    = case splitableFun split (name2fun name) of
-        Just cat' -> return $ Abs (Decl anyVar (mergeFun (name2fun name) cat') []) decls name
-	Nothing -> expandTyping split name [] decl decls []
-
-
-expandTyping :: Splitable -> Name -> [(Var, SCat)] -> SDecl -> [SDecl] -> [SDecl] 
-	     -> CnvMonad (Abstract SDecl Name)
-expandTyping split name env (Decl x cat args) [] decls 
-    = return $ Abs decl (reverse decls) name
-    where decl = substArgs split x env cat args []
-expandTyping split name env typ (Decl x xcat xargs : declsToDo) declsDone
-    = do (x', xcat', env') <- calcNewEnv
-         let decl = substArgs split x' env xcat' xargs []
-	 expandTyping split name env' typ declsToDo (decl : declsDone)
-    where calcNewEnv = case splitableCat split xcat of
-		         Just newFuns -> do newFun <- member newFuns
-                                            let newCat  = mergeFun newFun xcat
-		         -- Just newCats -> do newCat <- member newCats
-					    return (anyVar, newCat, (x,newCat) : env)
-			 Nothing -> return (x, xcat, env)
--}
-
--- new code
-convertAbstract :: Splitable -> Abstract SDecl Name
-		-> CnvMonad (Abstract SDecl Name)
-convertAbstract split (Abs decl decls name)
-    = case splitableFun split fun of
-        Just cat' -> return $ Abs (Decl anyVar ([] ::--> (mergeFun fun cat' ::@ []))) decls name
-	Nothing -> expandTyping split [] fun profiles [] decl decls []
-    where Name fun profiles = name
-
-expandTyping :: Splitable -> [(Var, SCat)]
-             -> Fun -> [Profile (SyntaxForest Fun)] -> [Profile (SyntaxForest Fun)] 
-             -> SDecl -> [SDecl] -> [SDecl] 
-	     -> CnvMonad (Abstract SDecl Name)
-expandTyping split env fun [] profiles (Decl x (typargs ::--> (cat ::@ args))) [] decls 
-    = return $ Abs decl (reverse decls) (Name fun (reverse profiles))
-    where decl = substArgs split x env typargs cat args []
-expandTyping split env fun (prof:profiles) profsDone typ 
-                 (Decl x (xtypargs ::--> (xcat ::@ xargs)) : declsToDo) declsDone
-    = do (x', xcat', env', prof') <- calcNewEnv
-         let decl = substArgs split x' env xtypargs xcat' xargs []
-	 expandTyping split env' fun profiles (prof' : profsDone) typ declsToDo (decl : declsDone)
-    where calcNewEnv = case splitableCat split xcat of
-			 Nothing      -> return (x, xcat, env, prof)
-		         Just newFuns -> do newFun <- member newFuns
-                                            let newCat  = mergeFun newFun xcat
-                                                newProf = Constant (FNode newFun [[]])
-                                            -- should really be using some kind of
-                                            -- "profile unification"
-					    return (anyVar, newCat, (x,newCat) : env, newProf)
-
-substArgs :: Splitable -> Var -> [(Var, SCat)] -> [FOType SCat]
-	  -> SCat -> [TTerm] -> [TTerm] -> SDecl
-substArgs split x env typargs cat [] args = Decl x (typargs ::--> (cat ::@ reverse args))
-substArgs split x env typargs cat (arg:argsToDo) argsDone
-    = case argLookup split env arg of
-        Just newCat -> substArgs split x env typargs (mergeArg cat newCat) argsToDo argsDone
-	Nothing     -> substArgs split x env typargs cat argsToDo (arg : argsDone)
-
-argLookup split env (TVar x)   = lookup x env 
-argLookup split env (con :@ _) = fmap (mergeFun fun) (splitableFun split fun)
-    where fun = constr2fun con
-      
-
-----------------------------------------------------------------------
--- splitable categories (finite, no dependencies)
--- they should also be used as some dependency
-
-type Splitable = (Assoc SCat [Fun], Assoc Fun SCat)
-
-splitableCat :: Splitable -> SCat -> Maybe [Fun]
-splitableCat = lookupAssoc . fst 
-
-splitableFun :: Splitable -> Fun -> Maybe SCat
-splitableFun = lookupAssoc . snd
-
-calcSplitable :: [SRule] -> Splitable
-calcSplitable rules = (listAssoc splitableCat2Funs, listAssoc splitableFun2Cat)
-    where splitableCat2Funs = groupPairs $ nubsort splitableCatFuns
-
-	  splitableFun2Cat = nubsort
-			     [ (fun, cat) | (cat, fun) <- splitableCatFuns ]
-
-          -- cat-fun pairs that are splitable
-	  splitableCatFuns = tracePrt "SimpleToFinite - splitable functions" prt $
-                             [ (cat, name2fun name) |
-			       Rule (Abs (Decl _ ([] ::--> (cat ::@ []))) [] name) _ <- rules,
-			       splitableCats ?= cat ]
-
-          -- all cats that are splitable
-          splitableCats = listSet $
-			  tracePrt "SimpleToFinite - finite categories to split" prt $
-			  (nondepCats <**> depCats) <\\> resultCats
-
-          -- all result cats for some pure function
-	  resultCats = tracePrt "SimpleToFinite - result cats" prt $
-                       nubsort [ cat | Rule (Abs (Decl _ (_ ::--> (cat ::@ _))) decls _) _ <- rules,
-				 not (null decls) ]
-
-          -- all cats in constants without dependencies
-          nondepCats = tracePrt "SimpleToFinite - nondep cats" prt $
-                       nubsort [ cat | Rule (Abs (Decl _ ([] ::--> (cat ::@ []))) [] _) _ <- rules ]
-
-          -- all cats occurring as some dependency of another cat
-	  depCats = tracePrt "SimpleToFinite - dep cats" prt $
-                    nubsort [ cat | Rule (Abs decl decls _) _ <- rules,
-			      cat <- varCats [] (decls ++ [decl]) ]
-
-	  varCats _ [] = []
-	  varCats env (Decl x (xargs ::--> xtyp@(xcat ::@ _)) : decls)
-	      = varCats ((x,xcat) : env) decls ++
-		[ cat | (_::@args) <- (xtyp:xargs), arg <- args, 
-                  y <- varsInTTerm arg, cat <- lookupList y env ]
-
-
-----------------------------------------------------------------------
--- utilities
--- mergeing categories
-
-mergeCats :: String -> String -> String -> SCat -> SCat -> SCat
-mergeCats before middle after (IC cat) (IC arg) 
-    = IC (before ++ cat ++ middle ++ arg ++ after)
-
-mergeFun, mergeArg :: SCat -> SCat -> SCat
-mergeFun = mergeCats "{" ":" "}"
-mergeArg = mergeCats "" "" ""
-
-
diff --git a/src/GF/Conversion/SimpleToMCFG.hs b/src/GF/Conversion/SimpleToMCFG.hs
deleted file mode 100644
index 8f23c905d..000000000
--- a/src/GF/Conversion/SimpleToMCFG.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/18 14:55:32 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
---
--- All different conversions from SimpleGFC to MCFG
------------------------------------------------------------------------------
-
-module GF.Conversion.SimpleToMCFG where
-
-import GF.Formalism.SimpleGFC 
-import GF.Conversion.Types
-
-import qualified GF.Conversion.SimpleToMCFG.Strict as Strict
-import qualified GF.Conversion.SimpleToMCFG.Nondet as Nondet
-import qualified GF.Conversion.SimpleToMCFG.Coercions as Coerce
-
-convertGrammarNondet, convertGrammarStrict :: SGrammar -> EGrammar
-convertGrammarNondet = Coerce.addCoercions . Nondet.convertGrammar
-convertGrammarStrict = Strict.convertGrammar
-
diff --git a/src/GF/Conversion/SimpleToMCFG/Coercions.hs b/src/GF/Conversion/SimpleToMCFG/Coercions.hs
deleted file mode 100644
index 319b99dcb..000000000
--- a/src/GF/Conversion/SimpleToMCFG/Coercions.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/09 09:28:44 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
---
--- Adding coercion functions to a MCFG if necessary.
------------------------------------------------------------------------------
-
-
-module GF.Conversion.SimpleToMCFG.Coercions
-    (addCoercions) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG
-import GF.Formalism.MCFG
-import GF.Conversion.Types 
-import GF.Data.SortedList
-import Data.List (groupBy)
-
-----------------------------------------------------------------------
-
-addCoercions :: EGrammar -> EGrammar
-addCoercions rules = coercions ++ rules
-    where (allHeads, allArgs) = unzip [ ((head, lbls), nubsort args) | 
-					Rule (Abs head args _) (Cnc lbls _ _) <- rules ]
-	  allHeadSet = nubsort allHeads
-	  allArgSet  = union   allArgs <\\> map fst allHeadSet
-	  coercions = tracePrt "SimpleToMCFG.Coercions - MCFG coercions" (prt . length) $
-		      concat $
-		      tracePrt "SimpleToMCFG.Coercions - MCFG coercions per category" 
-				   (prtList . map length) $
-		      combineCoercions 
-		        (groupBy sameECatFst allHeadSet) 
-			(groupBy sameECat    allArgSet)
-	  sameECatFst a b = sameECat (fst a) (fst b)
-
-
-combineCoercions [] _ = []
-combineCoercions _ [] = []
-combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs) 
-    = case compare (ecat2scat $ fst $ head heads) (ecat2scat $ head args) of
-        LT -> combineCoercions allHeads  allArgs'
-	GT -> combineCoercions allHeads' allArgs
-	EQ -> makeCoercion heads args : combineCoercions allHeads allArgs
-
-
-makeCoercion heads args
-    = [ Rule (Abs arg [head] coercionName) (Cnc lbls [lbls] lins)  |
-	(head@(ECat _ headCns), lbls) <- heads, 
-	let lins = [ Lin lbl [Cat (head, lbl, 0)] | lbl <- lbls ],
-	arg@(ECat _ argCns) <- args,
-	argCns `subset` headCns ]
-
-
-
diff --git a/src/GF/Conversion/SimpleToMCFG/Nondet.hs b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
deleted file mode 100644
index d6ff052f5..000000000
--- a/src/GF/Conversion/SimpleToMCFG/Nondet.hs
+++ /dev/null
@@ -1,256 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/08/17 08:27:29 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.7 $
---
--- Converting SimpleGFC grammars to MCFG grammars, nondeterministically.
--- Afterwards, the grammar has to be extended with coercion functions,
--- from the module 'GF.Conversion.SimpleToMCFG.Coercions'
---
--- the resulting grammars might be /very large/
---
--- the conversion is only equivalent if the GFC grammar has a context-free backbone.
------------------------------------------------------------------------------
-
-
-module GF.Conversion.SimpleToMCFG.Nondet
-    (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import Control.Monad
-
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG 
-import GF.Formalism.MCFG 
-import GF.Formalism.SimpleGFC 
-import GF.Conversion.Types
-
-import GF.Data.BacktrackM
-import GF.Data.Utilities (notLongerThan, updateNthM)
-
-------------------------------------------------------------
--- type declarations
-
-type CnvMonad a = BacktrackM Env a
-
-type Env    = (ECat, [ECat], LinRec, [SLinType]) -- variable bindings: [(Var, STerm)]
-type LinRec = [Lin SCat MLabel Token]
-
-
-----------------------------------------------------------------------
--- main conversion function
-
-maxNrRules :: Int
-maxNrRules = 5000
-
-convertGrammar :: SGrammar -> EGrammar 
-convertGrammar rules = traceCalcFirst rules' $
-		       tracePrt "SimpleToMCFG.Nondet - MCFG rules" (prt . length) $
-		       rules'
-    where rules' = rules >>= convertRule
---		       solutions conversion undefined
---    where conversion = member rules >>= convertRule
-
-convertRule :: SRule -> [ERule] -- CnvMonad ERule
-convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term))) =
---    | prt(name2fun fun) `elem` 
---      words "UseCl PosTP TPast ASimul SPredV IndefOneNP DefOneNP UseN2 mother_N2 jump_V" =
-    if notLongerThan maxNrRules rules 
-       then tracePrt ("SimpeToMCFG.Nondet - MCFG rules for " ++ prt fun) (prt . length) $
-	    rules
-       else trace2 "SimpeToMCFG.Nondet - TOO MANY RULES, function not converted" 
-		("More than " ++ show maxNrRules ++ " MCFG rules for " ++ prt fun) $
-            []
-    where rules = flip solutions undefined $
-		  do let cat : args = map decl2cat (decl : decls)
-		     writeState (initialECat cat, map initialECat args, [], ctypes)
-		     rterm <- simplifyTerm term
-		     reduceTerm ctype emptyPath rterm
-		     (newCat, newArgs, linRec, _) <- readState
-		     let newLinRec = map (instantiateArgs newArgs) linRec
-			 catPaths : argsPaths = map (lintype2paths emptyPath) (ctype : ctypes)
-		     -- checkLinRec argsPaths catPaths newLinRec
-		     return $ Rule (Abs newCat newArgs fun) (Cnc catPaths argsPaths newLinRec) 
-convertRule _ = [] -- failure
-
-
-----------------------------------------------------------------------
--- "type-checking" the resulting linearization
--- should not be necessary, if the algorithms (type-checking and conversion) are correct
-
-checkLinRec args lbls = mapM (checkLin args lbls) 
-
-checkLin args lbls (Lin lbl lin) 
-    | lbl `elem` lbls = mapM (symbol (checkArg args) (const (return ()))) lin
-    | otherwise = trace2 "SimpleToMCFG.Nondet - ERROR" "Label mismatch" $
-		  failure
-
-checkArg args (_cat, lbl, nr) 
-    | lbl `elem` (args !! nr) = return ()
---    | otherwise = trace2 "SimpleToMCFG.Nondet - ERROR" ("Label mismatch in arg " ++ prt nr) $
---		  failure
-    | otherwise = trace2 ("SimpleToMCFG.Nondet - ERROR: Label mismatch in arg " ++ prt nr) 
-		  (prt lbl ++ " `notElem` " ++ prt (args!!nr)) $
-		  failure
-
-
-----------------------------------------------------------------------
--- term simplification
-
-simplifyTerm :: STerm -> CnvMonad STerm
-simplifyTerm (term :! sel)      
-    = do sterm <- simplifyTerm term
-	 ssel <- simplifyTerm sel
-	 case sterm of
-	   Tbl table  -> do (pat, val) <- member table
-			    pat =?= ssel
-			    return val
-	   _ -> do sel' <- expandTerm ssel
-		   return (sterm +! sel')
--- simplifyTerm (Var x)           = readBinding x
-simplifyTerm (con :^ terms)    = liftM (con :^) $ mapM simplifyTerm terms
-simplifyTerm (Rec record)      = liftM Rec      $ mapM simplifyAssign record
-simplifyTerm (term :. lbl)     = liftM (+. lbl) $      simplifyTerm term
-simplifyTerm (Tbl table)       = liftM Tbl      $ mapM simplifyCase table
-simplifyTerm (Variants terms)  = liftM Variants $ mapM simplifyTerm terms
-simplifyTerm (term1 :++ term2) = liftM2 (:++) (simplifyTerm term1) (simplifyTerm term2)
-simplifyTerm term              = return term
-
-simplifyAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
-simplifyAssign (lbl, term) = liftM ((,) lbl) $ simplifyTerm term
-
-simplifyCase :: (STerm, STerm) -> CnvMonad (STerm, STerm)
-simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)
-
-
-------------------------------------------------------------
--- reducing simplified terms, collecting MCF rules
-
-reduceTerm :: SLinType -> SPath -> STerm -> CnvMonad ()
---reduceTerm ctype path (Variants terms) 
---    = member terms >>= reduceTerm ctype path
-reduceTerm (StrT)   path term = updateLin (path, term)
-reduceTerm (ConT _) path term = do pat <- expandTerm term
-				   updateHead (path, pat)
-reduceTerm (RecT rtype) path term
-    = sequence_ [ reduceTerm ctype (path ++. lbl) (term  +. lbl) | (lbl, ctype) <- rtype ]
-reduceTerm (TblT pats vtype) path table 
-    = sequence_ [ reduceTerm vtype (path ++! pat) (table +! pat) | pat <- pats ]
-
-
-------------------------------------------------------------
--- expanding a term to ground terms
-
-expandTerm :: STerm -> CnvMonad STerm
-expandTerm arg@(Arg nr _ path) 
-    = do ctypes <- readArgCTypes
-	 unifyPType arg $ lintypeFollowPath path $ ctypes !! nr
--- expandTerm arg@(Arg nr _ path) 
---     = do ctypes <- readArgCTypes
--- 	 pat <- member $ enumeratePatterns $ lintypeFollowPath path $ ctypes !! nr
--- 	 pat =?= arg
--- 	 return pat
-expandTerm (con :^ terms)   = liftM (con :^) $ mapM expandTerm terms
-expandTerm (Rec record)     = liftM  Rec     $ mapM expandAssign record
---expandTerm (Variants terms) = liftM Variants $ mapM expandTerm terms  
-expandTerm (Variants terms) = member terms >>= expandTerm  
-expandTerm term = error $ "expandTerm: " ++ prt term
-
-expandAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
-expandAssign (lbl, term) = liftM ((,) lbl) $ expandTerm term
-
-unifyPType :: STerm -> SLinType -> CnvMonad STerm
-unifyPType arg (RecT prec) = 
-    liftM Rec $
-    sequence [ liftM ((,) lbl) $
-	       unifyPType (arg +. lbl) ptype |
-	       (lbl, ptype) <- prec ]
-unifyPType (Arg nr _ path) (ConT terms) = 
-    do (_, args, _, _) <- readState
-       case lookup path (ecatConstraints (args !! nr)) of
-         Just term -> return term
-         Nothing -> do term <- member terms
-		       updateArg nr (path, term)
-		       return term
-
-------------------------------------------------------------
--- unification of patterns and selection terms
-
-(=?=) :: STerm -> STerm -> CnvMonad ()
--- Wildcard      =?= _               = return ()
--- Var x         =?= term            = addBinding x term
-Rec precord   =?= arg@(Arg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
-						(lbl, pat) <- precord ]
-pat           =?= Arg nr _ path   = updateArg nr (path, pat)
-(con :^ pats) =?= (con' :^ terms) = do guard (con==con' && length pats==length terms)
-				       sequence_ $ zipWith (=?=) pats terms
-Rec precord   =?= Rec record      = sequence_ [ maybe mzero (pat =?=) mterm |
-						(lbl, pat) <- precord,
-						let mterm = lookup lbl record ]
--- variants are not allowed in patterns, but in selection terms:
-term =?= Variants terms = member terms >>= (term =?=)
-pat =?= term = error $ "(=?=): " ++ prt pat ++ " =?= " ++ prt term
-
-----------------------------------------------------------------------
--- variable bindings (does not work correctly)
-{-
-addBinding x term = do (a, b, c, d, bindings) <- readState
-		       writeState (a, b, c, d, (x,term):bindings)
-
-readBinding x = do (_, _, _, _, bindings) <- readState
-		   return $ maybe (Var x) id $ lookup x bindings
--}
-
-------------------------------------------------------------
--- updating the MCF rule
-
-readArgCTypes :: CnvMonad [SLinType]
-readArgCTypes = do (_, _, _, env) <- readState
-		   return env
-
-updateArg :: Int -> Constraint -> CnvMonad ()
-updateArg arg cn
-    = do (head, args, lins, env) <- readState 
-	 args' <- updateNthM (addToECat cn) arg args
-	 writeState (head, args', lins, env)
-
-updateHead :: Constraint -> CnvMonad ()
-updateHead cn
-    = do (head, args, lins, env) <- readState
-	 head' <- addToECat cn head
-	 writeState (head', args, lins, env)
-
-updateLin :: Constraint -> CnvMonad ()
-updateLin (path, term) 
-    = do let newLins = term2lins term
-	 (head, args, lins, env) <- readState
-	 let lins' = lins ++ map (Lin path) newLins
-	 writeState (head, args, lins', env)
-
-term2lins :: STerm -> [[Symbol (SCat, SPath, Int) Token]]
-term2lins (Arg nr cat path) = return [Cat (cat, path, nr)]
-term2lins (Token str)       = return [Tok str]
-term2lins (t1 :++ t2)       = liftM2 (++) (term2lins t1) (term2lins t2)
-term2lins (Empty)           = return []
-term2lins (Variants terms)  = terms >>= term2lins
-term2lins term = error $ "term2lins: " ++ show term
-
-addToECat :: Constraint -> ECat -> CnvMonad ECat
-addToECat cn (ECat cat cns) = liftM (ECat 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)
-
-
-
diff --git a/src/GF/Conversion/SimpleToMCFG/Strict.hs b/src/GF/Conversion/SimpleToMCFG/Strict.hs
deleted file mode 100644
index a5519fcd8..000000000
--- a/src/GF/Conversion/SimpleToMCFG/Strict.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/09 09:28:44 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
---
--- Converting SimpleGFC grammars to MCFG grammars, deterministic.
---
--- the resulting grammars might be /very large/
---
--- the conversion is only equivalent if the GFC grammar has a context-free backbone.
------------------------------------------------------------------------------
-
-
-module GF.Conversion.SimpleToMCFG.Strict
-    (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import Control.Monad
-
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG 
-import GF.Formalism.MCFG 
-import GF.Formalism.SimpleGFC 
-import GF.Conversion.Types
-
-import GF.Data.BacktrackM
-import GF.Data.SortedList
-
-----------------------------------------------------------------------
--- main conversion function
-
-type CnvMonad a = BacktrackM () a
-
-convertGrammar :: SGrammar -> EGrammar 
-convertGrammar rules = tracePrt "SimpleToMCFG.Strict - MCFG rules" (prt . length) $
-		       solutions conversion undefined
-    where conversion = member rules >>= convertRule
-
-convertRule :: SRule -> CnvMonad ERule
-convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term)))
-    = do let cat : args  = map decl2cat (decl : decls)
-	     args_ctypes = zip3 [0..] args ctypes
-	 instArgs <- mapM enumerateArg args_ctypes
-	 let instTerm = substitutePaths instArgs term
-	 newCat <- extractECat cat ctype instTerm
-	 newArgs <- mapM (extractArg instArgs) args_ctypes
-	 let linRec = strPaths ctype instTerm >>= extractLin newArgs
-	 let newLinRec = map (instantiateArgs newArgs) linRec
-	     catPaths : argsPaths = map (lintype2paths emptyPath) (ctype : ctypes)
-	 return $ Rule (Abs newCat newArgs fun) (Cnc catPaths argsPaths newLinRec) 
-convertRule _ = failure
-
-----------------------------------------------------------------------
--- category extraction
-
-extractArg :: [STerm] -> (Int, SCat, SLinType) -> CnvMonad ECat
-extractArg args (nr, cat, ctype) = extractECat cat ctype (args !! nr)
-
-extractECat :: SCat -> SLinType -> STerm -> CnvMonad ECat
-extractECat cat ctype term = member $ map (ECat cat) $ parPaths ctype term
-
-enumerateArg :: (Int, SCat, SLinType) -> CnvMonad STerm
-enumerateArg (nr, cat, ctype) = member $ enumerateTerms (Just (Arg nr cat emptyPath)) ctype
-
-----------------------------------------------------------------------
--- Substitute each instantiated parameter path for its instantiation
-
-substitutePaths :: [STerm] -> STerm -> STerm
-substitutePaths arguments = subst 
-    where subst (Arg nr _ path)  = termFollowPath path (arguments !! nr)
-	  subst (con :^ terms)   = con :^ map subst terms
-	  subst (Rec record)     = Rec [ (lbl, subst term) | (lbl, term) <- record ]
-	  subst (term :. lbl)    = subst term +. lbl
-	  subst (Tbl table)      = Tbl [ (pat, subst term) | 
-				      (pat, term) <- table ]
-	  subst (term :! select) = subst term +! subst select
-	  subst (term :++ term') = subst term ?++ subst term'
-	  subst (Variants terms) = Variants $ map subst terms
-	  subst term = term
-
-----------------------------------------------------------------------
--- term paths extaction
-
-termPaths :: SLinType -> STerm -> [(SPath, (SLinType, STerm))]
-termPaths ctype (Variants terms) = terms >>= termPaths ctype
-termPaths (RecT rtype) (Rec record) 
-    = [ (path ++. lbl, value) |
-	(lbl, term) <- record,
-	let Just ctype = lookup lbl rtype,
-	(path, value) <- termPaths ctype term ]
-termPaths (TblT _ ctype) (Tbl table)
-    = [ (path ++! pat, value) |
-	(pat, term) <- table,
-	(path, value) <- termPaths ctype term ]
-termPaths ctype term | isBaseType ctype = [ (emptyPath, (ctype, 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 :: SLinType -> STerm -> [[(SPath, STerm)]]
-parPaths ctype term = mapM (uncurry (map . (,))) $ groupPairs $
-		      nubsort [ (path, value) | 
-				(path, (ConT _, value)) <- termPaths ctype term ]
-
-strPaths :: SLinType -> STerm -> [(SPath, STerm)]
-strPaths ctype term = [ (path, variants values) | (path, values) <- groupPairs paths ]
-    where paths = nubsort [ (path, value) | (path, (StrT, value)) <- termPaths ctype term ]
-
-----------------------------------------------------------------------
--- linearization extraction
-
-extractLin :: [ECat] -> (SPath, STerm) -> [Lin ECat MLabel Token]
-extractLin args (path, term) = map (Lin path) (convertLin term)
-    where convertLin (t1 :++ t2) = liftM2 (++) (convertLin t1) (convertLin t2)
-	  convertLin (Empty) = [[]]
-	  convertLin (Token tok) = [[Tok tok]]
-	  convertLin (Variants terms) = concatMap convertLin terms
-	  convertLin (Arg nr _ path) = [[Cat (args !! nr, path, nr)]]
-	  convertLin t = error $ "convertLin: " ++ prt t ++ "  " ++ prt (args, path)
-
diff --git a/src/GF/Conversion/TypeGraph.hs b/src/GF/Conversion/TypeGraph.hs
deleted file mode 100644
index 62ee9726e..000000000
--- a/src/GF/Conversion/TypeGraph.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/16 10:21:21 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.2 $
---
--- Printing the type hierarchy of an abstract module in GraphViz format
------------------------------------------------------------------------------
-
-
-module GF.Conversion.TypeGraph (prtTypeGraph, prtFunctionGraph) where
-
-import GF.Formalism.GCFG
-import GF.Formalism.SimpleGFC
-import GF.Formalism.Utilities
-import GF.Conversion.Types
-
-import GF.Data.Operations ((++++), (+++++))
-import GF.Infra.Print
-
-----------------------------------------------------------------------
--- | SimpleGFC to TypeGraph
---
--- assumes that the profiles in the Simple GFC names are trivial
-
-prtTypeGraph :: SGrammar -> String
-prtTypeGraph rules = "digraph TypeGraph {" ++++ 
-                     "concentrate=true;" ++++
-                     "node [shape=ellipse];" +++++
-                     unlines (map prtTypeGraphRule rules) +++++
-                     "}"
-
-prtTypeGraphRule :: SRule -> String
-prtTypeGraphRule (Rule abs@(Abs cat cats (Name fun _prof)) _)
-    = "// " ++ prt abs ++++
-      unlines [ prtSCat c ++ " -> " ++ prtSCat cat ++ ";" | c <- cats ]
-
-prtFunctionGraph :: SGrammar -> String
-prtFunctionGraph rules = "digraph FunctionGraph {" ++++ 
-                         "node [shape=ellipse];" +++++
-                         unlines (map prtFunctionGraphRule rules) +++++
-                         "}"
-
-prtFunctionGraphRule :: SRule -> String
-prtFunctionGraphRule (Rule abs@(Abs cat cats (Name fun _prof)) _)
-    = "// " ++ prt abs ++++
-      pfun ++ " [label=\"" ++ prt fun ++ "\", shape=box, style=dashed];" ++++
-      pfun ++ " -> " ++ prtSCat cat ++ ";" ++++
-      unlines [ prtSCat c ++ " -> " ++ pfun ++ ";" | c <- cats ]
-    where pfun = "GF_FUNCTION_" ++ prt fun
-
-prtSCat decl = prt (decl2cat decl)
-
-
diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs
deleted file mode 100644
index 97c2ace05..000000000
--- a/src/GF/Conversion/Types.hs
+++ /dev/null
@@ -1,146 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/08/11 14:11:46 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.10 $
---
--- All possible instantiations of different grammar formats used in conversion from GFC
------------------------------------------------------------------------------
-
-
-module GF.Conversion.Types where
-
----import GF.Conversion.FTypes
-
-import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent)
-import qualified GF.Canon.AbsGFC as AbsGFC (CIdent(..), Label(..))
-import qualified GF.GFCC.CId
-import qualified GF.Grammar.Grammar as Grammar (Term)
-
-import GF.Formalism.GCFG
-import GF.Formalism.SimpleGFC
-import GF.Formalism.MCFG
-import GF.Formalism.FCFG
-import GF.Formalism.CFG
-import GF.Formalism.Utilities
-import GF.Infra.Print
-import GF.Data.Assoc
-
-import Control.Monad (foldM)
-import Data.Array
-
-----------------------------------------------------------------------
--- * basic (leaf) types
-
--- ** input tokens
-
-type Token = String
-
--- ** function names
-
-type Fun  = Ident.Ident
-type Name = NameProfile Fun
-
-
-----------------------------------------------------------------------
--- * Simple GFC
-
-type SCat = Ident.Ident
-
-constr2fun :: Constr -> Fun
-constr2fun (AbsGFC.CIQ _ fun) = fun
-
--- ** grammar types
-
-type SGrammar = SimpleGrammar SCat Name Token
-type SRule    = SimpleRule    SCat Name Token
-
-type SPath    = Path    SCat Token
-type STerm    = Term    SCat Token
-type SLinType = LinType SCat Token
-type SDecl    = Decl    SCat
-
-----------------------------------------------------------------------
--- * erasing MCFG
-
-type EGrammar = MCFGrammar ECat Name ELabel Token
-type ERule    = MCFRule    ECat Name ELabel Token
-data ECat     = ECat SCat [Constraint]   deriving (Eq, Ord, Show)
-type ELabel   = SPath
-
-type Constraint = (SPath, STerm)
-
--- ** type coercions etc
-
-initialECat :: SCat -> ECat
-initialECat cat = ECat cat []
-
-ecat2scat :: ECat -> SCat
-ecat2scat (ECat cat _) = cat
-
-ecatConstraints :: ECat -> [Constraint]
-ecatConstraints (ECat _ cns) = cns
-
-sameECat :: ECat -> ECat -> Bool
-sameECat ec1 ec2 = ecat2scat ec1 == ecat2scat ec2
-
-coercionName :: Name
-coercionName = Name Ident.wildIdent [Unify [0]]
-
-isCoercion :: Name -> Bool
-isCoercion (Name fun [Unify [0]]) = Ident.isWildIdent fun
-isCoercion _ = False
-
-----------------------------------------------------------------------
--- * nonerasing MCFG
-
-type MGrammar = MCFGrammar MCat Name MLabel Token
-type MRule    = MCFRule    MCat Name MLabel Token
-data MCat     = MCat ECat [ELabel]   deriving (Eq, Ord, Show)
-type MLabel   = ELabel
-
-mcat2ecat :: MCat -> ECat
-mcat2ecat (MCat cat _) = cat
-
-mcat2scat :: MCat -> SCat
-mcat2scat = ecat2scat . mcat2ecat
-
-----------------------------------------------------------------------
--- * fast nonerasing MCFG
-
----- moved to FTypes by AR 20/9/2007
-
-
-----------------------------------------------------------------------
--- * CFG
-
-type CGrammar = CFGrammar CCat Name Token
-type CRule    = CFRule    CCat Name Token
-data CCat     = CCat      ECat ELabel  deriving (Eq, Ord, Show)
-
-ccat2ecat :: CCat -> ECat
-ccat2ecat (CCat cat _) = cat
-
-ccat2scat :: CCat -> SCat
-ccat2scat = ecat2scat . ccat2ecat
-
-----------------------------------------------------------------------
--- * pretty-printing
-
-instance Print ECat where
-    prt (ECat cat constrs) = prt cat ++ "{" ++ 
-			     concat [ prt path ++ "=" ++ prt term ++ ";" |
-				      (path, term) <- constrs ] ++ "}"
-
-instance Print MCat where
-    prt (MCat cat labels) = prt cat ++ prt labels
-
-instance Print CCat where
-    prt (CCat cat label) = prt cat ++ prt label
-
----- instance Print FCat where ---- FCat
-