"Committed_by_peb"

9 files changed, 194 insertions, 104 deletions

diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs
index 6a4adc253..5b5c4491e 100644
--- 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
diff --git a/src/GF/Conversion/GFCtoSimple.hs b/src/GF/Conversion/GFCtoSimple.hs
index 1764f1644..5e4313b1b 100644
--- 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))
diff --git a/src/GF/Conversion/MCFGtoCFG.hs b/src/GF/Conversion/MCFGtoCFG.hs
index c12bb6b53..2b86b633a 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/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
diff --git a/src/GF/Conversion/SimpleToFinite.hs b/src/GF/Conversion/SimpleToFinite.hs
index 4abc22356..cc180a7e1 100644
--- 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 "" "" ""
 
diff --git a/src/GF/Conversion/SimpleToMCFG.hs b/src/GF/Conversion/SimpleToMCFG.hs
index 5e299c8a0..2b829a52e 100644
--- 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
 
diff --git a/src/GF/Conversion/SimpleToMCFG/Coercions.hs b/src/GF/Conversion/SimpleToMCFG/Coercions.hs
index c1dc5b07c..a57953061 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/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
diff --git a/src/GF/Conversion/SimpleToMCFG/Nondet.hs b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
index b98b368ff..83e5fec96 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/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)
diff --git a/src/GF/Conversion/SimpleToMCFG/Strict.hs b/src/GF/Conversion/SimpleToMCFG/Strict.hs
index 17c2293ec..e1fd3ecfa 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/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) = [[]]
diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs
index d6b43bd58..672a57012 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/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