"Committed_by_peb"

9 files changed, 231 insertions, 118 deletions

diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs
index dbaded139..9e0b58be1 100644
--- a/src/GF/Conversion/GFC.hs
+++ b/src/GF/Conversion/GFC.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:49 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.7 $
+-- > CVS $Date: 2005/05/09 09:28:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.8 $
 --
 -- All conversions from GFC 
 -----------------------------------------------------------------------------
@@ -17,8 +17,13 @@ module GF.Conversion.GFC
 
 import GF.Infra.Option
 import GF.Canon.GFC (CanonGrammar)
-import GF.Infra.Ident (Ident)
-import GF.Conversion.Types (CGrammar, MGrammar, EGrammar, SGrammar)
+import GF.Infra.Ident (Ident, identC)
+
+import GF.Formalism.GCFG (Rule(..), Abstract(..))
+import GF.Formalism.SimpleGFC (decl2cat)
+import GF.Formalism.CFG (CFRule(..))
+import GF.Formalism.Utilities (symbol)
+import GF.Conversion.Types
 
 import qualified GF.Conversion.GFCtoSimple as G2S
 import qualified GF.Conversion.SimpleToFinite as S2Fin
@@ -27,13 +32,17 @@ import qualified GF.Conversion.RemoveErasing as RemEra
 import qualified GF.Conversion.SimpleToMCFG as S2M
 import qualified GF.Conversion.MCFGtoCFG as M2C
 
+import GF.Infra.Print
+
 ----------------------------------------------------------------------
 -- * GFC -> MCFG & CFG, using options to decide which conversion is used
 
 gfc2mcfg2cfg :: Options -> (CanonGrammar, Ident) -> (MGrammar, CGrammar)
 gfc2mcfg2cfg opts = \g -> let e = g2e g in (e2m e, e2c e)
     where e2c = mcfg2cfg
-	  e2m = removeErasing
+	  e2m = case getOptVal opts firstCat of
+		  Just cat -> flip removeErasing [identC cat]
+		  Nothing  -> flip removeErasing []
 	  g2e = case getOptVal opts gfcConversion of
 		  Just "strict" -> simple2mcfg_strict . gfc2simple
 		  Just "finite" -> simple2mcfg_nondet . gfc2finite
@@ -70,8 +79,44 @@ simple2mcfg_strict = S2M.convertGrammarStrict
 mcfg2cfg :: EGrammar -> CGrammar
 mcfg2cfg = M2C.convertGrammar
 
-removeErasing :: EGrammar -> MGrammar
-removeErasing = RemEra.convertGrammar
+removeErasing :: EGrammar -> [SCat] -> MGrammar
+removeErasing = RemEra.convertGrammar 
+
+----------------------------------------------------------------------
+-- * converting to some obscure formats
+
+gfc2abstract :: (CanonGrammar, Ident) -> [Abstract SCat Fun]
+gfc2abstract gr = [ Abs (decl2cat decl) (map decl2cat decls) (name2fun name) |
+		    Rule (Abs decl decls name) _ <- gfc2simple gr ]
+
+abstract2prolog :: [Abstract SCat Fun] -> String
+abstract2prolog gr = skvatt_hdr ++ concatMap abs2pl gr
+    where abs2pl (Abs cat [] fun) = prtQuoted cat ++ " ---> " ++ 
+				    "\"" ++ prt fun ++ "\".\n"
+	  abs2pl (Abs cat cats fun) =
+	      prtQuoted cat ++ " ---> " ++
+	      "\"(" ++ prt fun ++ "\"" ++
+	      prtBefore ", \" \", " (map prtQuoted cats) ++ ", \")\".\n"
+
+cfg2prolog :: CGrammar -> String
+cfg2prolog gr = skvatt_hdr ++ concatMap cfg2pl gr
+    where cfg2pl (CFRule cat syms _name) =
+	      prtQuoted cat ++ " ---> " ++
+	      if null syms then "\"\".\n" else
+	      prtSep ", " (map (symbol prtQuoted prTok) syms) ++ ".\n"
+	  prTok tok = "\"" ++ tok ++ " \""
+
+skvatt_hdr = ":- use_module(library(skvatt)).\n" ++ 
+	     ":- use_module(library(utils), [repeat/1]).\n" ++
+	     "corpus(File, StartCat, Depth, Size) :- \n" ++
+	     "        set_flag(gendepth, Depth),\n" ++ 
+	     "        tell(File), repeat(Size),\n" ++
+	     "        generate_words(StartCat, String), format('~s~n~n', [String]),\n" ++
+	     "        write(user_error, '.'),\n" ++ 
+	     "        fail ; told.\n\n"
+
+prtQuoted :: Print a => a -> String
+prtQuoted a = "'" ++ prt a ++ "'"
 
 
 
diff --git a/src/GF/Conversion/GFCtoSimple.hs b/src/GF/Conversion/GFCtoSimple.hs
index efdf51f2e..f0badda3a 100644
--- a/src/GF/Conversion/GFCtoSimple.hs
+++ b/src/GF/Conversion/GFCtoSimple.hs
@@ -4,13 +4,17 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:50 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
+-- > CVS $Date: 2005/05/09 09:28:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.6 $
 --
 -- Converting GFC to SimpleGFC
 --
--- the conversion might fail if the GFC grammar has dependent or higher-order types
+-- the conversion might fail if the GFC grammar has dependent or higher-order types,
+-- or if the grammar contains bound pattern variables
+-- (use -optimize=values/share/none when importing)
+--
+-- TODO: lift all functions to the 'Err' monad
 -----------------------------------------------------------------------------
 
 module GF.Conversion.GFCtoSimple
@@ -38,7 +42,7 @@ type Env = (CanonGrammar, I.Ident)
 
 convertGrammar :: Env -> SGrammar
 convertGrammar gram = trace2 "GFCtoSimple - concrete language" (prt (snd gram)) $
-		      tracePrt "GFCtoSimple - nr. simpleGFC rules" (prt . length) $
+		      tracePrt "GFCtoSimple - simpleGFC rules" (prt . length) $
 		      [ convertAbsFun gram fun typing |
 			A.Mod (A.MTAbs modname) _ _ _ defs <- modules,
 			A.AbsDFun fun typing _ <- defs ]
@@ -63,21 +67,21 @@ convertAbstract env fun a
 convertType :: Var -> [TTerm] -> A.Exp -> SDecl
 convertType x args (A.EApp a b) = convertType x (convertExp [] b : args) a
 convertType x args (A.EAtom at) = Decl x (convertCat at) args
-convertType x args exp = error $ "convertType: " ++ prt exp
+convertType x args exp          = error $ "GFCtoSimple.convertType: " ++ prt exp
 
 convertExp :: [TTerm] -> A.Exp -> TTerm
 convertExp args (A.EAtom at) = convertAtom args at
 convertExp args (A.EApp a b) = convertExp (convertExp [] b : args) a
-convertExp args exp = error $ "convertExp: " ++ prt exp
+convertExp args exp          = error $ "GFCtoSimple.convertExp: " ++ prt exp
 
 convertAtom :: [TTerm] -> A.Atom -> TTerm
 convertAtom args (A.AC con) = con :@ reverse args
 convertAtom []   (A.AV var) = TVar var
-convertAtom args atom = error $ "convertAtom: " ++ prt args ++ " " ++ prt atom
+convertAtom args atom       = error $ "GFCtoSimple.convertAtom: " ++ prt args ++ " " ++ prt atom
 
 convertCat :: A.Atom -> SCat
 convertCat (A.AC (A.CIQ _ cat)) = cat
-convertCat atom = error $ "convertCat: " ++ show atom
+convertCat atom                 = error $ "GFCtoSimple.convertCat: " ++ show atom
 
 ----------------------------------------------------------------------
 -- concrete definitions
@@ -88,45 +92,43 @@ convertConcrete gram (Abs decl args name) = Cnc ltyp largs term
 	  ltyp : largs = map (convertCType gram . lookupCType gram) (decl : args)
 
 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) 
-    = TblT (convertCType gram ptype) (convertCType gram vtype)
-convertCType gram ct@(A.Cn con) = ConT con $ map (convertTerm gram) $ groundTerms gram ct
-convertCType gram (A.TStr) = StrT
-convertCType gram (A.TInts n) = error "convertCType: cannot handle 'TInts' constructor"
+convertCType gram (A.RecType rec) = RecT [ (lbl, convertCType gram ctype) | A.Lbg lbl ctype <- rec ]
+convertCType gram (A.Table pt vt) = TblT (convertCType gram pt) (convertCType gram vt)
+convertCType gram ct@(A.Cn con)   = ConT con $ map (convertTerm gram) $ groundTerms gram ct
+convertCType gram (A.TStr)        = StrT
+convertCType gram (A.TInts n)     = error "GFCtoSimple.convertCType: cannot handle 'TInts' constructor"
 
 convertTerm :: Env -> A.Term -> STerm
-convertTerm gram (A.Arg arg) = convertArgVar arg
+convertTerm gram (A.Arg arg)       = convertArgVar arg
 convertTerm gram (A.Con con terms) = con :^ map (convertTerm gram) terms
-convertTerm gram (A.LI var) = Var var
-convertTerm gram (A.R rec) = Rec [ (lbl, convertTerm gram term) | A.Ass lbl term <- rec ]
-convertTerm gram (A.P term lbl) = convertTerm gram term +. lbl
+-- convertTerm gram (A.LI var)        = Var var
+convertTerm gram (A.R rec)         = Rec [ (lbl, convertTerm gram term) | A.Ass lbl term <- rec ]
+convertTerm gram (A.P term lbl)    = convertTerm gram term +. lbl
 convertTerm gram (A.V ctype terms) = Tbl [ (convertTerm gram pat, convertTerm gram term) |
 					  (pat, term) <- zip (groundTerms gram ctype) terms ]
-convertTerm gram (A.T ctype tbl) = Tbl [ (convertPatt pat, convertTerm gram term) |
-					A.Cas pats term <- tbl, pat <- pats ]
-convertTerm gram (A.S term sel) = convertTerm gram term +! convertTerm gram sel
+convertTerm gram (A.T ctype tbl)   = Tbl [ (convertPatt pat, convertTerm gram term) |
+					   A.Cas pats term <- tbl, pat <- pats ]
+convertTerm gram (A.S term sel)    = convertTerm gram term :! convertTerm gram sel
 convertTerm gram (A.C term1 term2) = convertTerm gram term1 ?++ convertTerm gram term2
-convertTerm gram (A.FV terms) = variants (map (convertTerm gram) terms)
+convertTerm gram (A.FV terms)      = variants (map (convertTerm gram) terms)
+convertTerm gram (A.E)             = Empty
+convertTerm gram (A.K (A.KS tok))  = Token tok
 -- 'pre' tokens are converted to variants (over-generating):
-convertTerm gram (A.K (A.KP [s] vs))
-    = variants $ Token s : [ Token v | A.Var [v] _ <- vs ]
-convertTerm gram (A.K (A.KP _ _)) = error "convertTerm: don't know how to handle string lists in 'pre' tokens"
-convertTerm gram (A.K (A.KS tok)) = Token tok
-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"
+convertTerm gram (A.K (A.KP strs vars))
+                                   = variants $ map conc $ strs : [ vs | A.Var vs _ <- vars ]
+    where conc = foldr1 (?++) . map Token 
+convertTerm gram (A.I con)         = error "GFCtoSimple.convertTerm: cannot handle 'I' constructor"
+convertTerm gram (A.EInt int)      = error "GFCtoSimple.convertTerm: cannot handle 'EInt' constructor"
 
 convertArgVar :: A.ArgVar -> STerm
-convertArgVar (A.A cat nr) = Arg (fromInteger nr) cat emptyPath
+convertArgVar (A.A cat nr)           = Arg (fromInteger nr) cat emptyPath
 convertArgVar (A.AB cat bindings nr) = Arg (fromInteger nr) cat emptyPath
 
 convertPatt (A.PC con pats) = con :^ map convertPatt pats
-convertPatt (A.PV x) = Var x
-convertPatt (A.PW) = Wildcard
-convertPatt (A.PR rec) = Rec [ (lbl, convertPatt pat) | A.PAss lbl pat <- rec ]
-convertPatt (A.PI n) = error "convertPatt: cannot handle 'PI' constructor"
+-- convertPatt (A.PV x)        = Var x
+-- convertPatt (A.PW)          = Wildcard
+convertPatt (A.PR rec)      = Rec [ (lbl, convertPatt pat) | A.PAss lbl pat <- rec ]
+convertPatt (A.PI n)        = error "GFCtoSimple.convertPatt: cannot handle 'PI' constructor"
 
 ----------------------------------------------------------------------
 
diff --git a/src/GF/Conversion/MCFGtoCFG.hs b/src/GF/Conversion/MCFGtoCFG.hs
index ad8521b3f..a58c31d37 100644
--- a/src/GF/Conversion/MCFGtoCFG.hs
+++ b/src/GF/Conversion/MCFGtoCFG.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:51 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
+-- > CVS $Date: 2005/05/09 09:28:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.6 $
 --
 -- Converting MCFG grammars to (possibly overgenerating) CFG
 -----------------------------------------------------------------------------
@@ -29,7 +29,7 @@ import GF.Conversion.Types
 -- * converting (possibly erasing) MCFG grammars
 
 convertGrammar :: EGrammar -> CGrammar
-convertGrammar gram = tracePrt "MCFGtoCFG - nr. context-free rules" (prt.length) $
+convertGrammar gram = tracePrt "MCFGtoCFG - context-free rules" (prt.length) $
 		       concatMap convertRule gram
 
 convertRule :: ERule -> [CRule]
diff --git a/src/GF/Conversion/RemoveErasing.hs b/src/GF/Conversion/RemoveErasing.hs
index 34fccd937..0062e5f36 100644
--- a/src/GF/Conversion/RemoveErasing.hs
+++ b/src/GF/Conversion/RemoveErasing.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:53 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.2 $
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.3 $
 --
 -- Removing erasingness from MCFG grammars (as in Ljunglöf 2004, sec 4.5.1)
 -----------------------------------------------------------------------------
@@ -18,7 +18,7 @@ module GF.Conversion.RemoveErasing
 import GF.System.Tracing
 import GF.Infra.Print
 
-import Control.Monad
+import Control.Monad 
 import Data.List (mapAccumL)
 import Data.Maybe (mapMaybe)
 import GF.Formalism.Utilities
@@ -29,18 +29,23 @@ import GF.Data.Assoc
 import GF.Data.SortedList
 import GF.Data.GeneralDeduction
 
-convertGrammar :: EGrammar -> MGrammar
-convertGrammar grammar
-    = tracePrt "RemoveErasing - nr. nonerasing rules" (prt . length) $
-      traceCalcFirst finalChart $
-      trace2 "RemoveErasing - nr. nonerasing cats" (prt $ length $ chartLookup finalChart False) $
-      trace2 "RemoveErasing - nr. initial ne-cats" (prt $ length initialCats) $
-      trace2 "RemoveErasing - nr. erasing rules" (prt $ length grammar) $
-      newGrammar
-    where newGrammar  = [ rule | NR rule <- chartLookup finalChart True ]
-	  finalChart  = buildChart keyof [newRules rulesByCat] initialCats
-	  initialCats = initialCatsBU rulesByCat
-	  rulesByCat  = accumAssoc id [ (cat, rule) | rule@(Rule (Abs cat _ _) _) <- grammar ]
+convertGrammar :: EGrammar -> [SCat] -> MGrammar
+convertGrammar grammar starts = newGrammar
+    where newGrammar  = tracePrt "RemoveErasing - nonerasing rules" (prt . length) $
+			[ rule | NR rule <- chartLookup finalChart True ]
+	  finalChart  = tracePrt "RemoveErasing - nonerasing cats" 
+			(prt . length . flip chartLookup False) $
+			buildChart keyof [newRules rulesByCat] $
+			tracePrt "RemoveErasing - initial ne-cats" (prt . length) $
+			initialCats
+	  initialCats = trace2 "RemoveErasing - starting categories" (prt starts) $
+			if null starts 
+			  then trace2 "RemoveErasing" "initialCatsBU" $
+			       initialCatsBU rulesByCat
+			  else trace2 "RemoveErasing" ("initialCatsTD: " ++ prt starts) $
+			       initialCatsTD rulesByCat starts
+	  rulesByCat  = trace2 "RemoveErasing - erasing rules" (prt $ length grammar) $
+			accumAssoc id [ (cat, rule) | rule@(Rule (Abs cat _ _) _) <- grammar ]
 
 data Item r c = NR r | NC c deriving (Eq, Ord, Show)
 
@@ -77,8 +82,13 @@ newRules grammar chart (NC newCat@(MCat cat lbls))
 	     accumProf nr = maybe (nr, Unify []) $ const (nr+1, Unify [nr])
 	     newName = Name fun (newProfile `composeProfiles` profile)
 
+         guard $ all (not . null) argLbls
 	 return $ NR (Rule (Abs newCat newArgs newName) (Cnc lbls argLbls newLins))
 
+initialCatsTD grammar starts =
+    [ cat | cat@(NC (MCat (ECat start _) _)) <- initialCatsBU grammar,
+      start `elem` starts ]
+
 initialCatsBU grammar 
     = [ NC (MCat cat [lbl]) | (cat, rules) <- aAssocs grammar, 
 	let Rule _ (Cnc lbls _ _) = head rules,
diff --git a/src/GF/Conversion/RemoveSingletons.hs b/src/GF/Conversion/RemoveSingletons.hs
index 0bb5c9ff7..6c3a6e7c7 100644
--- a/src/GF/Conversion/RemoveSingletons.hs
+++ b/src/GF/Conversion/RemoveSingletons.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:54 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.3 $
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.4 $
 --
 -- Instantiating all types which only have one single element.
 --
@@ -30,7 +30,7 @@ import Data.List (mapAccumL)
 
 convertGrammar :: SGrammar -> SGrammar
 convertGrammar grammar = if singles == emptyAssoc then grammar
-			 else tracePrt "RemoveSingletons - nr. non-singleton rules" (prt . length) $
+			 else tracePrt "RemoveSingletons - non-singleton rules" (prt . length) $
 			      map (convertRule singles) grammar
     where singles = calcSingletons grammar
 
diff --git a/src/GF/Conversion/SimpleToMCFG/Coercions.hs b/src/GF/Conversion/SimpleToMCFG/Coercions.hs
index 48b09cee2..319b99dcb 100644
--- 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/21 16:21:57 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
 --
 -- Adding coercion functions to a MCFG if necessary.
 -----------------------------------------------------------------------------
@@ -33,9 +33,9 @@ addCoercions rules = coercions ++ rules
 					Rule (Abs head args _) (Cnc lbls _ _) <- rules ]
 	  allHeadSet = nubsort allHeads
 	  allArgSet  = union   allArgs <\\> map fst allHeadSet
-	  coercions = tracePrt "SimpleToMCFG.Coercions - nr. MCFG coercions" (prt . length) $
+	  coercions = tracePrt "SimpleToMCFG.Coercions - MCFG coercions" (prt . length) $
 		      concat $
-		      tracePrt "SimpleToMCFG.Coerciions - nr. MCFG coercions per category" 
+		      tracePrt "SimpleToMCFG.Coercions - MCFG coercions per category" 
 				   (prtList . map length) $
 		      combineCoercions 
 		        (groupBy sameECatFst allHeadSet) 
diff --git a/src/GF/Conversion/SimpleToMCFG/Nondet.hs b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
index 39ac709cd..12db9511c 100644
--- 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/21 16:21:57 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
 --
 -- Converting SimpleGFC grammars to MCFG grammars, nondeterministically.
 -- Afterwards, the grammar has to be extended with coercion functions,
@@ -33,36 +33,72 @@ import GF.Formalism.SimpleGFC
 import GF.Conversion.Types
 
 import GF.Data.BacktrackM
-
+import GF.Data.Utilities (notLongerThan, updateNthM)
 
 ------------------------------------------------------------
 -- type declarations
 
 type CnvMonad a = BacktrackM Env a
 
-type Env    = (ECat, [ECat], LinRec, [SLinType])
+type Env    = (ECat, [ECat], LinRec, [SLinType]) -- variable bindings: [(Var, STerm)]
 type LinRec = [Lin SCat MLabel Token]
 
 
 ----------------------------------------------------------------------
 -- main conversion function
 
+maxNrRules :: Int
+maxNrRules = 1000
+
 convertGrammar :: SGrammar -> EGrammar 
-convertGrammar rules = tracePrt "SimpleToMCFG.Nondet - nr. MCFG rules" (prt . length) $
-		       solutions conversion undefined
-    where conversion = member rules >>= convertRule
-
-convertRule :: SRule -> CnvMonad ERule
-convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term)))
-    = do let cat : args = map decl2cat (decl : decls)
-	 writeState (initialECat cat, map initialECat args, [], ctypes)
-	 rterm <- simplifyTerm term
-	 reduceTerm ctype emptyPath rterm
-	 (newCat, newArgs, linRec, _) <- readState
-	 let newLinRec = map (instantiateArgs newArgs) linRec
-	     catPaths : argsPaths = map (lintype2paths emptyPath) (ctype : ctypes)
-	 return $ Rule (Abs newCat newArgs fun) (Cnc catPaths argsPaths newLinRec) 
-convertRule _ = failure
+convertGrammar rules = traceCalcFirst rules' $
+		       tracePrt "SimpleToMCFG.Nondet - MCFG rules" (prt . length) $
+		       rules'
+    where rules' = rules >>= convertRule
+--		       solutions conversion undefined
+--    where conversion = member rules >>= convertRule
+
+convertRule :: SRule -> [ERule] -- CnvMonad ERule
+convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term))) =
+--    | prt(name2fun fun) `elem` 
+--      words "UseCl PosTP TPast ASimul SPredV IndefOneNP DefOneNP UseN2 mother_N2 jump_V" =
+    if notLongerThan maxNrRules rules 
+       then tracePrt ("SimpeToMCFG.Nondet - MCFG rules for " ++ prt fun) (prt . length) $
+	    rules
+       else trace2 "SimpeToMCFG.Nondet - TOO MANY RULES, function not converted" 
+		("More than " ++ show maxNrRules ++ " MCFG rules for " ++ prt fun) $
+            []
+    where rules = flip solutions undefined $
+		  do let cat : args = map decl2cat (decl : decls)
+		     writeState (initialECat cat, map initialECat args, [], ctypes)
+		     rterm <- simplifyTerm term
+		     reduceTerm ctype emptyPath rterm
+		     (newCat, newArgs, linRec, _) <- readState
+		     let newLinRec = map (instantiateArgs newArgs) linRec
+			 catPaths : argsPaths = map (lintype2paths emptyPath) (ctype : ctypes)
+		     -- checkLinRec argsPaths catPaths newLinRec
+		     return $ Rule (Abs newCat newArgs fun) (Cnc catPaths argsPaths newLinRec) 
+convertRule _ = [] -- failure
+
+
+----------------------------------------------------------------------
+-- "type-checking" the resulting linearization
+-- should not be necessary, if the algorithms (type-checking and conversion) are correct
+
+checkLinRec args lbls = mapM (checkLin args lbls) 
+
+checkLin args lbls (Lin lbl lin) 
+    | lbl `elem` lbls = mapM (symbol (checkArg args) (const (return ()))) lin
+    | otherwise = trace2 "SimpleToMCFG.Nondet - ERROR" "Label mismatch" $
+		  failure
+
+checkArg args (_cat, lbl, nr) 
+    | lbl `elem` (args !! nr) = return ()
+--    | otherwise = trace2 "SimpleToMCFG.Nondet - ERROR" ("Label mismatch in arg " ++ prt nr) $
+--		  failure
+    | otherwise = trace2 ("SimpleToMCFG.Nondet - ERROR: Label mismatch in arg " ++ prt nr) 
+		  (prt lbl ++ " `notElem` " ++ prt (args!!nr)) $
+		  failure
 
 
 ----------------------------------------------------------------------
@@ -78,6 +114,7 @@ simplifyTerm (term :! sel)
 			    return val
 	   _ -> do sel' <- expandTerm ssel
 		   return (sterm +! sel')
+-- simplifyTerm (Var x)           = readBinding x
 simplifyTerm (con :^ terms)    = liftM (con :^) $ mapM simplifyTerm terms
 simplifyTerm (Rec record)      = liftM Rec      $ mapM simplifyAssign record
 simplifyTerm (term :. lbl)     = liftM (+. lbl) $      simplifyTerm term
@@ -85,10 +122,6 @@ simplifyTerm (Tbl table)       = liftM Tbl      $ mapM simplifyCase table
 simplifyTerm (Variants terms)  = liftM Variants $ mapM simplifyTerm terms
 simplifyTerm (term1 :++ term2) = liftM2 (:++) (simplifyTerm term1) (simplifyTerm term2)
 simplifyTerm term              = return term
--- error constructors:
---   (I CIdent) - from resource
---   (LI Ident) - pattern variable
---   (EInt Integer) - integer
 
 simplifyAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
 simplifyAssign (lbl, term) = liftM ((,) lbl) $ simplifyTerm term
@@ -101,8 +134,8 @@ simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)
 -- reducing simplified terms, collecting MCF rules
 
 reduceTerm :: SLinType -> SPath -> STerm -> CnvMonad ()
-reduceTerm ctype path (Variants terms) 
-    = member terms >>= reduceTerm ctype path
+--reduceTerm ctype path (Variants terms) 
+--    = member terms >>= reduceTerm ctype path
 reduceTerm (StrT)     path term = updateLin (path, term)
 reduceTerm (ConT _ _) path term = do pat <- expandTerm term
 				     updateHead (path, pat)
@@ -120,23 +153,41 @@ reduceTerm (TblT ptype vtype) path table
 expandTerm :: STerm -> CnvMonad STerm
 expandTerm arg@(Arg nr _ path) 
     = do ctypes <- readArgCTypes
-	 pat <- member $ enumeratePatterns $ lintypeFollowPath path $ ctypes !! nr
-	 pat =?= arg
-	 return pat
+	 unifyPType arg $ lintypeFollowPath path $ ctypes !! nr
+-- expandTerm arg@(Arg nr _ path) 
+--     = do ctypes <- readArgCTypes
+-- 	 pat <- member $ enumeratePatterns $ lintypeFollowPath path $ ctypes !! nr
+-- 	 pat =?= arg
+-- 	 return pat
 expandTerm (con :^ terms)   = liftM (con :^) $ mapM expandTerm terms
 expandTerm (Rec record)     = liftM  Rec     $ mapM expandAssign record
+--expandTerm (Variants terms) = liftM Variants $ mapM expandTerm terms  
 expandTerm (Variants terms) = member terms >>= expandTerm  
 expandTerm term = error $ "expandTerm: " ++ prt term
 
 expandAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
 expandAssign (lbl, term) = liftM ((,) lbl) $ expandTerm term
 
+unifyPType :: STerm -> SLinType -> CnvMonad STerm
+unifyPType arg (RecT prec) = 
+    liftM Rec $
+    sequence [ liftM ((,) lbl) $
+	       unifyPType (arg +. lbl) ptype |
+	       (lbl, ptype) <- prec ]
+unifyPType (Arg nr _ path) (ConT con terms) = 
+    do (_, args, _, _) <- readState
+       case lookup path (ecatConstraints (args !! nr)) of
+         Just term -> return term
+         Nothing -> do term <- member terms
+		       updateArg nr (path, term)
+		       return term
 
 ------------------------------------------------------------
 -- unification of patterns and selection terms
 
 (=?=) :: STerm -> STerm -> CnvMonad ()
-Wildcard      =?= _               = return ()
+-- Wildcard      =?= _               = return ()
+-- Var x         =?= term            = addBinding x term
 Rec precord   =?= arg@(Arg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
 						(lbl, pat) <- precord ]
 pat           =?= Arg nr _ path   = updateArg nr (path, pat)
@@ -147,6 +198,15 @@ Rec precord   =?= Rec record      = sequence_ [ maybe mzero (pat =?=) mterm |
 						let mterm = lookup lbl record ]
 pat =?= term = error $ "(=?=): " ++ prt pat ++ " =?= " ++ prt term
 
+----------------------------------------------------------------------
+-- variable bindings (does not work correctly)
+{-
+addBinding x term = do (a, b, c, d, bindings) <- readState
+		       writeState (a, b, c, d, (x,term):bindings)
+
+readBinding x = do (_, _, _, _, bindings) <- readState
+		   return $ maybe (Var x) id $ lookup x bindings
+-}
 
 ------------------------------------------------------------
 -- updating the MCF rule
@@ -158,7 +218,7 @@ readArgCTypes = do (_, _, _, env) <- readState
 updateArg :: Int -> Constraint -> CnvMonad ()
 updateArg arg cn
     = do (head, args, lins, env) <- readState 
-	 args' <- updateNth (addToECat cn) arg args
+	 args' <- updateNthM (addToECat cn) arg args
 	 writeState (head, args', lins, env)
 
 updateHead :: Constraint -> CnvMonad ()
@@ -193,11 +253,4 @@ addConstraint cn0 (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)
-
 
diff --git a/src/GF/Conversion/SimpleToMCFG/Strict.hs b/src/GF/Conversion/SimpleToMCFG/Strict.hs
index c6b703f04..6ca7c4737 100644
--- 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/21 16:21:58 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.5 $
 --
 -- Converting SimpleGFC grammars to MCFG grammars, deterministic.
 --
@@ -39,7 +39,7 @@ import GF.Data.SortedList
 type CnvMonad a = BacktrackM () a
 
 convertGrammar :: SGrammar -> EGrammar 
-convertGrammar rules = tracePrt "SimpleToMCFG.Strict - nr. MCFG rules" (prt . length) $
+convertGrammar rules = tracePrt "SimpleToMCFG.Strict - MCFG rules" (prt . length) $
 		       solutions conversion undefined
     where conversion = member rules >>= convertRule
 
diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs
index 05a7e66b5..c233ca69d 100644
--- a/src/GF/Conversion/Types.hs
+++ b/src/GF/Conversion/Types.hs
@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:56 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.7 $
+-- > CVS $Date: 2005/05/09 09:28:44 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.8 $
 --
 -- All possible instantiations of different grammar formats used in conversion from GFC
 -----------------------------------------------------------------------------
@@ -137,6 +137,9 @@ initialECat cat = ECat cat []
 ecat2scat :: ECat -> SCat
 ecat2scat (ECat cat _) = cat
 
+ecatConstraints :: ECat -> [Constraint]
+ecatConstraints (ECat _ cns) = cns
+
 sameECat :: ECat -> ECat -> Bool
 sameECat ec1 ec2 = ecat2scat ec1 == ecat2scat ec2