"Committed_by_peb"

2026-04-09 04:59:31 -06:00 · 2005-04-12 09:49:44 +00:00
parent 3c45e7c905
commit 81165cf09d
35 changed files with 285 additions and 3046 deletions
--- a/src/GF/Conversion/GFC.hs
+++ b/src/GF/Conversion/GFC.hs
@@ -4,37 +4,36 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:48 $ 
+-- > CVS $Date: 2005/04/12 10:49:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- All conversions from GFC 
 -----------------------------------------------------------------------------

 module GF.Conversion.GFC
    (module GF.Conversion.GFC,
-     SimpleGrammar, MGrammar, CGrammar) where
+     SGrammar, MGrammar, CGrammar) where

 import GFC (CanonGrammar)
 import Ident (Ident)
-import GF.Formalism.SimpleGFC (SimpleGrammar)
-import GF.Conversion.Types (CGrammar, MGrammar)
+import GF.Conversion.Types (CGrammar, MGrammar, SGrammar)

 import qualified GF.Conversion.GFCtoSimple as G2S
 import qualified GF.Conversion.SimpleToFinite as S2Fin
 import qualified GF.Conversion.SimpleToMCFG as S2M
 import qualified GF.Conversion.MCFGtoCFG as M2C

-gfc2simple :: (CanonGrammar, Ident) -> SimpleGrammar
+gfc2simple :: (CanonGrammar, Ident) -> SGrammar
 gfc2simple = G2S.convertGrammar

-simple2finite :: SimpleGrammar -> SimpleGrammar
+simple2finite :: SGrammar -> SGrammar
 simple2finite = S2Fin.convertGrammar

-simple2mcfg_nondet :: SimpleGrammar -> MGrammar
+simple2mcfg_nondet :: SGrammar -> MGrammar
 simple2mcfg_nondet = S2M.convertGrammarNondet

-simple2mcfg_strict :: SimpleGrammar -> MGrammar
+simple2mcfg_strict :: SGrammar -> MGrammar
 simple2mcfg_strict = S2M.convertGrammarStrict

 mcfg2cfg :: MGrammar -> CGrammar
--- a/src/GF/Conversion/GFCtoSimple.hs
+++ b/src/GF/Conversion/GFCtoSimple.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:48 $ 
+-- > CVS $Date: 2005/04/12 10:49:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Converting GFC to SimpleGFC
 --
@@ -20,6 +20,7 @@ import qualified AbsGFC as A
 import qualified Ident as I
 import GF.Formalism.GCFG
 import GF.Formalism.SimpleGFC 
+import GF.Conversion.Types

 import GFC (CanonGrammar)
 import MkGFC (grammar2canon)
@@ -35,7 +36,7 @@ import GF.Infra.Print

 type Env = (CanonGrammar, I.Ident)

-convertGrammar :: Env -> SimpleGrammar
+convertGrammar :: Env -> SGrammar
 convertGrammar gram = trace2 "converting language" (show (snd gram)) $
 		      tracePrt "#simpleGFC rules" (show . length) $
 		      [ convertAbsFun gram fun typing |
@@ -43,7 +44,7 @@ convertGrammar gram = trace2 "converting language" (show (snd gram)) $
 			A.AbsDFun fun typing _ <- defs ]
    where A.Gr modules = grammar2canon (fst gram)

-convertAbsFun :: Env -> I.Ident -> A.Exp -> SimpleRule
+convertAbsFun :: Env -> I.Ident -> A.Exp -> SRule
 convertAbsFun gram fun typing = Rule abs cnc
    where abs = convertAbstract [] fun typing
 	  cnc = convertConcrete gram abs
@@ -51,13 +52,15 @@ convertAbsFun gram fun typing = Rule abs cnc
 ----------------------------------------------------------------------
 -- abstract definitions

-convertAbstract :: [Decl] -> Name -> A.Exp -> Abstract Decl Name
+convertAbstract :: [SDecl] -> Fun -> A.Exp -> Abstract SDecl Name
 convertAbstract env fun (A.EProd x a b) 
    = convertAbstract ((x' ::: convertType [] a) : env) fun b
    where x' = if x==I.identC "h_" then anyVar else x
-convertAbstract env fun a = Abs (anyVar ::: convertType [] a) (reverse env) fun
+convertAbstract env fun a 
+    = Abs (anyVar ::: convertType [] a) (reverse env) name
+    where name = Name fun [ Unify [n] | n <- [0 .. length env-1] ]

-convertType :: [Atom] -> A.Exp -> Type
+convertType :: [Atom] -> A.Exp -> SType
 convertType args (A.EApp a (A.EAtom at)) = convertType (convertAtom at : args) a
 convertType args (A.EAtom at) = convertCat at :@ args

@@ -65,19 +68,19 @@ convertAtom :: A.Atom -> Atom
 convertAtom (A.AC con) = ACon con
 convertAtom (A.AV var) = AVar var

-convertCat :: A.Atom -> Cat
+convertCat :: A.Atom -> SCat
 convertCat (A.AC (A.CIQ _ cat)) = cat
 convertCat at = error $ "convertCat: " ++ show at

 ----------------------------------------------------------------------
 -- concrete definitions

-convertConcrete :: Env -> Abstract Decl Name -> Concrete LinType (Maybe Term)
-convertConcrete gram (Abs decl args fun) = Cnc ltyp largs term
-    where term = fmap (convertTerm gram) $ lookupLin gram fun 
+convertConcrete :: Env -> Abstract SDecl Name -> Concrete SLinType (Maybe STerm)
+convertConcrete gram (Abs decl args name) = Cnc ltyp largs term
+    where term = fmap (convertTerm gram) $ lookupLin gram $ name2fun name
 	  ltyp : largs = map (convertCType gram . lookupCType gram) (decl : args)

-convertCType :: Env -> A.CType -> LinType
+convertCType :: Env -> A.CType -> SLinType
 convertCType gram (A.RecType rec) 
    = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
 convertCType gram (A.Table ptype vtype) 
@@ -86,7 +89,7 @@ convertCType gram ct@(A.Cn con) = ConT con $ map (convertTerm gram) $ groundTerm
 convertCType gram (A.TStr) = StrT
 convertCType gram (A.TInts n) = error "convertCType: cannot handle 'TInts' constructor"

-convertTerm :: Env -> A.Term -> Term
+convertTerm :: Env -> A.Term -> STerm
 convertTerm gram (A.Arg arg) = convertArgVar arg
 convertTerm gram (A.Con con terms) = con :^ map (convertTerm gram) terms
 convertTerm gram (A.LI var) = Var var
@@ -108,7 +111,7 @@ convertTerm gram (A.E) = Empty
 convertTerm gram (A.I con) = error "convertTerm: cannot handle 'I' constructor"
 convertTerm gram (A.EInt int) = error "convertTerm: cannot handle 'EInt' constructor"

-convertArgVar :: A.ArgVar -> Term
+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

@@ -120,11 +123,11 @@ convertPatt (A.PI n) = error "convertPatt: cannot handle 'PI' constructor"

 ----------------------------------------------------------------------

-lookupLin :: Env -> Name -> Maybe A.Term
+lookupLin :: Env -> Fun -> Maybe A.Term
 lookupLin gram fun = err fail Just $
 		     Look.lookupLin (fst gram) (A.CIQ (snd gram) fun)

-lookupCType :: Env -> Decl -> A.CType
+lookupCType :: Env -> SDecl -> A.CType
 lookupCType env decl
    = errVal CMacros.defLinType $ 
      Look.lookupLincat (fst env) (A.CIQ (snd env) (decl2cat decl))
--- a/src/GF/Conversion/MCFGtoCFG.hs
+++ b/src/GF/Conversion/MCFGtoCFG.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:48 $ 
+-- > CVS $Date: 2005/04/12 10:49:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Converting MCFG grammars to (possibly overgenerating) CFG
 -----------------------------------------------------------------------------
@@ -30,11 +30,12 @@ convertGrammar gram = tracePrt "#context-free rules" (prt.length) $
 		      concatMap convertRule gram

 convertRule :: MRule -> [CRule]
-convertRule (Rule (Abs cat args name) (Cnc _ _ record)) 
-    = [ CFRule (CCat cat lbl) rhs (CName name profile) |
+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 profile = map (argPlaces lin) [0 .. length args-1]
+	let cprofile = map (Unify . argPlaces lin) [0 .. length args-1],
+	let profile = mprofile `composeProfiles` cprofile
      ]

 convertArg :: (MCat, MLabel, Int) -> CCat
--- a/src/GF/Conversion/SimpleToFinite.hs
+++ b/src/GF/Conversion/SimpleToFinite.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:48 $ 
+-- > CVS $Date: 2005/04/12 10:49:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Calculating the finiteness of each type in a grammar
 -----------------------------------------------------------------------------
@@ -19,6 +19,7 @@ import GF.Infra.Print

 import GF.Formalism.GCFG
 import GF.Formalism.SimpleGFC
+import GF.Conversion.Types

 import GF.Data.SortedList
 import GF.Data.Assoc
@@ -29,26 +30,27 @@ import Ident (Ident(..))

 type CnvMonad a = BacktrackM () a

-convertGrammar :: SimpleGrammar -> SimpleGrammar
+convertGrammar :: SGrammar -> SGrammar
 convertGrammar rules = tracePrt "#finite simpleGFC rules" (prt . length) $
 		       solutions cnvMonad ()
    where split = calcSplitable rules
 	  cnvMonad = member rules >>= convertRule split

-convertRule :: Splitable -> SimpleRule -> CnvMonad SimpleRule
+convertRule :: Splitable -> SRule -> CnvMonad SRule
 convertRule split (Rule abs cnc) 
    = do newAbs <- convertAbstract split abs
 	 return $ Rule newAbs cnc

-convertAbstract :: Splitable -> Abstract Decl Name -> CnvMonad (Abstract Decl Name)
-convertAbstract split (Abs (_ ::: typ) decls fun)
-    = case splitableFun split fun of
-        Just newCat -> return $ Abs (anyVar ::: (newCat :@ [])) decls fun
-	Nothing -> expandTyping split fun [] typ decls []
+convertAbstract :: Splitable -> Abstract SDecl Name
+		-> CnvMonad (Abstract SDecl Name)
+convertAbstract split (Abs (_ ::: typ) decls name)
+    = case splitableFun split (name2fun name) of
+        Just newCat -> return $ Abs (anyVar ::: (newCat :@ [])) decls name
+	Nothing -> expandTyping split name [] typ decls []


-expandTyping :: Splitable -> Name -> [(Var, Cat)] -> Type -> [Decl] -> [Decl] 
-	     -> CnvMonad (Abstract Decl Name)
+expandTyping :: Splitable -> Name -> [(Var, SCat)] -> SType -> [SDecl] -> [SDecl] 
+	     -> CnvMonad (Abstract SDecl Name)
 expandTyping split fun env (cat :@ atoms) [] decls 
    = return $ Abs decl (reverse decls) fun
    where decl = anyVar ::: substAtoms split env cat atoms []
@@ -61,7 +63,7 @@ expandTyping split fun env typ ((x ::: (xcat :@ xatoms)) : declsToDo) declsDone
 					    return (newCat, (x,newCat) : env)
 			 Nothing -> return (xcat, env)

-substAtoms :: Splitable -> [(Var, Cat)] -> Cat -> [Atom] -> [Atom] -> Type
+substAtoms :: Splitable -> [(Var, SCat)] -> SCat -> [Atom] -> [Atom] -> SType
 substAtoms split env cat [] atoms = cat :@ reverse atoms
 substAtoms split env cat (atom:atomsToDo) atomsDone
    = case atomLookup split env atom of
@@ -69,22 +71,22 @@ substAtoms split env cat (atom:atomsToDo) atomsDone
 	Nothing -> substAtoms split env cat atomsToDo (atom : atomsDone)

 atomLookup split env (AVar x) = lookup x env 
-atomLookup split env (ACon con) = splitableFun split (constr2name con)
+atomLookup split env (ACon con) = splitableFun split (constr2fun con)
      

 ----------------------------------------------------------------------
 -- splitable categories (finite, no dependencies)
 -- they should also be used as some dependency

-type Splitable = (Assoc Cat [Cat], Assoc Name Cat)
+type Splitable = (Assoc SCat [SCat], Assoc Fun SCat)

-splitableCat :: Splitable -> Cat -> Maybe [Cat]
+splitableCat :: Splitable -> SCat -> Maybe [SCat]
 splitableCat = lookupAssoc . fst 

-splitableFun :: Splitable -> Name -> Maybe Cat
+splitableFun :: Splitable -> Fun -> Maybe SCat
 splitableFun = lookupAssoc . snd

-calcSplitable :: [SimpleRule] -> Splitable
+calcSplitable :: [SRule] -> Splitable
 calcSplitable rules = (listAssoc splitableCat2Funs, listAssoc splitableFun2Cat)
    where splitableCat2Funs = groupPairs $ nubsort 
 			      [ (cat, mergeFun fun cat) | (cat, fun) <- splitableCatFuns ]
@@ -93,8 +95,8 @@ calcSplitable rules = (listAssoc splitableCat2Funs, listAssoc splitableFun2Cat)
 			     [ (fun, mergeFun fun cat) | (cat, fun) <- splitableCatFuns ]

          -- cat-fun pairs that are splitable
-	  splitableCatFuns = [ (cat, fun) |
-			       Rule (Abs (_ ::: (cat :@ [])) [] fun) _ <- rules,
+	  splitableCatFuns = [ (cat, name2fun name) |
+			       Rule (Abs (_ ::: (cat :@ [])) [] name) _ <- rules,
 			       splitableCats ?= cat ]

          -- all cats that are splitable
@@ -123,11 +125,11 @@ calcSplitable rules = (listAssoc splitableCat2Funs, listAssoc splitableFun2Cat)
 -- utilities
 -- mergeing categories

-mergeCats :: String -> String -> String -> Cat -> Cat -> Cat
+mergeCats :: String -> String -> String -> SCat -> SCat -> SCat
 mergeCats before middle after (IC cat) (IC arg) 
    = IC (before ++ cat ++ middle ++ arg ++ after)

-mergeFun, mergeArg :: Cat -> Cat -> Cat
+mergeFun, mergeArg :: SCat -> SCat -> SCat
 mergeFun = mergeCats "{" ":" "}"
 mergeArg = mergeCats "" "" ""

--- a/src/GF/Conversion/SimpleToMCFG.hs
+++ b/src/GF/Conversion/SimpleToMCFG.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:48 $ 
+-- > CVS $Date: 2005/04/12 10:49:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- All different conversions from SimpleGFC to MCFG
 -----------------------------------------------------------------------------
@@ -20,7 +20,7 @@ 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 :: SimpleGrammar -> MGrammar
+convertGrammarNondet, convertGrammarStrict :: SGrammar -> MGrammar
 convertGrammarNondet = Coerce.addCoercions . Nondet.convertGrammar
 convertGrammarStrict = Strict.convertGrammar

--- a/src/GF/Conversion/SimpleToMCFG/Coercions.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Coercions.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:49 $ 
+-- > CVS $Date: 2005/04/12 10:49:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Adding coercion functions to a MCFG if necessary.
 -----------------------------------------------------------------------------
@@ -45,7 +45,7 @@ addCoercions rules = coercions ++ rules
 combineCoercions [] _ = []
 combineCoercions _ [] = []
 combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs) 
-    = case compare (mcat2cat $ fst $ head heads) (mcat2cat $ head args) of
+    = case compare (mcat2scat $ fst $ head heads) (mcat2scat $ head args) of
        LT -> combineCoercions allHeads  allArgs'
 	GT -> combineCoercions allHeads' allArgs
 	EQ -> makeCoercion heads args : combineCoercions allHeads allArgs
--- a/src/GF/Conversion/SimpleToMCFG/Nondet.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:49 $ 
+-- > CVS $Date: 2005/04/12 10:49:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Converting SimpleGFC grammars to MCFG grammars, nondeterministically.
 -- Afterwards, the grammar has to be extended with coercion functions,
@@ -40,19 +40,19 @@ import GF.Data.BacktrackM

 type CnvMonad a = BacktrackM Env a

-type Env    = (MCat, [MCat], LinRec, [LinType])
-type LinRec = [Lin Cat MLabel Token]
+type Env    = (MCat, [MCat], LinRec, [SLinType])
+type LinRec = [Lin SCat MLabel Token]


 ----------------------------------------------------------------------
 -- main conversion function

-convertGrammar :: SimpleGrammar -> MGrammar 
+convertGrammar :: SGrammar -> MGrammar 
 convertGrammar rules = tracePrt "Nondet conversion: #MCFG rules" (prt . length) $
 		       solutions conversion undefined
    where conversion = member rules >>= convertRule

-convertRule :: SimpleRule -> CnvMonad MRule
+convertRule :: SRule -> CnvMonad MRule
 convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term)))
    = do let cat : args = map decl2cat (decl : decls)
 	 writeState (initialMCat cat, map initialMCat args, [], ctypes)
@@ -68,7 +68,7 @@ convertRule _ = failure
 ----------------------------------------------------------------------
 -- term simplification

-simplifyTerm :: Term -> CnvMonad Term
+simplifyTerm :: STerm -> CnvMonad STerm
 simplifyTerm (term :! sel)      
    = do sterm <- simplifyTerm term
 	 ssel <- simplifyTerm sel
@@ -90,17 +90,17 @@ simplifyTerm term              = return term
 --   (LI Ident) - pattern variable
 --   (EInt Integer) - integer

-simplifyAssign :: (Label, Term) -> CnvMonad (Label, Term)
+simplifyAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
 simplifyAssign (lbl, term) = liftM ((,) lbl) $ simplifyTerm term

-simplifyCase :: (Term, Term) -> CnvMonad (Term, Term)
+simplifyCase :: (STerm, STerm) -> CnvMonad (STerm, STerm)
 simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)


 ------------------------------------------------------------
 -- reducing simplified terms, collecting MCF rules

-reduceTerm :: LinType -> Path -> Term -> CnvMonad ()
+reduceTerm :: SLinType -> SPath -> STerm -> CnvMonad ()
 reduceTerm ctype path (Variants terms) 
    = member terms >>= reduceTerm ctype path
 reduceTerm (StrT)     path term = updateLin (path, term)
@@ -117,7 +117,7 @@ reduceTerm (TblT ptype vtype) path table
 ------------------------------------------------------------
 -- expanding a term to ground terms

-expandTerm :: Term -> CnvMonad Term
+expandTerm :: STerm -> CnvMonad STerm
 expandTerm arg@(Arg nr _ path) 
    = do ctypes <- readArgCTypes
 	 pat <- member $ enumeratePatterns $ lintypeFollowPath path $ ctypes !! nr
@@ -128,14 +128,14 @@ expandTerm (Rec record)     = liftM  Rec     $ mapM expandAssign record
 expandTerm (Variants terms) = member terms >>= expandTerm  
 expandTerm term = error $ "expandTerm: " ++ prt term

-expandAssign :: (Label, Term) -> CnvMonad (Label, Term)
+expandAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
 expandAssign (lbl, term) = liftM ((,) lbl) $ expandTerm term


 ------------------------------------------------------------
 -- unification of patterns and selection terms

-(=?=) :: Term -> Term -> CnvMonad ()
+(=?=) :: STerm -> STerm -> CnvMonad ()
 Wildcard      =?= _               = return ()
 Rec precord   =?= arg@(Arg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
 						(lbl, pat) <- precord ]
@@ -151,7 +151,7 @@ pat =?= term = error $ "(=?=): " ++ prt pat ++ " =?= " ++ prt term
 ------------------------------------------------------------
 -- updating the MCF rule

-readArgCTypes :: CnvMonad [LinType]
+readArgCTypes :: CnvMonad [SLinType]
 readArgCTypes = do (_, _, _, env) <- readState
 		   return env

@@ -174,7 +174,7 @@ updateLin (path, term)
 	 let lins' = lins ++ map (Lin path) newLins
 	 writeState (head, args, lins', env)

-term2lins :: Term -> [[Symbol (Cat, Path, Int) Token]]
+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)
--- a/src/GF/Conversion/SimpleToMCFG/Strict.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Strict.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:49 $ 
+-- > CVS $Date: 2005/04/12 10:49:45 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Converting SimpleGFC grammars to MCFG grammars, deterministic.
 --
@@ -37,12 +37,12 @@ import GF.Data.SortedList

 type CnvMonad a = BacktrackM () a

-convertGrammar :: SimpleGrammar -> MGrammar 
+convertGrammar :: SGrammar -> MGrammar 
 convertGrammar rules = tracePrt "Strict conversion: #MCFG rules" (prt . length) $
 		       solutions conversion undefined
    where conversion = member rules >>= convertRule

-convertRule :: SimpleRule -> CnvMonad MRule
+convertRule :: SRule -> CnvMonad MRule
 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
@@ -59,19 +59,19 @@ convertRule _ = failure
 ----------------------------------------------------------------------
 -- category extraction

-extractArg :: [Term] -> (Int, Cat, LinType) -> CnvMonad MCat
+extractArg :: [STerm] -> (Int, SCat, SLinType) -> CnvMonad MCat
 extractArg args (nr, cat, ctype) = extractMCat cat ctype (args !! nr)

-extractMCat :: Cat -> LinType -> Term -> CnvMonad MCat
+extractMCat :: SCat -> SLinType -> STerm -> CnvMonad MCat
 extractMCat cat ctype term = member $ map (MCat cat) $ parPaths ctype term

-enumerateArg :: (Int, Cat, LinType) -> CnvMonad 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 :: [Term] -> Term -> Term
+substitutePaths :: [STerm] -> STerm -> STerm
 substitutePaths arguments = subst 
    where subst (Arg nr _ path)  = termFollowPath path (arguments !! nr)
 	  subst (con :^ terms)   = con :^ map subst terms
@@ -87,7 +87,7 @@ substitutePaths arguments = subst
 ----------------------------------------------------------------------
 -- term paths extaction

-termPaths :: LinType -> Term -> [(Path, (LinType, Term))]
+termPaths :: SLinType -> STerm -> [(SPath, (SLinType, STerm))]
 termPaths ctype (Variants terms) = terms >>= termPaths ctype
 termPaths (RecT rtype) (Rec record) 
    = [ (path ++. lbl, value) |
@@ -105,19 +105,19 @@ termPaths ctype term | isBaseType ctype = [ (emptyPath, (ctype, term)) ]
 [p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
 -}

-parPaths :: LinType -> Term -> [[(Path, Term)]]
+parPaths :: SLinType -> STerm -> [[(SPath, STerm)]]
 parPaths ctype term = mapM (uncurry (map . (,))) $ groupPairs $
 		      nubsort [ (path, value) | 
 				(path, (ConT _ _, value)) <- termPaths ctype term ]

-strPaths :: LinType -> Term -> [(Path, 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 :: [MCat] -> (Path, Term) -> [Lin MCat MLabel Token]
+extractLin :: [MCat] -> (SPath, STerm) -> [Lin MCat MLabel Token]
 extractLin args (path, term) = map (Lin path) (convertLin term)
    where convertLin (t1 :++ t2) = liftM2 (++) (convertLin t1) (convertLin t2)
 	  convertLin (Empty) = [[]]
--- a/src/GF/Conversion/Types.hs
+++ b/src/GF/Conversion/Types.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:49 $ 
+-- > CVS $Date: 2005/04/12 10:49:44 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- All possible instantiations of different grammar formats used in conversion from GFC
 -----------------------------------------------------------------------------
@@ -14,52 +14,133 @@

 module GF.Conversion.Types where

-import qualified Ident
+import qualified Ident   (Ident, wildIdent, isWildIdent)
+import qualified AbsGFC  (CIdent(..))
 import qualified Grammar (Term)
-import qualified Macros

 import GF.Formalism.GCFG
 import GF.Formalism.SimpleGFC
 import GF.Formalism.MCFG
 import GF.Formalism.CFG
+import GF.Formalism.Utilities
 import GF.Infra.Print
+import GF.Data.Assoc
+
+import Monad (foldM)
+
+----------------------------------------------------------------------
+-- * basic (leaf) types
+
+-- ** input tokens
+
+type Token = String
+
+-- ** function names
+
+type Fun  = Ident.Ident
+data Name = Name Fun [Profile (SyntaxForest Fun)]
+	    deriving (Eq, Ord, Show)
+
+name2fun :: Name -> Fun
+name2fun (Name fun _) = fun
+
+-- | A profile is a simple representation of a function on a number of arguments.
+-- We only use lists of profiles
+data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
+			     -- 'Unify []' will become a metavariable,
+			     -- 'Unify [a,b]' means that the arguments are equal,
+	       | Epsilon a
+		 deriving (Eq, Ord, Show)
+
+-- | profile application; we need some way of unifying a list of arguments
+applyProfile :: ([b] -> a) -> [Profile a] -> [b] -> [a]
+applyProfile unify profile args = map apply profile
+    where apply (Unify xs)  = unify $ map (args !!) xs
+	  apply (Epsilon a) = a
+
+-- | monadic profile application
+applyProfileM :: Monad m => ([b] -> m a) -> [Profile a] -> [b] -> m [a]
+applyProfileM unify profile args = mapM apply profile
+    where apply (Unify xs)  = unify $ map (args !!) xs
+	  apply (Epsilon a) = return a
+
+-- | profile composition: 
+-- 
+-- >   applyProfile u z (ps `composeProfiles` qs) args
+-- >      ==
+-- >   applyProfile u z ps (applyProfile u z qs args)
+--
+-- compare with function composition
+--
+-- >   (p . q) arg
+-- >      ==
+-- >   p (q arg)
+--
+-- Note that composing an 'Epsilon' with two or more arguments returns an error
+-- (since 'Unify' can only take arguments) -- this might change in the future, if there is a need.
+composeProfiles :: [Profile a] -> [Profile a] -> [Profile a]
+composeProfiles ps qs = map compose ps
+    where compose (Unify [x]) = qs !! x
+	  compose (Unify xs)  = Unify [ y | x <- xs, let Unify ys = qs !! x, y <- ys ]
+	  compose epsilon     = epsilon
+
+
+
+----------------------------------------------------------------------
+-- * 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
+type SType    = Type    SCat

 ----------------------------------------------------------------------
 -- * MCFG

 type MGrammar = MCFGrammar MCat Name MLabel Token
 type MRule    = MCFRule    MCat Name MLabel Token
-data MCat     = MCat Cat [Constraint] deriving (Eq, Ord, Show)
-type MLabel   = Path
+data MCat     = MCat SCat [Constraint] deriving (Eq, Ord, Show)
+type MLabel   = SPath

-type Constraint = (Path, Term)
+type Constraint = (SPath, STerm)

-initialMCat :: Cat -> MCat
+-- ** type coercions etc
+
+initialMCat :: SCat -> MCat
 initialMCat cat = MCat cat []

-mcat2cat :: MCat -> Cat
-mcat2cat (MCat cat _) = cat
+mcat2scat :: MCat -> SCat
+mcat2scat (MCat cat _) = cat

 sameCat :: MCat -> MCat -> Bool
-sameCat mc1 mc2 = mcat2cat mc1 == mcat2cat mc2
+sameCat mc1 mc2 = mcat2scat mc1 == mcat2scat mc2

 coercionName :: Name
-coercionName = Ident.wildIdent
+coercionName = Name Ident.wildIdent [Unify [0]]

 isCoercion :: Name -> Bool
-isCoercion = Ident.isWildIdent
+isCoercion (Name fun [Unify [0]]) = Ident.isWildIdent fun
+isCoercion _ = False

 ----------------------------------------------------------------------
 -- * CFG

-type CGrammar = CFGrammar CCat CName Token
-type CRule    = CFRule    CCat CName Token
+type CGrammar = CFGrammar CCat Name Token
+type CRule    = CFRule    CCat Name Token

 data CCat     = CCat      MCat MLabel
 		deriving (Eq, Ord, Show)
-data CName    = CName     Name Profile
-		deriving (Eq, Ord, Show)
-type Profile   = [[Int]]

 ----------------------------------------------------------------------
 -- * pretty-printing
@@ -72,8 +153,12 @@ instance Print MCat where
 instance Print CCat where
    prt (CCat cat label) = prt cat ++ prt label

-instance Print CName where
-    prt (CName fun args) = prt fun ++ prt args
-
+instance Print Name where
+    prt (Name fun profile) = prt fun ++ prt profile
+
+instance Print a => Print (Profile a) where
+    prt (Unify [])   = "?"
+    prt (Unify args) = prtSep "=" args
+    prt (Epsilon a)  = prt a


--- a/src/GF/Data/Assoc.hs
+++ b/src/GF/Data/Assoc.hs
@@ -5,9 +5,9 @@
 -- Stability   : Stable
 -- Portability : Haskell 98
 --
-- > CVS $Date: 2005/03/29 11:17:54 $ 
+-- > CVS $Date: 2005/04/12 10:49:45 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
+-- > CVS $Revision: 1.3 $
 --
 -- Association lists, or finite maps,
 -- including sets as maps with result type @()@.
@@ -81,7 +81,7 @@ lookupWith :: Ord a => b -> Assoc a b -> a -> b
 ------------------------------------------------------------

 data Assoc a b = ANil | ANode (Assoc a b) a b (Assoc a b)
-		 deriving (Eq, Show)
+		 deriving (Eq, Ord, Show)

 emptyAssoc = ANil
 emptySet   = emptyAssoc
--- a/src/GF/Formalism/SimpleGFC.hs
+++ b/src/GF/Formalism/SimpleGFC.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:50 $ 
+-- > CVS $Date: 2005/04/12 10:49:45 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Simplistic GFC format
 -----------------------------------------------------------------------------
@@ -23,18 +23,10 @@ import GF.Infra.Print

 -- * basic (leaf) types

-type Name   = Ident.Ident
-type Cat    = Ident.Ident
 type Constr = AbsGFC.CIdent
 type Var    = Ident.Ident
-type Token  = String
 type Label  = AbsGFC.Label

-- ** type coercions etc
-
-constr2name :: Constr -> Name
-constr2name (AbsGFC.CIQ _ name) = name
-
 anyVar :: Var
 anyVar = Ident.wildIdent

@@ -42,79 +34,80 @@ anyVar = Ident.wildIdent

 -- * simple GFC

-type SimpleGrammar = Grammar Decl Name LinType (Maybe Term)
-type SimpleRule    = Rule    Decl Name LinType (Maybe Term)
+type SimpleGrammar c n t = Grammar  (Decl c) n (LinType c t) (Maybe (Term c t))
+type SimpleRule    c n t = Rule     (Decl c) n (LinType c t) (Maybe (Term c t))

 -- ** dependent type declarations

-data Decl = Var ::: Type
-	    deriving (Eq, Ord, Show)
-data Type = Cat :@ [Atom]
-	    deriving (Eq, Ord, Show)
-data Atom = ACon Constr
-	  | AVar Var
-	    deriving (Eq, Ord, Show)
+data Decl c = Var ::: Type c
+		   deriving (Eq, Ord, Show)
+data Type c = c :@ [Atom]
+		   deriving (Eq, Ord, Show)
+data Atom   = ACon Constr
+	    | AVar Var
+	      deriving (Eq, Ord, Show)

-decl2cat :: Decl -> Cat
+decl2cat :: Decl c -> c
 decl2cat (_ ::: (cat :@ _)) = cat

 -- ** linearization types and terms

-data LinType = RecT [(Label, LinType)]
-	     | TblT LinType LinType
-	     | ConT Constr [Term]
-	     | StrT
-	       deriving (Eq, Ord, Show)
+data LinType c t = RecT [(Label, LinType c t)]
+		 | TblT (LinType c t) (LinType c t)
+		 | ConT Constr [Term c t]
+		 | StrT
+		   deriving (Eq, Ord, Show)

-isBaseType :: LinType -> Bool
+isBaseType :: LinType c t -> Bool
 isBaseType (ConT _ _) = True
 isBaseType (StrT) = True
 isBaseType _ = False

-data Term = Arg Int Cat Path     -- ^ argument variable, the 'Path' is a path 
-				 -- pointing into the term 
-	  | Constr :^ [Term]     -- ^ constructor
-	  | Rec [(Label, Term)]  -- ^ record
-	  | Term :. Label        -- ^ record projection
-	  | Tbl [(Term, Term)]   -- ^ table of patterns\/terms
-	  | Term :! Term         -- ^ table selection
-	  | Variants [Term]      -- ^ variants
-	  | Term :++ Term        -- ^ concatenation
-	  | Token Token          -- ^ single token
-	  | Empty                -- ^ empty string
-	  | Wildcard             -- ^ wildcard pattern variable
-	  | Var Var              -- ^ bound pattern variable
+data Term c t
+    = Arg Int c (Path c t)       -- ^ argument variable, the 'Path' is a path 
+			         -- pointing into the term 
+    | Constr :^ [Term c t]       -- ^ constructor
+    | Rec [(Label, Term c t)]    -- ^ record
+    | Term c t :. Label          -- ^ record projection
+    | Tbl [(Term c t, Term c t)] -- ^ table of patterns\/terms
+    | Term c t :! Term c t       -- ^ table selection
+    | Variants [Term c t]        -- ^ variants
+    | Term c t :++ Term c t      -- ^ concatenation
+    | Token t   -- ^ single token
+    | Empty     -- ^ empty string
+    | Wildcard  -- ^ wildcard pattern variable
+    | Var Var   -- ^ bound pattern variable

-	    -- Res CIdent        -- resource identifier
-	    -- Int Integer       -- integer
+     -- Res CIdent        -- ^ resource identifier
+     -- Int Integer       -- ^ integer
 	    deriving (Eq, Ord, Show)

 -- ** calculations on terms

-(+.) :: Term -> Label -> Term
+(+.) :: Term c t -> Label -> Term c t
 Variants terms +. lbl = variants $ map (+. lbl) terms 
 Rec record +. lbl = maybe err id $ lookup lbl record
-    where err = error $ "(+.), label not in record: " ++ show (Rec record) ++ " +. " ++ show lbl
+    where err = error $ "(+.): label not in record"
 Arg arg cat path +. lbl = Arg arg cat (path ++. lbl)
 term +. lbl = term :. lbl

-(+!) :: Term -> Term -> Term
+(+!) :: (Eq c, Eq t) => Term c t -> Term c t -> Term c t
 Variants terms +! pat = variants $ map (+! pat) terms 
 term +! Variants pats = variants $ map (term +!) pats 
 term +! arg@(Arg _ _ _) = term :! arg
 Tbl table +! pat = maybe err id $ lookup pat table
-    where err = error $ "(+!), pattern not in table: " ++ show (Tbl table) ++ " +! " ++ show pat
+    where err = error $ "(+!): pattern not in table"
 Arg arg cat path +! pat = Arg arg cat (path ++! pat)
 term +! pat = term :! pat

-(?++) :: Term -> Term -> Term
+(?++) :: Term c t -> Term c t -> Term c t
 Variants terms ?++ term  = variants $ map (?++ term) terms
 term  ?++ Variants terms = variants $ map (term ?++) terms
 Empty ?++ term  = term
 term  ?++ Empty = term
 term1 ?++ term2 = term1 :++ term2

-variants :: [Term] -> Term
+variants :: [Term c t] -> Term c t
 variants terms0 = case concatMap flatten terms0 of
 		    [term] -> term
 		    terms  -> Variants terms
@@ -123,7 +116,7 @@ variants terms0 = case concatMap flatten terms0 of

 -- ** enumerations

-enumerateTerms :: Maybe Term -> LinType -> [Term]
+enumerateTerms :: (Eq c, Eq t) => Maybe (Term c t) -> LinType c t -> [Term c t]
 enumerateTerms arg (StrT) = maybe err return arg
    where err = error "enumeratePatterns: parameter type should not be string"
 enumerateTerms arg (ConT _ terms) = terms
@@ -134,41 +127,41 @@ enumerateTerms arg (TblT ptype ctype)
    = liftM Tbl $ mapM enumCase $ enumeratePatterns ptype
    where enumCase pat = liftM ((,) pat) $ enumerateTerms (fmap (+! pat) arg) ctype

-enumeratePatterns :: LinType -> [Term]
+enumeratePatterns :: (Eq c, Eq t) => LinType c t -> [Term c t]
 enumeratePatterns = enumerateTerms Nothing

 ----------------------------------------------------------------------

 -- * paths of record projections and table selections

-newtype Path = Path [Either Label Term] deriving (Eq, Ord, Show)
+newtype Path c t = Path [Either Label (Term c t)] deriving (Eq, Ord, Show)

-emptyPath :: Path
+emptyPath :: Path c t
 emptyPath = Path []

 -- ** calculations on paths

-(++.) :: Path -> Label -> Path 
+(++.) :: Path c t -> Label -> Path c t 
 Path path ++. lbl = Path (Left lbl : path)

-(++!) :: Path -> Term -> Path 
+(++!) :: Path c t -> Term c t -> Path c t 
 Path path ++! sel = Path (Right sel : path)

-lintypeFollowPath :: Path -> LinType -> LinType
+lintypeFollowPath :: Path c t -> LinType c t -> LinType c t
 lintypeFollowPath (Path path) = follow path 
    where follow [] ctype = ctype
 	  follow (Right pat : path) (TblT _ ctype) = follow path ctype
 	  follow (Left  lbl : path) (RecT rec)
 	      = maybe err (follow path) $ lookup lbl rec
-	      where err = error $ "follow: " ++ prt rec ++ " . " ++ prt lbl
+	      where err = error $ "lintypeFollowPath: label not in record type"

-termFollowPath :: Path -> Term -> Term
+termFollowPath :: (Eq c, Eq t) => Path c t -> Term c t -> Term c t
 termFollowPath (Path path) = follow (reverse path)
    where follow [] term = term
 	  follow (Right pat : path) term = follow path (term +! pat)
 	  follow (Left  lbl : path) term = follow path (term +. lbl)

-lintype2paths :: Path -> LinType -> [Path]
+lintype2paths :: (Eq c, Eq t) => Path c t -> LinType c t -> [Path c t]
 lintype2paths path (ConT _ _)   = []
 lintype2paths path (StrT)       = [ path ]
 lintype2paths path (RecT rec)   = concat [ lintype2paths (path ++. lbl) ctype |
@@ -178,25 +171,25 @@ lintype2paths path (TblT pt vt) = concat [ lintype2paths (path ++! pat) vt |

 ----------------------------------------------------------------------

-instance Print Decl where
+instance Print c => Print (Decl c) where
    prt (var ::: typ) 
 	| var == anyVar = prt typ
 	| otherwise     = prt var ++ ":" ++ prt typ 

-instance Print Type where
+instance Print c => Print (Type c) where
    prt (cat :@ ats) = prt cat ++ prtList ats

 instance Print Atom where
    prt (ACon con) = prt con
    prt (AVar var) = "?" ++ prt var

-instance Print LinType where
+instance (Print c, Print t) => Print (LinType c t) where
    prt (RecT rec) = "{" ++ concat [ prt l ++ ":" ++ prt t ++ "; " | (l,t) <- rec ] ++ "}"
    prt (TblT t1 t2) = "(" ++ prt t1 ++ " => " ++ prt t2 ++ ")"
    prt (ConT t ts) = prt t ++ "[" ++ prtSep "|" ts ++ "]"
    prt (StrT) = "Str"

-instance Print Term where
+instance (Print c, Print t) => Print (Term c t) where
    prt (Arg n c p) = prt c ++ "@" ++ prt n ++ "(" ++ prt p ++ ")"
    prt (c :^ [])  = prt c 
    prt (c :^ ts)  = prt c ++ prtList ts
@@ -211,7 +204,7 @@ instance Print Term where
    prt (term :! sel) = prt term ++ "!" ++ prt sel
    prt (Var var) = "?" ++ prt var

-instance Print Path where
+instance (Print c, Print t) => Print (Path c t) where
    prt (Path path) = concatMap prtEither (reverse path)
 	where prtEither (Left  lbl)  = "." ++ prt lbl
 	      prtEither (Right patt) = "!" ++ prt patt
--- a/src/GF/Formalism/Symbol.hs
+++ b/src/GF/Formalism/Symbol.hs
@@ -1,46 +0,0 @@
----------------------------------------------------------------------
-- |
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/11 13:52:50 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
--
-- Basic type declarations and functions to be used in grammar formalisms
-----------------------------------------------------------------------------
-
-
-module GF.Formalism.Symbol where
-
-import GF.Infra.Print
-
------------------------------------------------------------
-- symbols
-
-data Symbol c t = Cat c | Tok t
-		  deriving (Eq, Ord, Show)
-
-symbol :: (c -> a) -> (t -> a) -> Symbol c t -> a
-symbol fc ft (Cat cat) = fc cat
-symbol fc ft (Tok tok) = ft tok
-
-mapSymbol :: (c -> d) -> (t -> u) -> Symbol c t -> Symbol d u
-mapSymbol fc ft = symbol (Cat . fc) (Tok . ft)
-
------------------------------------------------------------
-- pretty-printing
-
-instance (Print c, Print t) => Print (Symbol c t) where
-    prt = symbol prt (simpleShow . prt)
-	where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
-	      mkEsc '\\' = "\\\\"
-	      mkEsc '\"' = "\\\""
-	      mkEsc '\n' = "\\n"
-	      mkEsc '\t' = "\\t"
-	      mkEsc chr  = [chr]
-    prtList = prtSep " "
-
-
-
--- a/src/GF/Parsing/CFGrammar.hs
+++ b/src/GF/Parsing/CFGrammar.hs
@@ -1,153 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : CFGrammar
-- Maintainer  : Peter Ljunglöf
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:54 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Definitions of context-free grammars,
-- parser information and chart conversion
----------------------------------------------------------------------
-
-module GF.Parsing.CFGrammar
-    (-- * Type definitions
-     Grammar,
-     Rule(..),
-     CFParser,
-     -- * Parser information
-     pInfo,
-     PInfo(..),
-     -- * Building parse charts
-     edges2chart,
-     -- * Grammar checking
-     checkGrammar
-    ) where
-
-import GF.System.Tracing 
-
-- haskell modules:
-import Array 
-- gf modules:
-import GF.Data.SortedList
-import GF.Data.Assoc
-import qualified CF 
-- parser modules:
-import GF.Parsing.Utilities
-import GF.Printing.PrintParser
-
-
------------------------------------------------------------
-- type definitions
-
-type Grammar n c t = [Rule n c t]
-data Rule    n c t = Rule c [Symbol c t] n
-		     deriving (Eq, Ord, Show)
-
-
-type CFParser n c t = PInfo n c t -> [c] -> Input t -> [Edge (Rule n c t)]
-- - - - - - - - - - - - - - - - - - ^^^ possible starting categories
-
-
------------------------------------------------------------
-- parser information
-
-pInfo :: (Ord n, Ord c, Ord t) => Grammar n c t -> PInfo n c t
-
-data PInfo n c t
-    = PInfo { grammarTokens        :: SList t,
-	      nameRules            :: Assoc n            (SList (Rule n c t)),
-	      topdownRules         :: Assoc c            (SList (Rule n c t)),
-	      bottomupRules        :: Assoc (Symbol c t) (SList (Rule n c t)),
-	      emptyLeftcornerRules :: Assoc c            (SList (Rule n c t)),
-	      emptyCategories      :: Set c,
-	      cyclicCategories     :: SList c,
-	      -- ^^ONLY FOR DIRECT CYCLIC RULES!!!
-	      leftcornerTokens     :: Assoc c (SList t)
-	      -- ^^DOES NOT WORK WITH EMPTY RULES!!!
-	    }
-
-- this is not permanent...
-pInfo grammar = pInfo' (filter (not.isCyclic) grammar)
-
-pInfo' grammar = tracePrt "#parserInfo" prt $
-		 PInfo grToks nmRules tdRules buRules elcRules emptyCats cyclicCats leftToks 
-    where grToks    = union [ nubsort [ tok | Tok tok <- rhs ] | Rule _ rhs _ <- grammar ]
-	  nmRules   = accumAssoc id [ (name, rule) | rule@(Rule _ _ name) <- grammar ]
-	  tdRules   = accumAssoc id [ (cat,  rule) | rule@(Rule cat _ _) <- grammar ]
-	  buRules   = accumAssoc id [ (next, rule) | rule@(Rule _ (next:_) _) <- grammar ]
-	  elcRules  = accumAssoc id $ limit lc emptyRules
-	  leftToks  = accumAssoc id $ limit lc $ 
-		            nubsort [ (cat, token) | Rule cat (Tok token:_) _ <- grammar ]
-	  lc (left, res)  = nubsort [ (cat, res)   | Rule cat _ _ <- buRules ? Cat left ]
-	  emptyRules      = nubsort [ (cat, rule)  | rule@(Rule cat [] _) <- grammar ]
-	  emptyCats       = listSet $ limitEmpties $ map fst emptyRules
-	  limitEmpties es = if es==es' then es else limitEmpties es'
-	      where es'   = nubsort [ cat | Rule cat rhs _ <- grammar, 
-				      all (symbol (`elem` es) (const False)) rhs ]
-	  cyclicCats = nubsort [ cat | Rule cat [Cat cat'] _ <- grammar, cat == cat' ]
-
-isCyclic (Rule cat [Cat cat'] _) = cat==cat'
-isCyclic _ = False
-
------------------------------------------------------------
-- building parse charts
-
-edges2chart :: (Ord n, Ord c, Ord t) => Input t -> 
-	       [Edge (Rule n c t)] -> ParseChart n (Edge c)
-
----------
-
-edges2chart input edges 
-    = accumAssoc id [ (Edge i k cat, (name, children i k rhs)) |
-		      Edge i k (Rule cat rhs name) <- edges ]
-    where children i k []            = [ [] | i == k ]
-	  children i k (Tok tok:rhs) = [ rest | i <= k,
-					 j <- (inputFrom input ! i) ? tok,
-					 rest <- children j k rhs ]
-	  children i k (Cat cat:rhs) = [ Edge i j cat : rest | i <= k,
-					 j <- echart ? (i, cat),
-					 rest <- children j k rhs ]
-	  echart = accumAssoc id [ ((i, cat), j) | Edge i j (Rule cat _ _) <- edges ]
-
-
------------------------------------------------------------
-- grammar checking
-
-checkGrammar :: (Ord n, Ord c, Ord t, Print n, Print c, Print t) => 
-		Grammar n c t -> [String]
-
----------
-
-checkGrammar rules = [ "rhs category does not exist: " ++ prt cat ++ "\n" ++
-		       "  in rule: " ++ prt rule |
-		       rule@(Rule _ rhs _) <- rules,
-		       Cat cat <- rhs, cat `notElem` cats ]
-    where cats = nubsort [ cat | Rule cat _ _ <- rules ]
-
-
------------------------------------------------------------
-- pretty-printing
-
-instance (Print n, Print c, Print t) => Print (Rule n c t) where
-    prt (Rule cat rhs name) = prt name ++ ". " ++ prt cat ++ " -> " ++ prt rhs ++ 
-			      (if null rhs then ".\n" else "\n")
-    prtList = concatMap prt
-
-
-instance (Ord n, Ord c, Ord t) => Print (PInfo n c t) where
-    prt pI = "[ tokens=" ++ show (length (grammarTokens pI)) ++
-	     "; names=" ++ sla nameRules ++ 
-	     "; tdCats=" ++ sla topdownRules ++
-	     "; buCats=" ++ sla bottomupRules ++ 
-	     "; elcCats=" ++ sla emptyLeftcornerRules ++
-	     "; eCats=" ++ sla emptyCategories ++
-	     "; cCats=" ++ show (length (cyclicCategories pI)) ++
-	     -- "; lctokCats=" ++ sla leftcornerTokens ++ 
-	     " ]"
-	where sla f = show $ length $ aElems $ f pI
-
-
--- a/src/GF/Parsing/ConvertFiniteGFC.hs
+++ b/src/GF/Parsing/ConvertFiniteGFC.hs
@@ -1,272 +0,0 @@
----------------------------------------------------------------------
-- |
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:58:46 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Calculating the finiteness of each type in a grammar
-----------------------------------------------------------------------------
-
-module GF.Parsing.ConvertFiniteGFC where
-
-import Operations
-import GFC
-import MkGFC
-import AbsGFC
-import Ident (Ident(..))
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
-import GF.Data.SortedList
-import GF.Data.Assoc
-import GF.Data.BacktrackM
-
-type Cat = Ident
-type Name = Ident
-
-type CnvMonad a = BacktrackM () () a
-
-convertGrammar :: CanonGrammar -> CanonGrammar
-convertGrammar = canon2grammar . convertCanon . grammar2canon
-
-convertCanon :: Canon -> Canon
-convertCanon (Gr modules) = Gr (map (convertModule split) modules)
-    where split = calcSplitable modules
-
-convertModule :: Splitable -> Module -> Module
-convertModule split (Mod mtyp ext op fl defs) 
-    = Mod mtyp ext op fl newDefs
-    where newDefs  = solutions defMonad () () 
-	  defMonad = member defs >>= convertDef split
-
----------------------------------------------------------------------
-- the main conversion function
-convertDef :: Splitable -> Def -> CnvMonad Def
-
-- converting abstract "cat" definitions
-convertDef split (AbsDCat cat decls cidents)
-    = case splitableCat split cat of
-        Just newCats -> do newCat <- member newCats
-			   return $ AbsDCat newCat decls cidents
-	Nothing -> do (newCat, newDecls) <- expandDecls cat decls
-		      return $ AbsDCat newCat newDecls cidents
-    where expandDecls cat [] = return (cat, [])
-	  expandDecls cat (decl@(Decl var typ) : decls)
-	      = do (newCat, newDecls) <- expandDecls cat decls
-		   let argCat = resultCat typ
-		   case splitableCat split argCat of
-		     Nothing -> return (newCat, decl : newDecls) 
-		     Just newArgs -> do newArg <- member newArgs
-					return (mergeArg newCat newArg, newDecls)
-
-- converting abstract "fun" definitions
-convertDef split (AbsDFun fun typ@(EAtom (AC (CIQ mod cat))) def)
-    = case splitableFun split fun of
-        Just newCat -> return (AbsDFun fun (EAtom (AC (CIQ mod newCat))) def)
-	Nothing -> do newTyp <- expandType split [] typ
-		      return (AbsDFun fun newTyp def)
-convertDef split (AbsDFun fun typ def)
-    = do newTyp <- expandType split [] typ
-	 return (AbsDFun fun newTyp def)
-
-- converting concrete "lincat" definitions
-- convertDef split (
-
-convertDef _ def = return def
-
----------------------------------------------------------------------
-- expanding type expressions
-expandType :: Splitable -> [(Ident, Cat)] -> Exp -> CnvMonad Exp
-expandType split env (EProd x a@(EAtom (AC (CIQ mod cat))) b)
-    = case splitableCat split cat of
-        Nothing -> do b' <- expandType split env b
-		      return (EProd x a b')
-	Just newCats -> do newCat <- member newCats
-			   b' <- expandType split ((x,newCat):env) b
-			   return (EProd x (EAtom (AC (CIQ mod newCat))) b')
-expandType split env (EProd x a b)
-    = do a' <- expandType split env a
-	 b' <- expandType split env b
-	 return (EProd x a' b')
-expandType split env app
-    = expandApp split env [] app
-
-expandApp :: Splitable -> [(Ident, Cat)] -> [Cat] -> Exp -> CnvMonad Exp
-expandApp split env addons (EAtom (AC (CIQ mod cat)))
-    = return (EAtom (AC (CIQ mod (foldl mergeArg cat addons))))
-expandApp split env addons (EApp exp arg@(EAtom (AC (CIQ mod fun))))
-    = case splitableFun split fun of
-        Just newCat -> expandApp split env (newCat:addons) exp
-	Nothing -> do exp' <- expandApp split env addons exp
-		      return (EApp exp' arg)
-expandApp split env addons (EApp exp arg@(EAtom (AV x)))
-    = case lookup x env of
-        Just newCat -> expandApp split env (newCat:addons) exp
-	Nothing -> do exp' <- expandApp split env addons exp
-		      return (EApp exp' arg)
-
----------------------------------------------------------------------
-- splitable categories (finite, no dependencies)
-- they should also be used as some dependency
-
-type Splitable = (Assoc Cat [Cat], Assoc Name Cat)
-
-splitableCat :: Splitable -> Cat -> Maybe [Cat]
-splitableCat = lookupAssoc . fst 
-
-splitableFun :: Splitable -> Name -> Maybe  Cat
-splitableFun = lookupAssoc . snd
-
-calcSplitable :: [Module] -> Splitable
-calcSplitable modules = (listAssoc splitableCats, listAssoc splitableFuns)
-    where splitableCats = tracePrt "splitableCats" (prtSep " ") $
-			  groupPairs $ nubsort 
-			  [ (cat, mergeFun fun cat) | (cat, fun) <- constantCats ]
-
-	  splitableFuns = tracePrt "splitableFuns" (prtSep " ") $
-			  nubsort
-			  [ (fun, mergeFun fun cat) | (cat, fun) <- constantCats ]
-
-	  constantCats = tracePrt "constantCats" (prtSep " ") $
-			 [ (cat, fun) |
-			   AbsDFun fun (EAtom (AC (CIQ _ cat))) _ <- absDefs,
-			   dependentConstants ?= cat ]
-
-          dependentConstants = listSet $
-			       tracePrt "dep consts" prt $
-			       dependentCats <\\> funCats
-
-	  funCats = tracePrt "fun cats" prt $
-		    nubsort [ resultCat typ |
-			      AbsDFun _ typ@(EProd _ _ _) _ <- absDefs ]
-
-          dependentCats = tracePrt "dep cats" prt $
-			  nubsort [ cat | AbsDCat _ decls _ <- absDefs,
-				    Decl _ (EAtom (AC (CIQ _ cat))) <- decls ]
-			    
-          absDefs = concat [ defs | Mod (MTAbs _) _ _ _ defs <- modules ]
-
-
----------------------------------------------------------------------
-- utilities
-
-- the main result category of a type expression
-resultCat :: Exp -> Cat
-resultCat (EProd _ _ b) = resultCat b
-resultCat (EApp a _) = resultCat a
-resultCat (EAtom (AC (CIQ _ cat))) = cat
-
-- mergeing categories
-mergeCats :: String -> String -> String -> Cat -> Cat -> Cat
-mergeCats before middle after (IC cat) (IC arg) 
-    = IC (before ++ cat ++ middle ++ arg ++ after)
-
-mergeFun, mergeArg :: Cat -> Cat -> Cat
-mergeFun = mergeCats "{" ":" "}"
-mergeArg = mergeCats "" "" ""
-
----------------------------------------------------------------------
-- obsolete?
-
-{-
-type FiniteCats = Assoc Cat Integer
-
-calculateFiniteness :: Canon -> FiniteCats
-calculateFiniteness canon@(Gr modules) 
-    = trace2 "#typeInfo" (prt tInfo) $
-      finiteCats
-
-    where finiteCats = listAssoc [ (cat, fin) | (cat, Just fin) <- finiteInfo ]
-          finiteInfo = map finInfo groups 
-
-	  finInfo :: (Cat, [[Cat]]) -> (Cat, Maybe Integer)
-	  finInfo (cat, ctxts)
-	      | cyclicCats ?= cat = (cat, Nothing)
-	      | otherwise = (cat, fmap (sum . map product) $
-			     sequence (map (sequence . map lookFinCat) ctxts))
-
-	  lookFinCat :: Cat -> Maybe Integer
-	  lookFinCat cat = maybe (error "lookFinCat: Nothing") id $
-			   lookup cat finiteInfo
-
-	  cyclicCats :: Set Cat
-	  cyclicCats = listSet $
-		       tracePrt "cyclic cats" prt $
-		       union $ map nubsort $ cyclesIn dependencies
-
-	  dependencies :: [(Cat, [Cat])]
-	  dependencies = tracePrt "dependencies" (prtAfter "\n") $
-			 mapSnd (union . nubsort) groups
-
-	  groups :: [(Cat, [[Cat]])]
-	  groups  = tracePrt "groups" (prtAfter "\n") $
-		    mapSnd (map snd) $ groupPairs (nubsort allFuns)
-
-	  allFuns = tracePrt "all funs" (prtAfter "\n") $
-		    [ (cat, (fun, ctxt)) |
-		      Mod (MTAbs _) _ _ _ defs <- modules,
-		      AbsDFun fun typ _ <- defs,
-		      let (cat, ctxt) = err error id $ typeForm typ ]
-
-          tInfo = calculateTypeInfo 30 finiteCats (splitDefs canon)
-
-- | stolen from 'Macros.qTypeForm', converted to GFC, and severely simplified
-typeForm :: Monad m => Exp -> m (Cat, [Cat])
-typeForm t = case t of
-  EProd x a b  -> do
-    (cat, ctxt) <- typeForm b 
-    a' <- stripType a
-    return (cat, a':ctxt)
-  EApp c a -> do
-    (cat, _) <- typeForm c
-    return (cat, [])
-  EAtom (AC (CIQ _ con)) ->
-    return (con, []) 
-  _       -> 
-    fail $ "no normal form of type: " ++ prt t
-
-stripType :: Monad m => Exp -> m Cat
-stripType (EApp c a) = stripType c
-stripType (EAtom (AC (CIQ _ con))) = return con
-stripType t = fail $ "can't strip type: " ++ prt t
-
-mapSnd f xs = [ (a, f b) | (a, b) <- xs ]
-}
-
----------------------------------------------------------------------
-- obsolete?
-
-{-
-type SplitDefs = ([Def],  [Def],  [Def],  [Def])
-----            AbsDCat AbsDFun CncDCat CncDFun
-
-splitDefs :: Canon -> SplitDefs
-splitDefs (Gr modules) = foldr splitDef ([], [], [], []) $ 
-			 concat [ defs | Mod _ _ _ _ defs <- modules ]
-
-splitDef :: Def -> SplitDefs -> SplitDefs
-splitDef ac@(AbsDCat _ _ _) (acs, afs, ccs, cfs) = (ac:acs, afs, ccs, cfs)
-splitDef af@(AbsDFun _ _ _) (acs, afs, ccs, cfs) = (acs, af:afs, ccs, cfs)
-splitDef cc@(CncDCat _ _ _ _) (acs, afs, ccs, cfs) = (acs, afs, cc:ccs, cfs)
-splitDef cf@(CncDFun _ _ _ _ _) (acs, afs, ccs, cfs) = (acs, afs, ccs, cf:cfs)
-splitDef _ sd = sd
-
--calculateTypeInfo :: Integer -> FiniteCats -> SplitDefs -> ?
-calculateTypeInfo maxFin allFinCats (acs, afs, ccs, cfs)
-    = (depCatsToExpand, catsToSplit)
-    where absDefsToExpand = tracePrt "absDefsToExpand" prt $
-			    [ ((cat, fin), cats) | 
-			      AbsDCat cat args _ <- acs, 
-			      not (null args),
-			      cats <- mapM catOfDecl args,
-			      fin <- lookupAssoc allFinCats cat,
-			      fin <= maxFin
-			    ]
-	  (depCatsToExpand, argsCats') = unzip absDefsToExpand
-	  catsToSplit = union (map nubsort argsCats')
-	  catOfDecl (Decl _ exp) = err fail return $ stripType exp
-}
--- a/src/GF/Parsing/ConvertGFCtoMCFG.hs
+++ b/src/GF/Parsing/ConvertGFCtoMCFG.hs
@@ -1,34 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ConvertGFCtoMCFG
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:54 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- All different conversions from GFC to MCFG
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ConvertGFCtoMCFG
-    (convertGrammar) where
-
-import GFC (CanonGrammar)
-import GF.Parsing.GrammarTypes
-import Ident (Ident(..))
-import Option
-import GF.System.Tracing
-
-import qualified GF.Parsing.ConvertGFCtoMCFG.Old as Old
-import qualified GF.Parsing.ConvertGFCtoMCFG.Nondet as Nondet
-import qualified GF.Parsing.ConvertGFCtoMCFG.Strict as Strict
-import qualified GF.Parsing.ConvertGFCtoMCFG.Coercions as Coerce
-
-convertGrammar :: String -> (CanonGrammar, Ident) -> MCFGrammar
-convertGrammar "nondet" = Coerce.addCoercions . Nondet.convertGrammar
-convertGrammar "strict" = Strict.convertGrammar
-convertGrammar "old" = Old.convertGrammar
-
--- a/src/GF/Parsing/ConvertGFCtoMCFG/Coercions.hs
+++ b/src/GF/Parsing/ConvertGFCtoMCFG/Coercions.hs
@@ -1,71 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ConvertGFCtoMCFG.Coercions
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:55 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Adding coercion functions to a MCFG if necessary.
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ConvertGFCtoMCFG.Coercions (addCoercions) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
-- import PrintGFC
-- import qualified PrGrammar as PG
-
-import qualified Ident
-import GF.Parsing.Utilities
-import GF.Parsing.GrammarTypes 
-import GF.Parsing.MCFGrammar (Rule(..), Lin(..))
-import GF.Data.SortedList
-import List (groupBy) -- , transpose)
-
----------------------------------------------------------------------
-
-addCoercions :: MCFGrammar -> MCFGrammar
-addCoercions rules = coercions ++ rules
-    where (allHeads, allArgs) = unzip [ ((head, lbls), nubsort args) | 
-					Rule head args lins _ <- rules, 
-					let lbls = [ lbl | Lin lbl _ <- lins ] ]
-	  allHeadSet = nubsort allHeads
-	  allArgSet  = union   allArgs <\\> map fst allHeadSet
-	  coercions = tracePrt "#coercions total" (prt . length) $
-		      concat $
-		      tracePrt "#coercions per cat" (prtList . map length) $
-		      combineCoercions 
-		        (groupBy sameCatFst allHeadSet) 
-			(groupBy sameCat    allArgSet)
-	  sameCatFst a b = sameCat (fst a) (fst b)
-
-
-combineCoercions [] _ = []
-combineCoercions _ [] = []
-combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs) 
-    = case compare (mainCat $ fst $ head heads) (mainCat $ head args) of
-        LT -> combineCoercions allHeads  allArgs'
-	GT -> combineCoercions allHeads' allArgs
-	EQ -> makeCoercion heads args : combineCoercions allHeads allArgs
-
-
-makeCoercion heads args = [ Rule arg [head] lins coercionName |
-			    (head@(MCFCat _ headCns), lbls) <- heads, 
-			    let lins = [ Lin lbl [Cat (head, lbl, 0)] | lbl <- lbls ],
-			    arg@(MCFCat _ argCns) <- args,
-			    argCns `subset` headCns ]
-
-
-coercionName = Ident.IW
-
-mainCat (MCFCat c _) = c
-
-sameCat mc1 mc2 = mainCat mc1 == mainCat mc2
-
-
--- a/src/GF/Parsing/ConvertGFCtoMCFG/Nondet.hs
+++ b/src/GF/Parsing/ConvertGFCtoMCFG/Nondet.hs
@@ -1,280 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ConvertGFCtoMCFG.Nondet
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:55 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Converting GFC grammars to MCFG grammars, nondeterministically.
--
-- the resulting grammars might be /very large/
--
-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
-- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ConvertGFCtoMCFG.Nondet (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
-- import PrintGFC
-- import qualified PrGrammar as PG
-
-import Monad
-import Ident (Ident(..))
-import AbsGFC
-import GFC
-import Look
-import Operations
-import qualified Modules as M
-import CMacros (defLinType)
-import MkGFC (grammar2canon)
-import GF.Parsing.Utilities
-import GF.Parsing.GrammarTypes 
-import GF.Parsing.MCFGrammar (Grammar, Rule(..), Lin(..))
-import GF.Data.SortedList
-- import Maybe (listToMaybe)
-import List (groupBy) -- , transpose)
-
-import GF.Data.BacktrackM
-
----------------------------------------------------------------------
-
-type GrammarEnv  = (CanonGrammar, Ident)
-
-convertGrammar :: GrammarEnv -- ^ the canonical grammar, together with the selected language
-	       -> MCFGrammar -- ^ the resulting MCF grammar
-convertGrammar gram = trace2 "language" (prt (snd gram)) $
-		      trace2 "modules" (prtSep " " modnames) $
-		      tracePrt "#mcf-rules total" (prt . length) $
-		      solutions conversion gram undefined
-    where Gr modules = grammar2canon (fst gram)
-	  modnames   = uncurry M.allExtends gram
-	  conversion = member modules >>= convertModule
-	  convertModule (Mod (MTCnc modname _) _ _ _ defs)
-	      | modname `elem` modnames = member defs >>= convertDef 
-	  convertModule _ = failure
-
-convertDef :: Def -> CnvMonad MCFRule
-convertDef (CncDFun fun (CIQ _ cat) args term _)
-    | trace2 "converting function" (prt fun) True
-    = do let iCat : iArgs = map initialMCat (cat : map catOfArg args)
-	 writeState (iCat, iArgs, [])
-	 convertTerm cat term
-	 (newCat, newArgs, linRec) <- readState
-	 let newTerm = map (instLin newArgs) linRec
-	 traceDot $
-	   return (Rule newCat newArgs newTerm fun)
-convertDef _ = failure
-
-instLin newArgs (Lin lbl lin) = Lin lbl (map instSym lin)
-    where instSym = mapSymbol instCat id
-	  instCat (_, lbl, arg) = (newArgs !! arg, lbl, arg)
-
-convertTerm :: Cat -> Term -> CnvMonad ()
-convertTerm cat term = do rterm <- simplifyTerm term
-			  env <- readEnv
-			  let ctype = lookupCType env cat
-			  reduce ctype rterm emptyPath
-
------------------------------------------------------------
-
-type CnvMonad a = BacktrackM GrammarEnv CMRule a
-
-type CMRule = (MCFCat, [MCFCat], LinRec)
-type LinRec = [Lin Cat Path Tokn]
-
-initialMCat :: Cat -> MCFCat
-initialMCat cat = MCFCat cat []
-
----------------------------------------------------------------------
-
-simplifyTerm :: Term -> CnvMonad STerm
-simplifyTerm (Arg (A cat nr))  = return (SArg (fromInteger nr) cat emptyPath)
-simplifyTerm (Con con terms)   = liftM (SCon con) $ mapM simplifyTerm terms
-simplifyTerm (R record)        = liftM SRec       $ mapM simplifyAssign record
-simplifyTerm (P term lbl)      = liftM (+. lbl)   $      simplifyTerm term
-simplifyTerm (T ct table)      = liftM STbl $ sequence $ concatMap simplifyCase table
-simplifyTerm (V ct terms)  
-    = do env <- readEnv
-	 liftM STbl $ sequence [ liftM ((,) pat) (simplifyTerm term) |
-				 (pat, term) <- zip (groundTerms env ct) terms ]
-simplifyTerm (S term sel)      
-    = do sterm <- simplifyTerm term
-	 ssel <- simplifyTerm sel
-	 case sterm of
-	   STbl table  -> do (pat, val) <- member table
-			     pat =?= ssel
-			     return val
-	   _ -> do sel' <- expandTerm ssel
-		   return (sterm +! sel')
-simplifyTerm (FV terms)        = liftM SVariants $ mapM simplifyTerm terms
-simplifyTerm (term1 `C` term2) = liftM2 (SConcat) (simplifyTerm term1) (simplifyTerm term2)
-simplifyTerm (K tokn)          = return $ SToken tokn
-simplifyTerm (E)               = return $ SEmpty
-simplifyTerm x                 = error $ "simplifyTerm: " ++ show x
-- error constructors:
--   (I CIdent) - from resource
--   (LI Ident) - pattern variable
--   (EInt Integer) - integer
-
-simplifyAssign :: Assign -> CnvMonad (Label, STerm)
-simplifyAssign (Ass lbl term) = liftM ((,) lbl) $ simplifyTerm term
-
-simplifyCase :: Case -> [CnvMonad (STerm, STerm)]
-simplifyCase (Cas pats term) = [ liftM2 (,) (simplifyPattern pat) (simplifyTerm term) |
-				 pat <- pats ]
-
-simplifyPattern :: Patt -> CnvMonad STerm
-simplifyPattern (PC con pats) = liftM (SCon con) $ mapM simplifyPattern pats
-simplifyPattern (PW)          = return SWildcard
-simplifyPattern (PR record)   = do record' <- mapM simplifyPattAssign record
-				   case filter (\row -> snd row /= SWildcard) record' of
-				     []       -> return SWildcard
-				     record'' -> return (SRec record')
-simplifyPattern x = error $ "simplifyPattern: " ++ show x
-- error constructors:
--   (PV Ident) - pattern variable
-
-simplifyPattAssign :: PattAssign -> CnvMonad (Label, STerm)
-simplifyPattAssign (PAss lbl pat) = liftM ((,) lbl) $ simplifyPattern pat
-
-
------------------------------------------------------------
-- reducing simplified terms, collecting mcf rules
-
-reduce :: CType -> STerm -> Path -> CnvMonad ()
-reduce TStr   term path = updateLin (path, term)
-reduce (Cn _) term path
-    = do pat <- expandTerm term
-	 updateHead (path, pat)
-reduce ctype (SVariants terms) path 
-    = do term <- member terms
-	 reduce ctype term path
-reduce (RecType rtype) term path
-    = sequence_ [ reduce ctype (term +. lbl) (path ++. lbl) |
-		  Lbg lbl ctype <- rtype ]
-reduce (Table _ ctype) (STbl table) path
-    = sequence_ [ reduce ctype term (path ++! pat) |
-		  (pat, term) <- table ]
-reduce (Table ptype vtype) arg@(SArg _ _ _) path 
-    = do env <- readEnv
-	 sequence_ [ reduce vtype (arg +! pat) (path ++! pat) |
-		     pat <- groundTerms env ptype ]
-reduce ctype term path = error ("reduce:\n  ctype = (" ++ show ctype ++ 
-				")\n  term = (" ++ show term ++ 
-				")\n  path = (" ++ show path ++ ")\n")
-
-
------------------------------------------------------------
-- expanding a term to ground terms
-
-expandTerm :: STerm -> CnvMonad STerm
-expandTerm arg@(SArg _ _ _) 
-    = do env <- readEnv
-	 pat <- member $ groundTerms env $ cTypeForArg env arg
-	 pat =?= arg
-	 return pat
-expandTerm (SCon con terms)  = liftM (SCon con) $ mapM expandTerm terms
-expandTerm (SRec record)     = liftM  SRec      $ mapM expandAssign record
-expandTerm (SVariants terms) = member terms >>= expandTerm
-expandTerm term = error $ "expandTerm: " ++ show term
-
-expandAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
-expandAssign (lbl, term)   = liftM ((,) lbl) $ expandTerm term
-
------------------------------------------------------------
-- unification of patterns and selection terms
-
-(=?=) :: STerm -> STerm -> CnvMonad ()
-SWildcard     =?= _                = return ()
-SRec precord  =?= arg@(SArg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
-						 (lbl, pat) <- precord ]
-pat           =?= SArg arg _ path  = updateArg arg (path, pat)
-SCon con pats =?= SCon con' terms  = do guard (con==con' && length pats==length terms)
-					sequence_ $ zipWith (=?=) pats terms
-SRec precord  =?= SRec record      = sequence_ [ maybe mzero (pat =?=) mterm |
-						 (lbl, pat) <- precord,
-						 let mterm = lookup lbl record ]
-pat =?= term = error $ "(=?=): " ++ show pat ++ " =?= " ++ show term
-
-
------------------------------------------------------------
-- updating the mcf rule
-
-updateArg :: Int -> Constraint -> CnvMonad ()
-updateArg arg cn
-    = do (head, args, lins) <- readState 
-	 args' <- updateNth (addToMCFCat cn) arg args
-	 writeState (head, args', lins)
-
-updateHead :: Constraint -> CnvMonad ()
-updateHead cn
-    = do (head, args, lins) <- readState
-	 head' <- addToMCFCat cn head
-	 writeState (head', args, lins)
-
-updateLin :: Constraint -> CnvMonad ()
-updateLin (path, term) 
-    = do let newLins = term2lins term
-	 (head, args, lins) <- readState
-	 let lins' = lins ++ map (Lin path) newLins
-	 writeState (head, args, lins')
-
-term2lins :: STerm -> [[Symbol (Cat, Path, Int) Tokn]]
-term2lins (SArg arg cat path) = return [Cat (cat, path, arg)]
-term2lins (SToken str)        = return [Tok str]
-term2lins (SConcat t1 t2)     = liftM2 (++) (term2lins t1) (term2lins t2)
-term2lins (SEmpty)            = return []
-term2lins (SVariants terms)   = terms >>= term2lins
-term2lins term = error $ "term2lins: " ++ show term
-
-addToMCFCat :: Constraint -> MCFCat -> CnvMonad MCFCat
-addToMCFCat cn (MCFCat cat cns) = liftM (MCFCat cat) $ addConstraint cn cns
-
-addConstraint :: Constraint -> [Constraint] -> CnvMonad [Constraint]
-addConstraint cn0 (cn : cns)
-    | fst cn0 >  fst cn = liftM (cn:) (addConstraint cn0 cns)
-    | fst cn0 == fst cn = guard (snd cn0 == snd cn) >>
-			  return (cn : cns)
-addConstraint cn0 cns   = return (cn0 : cns)
-
-
----------------------------------------------------------------------
-- utilities 
-
-updateNth :: Monad m => (a -> m a) -> Int -> [a] -> m [a]
-updateNth update 0 (a : as) = liftM (:as) (update a)
-updateNth update n (a : as) = liftM (a:)  (updateNth update (n-1) as)
-
-catOfArg (A aCat _) = aCat
-catOfArg (AB aCat _ _) = aCat
-
-lookupCType :: GrammarEnv -> Cat -> CType
-lookupCType env cat = errVal defLinType $ 
-		      lookupLincat (fst env) (CIQ (snd env) cat)
-
-groundTerms :: GrammarEnv -> CType -> [STerm]
-groundTerms env ctype = err error (map term2spattern) $
-			allParamValues (fst env) ctype
-
-cTypeForArg :: GrammarEnv -> STerm -> CType
-cTypeForArg env (SArg nr cat (Path path))
-    = follow path $ lookupCType env cat
-    where follow [] ctype = ctype
-	  follow (Right pat : path) (Table _ ctype) = follow path ctype
-	  follow (Left lbl : path) (RecType rec)
-	      = case [ ctype | Lbg lbl' ctype <- rec, lbl == lbl' ] of
-		  [ctype] -> follow path ctype
-		  err     -> error $ "follow: " ++ show rec ++ " . " ++ show lbl ++ 
-			             " results in " ++ show err
-
-term2spattern (R rec)         = SRec [ (lbl, term2spattern term) | Ass lbl term <- rec ]
-term2spattern (Con con terms) = SCon con $ map term2spattern terms
-
--- a/src/GF/Parsing/ConvertGFCtoMCFG/Old.hs
+++ b/src/GF/Parsing/ConvertGFCtoMCFG/Old.hs
@@ -1,277 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ConvertGFCtoMCFG.Old
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:55 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.3 $
--
-- Converting GFC grammars to MCFG grammars. (Old variant)
--
-- the resulting grammars might be /very large/
--
-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
-- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ConvertGFCtoMCFG.Old (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
--import PrintGFC
-import qualified PrGrammar as PG
-
-import Monad (liftM, liftM2, guard)
-- import Maybe (listToMaybe)
-import Ident (Ident(..))
-import AbsGFC
-import GFC
-import Look
-import Operations
-import qualified Modules as M
-import CMacros (defLinType)
-import MkGFC (grammar2canon)
-import GF.Parsing.Utilities
-import GF.Parsing.GrammarTypes 
-import GF.Parsing.MCFGrammar (Rule(..), Lin(..))
-import GF.Data.SortedList (nubsort, groupPairs)
-import Maybe (listToMaybe)
-import List (groupBy, transpose)
-
----------------------------------------------------------------------
-- old style types
-
-data XMCFCat = XMCFCat Cat [(XPath, Term)] deriving (Eq, Ord, Show)
-type XMCFLabel = XPath
-
-cnvXMCFCat :: XMCFCat -> MCFCat
-cnvXMCFCat (XMCFCat cat constrs) = MCFCat cat [ (cnvXPath path, cnvTerm term) | 
-						(path, term) <- constrs ]
-
-cnvXMCFLabel :: XMCFLabel -> MCFLabel
-cnvXMCFLabel = cnvXPath
-
-cnvXMCFLin :: Lin XMCFCat XMCFLabel Tokn -> Lin MCFCat MCFLabel Tokn
-cnvXMCFLin (Lin lbl lin) = Lin (cnvXMCFLabel lbl) $
-			   map (mapSymbol cnvSym id) lin
-    where cnvSym (cat, lbl, nr) = (cnvXMCFCat cat, cnvXMCFLabel lbl, nr)
-
-- Term -> STerm
-
-cnvTerm (R rec) = SRec [ (lbl, cnvTerm term) | Ass lbl term <- rec ]
-cnvTerm (T _ tbl) = STbl [ (cnvPattern pat, cnvTerm term) | 
-			   Cas pats term <- tbl, pat <- pats ]
-cnvTerm (Con con terms) = SCon con $ map cnvTerm terms
-cnvTerm term
-    | isArgPath term = cnvArgPath term
-
-cnvPattern (PR rec) = SRec [ (lbl, cnvPattern term) | PAss lbl term <- rec ]
-cnvPattern (PC con pats) = SCon con $ map cnvPattern pats
-cnvPattern (PW) = SWildcard
-
-isArgPath (Arg _) = True
-isArgPath (P _ _) = True
-isArgPath (S _ _) = True
-isArgPath _ = False
-
-cnvArgPath (Arg (A cat nr)) = SArg (fromInteger nr) cat emptyPath
-cnvArgPath (term `P` lbl) = cnvArgPath term +. lbl
-cnvArgPath (term `S` sel) = cnvArgPath term +! cnvTerm sel
-
-- old style paths
-
-newtype XPath = XPath [Either Label Term] deriving (Eq, Ord, Show)
-
-cnvXPath :: XPath -> Path
-cnvXPath (XPath path) = Path (map (either Left (Right . cnvTerm)) (reverse path))
-
-emptyXPath :: XPath
-emptyXPath = XPath []
-
-(++..) :: XPath -> Label -> XPath 
-XPath path ++.. lbl = XPath (Left lbl : path)
-
-(++!!) :: XPath -> Term -> XPath 
-XPath path ++!! sel = XPath (Right sel : path)
-
----------------------------------------------------------------------
-
-- | combining alg. 1 and alg. 2 from Ljunglöf's PhD thesis
-convertGrammar :: (CanonGrammar, Ident) -> MCFGrammar
-convertGrammar (gram, lng) = trace2 "language" (prt lng) $
-			     trace2 "modules" (prtSep " " modnames) $
-			     trace2 "#lin-terms" (prt (length cncdefs)) $
-			     tracePrt "#mcf-rules total" (prt.length) $
-			     concat $
-			     tracePrt "#mcf-rules per fun" 
-			     (\rs -> concat [" "++show n++"="++show (length r) | 
-					     (n, r) <- zip [1..] rs]) $
-			     map (convertDef gram lng) cncdefs
-    where Gr mods = grammar2canon gram
-	  cncdefs = [ def | Mod (MTCnc modname _) _ _ _ defs <- mods, 
-		      modname `elem` modnames, 
-		      def@(CncDFun _ _ _ _ _) <- defs ]
-	  modnames = M.allExtends gram lng
-
-
-convertDef :: CanonGrammar -> Ident -> Def -> [MCFRule]
-convertDef gram lng (CncDFun fun (CIQ _ cat) args term _)
-    = [ Rule (cnvXMCFCat newCat) (map cnvXMCFCat newArgs) (map cnvXMCFLin newTerm) fun |
-	let ctype     = lookupCType gram lng cat,
-	instArgs     <- mapM (enumerateInsts gram lng) args,
-	let instTerm  = substitutePaths gram lng instArgs term,
-	newCat       <- emcfCat gram lng cat instTerm,
-	newArgs      <- mapM (extractArg gram lng instArgs) args,
-	let newTerm   = concatMap (extractLin newArgs) $ strPaths gram lng ctype instTerm
-      ]
-
-
-- gammalt skräp:
-- mergeArgs = zipWith mergeRec
-- mergeRec (R r1) (R r2) = R (r1 ++ r2)
-
-extractArg :: CanonGrammar -> Ident -> [Term] -> ArgVar -> [XMCFCat]
-extractArg gram lng args (A cat nr) = emcfCat gram lng cat (args !!! nr)
-
-
-emcfCat :: CanonGrammar -> Ident -> Ident -> Term -> [XMCFCat]
-emcfCat gram lng cat = map (XMCFCat cat) . parPaths gram lng (lookupCType gram lng cat) 
-
-
-extractLin :: [XMCFCat] -> (XPath, Term) -> [Lin XMCFCat XMCFLabel Tokn]
-extractLin args (path, term) = map (Lin path) (convertLin term)
-    where convertLin (t1 `C` t2) = liftM2 (++) (convertLin t1) (convertLin t2)
-	  convertLin (E) = [[]]
-	  convertLin (K tok) = [[Tok tok]]
-	  convertLin (FV terms) = concatMap convertLin terms
-	  convertLin term = map (return . Cat) $ flattenTerm emptyXPath term
-	  flattenTerm path (Arg (A _ nr)) = [(args !!! nr, path, fromInteger nr)]
-	  flattenTerm path (term `P` lbl) = flattenTerm (path ++.. lbl) term
-	  flattenTerm path (term `S` sel) = flattenTerm (path ++!! sel) term
-	  flattenTerm path (FV terms)     = concatMap (flattenTerm path) terms
-	  flattenTerm path term = error $ "flattenTerm: \n  " ++ show path ++ "\n  " ++ prt term 
-
-
-enumerateInsts :: CanonGrammar -> Ident -> ArgVar -> [Term]
-enumerateInsts gram lng arg@(A argCat _) = enumerate (Arg arg) (lookupCType gram lng argCat)
-    where enumerate path (TStr) = [ path ]
-	  enumerate path (Cn con) = okError $ lookupParamValues gram con
-	  enumerate path (RecType r) 
-	      = map R $ sequence [ map (lbl `Ass`) $ 
-				   enumerate (path `P` lbl) ctype |
-				   lbl `Lbg` ctype <- r ]
-	  enumerate path (Table s t)
-	      = map (T s) $ sequence [ map ([term2pattern sel] `Cas`) $ 
-				       enumerate (path `S` sel) t |
-				       sel <- enumerate (error "enumerate") s ]
-
-
-
-termPaths :: CanonGrammar -> Ident -> CType -> Term -> [(XPath, (CType, Term))]
-termPaths gr l (TStr) term = [ (emptyXPath, (TStr, term)) ]
-termPaths gr l (RecType rtype) (R record) 
-    = [ (path ++.. lbl, value) |
-	lbl `Ass` term <- record,
-	let ctype = okError $ maybeErr "termPaths/record" $ lookupLabelling lbl rtype,
-	(path, value) <- termPaths gr l ctype term ]
-termPaths gr l (Table _ ctype) (T _ table)
-    = [ (path ++!! pattern2term pat, value) |
-	pats `Cas` term <- table, pat <- pats,
-	(path, value) <- termPaths gr l ctype term ]
-termPaths gr l (Table _ ctype) (V ptype table)
-    = [ (path ++!! pat, value) |
-	(pat, term) <- zip (okError $ allParamValues gr ptype) table,
-	(path, value) <- termPaths gr l ctype term ]
-termPaths gr l ctype (FV terms)
-    = concatMap (termPaths gr l ctype) terms
-termPaths gr l (Cn pc) term = [ (emptyXPath, (Cn pc, term)) ]
-
-{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
-{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
-[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
-}
-
-parPaths :: CanonGrammar -> Ident -> CType -> Term -> [[(XPath, Term)]]
-parPaths gr l ctype term = mapM (uncurry (map . (,))) (groupPairs paths)
-    where paths = nubsort [ (path, value) | (path, (Cn _, value)) <- termPaths gr l ctype term ]
-
-strPaths :: CanonGrammar -> Ident -> CType -> Term -> [(XPath, Term)]
-strPaths gr l ctype term = [ (path, evalFV values) | (path, values) <- groupPairs paths ]
-    where paths = nubsort [ (path, value) | (path, (TStr, value)) <- termPaths gr l ctype term ]
-
-
-- Substitute each instantiated parameter path for its instantiation
-substitutePaths :: CanonGrammar -> Ident -> [Term] -> Term -> Term
-substitutePaths gr l arguments trm  = subst trm
-    where subst (con `Con` terms) = con `Con` map subst terms
-	  subst (R record)        = R $ map substAss record
-	  subst (term `P` lbl)    = subst term `evalP` lbl
-	  subst (T ptype table)   = T ptype $ map substCas table
-	  subst (V ptype table)   = T ptype [ [term2pattern pat] `Cas` subst term | 
-					      (pat, term) <- zip (okError $ allParamValues gr ptype) table ]
-	  subst (term `S` select) = subst term `evalS` subst select
-	  subst (term `C` term')  = subst term `C` subst term'
-	  subst (FV terms)        = evalFV $ map subst terms
-	  subst (Arg (A _ arg))   = arguments !!! arg
-	  subst term              = term
-
-          substAss (l `Ass` term) = l `Ass` subst term
-	  substCas (p `Cas` term) = p `Cas` subst term
-
-
-evalP (R record) lbl = okError $ maybeErr errStr $ lookupAssign lbl record
-    where errStr = "evalP: " ++ prt (R record `P` lbl)
-evalP (FV terms) lbl = evalFV [ evalP term lbl | term <- terms ]
-evalP term       lbl = term `P` lbl
-
-evalS t@(T _ tbl) sel = maybe (t `S` sel) id $ lookupCase sel tbl
-evalS (FV terms)  sel = evalFV [ term `evalS` sel | term <- terms ]
-evalS term   (FV sels)= evalFV [ term `evalS` sel | sel <- sels ]
-evalS term        sel = term `S` sel
-
-evalFV terms0 = case nubsort (concatMap flattenFV terms0) of
-	          [term] -> term
-		  terms  -> FV terms
-    where flattenFV (FV ts) = ts
-	  flattenFV  t      = [t]
-
-
----------------------------------------------------------------------
-- utilities 
-
-- lookup a CType for an Ident
-lookupCType :: CanonGrammar -> Ident -> Ident -> CType
-lookupCType gr lng c = errVal defLinType $ lookupLincat gr (CIQ lng c)
-
-- lookup a label in a (record / record ctype / table)
-lookupAssign    :: Label -> [Assign]    -> Maybe Term
-lookupLabelling :: Label -> [Labelling] -> Maybe CType
-lookupCase      :: Term  -> [Case]      -> Maybe Term
-
-lookupAssign    lbl rec  = listToMaybe [ term | lbl' `Ass` term <- rec, lbl == lbl' ] 
-lookupLabelling lbl rtyp = listToMaybe [ ctyp | lbl' `Lbg` ctyp <- rtyp, lbl == lbl' ]
-lookupCase      sel tbl  = listToMaybe [ term | pats `Cas` term <- tbl, sel `matchesPats` pats ]
-
-matchesPats :: Term -> [Patt] -> Bool
-matchesPats term patterns = or [ term == pattern2term pattern | pattern <- patterns ]
-
-- converting between patterns and terms
-pattern2term :: Patt -> Term
-term2pattern :: Term -> Patt
-
-pattern2term (con `PC` patterns) = con `Con` map pattern2term patterns
-pattern2term (PR record) = R [ lbl `Ass` pattern2term pattern | 
-			       lbl `PAss` pattern <- record ]
-
-term2pattern (con `Con` terms) = con `PC` map term2pattern terms
-term2pattern (R record) = PR [ lbl `PAss` term2pattern term |
-			       lbl `Ass` term <- record ]
-
-- list lookup for Integers instead of Ints
-(!!!) :: [a] -> Integer -> a
-xs !!! n = xs !! fromInteger n
--- a/src/GF/Parsing/ConvertGFCtoMCFG/Strict.hs
+++ b/src/GF/Parsing/ConvertGFCtoMCFG/Strict.hs
@@ -1,195 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ConvertGFCtoMCFG.Strict
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:55 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Converting GFC grammars to MCFG grammars, nondeterministically.
--
-- the resulting grammars might be /very large/
--
-- the conversion is only equivalent if the GFC grammar has a context-free backbone.
-- (also, the conversion might fail if the GFC grammar has dependent or higher-order types)
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ConvertGFCtoMCFG.Strict (convertGrammar) where
-
-import GF.System.Tracing
-- import IOExts (unsafePerformIO)
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
-- import PrintGFC
-- import qualified PrGrammar as PG
-
-import Monad
-import Ident (Ident(..))
-import AbsGFC
-import GFC
-import Look
-import Operations
-import qualified Modules as M
-import CMacros (defLinType)
-import MkGFC (grammar2canon)
-import GF.Parsing.Utilities
-import GF.Parsing.GrammarTypes 
-import GF.Parsing.MCFGrammar (Grammar, Rule(..), Lin(..))
-import GF.Data.SortedList
-- import Maybe (listToMaybe)
-import List (groupBy) -- , transpose)
-
-import GF.Data.BacktrackM
-
----------------------------------------------------------------------
-
-type GrammarEnv  = (CanonGrammar, Ident)
-
-convertGrammar :: GrammarEnv -- ^ the canonical grammar, together with the selected language
-	       -> MCFGrammar -- ^ the resulting MCF grammar
-convertGrammar gram = trace2 "language" (prt (snd gram)) $
-		      trace2 "modules" (prtSep " " modnames) $
-		      tracePrt "#mcf-rules total" (prt . length) $
-		      solutions conversion gram undefined
-    where Gr modules = grammar2canon (fst gram)
-	  modnames   = uncurry M.allExtends gram
-	  conversion = member modules >>= convertModule
-	  convertModule (Mod (MTCnc modname _) _ _ _ defs)
-	      | modname `elem` modnames = member defs >>= convertDef 
-	  convertModule _ = failure
-
-convertDef :: Def -> CnvMonad MCFRule
-convertDef (CncDFun fun (CIQ _ cat) args term _)
-    | trace2 "converting function" (prt fun) True
-    = do env <- readEnv
-	 let ctype = lookupCType env cat
-	 instArgs <- mapM enumerateArg args
-	 let instTerm = substitutePaths env instArgs term
-	 newCat <- emcfCat cat instTerm
-	 newArgs <- mapM (extractArg instArgs) args
-	 let newTerm = strPaths env ctype instTerm >>= extractLin newArgs
-	 traceDot $ 
-	   return (Rule newCat newArgs newTerm fun)
-convertDef _ = failure
-
------------------------------------------------------------
-
-type CnvMonad a = BacktrackM GrammarEnv () a
-
----------------------------------------------------------------------
-- strict conversion
-
-extractArg :: [STerm] -> ArgVar -> CnvMonad MCFCat
-extractArg args (A cat nr) = emcfCat cat (args !! fromInteger nr)
-
-emcfCat :: Cat -> STerm -> CnvMonad MCFCat
-emcfCat cat term = do env <- readEnv
-		      member $ map (MCFCat cat) $ parPaths env (lookupCType env cat) term
-
-enumerateArg :: ArgVar -> CnvMonad STerm
-enumerateArg (A cat nr) = do env <- readEnv
-			     let ctype = lookupCType env cat
-			     enumerate (SArg (fromInteger nr) cat emptyPath) ctype
-    where enumerate arg (TStr) = return arg 
-	  enumerate arg ctype@(Cn _) = do env <- readEnv 
-					  member $ groundTerms env ctype
-	  enumerate arg (RecType rtype) 
-	      = liftM SRec $ sequence [ liftM ((,) lbl) $ 
-					enumerate (arg +. lbl) ctype |
-					lbl `Lbg` ctype <- rtype ]
-	  enumerate arg (Table stype ctype)
-	      = do env <- readEnv
-		   state <- readState
-		   liftM STbl $ sequence [ liftM ((,) sel) $ 
-					   enumerate (arg +! sel) ctype |
-					   sel <- solutions (enumerate err stype) env state ]
-	      where err = error "enumerate: parameter type should not be string"
-
-- Substitute each instantiated parameter path for its instantiation
-substitutePaths :: GrammarEnv -> [STerm] -> Term -> STerm
-substitutePaths env arguments trm  = subst trm
-    where subst (con `Con` terms) = con `SCon` map subst terms
-	  subst (R record)        = SRec [ (lbl, subst term) | lbl `Ass` term <- record ]
-	  subst (term `P` lbl)    = subst term +. lbl
-	  subst (T ptype table)   = STbl [ (pattern2sterm pat, subst term) | 
-					   pats `Cas` term <- table, pat <- pats ]
-	  subst (V ptype table)   = STbl [ (pat, subst term) | 
-					   (pat, term) <- zip (groundTerms env ptype) table ]
-	  subst (term `S` select) = subst term +! subst select
-	  subst (term `C` term')  = subst term `SConcat` subst term'
-	  subst (K str)           = SToken str
-	  subst (E)               = SEmpty
-	  subst (FV terms)        = evalFV $ map subst terms
-	  subst (Arg (A _ arg))   = arguments !! fromInteger arg
-
-
-termPaths :: GrammarEnv -> CType -> STerm -> [(Path, (CType, STerm))]
-termPaths env (TStr) term = [ (emptyPath, (TStr, term)) ]
-termPaths env (RecType rtype) (SRec record) 
-    = [ (path ++. lbl, value) |
-	(lbl, term) <- record,
-	let ctype = lookupLabelling lbl rtype,
-	(path, value) <- termPaths env ctype term ]
-termPaths env (Table _ ctype) (STbl table)
-    = [ (path ++! pat, value) |
-	(pat, term) <- table,
-	(path, value) <- termPaths env ctype term ]
-termPaths env ctype (SVariants terms)
-    = terms >>= termPaths env ctype
-termPaths env (Cn pc) term = [ (emptyPath, (Cn pc, term)) ]
-
-{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
-{a=a1; b=b1}  | {a=a2; b=b2}   ==>  {a=a1|a2; b=b1|b2}
-[p=>p1;q=>q1] | [p=>p2;q=>q2]  ==>  [p=>p1|p2;q=>q1|q2]
-}
-
-parPaths :: GrammarEnv -> CType -> STerm -> [[(Path, STerm)]]
-parPaths env ctype term = mapM (uncurry (map . (,))) (groupPairs paths)
-    where paths = nubsort [ (path, value) | (path, (Cn _, value)) <- termPaths env ctype term ]
-
-strPaths :: GrammarEnv -> CType -> STerm -> [(Path, STerm)]
-strPaths env ctype term = [ (path, evalFV values) | (path, values) <- groupPairs paths ]
-    where paths = nubsort [ (path, value) | (path, (TStr, value)) <- termPaths env ctype term ]
-
-extractLin :: [MCFCat] -> (Path, STerm) -> [Lin MCFCat MCFLabel Tokn]
-extractLin args (path, term) = map (Lin path) (convertLin term)
-    where convertLin (t1 `SConcat` t2) = liftM2 (++) (convertLin t1) (convertLin t2)
-	  convertLin (SEmpty) = [[]]
-	  convertLin (SToken tok) = [[Tok tok]]
-	  convertLin (SVariants terms) = concatMap convertLin terms
-	  convertLin (SArg nr _ path) = [[Cat (args !! nr, path, nr)]]
-
-evalFV terms0 = case nubsort (concatMap flattenFV terms0) of
-	          [term] -> term
-		  terms  -> SVariants terms
-    where flattenFV (SVariants ts) = ts
-	  flattenFV  t      = [t]
-
----------------------------------------------------------------------
-- utilities 
-
-lookupCType :: GrammarEnv -> Cat -> CType
-lookupCType env cat = errVal defLinType $ 
-		      lookupLincat (fst env) (CIQ (snd env) cat)
-
-lookupLabelling :: Label -> [Labelling] -> CType
-lookupLabelling lbl rtyp = case [ ctyp | lbl' `Lbg` ctyp <- rtyp, lbl == lbl' ] of
-			     [ctyp] -> ctyp
-			     err -> error $ "lookupLabelling:" ++ show err
-
-groundTerms :: GrammarEnv -> CType -> [STerm]
-groundTerms env ctype = err error (map term2spattern) $
-			allParamValues (fst env) ctype
-
-term2spattern (R rec)         = SRec [ (lbl, term2spattern term) | Ass lbl term <- rec ]
-term2spattern (Con con terms) = SCon con $ map term2spattern terms
-
-pattern2sterm :: Patt -> STerm
-pattern2sterm (con `PC` patterns) = con `SCon` map pattern2sterm patterns
-pattern2sterm (PR record) = SRec [ (lbl, pattern2sterm pattern) | 
-				   lbl `PAss` pattern <- record ]
-
--- a/src/GF/Parsing/ConvertGrammar.hs
+++ b/src/GF/Parsing/ConvertGrammar.hs
@@ -1,44 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ConvertGrammar
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:54 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- All (?) grammar conversions which are used in GF
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ConvertGrammar
-    (pInfo, emptyPInfo,
-     module GF.Parsing.GrammarTypes
-    ) where
-
-import GFC (CanonGrammar)
-import MkGFC (grammar2canon)
-import GF.Parsing.GrammarTypes
-import Ident (Ident(..))
-import Option
-import GF.System.Tracing
-
-- import qualified GF.Parsing.FiniteTypes.Calc  as Fin
-import qualified GF.Parsing.ConvertGFCtoMCFG  as G2M
-import qualified GF.Parsing.ConvertMCFGtoCFG  as M2C
-import qualified GF.Parsing.MCFGrammar        as MCFG
-import qualified GF.Parsing.CFGrammar         as CFG
-
-pInfo :: Options -> CanonGrammar -> Ident -> PInfo 
-pInfo opts canon lng = PInfo mcfg cfg mcfp cfp
-    where mcfg = G2M.convertGrammar cnv (canon, lng)
-	  cnv  = maybe "nondet" id $ getOptVal opts gfcConversion 
-	  cfg  = M2C.convertGrammar mcfg
-	  mcfp = MCFG.pInfo mcfg
-	  cfp  = CFG.pInfo cfg
-
-emptyPInfo :: PInfo
-emptyPInfo = PInfo [] [] (MCFG.pInfo []) (CFG.pInfo [])
-
--- a/src/GF/Parsing/ConvertMCFGtoCFG.hs
+++ b/src/GF/Parsing/ConvertMCFGtoCFG.hs
@@ -1,52 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ConvertMCFGtoCFG
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:54 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Converting MCFG grammars to (possibly overgenerating) CFG
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ConvertMCFGtoCFG
-    (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-
-import Monad
-import GF.Parsing.Utilities
-import qualified GF.Parsing.MCFGrammar as MCFG
-import qualified GF.Parsing.CFGrammar as CFG
-import GF.Parsing.GrammarTypes
-
-convertGrammar :: MCFGrammar -> CFGrammar
-convertGrammar gram = tracePrt "#cf-rules" (prt.length) $
-		      concatMap convertRule gram
-
-convertRule :: MCFRule -> [CFRule]
-convertRule (MCFG.Rule cat args record name) 
-    = [ CFG.Rule (CFCat cat lbl) rhs (CFName name profile) |
-	MCFG.Lin lbl lin <- record,
-	let rhs = map (mapSymbol convertArg id) lin,
-	let profile = map (argPlaces lin) [0 .. length args-1]
-      ]
-
-convertArg (cat, lbl, _arg) = CFCat cat lbl
-
-argPlaces lin arg = [ place | ((_cat, _lbl, arg'), place) <- 
-		      zip (filterCats lin) [0::Int ..], arg == arg' ]
-
-filterCats syms = [ cat | Cat cat <- syms ]
-
-
-
-
-
-
-
--- a/src/GF/Parsing/GFC.hs
+++ b/src/GF/Parsing/GFC.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:52:51 $ 
+-- > CVS $Date: 2005/04/12 10:49:45 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- The main parsing module, parsing GFC grammars
 -- by translating to simpler formats, such as PMCFG and CFG
@@ -45,7 +45,7 @@ import qualified GF.NewParsing.CFG as PC
 -- parsing information

 data PInfo = PInfo { mcfPInfo :: (), -- ^ not implemented yet
-		     cfPInfo  :: PC.CFPInfo CCat CName Token }
+		     cfPInfo  :: PC.CFPInfo CCat Name Token }

 buildPInfo :: MGrammar -> CGrammar -> PInfo
 buildPInfo mcfg cfg = PInfo { mcfPInfo = (),
@@ -77,7 +77,7 @@ parse strategy pinfo abs start = parse ('c':strategy) pinfo abs start

 ----------------------------------------------------------------------

-parseCFG :: String -> PInfo -> [CCat] -> [Token] -> [SyntaxTree Name]
+parseCFG :: String -> PInfo -> [CCat] -> [Token] -> [SyntaxTree Fun]
 parseCFG strategy pInfo startCats inString = trace2 "Parser" "CFG" $
 					     trees
    where trees    = tracePrt "#trees" (prt . length) $
@@ -144,7 +144,7 @@ newParser (m:strategy) gr (_, startCat) inString
 ----------------------------------------------------------------------
 -- parse trees to GF terms

-tree2term :: Ident.Ident -> SyntaxTree Name -> Grammar.Term
+tree2term :: Ident.Ident -> SyntaxTree Fun -> Grammar.Term
 tree2term abs (TNode f ts) = Macros.mkApp (Macros.qq (abs,f)) (map (tree2term abs) ts)
 tree2term abs (TMeta)      = Macros.mkMeta 0

@@ -152,19 +152,19 @@ tree2term abs (TMeta)      = Macros.mkMeta 0
 ----------------------------------------------------------------------
 -- conversion and unification of forests

-convertFromCFForest :: SyntaxForest CName -> [SyntaxForest Name]
+convertFromCFForest :: SyntaxForest Name -> [SyntaxForest Fun]

 -- simplest implementation
-convertFromCFForest (FNode (CName name profile) children) 
+convertFromCFForest (FNode name@(Name fun profile) children) 
    | isCoercion name = concat chForests
-    | otherwise       = [ FNode name chForests | not (null chForests) ]
-    where chForests   = concat [ mapM (checkProfile forests) profile |
+    | otherwise       = [ FNode fun chForests | not (null chForests) ]
+    where chForests   = concat [ applyProfileM unifyManyForests profile forests |
 				 forests0 <- children,
 				 forests <- mapM convertFromCFForest forests0 ]

 {-
 -- more intelligent(?) implementation
-convertFromCFForest (FNode (CName name profile) children) 
+convertFromCFForest (FNode (Name name profile) children) 
    | isCoercion name = concat chForests
    | otherwise       = [ FNode name chForests | not (null chForests) ]
    where chForests   = concat [ mapM (checkProfile forests) profile |
@@ -172,16 +172,16 @@ convertFromCFForest (FNode (CName name profile) children)
 				 forests <- mapM convertFromCFForest forests0 ]
 -}

-checkProfile forests = unifyManyForests . map (forests !!)
-
-
+{-
 ----------------------------------------------------------------------
 -- conversion and unification for parse trees instead of forests
+-- OBSOLETE!

-convertFromCFTree :: SyntaxTree CName -> [SyntaxTree Name]
-convertFromCFTree (TNode (CName name profile) children0) 
-    = [ TNode name children |
-	children1 <- mapM convertFromCFTree children0,
-	children <- mapM (checkProfile children1) profile ]
-    where checkProfile trees = unifyManyTrees . map (trees !!)
-
+convertFromCFTree :: SyntaxTree Name -> [SyntaxTree Fun]
+convertFromCFTree (TNode name@(Name fun profile) children0) 
+    | isCoercion name = concat chTrees
+    | otherwise       = map (TNode fun) chTrees
+    where chTrees = [ children |
+		      children1 <- mapM convertFromCFTree children0,
+		      children <- applyProfileM unifyManyTrees profile children1 ]
+-}
--- a/src/GF/Parsing/GeneralChart.hs
+++ b/src/GF/Parsing/GeneralChart.hs
@@ -1,86 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : GeneralChart
-- Maintainer  : Peter Ljunglöf
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/21 22:31:48 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Simple implementation of deductive chart parsing
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.GeneralChart
-    (-- * Type definition
-     Chart,
-     -- * Main functions
-     chartLookup,
-     buildChart,
-     -- * Probably not needed
-     emptyChart,
-     chartMember,
-     chartInsert,
-     chartList,
-     addToChart
-    ) where
-
-- import Trace 
-
-import GF.Data.RedBlackSet
-
-- main functions
-
-chartLookup :: (Ord item, Ord key) => Chart item key -> key -> [item]
-buildChart  :: (Ord item, Ord key) => (item -> key) -> 
-	       [Chart item key -> item -> [item]] -> [item] -> [item]
-
-buildChart keyof rules axioms     = chartList (addItems axioms emptyChart)
-    where addItems []             = id
-	  addItems (item:items)   = addItems items . addItem item
-
-          -- addItem item | trace ("+ "++show item++"\n") False = undefined
-          addItem item            = addToChart item (keyof item) 
-				    (\chart -> foldr (consequence item) chart rules)
-
-          consequence item rule chart = addItems (rule chart item) chart
-
-- probably not needed
-
-emptyChart  :: (Ord item, Ord key) => Chart item key
-chartMember :: (Ord item, Ord key) => Chart item key -> item -> key -> Bool
-chartInsert :: (Ord item, Ord key) => Chart item key -> item -> key -> Maybe (Chart item key)
-chartList   :: (Ord item, Ord key) => Chart item key -> [item]
-addToChart  :: (Ord item, Ord key) => item -> key -> (Chart item key -> Chart item key) -> Chart item key -> Chart item key
-
-addToChart item key after chart = maybe chart after (chartInsert chart item key)
-
-
--------------------------------------------------------------------------------
-- key charts as red/black trees
-
-newtype Chart         item key = KC (RedBlackMap key item)
-    deriving Show
-
-emptyChart                     = KC rbmEmpty
-chartMember (KC tree) item key = rbmElem key item tree
-chartInsert (KC tree) item key = fmap KC (rbmInsert key item tree)
-chartLookup (KC tree)      key = rbmLookup key tree
-chartList   (KC tree)          = concatMap snd (rbmList tree)
--------------------------------------------------------------------------------}
-
-
-{--------------------------------------------------------------------------------
-- key charts as unsorted association lists -- OBSOLETE!
-
-newtype Chart          item key = SC [(key, item)]
-
-emptyChart = SC []
-chartMember (SC chart) item key = (key,item) `elem` chart
-chartInsert (SC chart) item key = if (key,item) `elem` chart then Nothing else Just (SC ((key,item):chart))
-chartLookup (SC chart)      key = [ item | (key',item) <- chart, key == key' ]
-chartList   (SC chart)          = map snd chart
--------------------------------------------------------------------------------}
-
--- a/src/GF/Parsing/GrammarTypes.hs
+++ b/src/GF/Parsing/GrammarTypes.hs
@@ -1,146 +0,0 @@
----------------------------------------------------------------------
-- |
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:54 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- All possible instantiations of different grammar formats used for parsing
--
-- Plus some helper types and utilities
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.GrammarTypes
-    (-- * Main parser information
-     PInfo(..),
-     -- * Multiple context-free grammars
-     MCFGrammar, MCFRule, MCFPInfo,
-     MCFCat(..), MCFLabel,
-     Constraint,
-     -- * Context-free grammars
-     CFGrammar, CFRule, CFPInfo,
-     CFProfile, CFName(..), CFCat(..),
-     -- * Assorted types
-     Cat, Name, Constr, Label, Tokn,
-     -- * Simplified terms
-     STerm(..), (+.), (+!),
-     -- * Record\/table paths
-     Path(..), emptyPath,
-     (++.), (++!)
-    ) where
-
-import Ident (Ident(..))
-import AbsGFC
-- import qualified GF.Parsing.FiniteTypes.Calc as Fin
-import qualified GF.Parsing.CFGrammar as CFG
-import qualified GF.Parsing.MCFGrammar as MCFG
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
-
----------------------------------------------------------------------
-
-data PInfo = PInfo { mcfg :: MCFGrammar,
-		     cfg :: CFGrammar,
-		     mcfPInfo :: MCFPInfo,
-		     cfPInfo :: CFPInfo }
-
-type MCFGrammar  = MCFG.Grammar Name MCFCat MCFLabel Tokn
-type MCFRule     = MCFG.Rule    Name MCFCat MCFLabel Tokn
-type MCFPInfo    = MCFG.PInfo   Name MCFCat MCFLabel Tokn
-
-data MCFCat      = MCFCat Cat [Constraint] deriving (Eq, Ord, Show)
-type MCFLabel    = Path
-
-type Constraint  = (Path, STerm)
-
-type CFGrammar   = CFG.Grammar CFName CFCat Tokn
-type CFRule      = CFG.Rule    CFName CFCat Tokn
-type CFPInfo     = CFG.PInfo   CFName CFCat Tokn
-
-type CFProfile   = [[Int]]
-data CFName      = CFName Name   CFProfile deriving (Eq, Ord, Show)
-data CFCat       = CFCat  MCFCat MCFLabel  deriving (Eq, Ord, Show)
-
----------------------------------------------------------------------
-
-type Cat    = Ident
-type Name   = Ident
-type Constr = CIdent
-
-data STerm    = SArg Int Cat Path     -- ^ argument variable, the 'Path' is a path 
-				      -- pointing into the term 
-	      | SCon Constr [STerm]   -- ^ constructor
-	      | SRec [(Label, STerm)] -- ^ record
-	      | STbl [(STerm, STerm)] -- ^ table of patterns\/terms
-	      | SVariants [STerm]     -- ^ variants
-	      | SConcat STerm STerm   -- ^ concatenation
-	      | SToken Tokn           -- ^ single token
-	      | SEmpty                -- ^ empty string
-	      | SWildcard             -- ^ wildcard pattern variable
-
-	      -- SRes CIdent        -- resource identifier
-	      -- SVar Ident         -- bound pattern variable
-	      -- SInt Integer       -- integer
-		deriving (Eq, Ord, Show)
-
-(+.) :: STerm -> Label -> STerm
-SRec record +. lbl = maybe err id $ lookup lbl record
-    where err = error $ "(+.), label not in record: " ++ show (SRec record) ++ " +. " ++ show lbl
-SArg arg cat path +. lbl = SArg arg cat (path ++. lbl)
-SVariants terms +. lbl = SVariants $ map (+. lbl) terms 
-sterm +. lbl = error $ "(+.): " ++ show sterm ++ " +. " ++ show lbl
-
-(+!) :: STerm -> STerm -> STerm
-STbl table +! pat = maybe err id $ lookup pat table
-    where err = error $ "(+!), pattern not in table: " ++ show (STbl table) ++ " +! " ++ show pat
-SArg arg cat path +! pat = SArg arg cat (path ++! pat)
-SVariants terms +! pat = SVariants $ map (+! pat) terms 
-term +! SVariants pats = SVariants $ map (term +!) pats 
-sterm +! pat = error $ "(+!): " ++ show sterm ++ " +! " ++ show pat
-
----------------------------------------------------------------------
-
-newtype Path = Path [Either Label STerm] deriving (Eq, Ord, Show)
-
-emptyPath :: Path
-emptyPath = Path []
-
-(++.) :: Path -> Label -> Path 
-Path path ++. lbl = Path (Left lbl : path)
-
-(++!) :: Path -> STerm -> Path 
-Path path ++! sel = Path (Right sel : path)
-
------------------------------------------------------------
-
-instance Print STerm where
-    prt (SArg n c p) = prt c ++ "@" ++ prt n ++ prt p
-    prt (SCon c [])  = prt c 
-    prt (SCon c ts)  = prt c ++ prtList ts
-    prt (SRec rec)   = "{" ++ concat [ prt l ++ "=" ++ prt t ++ ";" | (l,t) <- rec ] ++ "}"
-    prt (STbl tbl)   = "[" ++ concat [ prt p ++ "=>" ++ prt t ++ ";" | (p,t) <- tbl ] ++ "}"
-    prt (SVariants ts)  = "{| " ++ prtSep " | " ts ++ " |}"
-    prt (SConcat t1 t2) = prt t1 ++ "++" ++ prt t2
-    prt (SToken t)   = prt t
-    prt (SEmpty)     = "[]"
-    prt (SWildcard)  = "_"
-
-instance Print MCFCat where
-    prt (MCFCat cat params) 
-	= prt cat ++ "{" ++ concat [ prt path ++ "=" ++ prt term ++ ";" |
-				     (path, term) <- params ] ++ "}"
-
-instance Print CFName where
-    prt (CFName name profile) = prt name ++ prt profile
-
-instance Print CFCat where
-    prt (CFCat cat lbl) = prt cat ++ prt lbl
-
-instance Print Path where
-    prt (Path path) = concatMap prtEither (reverse path)
-	where prtEither (Left  lbl)  = "." ++ prt lbl
-	      prtEither (Right patt) = "!" ++ prt patt
--- a/src/GF/Parsing/IncrementalChart.hs
+++ b/src/GF/Parsing/IncrementalChart.hs
@@ -1,50 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : IncrementalChart
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/21 22:31:49 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Implementation of /incremental/ deductive parsing,
-- i.e. parsing one word at the time.
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.IncrementalChart
-    (-- * Type definitions
-     IncrementalChart,
-     -- * Functions
-     buildChart,
-     chartList
-    ) where
-
-import Array
-import GF.Data.SortedList
-import GF.Data.Assoc
-
-buildChart :: (Ord item, Ord key) => (item -> key) -> 
-	      (Int -> item -> SList item) -> 
-	      (Int ->         SList item) -> 
-	      (Int, Int) -> IncrementalChart item key
-
-chartList :: (Ord item, Ord key) => (Int -> item -> edge) -> IncrementalChart item key -> [edge]
-
-type IncrementalChart item key = Array Int (Assoc key (SList item))
-
----------
-
-buildChart keyof rules axioms bounds = finalChartArray
-    where buildState k     = limit (rules k) $ axioms k
-	  finalChartList   = map buildState [fst bounds .. snd bounds]
-	  finalChartArray  = listArray bounds $ map stateAssoc finalChartList
-	  stateAssoc state = accumAssoc id [ (keyof item, item) | item <- state ]
-
-chartList combine chart = [ combine k item | 
-			    (k, state) <- assocs chart, 
-			    item <- concatMap snd $ aAssocs state ]
-
-
--- a/src/GF/Parsing/MCFGrammar.hs
+++ b/src/GF/Parsing/MCFGrammar.hs
@@ -1,206 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : MCFGrammar
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/21 22:31:49 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.1 $
--
-- Definitions of multiple context-free grammars,
-- parser information and chart conversion
-----------------------------------------------------------------------------
-
-module GF.Parsing.MCFGrammar 
-    (-- * Type definitions
-     Grammar,
-     Rule(..),
-     Lin(..),
-     -- * Parser information
-     MCFParser,
-     MEdge,
-     edges2chart,
-     PInfo,
-     pInfo,
-     -- * Ranges
-     Range(..),
-     makeRange,
-     concatRange,
-     unifyRange,
-     unionRange,
-     failRange,
-     -- * Utilities
-     select,
-     updateIndex
-    ) where
-
-- gf modules:
-import GF.Data.SortedList
-import GF.Data.Assoc
-- parser modules:
-import GF.Parsing.Utilities
-import GF.Printing.PrintParser
-
-
-
-select :: [a] -> [(a, [a])]
-select [] = []
-select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ]
-
-updateIndex :: Functor f => Int -> [a] -> (a -> f a) -> f [a]
-updateIndex 0 (a:as) f = fmap (:as) $ f a
-updateIndex n (a:as) f = fmap (a:)  $ updateIndex (n-1) as f
-updateIndex _ _ _ = error "ParserUtils.updateIndex: Index out of range"
-
-
------------------------------------------------------------
-- grammar types
-
-type Grammar n c l t = [Rule n c l t]
-data Rule    n c l t = Rule c [c] [Lin c l t] n
-		       deriving (Eq, Ord, Show)
-data Lin       c l t = Lin l [Symbol (c, l, Int) t]
-		       deriving (Eq, Ord, Show)
-
-- variants is simply several linearizations with the same label
-
-
------------------------------------------------------------
-- parser information
-
-type PInfo n c l t = Grammar n c l t
-
-pInfo :: Grammar n c l t -> PInfo n c l t
-pInfo = id
-
-type MCFParser n c l t = PInfo n c l t -> [c] -> Input t -> ParseChart n (MEdge c l)
-
-type MEdge c l = (c, [(l, Range)])
-
-edges2chart :: (Ord n, Ord c, Ord l) =>
-	       [(n, MEdge c l, [MEdge c l])] -> ParseChart n (MEdge c l)
-edges2chart edges = fmap groupPairs $ accumAssoc id $
-		    [ (medge, (name, medges)) | (name, medge, medges) <- edges ]
-
-
------------------------------------------------------------
-- ranges as sets of int-pairs
-
-newtype Range = Rng (SList (Int, Int)) deriving (Eq, Ord, Show)
-
-makeRange :: SList (Int, Int) -> Range
-makeRange rho = Rng rho
-
-concatRange :: Range -> Range -> Range
-concatRange (Rng rho) (Rng rho') = Rng $ nubsort [ (i,k) | (i,j) <- rho, (j',k) <- rho', j==j' ]
-
-unifyRange :: Range -> Range -> Range
-unifyRange  (Rng rho) (Rng rho') = Rng $ rho <**> rho'
-
-unionRange :: Range -> Range -> Range
-unionRange  (Rng rho) (Rng rho') = Rng $ rho <++> rho'
-
-failRange :: Range
-failRange = Rng []
-
-
------------------------------------------------------------
-- pretty-printing
-
-instance (Print n, Print c, Print l, Print t) => Print (Rule n c l t) where
-    prt (Rule cat args record name) 
-	= prt name ++ ". " ++ prt cat ++ " -> " ++ prtSep " " args ++ "\n" ++ prt record
-    prtList = concatMap prt
-
-instance (Print c, Print l, Print t) => Print (Lin c l t) where
-    prt (Lin lbl lin) = prt lbl ++ " = " ++ prtSep " " (map (symbol prArg (show.prt)) lin)
-	where prArg (cat, lbl, arg) = prt cat ++ "@" ++ prt arg ++ "." ++ prt lbl
-    prtList = prtBeforeAfter "\t" "\n" 
-
-instance Print Range where
-    prt (Rng rho) = "(" ++ prtSep "|" [ show i ++ "-" ++ show j | (i,j) <- rho ] ++ ")"
-
-{-
------------------------------------------------------------
-- items & forests
-
-data Item    n c l   = Item n (MEdge c l) [[MEdge c l]]
-		       deriving (Eq, Ord, Show)
-type MEdge     c l   = (c, [Edge l])
-
-items2forests :: (Ord n, Ord c, Ord l) => Edge ((c, l) -> Bool) -> [Item n c l] -> [ParseForest n]
-
----------
-
-items2forests (Edge i0 k0 startCat) items 
-    = concatMap edge2forests $ filter checkEdge $ aElems chart
-    where edge2forests (cat, []) = [FMeta]
-	  edge2forests edge = filter checkForest $ map item2forest (chart ? edge)
-
-	  item2forest (Item name _ children) = FNode name [ forests | edges <- children,
-							    forests <- mapM edge2forests edges ]
-
-	  checkEdge (cat, [Edge i k lbl]) = i == i0 && k == k0 && startCat (cat, lbl)
-	  checkEdge _ = False
-
-          checkForest (FNode _ children) = not (null children)
-
-          chart = accumAssoc id [ (edge, item) | item@(Item _ edge _) <- items ]
-}
-
-
------------------------------------------------------------
-- grammar checking
-{-
--checkGrammar :: (Ord c, Ord l, Print n, Print c, Print l, Print t) => Grammar n c l t -> [String]
-
-checkGrammar rules
-    = do rule@(Rule cat rhs record name) <- rules
-	 if null record 
-            then [ "empty linearization record in rule: " ++ prt rule ]
-	    else [ "category does not exist: " ++ prt rcat ++ "\n" ++
-		   "  - in rule: " ++ prt rule |
-		   rcat <- rhs, rcat `notElem` lhsCats ] ++
- 	         do Lin _ lin <- record  
-		    Cat (arg, albl) <- lin
-		    if arg<0 || arg>=length rhs 
-		       then [ "argument index out of range: " ++ show arg ++ "/" ++ prt albl ++ "\n" ++
-			      "  - in rule: " ++ prt rule ]
-		       else [ "label does not exist: " ++ prt albl ++ "\n" ++
-			      "  - from rule: " ++ prt rule ++
-			      "  - in rule: " ++ prt arule |
-			      arule@(Rule _ acat _ arecord) <- rules,
-			      acat == rhs !! arg,
-			      albl `notElem` [ lbl | Lin lbl _ <- arecord ] ]
-    where lhsCats = nubsort [ cat | Rule _ cat _ _ <- rules ]
-}
-
-
-
-
-
-{-----
------------------------------------------------------------
-- simplifications 
-
-splitMRule :: (Ord n, Ord c, Ord l, Ord t) => Grammar n c l t -> Rule n c l t -> [Rule n c l t]
-splitMRule rules (Rule name cat args record) = nubsort [ (Rule name cat args splitrec) |
-							 (cat', lbls) <- rhsCats, cat == cat',
-							 let splitrec = [ lin | lin@(Lin lbl _) <- record, lbl `elem` lbls ] ]
-    where rhsCats = limit rhsC lhsCats
-	  lhsCats = nubsort [ (cat, [lbl]) | Rule _ cat _ record <- rules, Lin lbl _ <- record ]
-	  rhsC (cat, lbls) = nubsort [ (rcat, rlbls) |
-				       Rule _ cat' rhs lins <- rules, cat == cat',
-				       (arg, rcat) <- zip [0..] rhs,
-				       let rlbls = nubsort [ rlbl | Lin lbl lin <- lins, lbl `elem` lbls,
-							     Cat (arg', rlbl) <- lin, arg == arg' ],
-				       not $ null rlbls
-				     ]
-
-
----}
-
-
-
--- a/src/GF/Parsing/ParseCF.hs
+++ b/src/GF/Parsing/ParseCF.hs
@@ -1,82 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ParseCF
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:54 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.3 $
--
-- Chart parsing of grammars in CF format
-----------------------------------------------------------------------------
-
-module GF.Parsing.ParseCF (parse, alternatives) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
-
-import GF.Data.SortedList (nubsort)
-import GF.Data.Assoc
-import qualified CF
-import qualified CFIdent as CFI
-import GF.Parsing.Utilities
-import GF.Parsing.CFGrammar
-import qualified GF.Parsing.ParseCFG as P
-
-type Token    = CFI.CFTok
-type Name     = CFI.CFFun
-type Category = CFI.CFCat
-
-alternatives :: [(String, [String])]
-alternatives = [ ("gb",  ["G","GB","_gen","_genBU"]),
-		 ("gt",  ["GT","_genTD"]),
-		 ("ibn", ["","I","B","IB","IBN","_inc","BU","_incBU"]),
-		 ("ibb", ["BB","IBB","BU_BUF","_incBU_BUF"]),
-		 ("ibt", ["BT","IBT","BU_TDF","_incBU_TDF"]),
-		 ("iba", ["BA","IBA","BU_BTF","BU_TBF","_incBU_BTF","_incBU_TBF"]),
-		 ("itn", ["T","IT","ITN","TD","_incTD"]),
-		 ("itb", ["TB","ITB","TD_BUF","_incTD_BUF"])
-	       ]
-
-parse :: String -> CF.CF -> Category -> CF.CFParser
-parse = buildParser . P.parse 
-
-buildParser :: CFParser Name Category Token -> CF.CF -> Category -> CF.CFParser
-buildParser parser cf start tokens = trace "ParseCF" $
-				     (parseResults, parseInformation)
-    where parseInformation = prtSep "\n" trees
-	  parseResults     = {-take maxTake-} [ (tree2cfTree t, []) | t <- trees ]
-	  theInput = input tokens
-	  edges    = tracePrt "#edges" (prt.length) $
-		     parser pInf [start] theInput
-	  chart    = tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
-		     edges2chart theInput $ map (fmap addCategory) edges
-	  forests  = tracePrt "#forests" (prt.length) $
-		     chart2forests chart (const False) $ 
-		     uncurry Edge (inputBounds theInput) start
-	  trees    = tracePrt "#trees" (prt.length) $
-		     concatMap forest2trees forests
-	  pInf     = pInfo $ cf2grammar cf (nubsort tokens)
-	  
-
-addCategory (Rule cat rhs name) = Rule cat rhs (name, cat)
-
-tree2cfTree (TNode (name, cat) trees) = CF.CFTree (name, (cat, map tree2cfTree trees))
-
-cf2grammar :: CF.CF -> [Token] -> Grammar Name Category Token
-cf2grammar cf tokens = [ Rule cat rhs name |
-			 (name, (cat, rhs0)) <- cfRules, 
-			 rhs <- mapM item2symbol rhs0 ] 
-    where cfRules = concatMap (CF.predefRules (CF.predefOfCF cf)) tokens ++ 
-		    CF.rulesOfCF cf 
-	  item2symbol (CF.CFNonterm cat) = [Cat cat]
-	  item2symbol item = map Tok $ filter (CF.matchCFTerm item) tokens
-
-- maxTake :: Int
-- maxTake = 500
-- maxTake = maxBound
-
-
--- a/src/GF/Parsing/ParseCFG.hs
+++ b/src/GF/Parsing/ParseCFG.hs
@@ -1,43 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ParseCFG
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/21 22:31:51 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Main parsing module for context-free grammars
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ParseCFG (parse) where
-
-import Char (toLower)
-import GF.Parsing.Utilities
-import GF.Parsing.CFGrammar
-import qualified GF.Parsing.ParseCFG.General as PGen
-import qualified GF.Parsing.ParseCFG.Incremental as PInc
-
-
-parse :: (Ord n, Ord c, Ord t, Show t) => 
-	 String -> CFParser n c t
-parse = decodeParser . map toLower
-
-decodeParser ['g',s]   = PGen.parse (decodeStrategy s)
-decodeParser ['i',s,f] = PInc.parse (decodeStrategy s, decodeFilter f)
-decodeParser _ = decodeParser "ibn"
-
-decodeStrategy 'b' = (True, False)
-decodeStrategy 't' = (False, True)
-
-decodeFilter 'a' = (True, True)
-decodeFilter 'b' = (True, False)
-decodeFilter 't' = (False, True)
-decodeFilter 'n' = (False, False)
-
-
-
-
--- a/src/GF/Parsing/ParseCFG/General.hs
+++ b/src/GF/Parsing/ParseCFG/General.hs
@@ -1,84 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ParseCFG.General
-- Maintainer  : Peter Ljunglöf
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:55 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Several implementations of CFG chart parsing
-----------------------------------------------------------------------------
-
-module GF.Parsing.ParseCFG.General 
-    (parse, Strategy) where
-
-import GF.System.Tracing
-
-import GF.Parsing.Utilities
-import GF.Parsing.CFGrammar
-import GF.Parsing.GeneralChart 
-import GF.Data.Assoc
-
-parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser n c t
-parse strategy grammar start = extract . process strategy grammar start
-
-type Strategy = (Bool, Bool) -- (isBottomup, isTopdown)
-
-extract :: [Item n (Symbol c t)] -> [Edge (Rule n c t)]
-extract edges =
-    edges'
-    where edges' = [ Edge j k (Rule cat (reverse found) name) |
-		     Edge j k (Cat cat, found, [], Just name) <- edges ]
-
-process :: (Ord n, Ord c, Ord t) => Strategy -> PInfo n c t -> 
-	   [c] -> Input t -> [Item n (Symbol c t)]
-process (isBottomup, isTopdown) grammar start
-    = trace ("CFParserGeneral" ++ 
-	     (if isBottomup then " BU" else "") ++ 
-	     (if isTopdown  then " TD" else "")) $
-      buildChart keyof [predict, combine] . axioms 
-    where axioms input = initial ++ scan input
-
-          scan input = map (fmap mkEdge) (inputEdges input)
-	  mkEdge tok = (Tok tok, [], [], Nothing)
-
-          -- the combine rule
-          combine chart (Edge j k (next, _, [], _))
-	      = [ edge `forwardTo` k | edge <- chartLookup chart (Active next j) ]
-          combine chart edge@(Edge _ j (_, _, next:_, _))
-	      = [ edge `forwardTo` k | Edge _ k _ <- chartLookup chart (Passive next j) ]
-
-          -- initial predictions
-          initial = [ loopingEdge 0 rule | cat <- start, rule <- tdRuleLookup ? cat ]
-
-          -- predictions
-          predict chart (Edge j k (next, _, [], _)) | isBottomup 
-	      = [ loopingEdge j rule `forwardTo` k | rule <- bottomupRules grammar ? next ]
-	      -- - - - - - - - - -   ^^^^^^^^^^^^^ Kilbury prediction: move dot forward
-	  predict chart (Edge _ k (_, _, Cat cat:_, _))
-	      = [ loopingEdge k rule | rule <- tdRuleLookup ? cat ]
-	  predict _ _ = []
-
-          tdRuleLookup | isTopdown  = topdownRules grammar
-		       | isBottomup = emptyLeftcornerRules grammar
-
-- internal representation of parse items
-
-type Item   n s = Edge (s, [s], [s], Maybe n)
-type IChart n s = Chart (Item n s) (IKey s)
-data IKey     s = Active  s Int
-		| Passive s Int
-		  deriving (Eq, Ord, Show)
-
-keyof (Edge _ j (_, _, next:_, _)) = Active next j
-keyof (Edge j _ (cat, _, [], _))   = Passive cat j
-
-forwardTo (Edge i j (cat, found, next:tofind, name)) k = Edge i k (cat, next:found, tofind, name)
-
-loopingEdge k (Rule cat tofind name) = Edge k k (Cat cat, [], tofind, Just name)
-
-
-
--- a/src/GF/Parsing/ParseCFG/Incremental.hs
+++ b/src/GF/Parsing/ParseCFG/Incremental.hs
@@ -1,143 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ParseCFG.Incremental
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:55 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Incremental chart parsing for context-free grammars
-----------------------------------------------------------------------------
-
- 
-
-module GF.Parsing.ParseCFG.Incremental 
-    (parse, Strategy) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-
-- haskell modules:
-import Array
-- gf modules:
-import GF.Data.SortedList
-import GF.Data.Assoc
-import Operations
-- parser modules:
-import GF.Parsing.Utilities
-import GF.Parsing.CFGrammar
-import GF.Parsing.IncrementalChart
-
-
-type Strategy = ((Bool, Bool), (Bool, Bool)) -- (predict:(BU, TD), filter:(BU, TD))
-
-parse :: (Ord n, Ord c, Ord t, Show t) => 
-	 Strategy -> CFParser n c t
-parse ((isPredictBU, isPredictTD), (isFilterBU, isFilterTD)) grammar start input =
-    trace2 "CFParserIncremental" 
-	       ((if isPredictBU then "BU-predict " else "") ++
-		(if isPredictTD then "TD-predict " else "") ++
-		(if isFilterBU  then "BU-filter " else "") ++
-		(if isFilterTD  then "TD-filter " else "")) $
-    trace2 "input" (show (inputTo input)) $
-    finalEdges
-    where finalEdges = [ Edge j k (Rule cat (reverse found) name) |
-			 (k, state) <- 
-			   tracePrt "#passiveChart"
-			   (prt . map (length . (?Passive) . snd)) $
-			   tracePrt "#activeChart" 
-			   (prt . map (length . concatMap snd . aAssocs . snd)) $
-			   assocs finalChart,
-			 Item j (Rule cat _Nil name) found <- state ? Passive ]
-
-	  finalChart = buildChart keyof rules axioms $ inputBounds input
-
-          axioms 0 = --tracePrt ("axioms 0") (prtSep "\n") $
-		     union $ map (tdInfer 0) start
-	  axioms k = --tracePrt ("axioms "++show k) (prtSep "\n") $
-		     union [ buInfer j k (Tok token) |
-			     (token, js) <- aAssocs (inputTo input ! k), j <- js ]
-
-          rules k (Item j (Rule cat [] _) _)
-	      = buInfer j k (Cat cat)
-          rules k (Item j rule@(Rule _ (Cat next:_) _) found) 
-	      = tdInfer k next <++> 
-	        -- hack for empty rules:
-		[ Item j (forward rule) (Cat next:found) | 
-		  emptyCategories grammar ?= next ]
-	  rules _ _ = []
-
-          buInfer j k next = --tracePrt ("buInfer "++show(j,k)++" "++prt next) (prtSep "\n") $
-			     buPredict j k next <++> buCombine j k next 
-          tdInfer   k next = tdPredict   k next
-
-	  -- the combine rule
-          buCombine j k next
-	      | j == k    = [] -- hack for empty rules
-	      | otherwise = [ Item i (forward rule) (next:found) | 
-			      Item i rule found <- (finalChart ! j) ? Active next ]
-
-	  -- kilbury bottom-up prediction
-          buPredict j k next
-	      = [ Item j rule [next] | isPredictBU,
-		  rule <- map forward $ --tracePrt ("buRules "++prt next) (prtSep "\n") $
-		                        bottomupRules grammar ? next,
-		  buFilter rule k, 
-		  tdFilter rule j k ]
-
-	  -- top-down prediction
-          tdPredict k cat
-	      = [ Item k rule [] | isPredictTD || isFilterTD,
-		  rule <- topdownRules grammar ? cat,
-		  buFilter rule k ] <++>
-		-- hack for empty rules:
-		[ Item k rule [] | isPredictBU,
-		  rule <- emptyLeftcornerRules grammar ? cat ]
-
-          -- bottom up filtering: input symbol k can begin the given symbol list (first set)
-	  -- leftcornerTokens DOESN'T WORK WITH EMPTY RULES!!!
-	  buFilter (Rule _ (Cat cat:_) _) k | isFilterBU
-	      = k < snd (inputBounds input) && 
-		hasCommonElements (leftcornerTokens grammar ? cat) 
-				      (aElems (inputFrom input ! k))
-	  buFilter _ _ = True
-
-          -- top down filtering: 'cat' is reachable by an active edge ending in node j < k
-          tdFilter (Rule cat _ _) j k | isFilterTD && j < k
-					  = (tdFilters ! j) ?= cat
-	  tdFilter _ _ _ = True
-
-	  tdFilters    = listArray (inputBounds input) $ 
-			 map (listSet . limit leftCats . activeCats) [0..]
-	  activeCats j = [ next | Active (Cat next) <- aElems (finalChart ! j) ]
-	  leftCats cat = [ left | Rule _cat (Cat left:_) _ <- topdownRules grammar ? cat ]
-
-
-- type declarations, items & keys
-data Item n c t = Item Int (Rule n c t) [Symbol c t]
-		  deriving (Eq, Ord, Show)
-
-data IKey   c t = Active (Symbol c t) | Passive
-		  deriving (Eq, Ord, Show)
-
-keyof :: Item n c t -> IKey c t
-keyof (Item _ (Rule _ (next:_) _) _) = Active next
-keyof (Item _ (Rule _ [] _) _)       = Passive
-
-forward :: Rule n c t -> Rule n c t 
-forward (Rule cat (_:rest) name) = Rule cat rest name
-
-
-instance (Print n, Print c, Print t) => Print (Item n c t) where
-    prt (Item k (Rule cat rhs name) syms) 
-	= "<" ++show k++ ": "++prt name++". "++
-	  prt cat++" -> "++prt rhs++" / "++prt syms++">"
-
-instance (Print c, Print t) => Print (IKey c t) where
-    prt (Active sym) = "?" ++ prt sym
-    prt (Passive) = "!"
-
-
--- a/src/GF/Parsing/ParseGFC.hs
+++ b/src/GF/Parsing/ParseGFC.hs
@@ -1,177 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ParseGFC
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:54 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.3 $
--
-- The main parsing module, parsing GFC grammars
-- by translating to simpler formats, such as PMCFG and CFG
----------------------------------------------------------------------
-
-module GF.Parsing.ParseGFC (newParser) where
-
-import GF.System.Tracing 
-import GF.Printing.PrintParser
-import qualified PrGrammar
-
-- Haskell modules
-import Monad
-- import Ratio ((%))
-- GF modules
-import qualified Grammar as GF
-import Values
-import qualified Macros 
-import qualified Modules as Mods
-import qualified AbsGFC
-import qualified Ident
-import qualified ShellState as SS
-import Operations
-import GF.Data.SortedList 
-- Conversion and parser modules
-import GF.Data.Assoc
-import GF.Parsing.Utilities
-- import ConvertGrammar
-import GF.Parsing.GrammarTypes
-import qualified GF.Parsing.MCFGrammar as M
-import qualified GF.Parsing.CFGrammar as C
-import qualified GF.Parsing.ParseMCFG as PM
-import qualified GF.Parsing.ParseCFG as PC
--import MCFRange
-
-newParser :: String -> SS.StateGrammar -> GF.Cat -> String -> Err [GF.Term]
-
-- parsing via MCFG
-newParser (m:strategy) gr (_, startCat) inString 
-    | m=='m' || m=='M' = trace2 "Parser" "MCFG" $ Ok terms
-    where terms    = map (ptree2term abstract) trees
-	  trees    = --tracePrt "trees" (prtBefore "\n") $
-		     tracePrt "#trees" (prt . length) $
-		     concatMap forest2trees forests
-	  forests  = --tracePrt "forests" (prtBefore "\n") $
-		     tracePrt "#forests" (prt . length) $
-		     concatMap (chart2forests chart isMeta) finalEdges
-	  isMeta = null . snd
-	  finalEdges = tracePrt "finalEdges" (prtBefore "\n") $
-		       filter isFinalEdge $ aElems chart
-- 		       nubsort [ (cat, [(lbl, E.makeRange [(i,j)])]) | 
-- 				 let (i, j) = inputBounds inTokens,
-- 				 E.Rule cat _ [E.Lin lbl _] _ <- pInf,
-- 				 isStartCat cat ]
-	  isFinalEdge (cat, rows) 
-	      = isStartCat cat && 
-		inputBounds inTokens `elem` concat [ rho | (_, M.Rng rho) <- rows ]
-	  chart    = --tracePrt "chart" (prtBefore "\n" . aAssocs) $
-		     tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
-		     PM.parse strategy pInf starters inTokens
-	  inTokens = input $ map AbsGFC.KS $ words inString
-	  pInf     = -- tracePrt "avg rec" (\gr -> show (sum [ length rec | E.Rule _ _ rec _ <- gr ] % length gr)) $
-		     mcfPInfo $ SS.statePInfo gr
-	  starters = tracePrt "startCats" prt $
-		     filter isStartCat $ nubsort [ cat | M.Rule cat _ _ _ <- pInf ]
-	  isStartCat (MCFCat cat _) = cat == startCat
-	  abstract = tracePrt "abstract module" PrGrammar.prt $
-		     SS.absId gr
-
-- parsing via CFG
-newParser (c:strategy) gr (_, startCat) inString 
-    | c=='c' || c=='C' = trace2 "Parser" "CFG" $ Ok terms
-    where terms    = -- tracePrt "terms" (unlines . map PrGrammar.prt) $
-		     map (ptree2term abstract) trees
-	  trees    = tracePrt "#trees" (prt . length) $
-		     --tracePrt "trees" (prtSep "\n") $
-		     concatMap forest2trees forests
-	  forests  = tracePrt "$cfForests" (prt) $ -- . length) $
-		     tracePrt "forests" (unlines . map prt) $
-		     concatMap convertFromCFForest cfForests
-	  cfForests= tracePrt "cfForests" (unlines . map prt) $
-		     concatMap (chart2forests chart (const False)) finalEdges
-	  finalEdges = tracePrt "finalChartEdges" prt $
-		       map (uncurry Edge (inputBounds inTokens)) starters
-	  chart    = --tracePrt "finalChartEdges" (prt . (? finalEdge)) $
-		     tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
-		     C.edges2chart inTokens edges
-	  edges    = --tracePrt "finalEdges" 
-		     --(prt . filter (\(Edge i j _) -> (i,j)==inputBounds inTokens)) $
-		     tracePrt "#edges" (prt . length) $
-		     PC.parse strategy pInf starters inTokens
-	  inTokens = input $ map AbsGFC.KS $ words inString
-	  pInf     = cfPInfo $ SS.statePInfo gr
-	  starters = tracePrt "startCats" prt $
-		     filter isStartCat $ map fst $ aAssocs $ C.topdownRules pInf
-	  isStartCat (CFCat (MCFCat cat _) _) = cat == startCat
-	  abstract = tracePrt "abstract module" PrGrammar.prt $
-		     SS.absId gr
-		     --ifNull (Ident.identC "ABS") last $ 
-		     --[i | (i, Mods.ModMod m) <- Mods.modules (SS.grammar gr), Mods.isModAbs m]
-
-newParser "" gr start inString = newParser "c" gr start inString
-
-newParser opt gr (_,cat) _ = 
-  Bad ("new-parser '" ++ opt ++ "' not defined yet")
-
-ptree2term :: Ident.Ident -> ParseTree Name -> GF.Term
-ptree2term a (TNode f ts) = Macros.mkApp (Macros.qq (a,f)) (map (ptree2term a) ts)
-ptree2term a (TMeta)      = GF.Meta (GF.MetaSymb 0)
-
----------------------------------------------------------------------
-- conversion and unification of forests
-
-convertFromCFForest :: ParseForest CFName -> [ParseForest Name]
-convertFromCFForest (FNode (CFName name profile) children) 
-    | isCoercion name = concat chForests
-    | otherwise       = [ FNode name chForests | not (null chForests) ]
-    where chForests   = concat [ mapM (checkProfile forests) profile |
-				 forests0 <- children,
-				 forests <- mapM convertFromCFForest forests0 ]
-	  checkProfile forests = unifyManyForests . map (forests !!)
-				 -- foldM unifyForests FMeta . map (forests !!)
-
-isCoercion Ident.IW = True
-isCoercion _        = False
-
-unifyManyForests :: Eq n => [ParseForest n] -> [ParseForest n]
-unifyManyForests [] = [FMeta]
-unifyManyForests [f] = [f]
-unifyManyForests (f:g:fs) = do h <- unifyForests f g
-			       unifyManyForests (h:fs)
-
-unifyForests :: Eq n => ParseForest n -> ParseForest n -> [ParseForest n]
-unifyForests FMeta  forest = [forest]
-unifyForests forest FMeta  = [forest]
-unifyForests (FNode name1 children1) (FNode name2 children2)
-    = [ FNode name1 children | name1 == name2, not (null children) ]
-    where children = [ forests | forests1 <- children1, forests2 <- children2,
-		       forests <- zipWithM unifyForests forests1 forests2 ]
-
-
-
-{-
----------------------------------------------------------------------
-- conversion and unification for parse trees instead of forests
-
-convertFromCFTree :: ParseTree CFName -> [ParseTree Name]
-convertFromCFTree (TNode (CFName name profile) children0) 
-    = [ TNode name children |
-	children1 <- mapM convertFromCFTree children0,
-	children <- mapM (checkProfile children1) profile ]
-    where checkProfile trees = unifyManyTrees . map (trees !!)
-
-unifyManyTrees :: Eq n => [ParseTree n] -> [ParseTree n]
-unifyManyTrees [] = [TMeta]
-unifyManyTrees [f] = [f]
-unifyManyTrees (f:g:fs) = do h <- unifyTrees f g
-			     unifyManyTrees (h:fs)
-
-unifyTrees TMeta tree = [tree]
-unifyTrees tree TMeta = [tree]
-unifyTrees (TNode name1 children1) (TNode name2 children2)
-    = [ TNode name1 children | name1 == name2, 
-	children <- zipWithM unifyTrees children1 children2 ]
-
-}
-
--- a/src/GF/Parsing/ParseMCFG.hs
+++ b/src/GF/Parsing/ParseMCFG.hs
@@ -1,37 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ParseMCFG
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/21 22:31:52 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Main module for MCFG parsing
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.ParseMCFG (parse) where
-
-import Char (toLower)
-import GF.Parsing.Utilities
-import GF.Parsing.MCFGrammar
-import qualified GF.Parsing.ParseMCFG.Basic as PBas
-import GF.Printing.PrintParser
---- import qualified MCFParserBasic2 as PBas2 -- file not found AR
-
-
-parse :: (Ord n, Ord c, Ord l, Ord t,
-	  Print n, Print c, Print l, Print t) => 
-	 String -> MCFParser n c l t
-parse str = decodeParser (map toLower str)
-
-decodeParser "b"  = PBas.parse
---- decodeParser "c"  = PBas2.parse
-decodeParser _    = decodeParser "b"
-
-
-
-
--- a/src/GF/Parsing/ParseMCFG/Basic.hs
+++ b/src/GF/Parsing/ParseMCFG/Basic.hs
@@ -1,156 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : ParseMCFG.Basic
-- Maintainer  : Peter Ljunglöf
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:55 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Simplest possible implementation of MCFG chart parsing
-----------------------------------------------------------------------------
-
-module GF.Parsing.ParseMCFG.Basic 
-    (parse) where
-
-import GF.System.Tracing
-
-import Ix
-import GF.Parsing.Utilities
-import GF.Parsing.MCFGrammar
-import GF.Parsing.GeneralChart 
-import GF.Data.Assoc
-import GF.Data.SortedList
-import GF.Printing.PrintParser
-
-
-parse :: (Ord n, Ord c, Ord l, Ord t,
-	  Print n, Print c, Print l, Print t) => 
-	 MCFParser n c l t
-parse grammar start = edges2chart . extract . process grammar 
-
-
-extract :: [Item n c l t] -> [(n, MEdge c l, [MEdge c l])]
-extract items = tracePrt "#passives" (prt.length) $
-		--trace2 "passives" (prtAfter "\n" [ i | i@(PItem _) <- items ]) $
-		[ item | PItem item <- items ]
-
-
-process :: (Ord n, Ord c, Ord l, Ord t, 
-	    Print n, Print c, Print l, Print t) => 
-	   Grammar n c l t -> Input t -> [Item n c l t]
-process grammar input = buildChart keyof rules axioms
-    where axioms = initial
-	  rules  = [combine, scan, predict]
-
-          -- axioms
-	  initial = traceItems "axiom" [] $
-		    [ nextLin name tofind (addNull cat) (map addNull args) |
-		      Rule cat args tofind name <- grammar ]
-
-	  addNull a = (a, [])
-
-	  -- predict 
-	  predict chart i1@(Item name tofind rho (Lin lbl []) (cat, found0) children)
-	      = traceItems "predict" [i1] 
-		[ nextLin name tofind (cat, found) children | 
-		  let found = insertRow lbl rho found0 ]
-	  predict _ _ = []
-
-          -- combine 
-	  combine chart active@(Item _ _ _ (Lin _ (Cat(cat,_,_):_)) _ _)
-	      = do passive <- chartLookup chart (Passive cat)
-		   combineItems active passive
-	  combine chart passive@(PItem (_, (cat, _), _))
-	      = do active <- chartLookup chart (Active cat)
-		   combineItems active passive
-	  combine _ _ = []
-
-          combineItems i1@(Item name tofind rho0 (Lin lbl (Cat(_,lbl',nr):rest)) found children0)
-		       i2@(PItem (_, found', _))
-	      = traceItems "combine" [i1,i2]
-		[ Item name tofind rho (Lin lbl rest) found children |
-		  rho1 <- lookupLbl lbl' found',
-		  let rho = concatRange rho0 rho1,
-		  children <- updateChild nr children0 (snd found') ]
-
-          -- scan
-	  scan chart i1@(Item name tofind rho0 (Lin lbl (Tok tok:rest)) found children)
-	      = traceItems "scan" [i1]
-		[ Item name tofind rho (Lin lbl rest) found children |
-		  let rho = concatRange rho0 (rangeOfToken tok) ]
-	  scan _ _ = []
-
-          -- utilities
-          rangeOfToken tok = makeRange $ inputToken input ? tok
-
-          zeroRange = makeRange $ map (\i -> (i,i)) $ range $ inputBounds input
-
-          nextLin name [] found children = PItem (name, found, children)
-          nextLin name (lin : tofind) found children 
-	      = Item name tofind zeroRange lin found children 
-
-lookupLbl a = map snd . filter (\b -> a == fst b) . snd
-updateChild nr children found = updateIndex nr children $
-				\child -> if null (snd child)
-					     then [ (fst child, found) ]
-					     else [ child | snd child == found ]
-
-insertRow lbl rho [] = [(lbl, rho)]
-insertRow lbl rho rows'@(row@(lbl', rho') : rows)
-    = case compare lbl lbl' of
-        LT -> row : insertRow lbl rho rows
-	GT -> (lbl, rho) : rows'
-	EQ -> (lbl, unionRange rho rho') : rows
-
-
-- internal representation of parse items
-
-data Item n c l t
-    = Item n [Lin c l t] -- tofind
-      Range (Lin c l t) -- current row
-      (MEdge c l) -- found rows
-      [MEdge c l] -- found children
-    | PItem (n, MEdge c l, [MEdge c l])
-    deriving (Eq, Ord, Show)
-
-data IKey c = Passive c | Active c | AnyItem
-		deriving (Eq, Ord, Show)
-
-keyof (PItem (_, (cat, _), _)) = Passive cat
-keyof (Item _ _ _ (Lin _ (Cat(cat,_,_):_)) _ _) = Active cat
-keyof _ = AnyItem
-
-
-- tracing
-
--type TraceItem = Item String String Char String
-traceItems :: (Print n, Print l, Print c, Print t) =>
-	      String -> [Item n c l t] -> [Item n c l t] -> [Item n c l t] 
-traceItems rule trigs items
-    | null items || True = items
-    | otherwise = trace ("\n" ++ rule ++ ":" ++ 
-			 unlines [ "\t" ++ prt i | i <- trigs ] ++ "=>" ++
-			 unlines [ "\t" ++ prt i | i <- items ]) items
-
-- pretty-printing
-
-instance (Print n, Print c, Print l, Print t) => Print (Item n c l t) where
-    prt (Item name tofind rho lin (cat, found) children)
-	= prt name ++ ". " ++ prt cat ++ prtRhs (map fst children) ++ 
-	  "   { " ++ prt rho ++ prt lin ++ " ; " ++
-	  concat [ prt lbl ++ "=" ++ prt ln ++ " " | 
-		   Lin lbl ln <- tofind ] ++ "; " ++
-	  concat [ prt lbl ++ "=" ++ prt rho ++ " " | 
-		   (lbl, rho) <- found ] ++ "}   " ++
-	  concat [ "[ " ++ concat [ prt lbl ++ "=" ++ prt rho ++ " " | 
-				    (lbl,rho) <- child ] ++ "]   " | 
-		   child <- map snd children ]
-    prt (PItem (name, edge, edges)) 
-	= prt name ++ ". " ++ prt edge ++ prtRhs edges
-
-prtRhs [] = ""
-prtRhs rhs = " -> " ++ prtSep " " rhs
-
--- a/src/GF/Parsing/Utilities.hs
+++ b/src/GF/Parsing/Utilities.hs
@@ -1,188 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : Parsing.Utilities
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/29 11:17:54 $ 
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Basic type declarations and functions to be used when parsing
-----------------------------------------------------------------------------
-
-
-module GF.Parsing.Utilities 
-    ( -- * Symbols
-      Symbol(..), symbol, mapSymbol,
-      -- * Edges
-      Edge(..),
-      -- * Parser input
-      Input(..), makeInput, input, inputMany,
-      -- * charts, parse forests & trees
-      ParseChart, ParseForest(..), ParseTree(..),
-      chart2forests, forest2trees
-    ) where
-
-- haskell modules:
-import Monad
-import Array
-- gf modules:
-import GF.Data.SortedList
-import GF.Data.Assoc
-- parsing modules:
-import GF.Printing.PrintParser
-
------------------------------------------------------------
-- symbols
-
-data Symbol c t = Cat c | Tok t
-		  deriving (Eq, Ord, Show)
-
-symbol    :: (c -> a) -> (t -> a) -> Symbol c t -> a
-mapSymbol :: (c -> d) -> (t -> u) -> Symbol c t -> Symbol d u
-
----------
-
-symbol fc ft (Cat cat) = fc cat
-symbol fc ft (Tok tok) = ft tok
-
-mapSymbol fc ft = symbol (Cat . fc) (Tok . ft)
-
-
------------------------------------------------------------
-- edges
-
-data Edge s = Edge Int Int s
-	      deriving (Eq, Ord, Show)
-
-instance Functor Edge where
-    fmap f (Edge i j s) = Edge i j (f s)
-
-
------------------------------------------------------------
-- parser input 
-
-data Input t = MkInput { inputEdges  :: [Edge t],
-			 inputBounds :: (Int, Int),
-			 inputFrom   :: Array Int (Assoc t [Int]),
-			 inputTo     :: Array Int (Assoc t [Int]),
-			 inputToken  :: Assoc t [(Int, Int)]
-		       }
-
-makeInput :: Ord t => [Edge t] -> Input t
-input     :: Ord t =>  [t]     -> Input t
-inputMany :: Ord t => [[t]]    -> Input t
-
----------
-
-makeInput inEdges  | null inEdges = input []
-		   | otherwise    = MkInput inEdges inBounds inFrom inTo inToken
-    where inBounds = foldr1 minmax [ (i, j) | Edge i j _ <- inEdges ]
-	      where minmax (a, b) (a', b') = (min a a', max b b')
-	  inFrom   = fmap (accumAssoc id) $ accumArray (<++>) [] inBounds $
-		     [ (i, [(tok, j)]) | Edge i j tok <- inEdges ]
-	  inTo     = fmap (accumAssoc id) $ accumArray (<++>) [] inBounds
-		     [ (j, [(tok, i)]) | Edge i j tok <- inEdges ]
-	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
-
-input toks         = MkInput inEdges inBounds inFrom inTo inToken
-    where inEdges  = zipWith3 Edge [0..] [1..] toks
-	  inBounds = (0, length toks)
-	  inFrom   = listArray inBounds $
-		     [ listAssoc [(tok, [j])] | (tok, j) <- zip toks [1..] ] ++ [ listAssoc [] ]
-	  inTo     = listArray inBounds $
-		     [ listAssoc [] ] ++ [ listAssoc [(tok, [i])] | (tok, i) <- zip toks [0..] ]
-	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
-
-inputMany toks     = MkInput inEdges inBounds inFrom inTo inToken
-    where inEdges  = [ Edge i j t | (i, j, ts) <- zip3 [0..] [1..] toks, t <- ts ]
-	  inBounds = (0, length toks)
-	  inFrom   = listArray inBounds $
-		     [ listAssoc [ (t, [j]) | t <- nubsort ts ] | (ts, j) <- zip toks [1..] ]
-		     ++ [ listAssoc [] ]
-	  inTo     = listArray inBounds $
-		     [ listAssoc [] ] ++ 
-		     [ listAssoc [ (t, [i]) | t <- nubsort ts ] | (ts, i) <- zip toks [0..] ]
-	  inToken  = accumAssoc id [ (tok, (i, j)) | Edge i j tok <- inEdges ]
-
-
------------------------------------------------------------
-- charts, parse forests & trees
-
-type ParseChart n e = Assoc e [(n, [[e]])]
-
-data ParseForest n = FNode n [[ParseForest n]] | FMeta 
-		     deriving (Eq, Ord, Show)
-
-data ParseTree n = TNode n [ParseTree n] | TMeta 
-		   deriving (Eq, Ord, Show)
-
-chart2forests :: Ord e => ParseChart n e -> (e -> Bool) -> e -> [ParseForest n]
-
--filterCoercions :: (n -> Bool) -> ParseForest n -> [ParseForest n]
-
-forest2trees :: ParseForest n -> [ParseTree n]
-
-instance Functor ParseTree where
-    fmap f (TNode n trees) = TNode (f n) $ map (fmap f) trees
-    fmap f (TMeta) = TMeta 
-	     
-instance Functor ParseForest where
-    fmap f (FNode n forests) = FNode (f n) $ map (map (fmap f)) forests
-    fmap f (FMeta) = FMeta 
-
----------
-
-chart2forests chart isMeta = edge2forests
-    where item2forest (name, children) = FNode name $
-					 do edges <- children
-					    mapM edge2forests edges 
-          edge2forests edge 
-	      | isMeta     edge = [FMeta]
-	      | otherwise       = filter checkForest $ map item2forest $ chart ? edge
-	  checkForest (FNode _ children) = not (null children)
-
-- filterCoercions _ (FMeta) = [FMeta]
-- filterCoercions isCoercion (FNode s forests) 
--     | isCoercion s = do [forest] <- forests ; filterCoercions isCoercion forest
--     | otherwise    = FNode s $ do children <- forests ; mapM (filterCoercions isCoercion)
-
-forest2trees (FNode s forests) = map (TNode s) $ forests >>= mapM forest2trees
-forest2trees (FMeta) = [TMeta]
-
-
-
------------------------------------------------------------
-- pretty-printing
-
-instance (Print c, Print t) => Print (Symbol c t) where
-    prt = symbol prt (simpleShow.prt)
-    prtList = prtSep " "
-
-simpleShow :: String -> String
-simpleShow s = "\"" ++ concatMap mkEsc s ++ "\""
-    where
-    mkEsc :: Char -> String
-    mkEsc c = case c of
-		     _ | elem c "\\\"" -> '\\' : [c]
-		     '\n' -> "\\n"
-		     '\t' -> "\\t"
-		     _ -> [c]
-
-instance (Print s) => Print (Edge s) where
-    prt (Edge i j s) = "[" ++ show i ++ "-" ++ show j ++ ": " ++ prt s ++ "]"
-    prtList = prtSep ""
-
-instance (Print s) => Print (ParseTree s) where
-    prt (TNode s trees) = prt s ++ "^{" ++ prtSep " " trees ++ "}"
-    prt (TMeta) = "?"
-    prtList = prtAfter "\n"
-
-instance (Print s) => Print (ParseForest s) where
-    prt (FNode s forests) = prt s ++ "^{" ++ prtSep " | " (map (prtSep " ") forests) ++ "}"
-    prt (FMeta) = "?"
-    prtList = prtAfter "\n"
-
-
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/04/11 13:53:39 $ 
+-- > CVS $Date: 2005/04/12 10:49:45 $ 
 -- > CVS $Author: peb $
-- > CVS $Revision: 1.51 $
+-- > CVS $Revision: 1.52 $
 --
 -- A database for customizable GF shell commands. 
 --
@@ -84,6 +84,7 @@ import qualified GF.Printing.PrintParser as Prt
 --import qualified GF.Conversion.SimpleToMCFG as S2M
 --import GF.Conversion.FromGFC 
 import qualified GF.Infra.Print as Prt2
+import qualified GF.Conversion.GFC as Cnv

 import GFC
 import qualified MkGFC as MC
@@ -255,39 +256,16 @@ customGrammarPrinter =
  ,(strCI "gfc",     GFC.showGFC . stateGrammarST)
  ,(strCI "canonOpt",showCanonOpt "Lang" . stateGrammarST)
 -}
+
 -- add your own grammar printers here
-- grammar conversions, (peb) 
--  ,(strCI "gfc_show",   show . grammar2canon . stateGrammarST)
-  ,(strCI "mcfg-old",       Prt.prt . CnvOld.mcfg . statePInfoOld)
-  ,(strCI "cfg-old",        Prt.prt . CnvOld.cfg . statePInfoOld)
--  ,(strCI "mcfg_show",  show . CnvOld.mcfg . statePInfoOld)
--  ,(strCI "cfg_show",   show . CnvOld.cfg . statePInfoOld)
-- hack for printing finiteness of grammar categories:
-- ,(strCI "finiteness", Prt.prtAfter "\n" . Assoc.aAssocs . CnvOld.fintypes . statePInfoOld)
--  ,(strCI "finite",     prCanon . Fin.convertGrammar . stateGrammarST)
--  ,(strCI "simpleMCF",  (\sg -> Prt.prt $ MCFSimp.convertGrammar "nondet" $
--			 Simp.convertGrammar (stateGrammarST sg, cncId sg)))
--  ,(strCI "simpleGFC",  (\sg -> Prt.prt $ Simp.convertGrammar (stateGrammarST sg, cncId sg)))
--  ,(strCI "finiteSimple", (\sg -> Prt.prt $ FinSimp.convertGrammar $ 
--			   Simp.convertGrammar (stateGrammarST sg, cncId sg)))
--- also include printing via grammar2syntax!
--  ,(strCI "g2s", (\sg -> Prt2.prt $ G2S.convertGrammar (stateGrammarST sg, cncId sg)))
--  ,(strCI "g2s2m", (\sg -> Prt2.prt $ S2M.convertGrammar "nondet" $ 
--		    G2S.convertGrammar (stateGrammarST sg, cncId sg)))
-  ,(strCI "mcfg", Prt2.prt . stateMCFG)
-  ,(strCI "cfg", Prt2.prt . stateCFG)
-{-
-  ,(strCI "simple", Prt2.prt . convertToSimple "" . stateGrammarLang)
-  ,(strCI "mcfg-nondet", Prt2.prt . convertToMCFG "" "nondet" . stateGrammarLang)
-  ,(strCI "mcfg-strict", Prt2.prt . convertToMCFG "" "strict" . stateGrammarLang)
-  ,(strCI "cfg-nondet", Prt2.prt . convertToCFG "" "nondet" . stateGrammarLang)
-  ,(strCI "cfg-strict", Prt2.prt . convertToCFG "" "strict" . stateGrammarLang)
-  ,(strCI "fin-simple", Prt2.prt . convertToSimple "fin" . stateGrammarLang)
-  ,(strCI "fin-mcfg-nondet", Prt2.prt . convertToMCFG "fin" "nondet" . stateGrammarLang)
-  ,(strCI "fin-mcfg-strict", Prt2.prt . convertToMCFG "fin" "strict" . stateGrammarLang)
-  ,(strCI "fin-cfg-nondet", Prt2.prt . convertToCFG "fin" "nondet" . stateGrammarLang)
-  ,(strCI "fin-cfg-strict", Prt2.prt . convertToCFG "fin" "strict" . stateGrammarLang)
-}
+-- grammar conversions:
+  ,(strCI "mcfg",     Prt2.prt . stateMCFG)
+  ,(strCI "cfg",      Prt2.prt . stateCFG)
+-- obsolete, or only for testing:
+  ,(strCI "simple",   Prt2.prt . Cnv.gfc2simple . stateGrammarLang)
+  ,(strCI "finite",   Prt2.prt . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
+  ,(strCI "mcfg-old", Prt.prt . CnvOld.mcfg . statePInfoOld)
+  ,(strCI "cfg-old",  Prt.prt . CnvOld.cfg . statePInfoOld)
  ] 

 customMultiGrammarPrinter =