GFCC to FCFG conversion

11 files changed, 283 insertions, 293 deletions

diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index e01171b18..80956d8ff 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -17,6 +17,7 @@ module GF.Compile.ShellState where
 import GF.Data.Operations
 import GF.Canon.GFC
 import GF.Canon.AbsGFC
+import GF.Canon.CanonToGFCC as C2GFCC
 import GF.Grammar.Macros
 import GF.Grammar.MMacros
 
@@ -43,6 +44,7 @@ import qualified Transfer.InterpreterAPI as T
 
 import qualified GF.OldParsing.ConvertGrammar as CnvOld -- OBSOLETE
 import qualified GF.Conversion.GFC as Cnv
+import qualified GF.Conversion.SimpleToFCFG as FCnv
 import qualified GF.Parsing.GFC as Prs
 
 import Control.Monad (mplus)
@@ -229,8 +231,11 @@ updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do
 
   let abstrs = nubBy (\ (x,_) (y,_) -> x == y) $ 
                maybe id (\a -> ((a,concrs0):)) abstr0 $ abstracts sh
-
-  let cgr = cgr0 ---- filterAbstracts (map fst abstrs) cgr0
+               
+  let needed = nub $ concatMap (requiredCanModules (length abstrs == 1) cgr0) (maybe [] singleton abstr0 ++ concrs0)
+      purge  = nubBy (\x y -> fst x == fst y) . filter (\(m,mo) -> elem m needed && not (isIncompleteCanon (m,mo)))
+      
+  let cgr = M.MGrammar $ purge $ M.modules cgr0
 
   let oldConcrs = map (snd . fst) (concretes sh)
       newConcrs = maybe [] (M.allConcretes gr) abstr0
@@ -238,7 +243,8 @@ updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do
   let complete m = case M.lookupModule gr m of
         Ok mo -> not $ isIncompleteCanon (m,mo)
         _ -> False
-  let concrs = filter complete $ nub $ newConcrs ++ oldConcrs
+        
+  let concrs = filter (\i -> complete i && elem i needed) $ nub $ newConcrs ++ oldConcrs
       concr0 = ifNull Nothing (return . head) concrs
       notInrts f = notElem f $ map fst rts
       subcgr = unSubelimCanon cgr
@@ -252,9 +258,12 @@ updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do
   let probss = [] -----
 
 
-  let fromGFC              = snd . snd . Cnv.convertGFC opts
-      (mcfgs, fcfgs, cfgs) = unzip3 $ map (curry fromGFC cgr) concrs
-      pInfos               = zipWith3 Prs.buildPInfo mcfgs fcfgs cfgs
+  let fromGFC       = snd . snd . Cnv.convertGFC opts
+      (mcfgs, cfgs) = unzip $ map (curry fromGFC cgr) concrs
+      fcfgs         = FCnv.convertGrammar (C2GFCC.mkCanon2gfcc cgr)
+      pInfos        = zipWith3 Prs.buildPInfo mcfgs (map snd fcfgs) cfgs
+      
+      
 
   let funs = funRulesOf cgr
   let cats = allCatsOf cgr
@@ -273,9 +282,9 @@ updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do
     canModules = cgr,
     srcModules = src,
     cfs        = cf's,
-    abstracts  = abstrs,
+    abstracts  = maybe [] (\a -> [(a,concrs)]) abstr0,
     mcfgs      = zip concrs mcfgs,
-    fcfgs      = zip concrs fcfgs,
+    fcfgs      = fcfgs,
     cfgs       = zip concrs cfgs,
     pInfos     = zip concrs pInfos,
     morphos    = morphs,
diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs
index 2fff4be26..dcaa784f3 100644
--- a/src/GF/Conversion/GFC.hs
+++ b/src/GF/Conversion/GFC.hs
@@ -18,6 +18,7 @@ module GF.Conversion.GFC
 import GF.Infra.Option
 import GF.Canon.GFC (CanonGrammar)
 import GF.Infra.Ident (Ident, identC)
+import qualified GF.Infra.Modules as M
 
 import GF.Formalism.GCFG (Rule(..), Abstract(..))
 import GF.Formalism.SimpleGFC (decl2cat)
@@ -31,23 +32,22 @@ import qualified GF.Conversion.RemoveSingletons as RemSing
 import qualified GF.Conversion.RemoveErasing as RemEra
 import qualified GF.Conversion.RemoveEpsilon as RemEps
 import qualified GF.Conversion.SimpleToMCFG as S2M
-import qualified GF.Conversion.SimpleToFCFG as S2FM
---import qualified GF.Conversion.MCFGtoFCFG as M2FM
 import qualified GF.Conversion.MCFGtoCFG as M2C
 
 import GF.Infra.Print
 
 import GF.System.Tracing
+import qualified Debug.Trace as D
 
 ----------------------------------------------------------------------
 -- * GFC -> MCFG & CFG, using options to decide which conversion is used
 
-convertGFC :: Options -> (CanonGrammar, Ident) 
-           -> (SGrammar, (EGrammar, (MGrammar, FGrammar, CGrammar)))
+convertGFC :: Options -> (CanonGrammar, Ident)
+           -> (SGrammar, (EGrammar, (MGrammar, CGrammar)))
 convertGFC opts = \g -> let s = g2s g
                             e = s2e s 
                             m = e2m e
-                        in trace2 "Options" (show opts) (s, (e, (m, s2fm s, e2c e)))
+                        in D.trace (show ((M.greatestAbstract (fst g),snd g))) $ trace2 "Options" (show opts) (s, (e, (m, e2c e)))
     where e2c = M2C.convertGrammar
 	  e2m = case getOptVal opts firstCat of
 		  Just cat -> flip erasing [identC cat]
@@ -57,8 +57,6 @@ convertGFC opts = \g -> let s = g2s g
 		  Just "finite-strict"     -> strict
 		  Just "epsilon"           -> epsilon . nondet
 		  _                        -> nondet
-	  s2fm= S2FM.convertGrammar
-          m2fm= undefined --M2FM.convertGrammar
 	  g2s = case getOptVal opts gfcConversion of
 		  Just "finite"            -> finite . simple
 		  Just "finite2"           -> finite . finite . simple
@@ -82,20 +80,12 @@ gfc2simple opts = fst . convertGFC opts
 gfc2mcfg :: Options -> (CanonGrammar, Ident) -> MGrammar
 gfc2mcfg opts g = mcfg
   where
-    (mcfg, _, _) = snd (snd (convertGFC opts g))
+    (mcfg, _) = snd (snd (convertGFC opts g))
 
 gfc2cfg :: Options -> (CanonGrammar, Ident) -> CGrammar
 gfc2cfg opts g = cfg
   where
-    (_, _, cfg) = snd (snd (convertGFC opts g))
-
-gfc2fcfg :: Options -> (CanonGrammar, Ident) -> FGrammar
-gfc2fcfg opts g = fcfg
-  where
-    (_, fcfg, _) = snd (snd (convertGFC opts g))
-
-mcfg2fcfg :: MGrammar -> FGrammar
-mcfg2fcfg = undefined --M2FM.convertGrammar
+    (_, cfg) = snd (snd (convertGFC opts g))
 
 
 ----------------------------------------------------------------------
diff --git a/src/GF/Conversion/SimpleToFCFG.hs b/src/GF/Conversion/SimpleToFCFG.hs
index fbefd8693..adc517258 100644
--- a/src/GF/Conversion/SimpleToFCFG.hs
+++ b/src/GF/Conversion/SimpleToFCFG.hs
@@ -22,11 +22,10 @@ import GF.Infra.Ident
 import Control.Monad
 
 import GF.Formalism.Utilities
-import GF.Formalism.GCFG 
 import GF.Formalism.FCFG
-import GF.Formalism.SimpleGFC 
 import GF.Conversion.Types
-import GF.Canon.AbsGFC(CIdent(..))
+import GF.Canon.GFCC.AbsGFCC
+import GF.Canon.GFCC.DataGFCC
 
 import GF.Data.BacktrackM
 import GF.Data.SortedList
@@ -36,40 +35,47 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.List as List
 import Data.Array
+import Data.Maybe
 
 ----------------------------------------------------------------------
 -- main conversion function
 
-convertGrammar :: SGrammar -> FGrammar
-convertGrammar srules = getFRules (loop frulesEnv)
+convertGrammar :: Grammar -> [(Ident,FGrammar)]
+convertGrammar g@(Grm hdr (Abs abs_defs) cncs) = [(i2i cncname,convert abs_defs conc) | cncname <- cncnames gfcc, conc <- Map.lookup cncname (concretes gfcc)]
   where
-    (srulesMap,frulesEnv) = List.foldl' helper (Map.empty,emptyFRulesEnv) srules
-      where
-        helper (srulesMap,frulesEnv) rule@(Rule (Abs decl _ _) (Cnc ctype _ _)) = 
-          let srulesMap' = Map.insertWith (++) (decl2cat decl) [rule] srulesMap
-              frulesEnv' = List.foldl' (\env selector -> convertRule selector rule env) 
-                                       frulesEnv
-                                       (mkSingletonSelectors ctype)
-          in srulesMap' `seq` frulesEnv' `seq` (srulesMap',frulesEnv')
-
-    loop frulesEnv =
-      let (todo, frulesEnv') = takeToDoRules srulesMap frulesEnv
-      in case todo of
-           [] -> frulesEnv'
-           _  -> loop $! List.foldl' (\env (srules,selector) -> 
-                         List.foldl' (\env srule             -> convertRule selector srule env) env srules) frulesEnv' todo
+    gfcc = mkGFCC g
 
+    i2i (CId i) = IC i
 
-----------------------------------------------------------------------
--- rule conversion
-
-convertRule :: STermSelector -> SRule -> FRulesEnv -> FRulesEnv
-convertRule selector (Rule (Abs decl decls (Name fun profile)) (Cnc ctype ctypes (Just term))) frulesEnv =
+    convert :: [AbsDef] -> TermMap -> FGrammar
+    convert abs_defs cnc_defs = getFRules (loop frulesEnv)
+      where
+        srules = [(XRule id args res (map findLinType args) (findLinType res) term) | Fun id (Typ args res) exp <- abs_defs, term <- Map.lookup id cnc_defs]
+        
+        findLinType (CId id) = fromJust (Map.lookup (CId ("__"++id)) cnc_defs)
+
+        (srulesMap,frulesEnv) = List.foldl' helper (Map.empty,emptyFRulesEnv) srules
+           where
+	     helper (srulesMap,frulesEnv) rule@(XRule id abs_args abs_res cnc_args cnc_res term) = 
+	       let srulesMap' = Map.insertWith (++) abs_res [rule] srulesMap
+	           frulesEnv' = List.foldl' (\env selector -> convertRule cnc_defs selector rule env)
+	                                    frulesEnv
+	                                    (mkSingletonSelectors cnc_res)
+               in srulesMap' `seq` frulesEnv' `seq` (srulesMap',frulesEnv')
+
+        loop frulesEnv =
+          let (todo, frulesEnv') = takeToDoRules srulesMap frulesEnv
+          in case todo of
+               [] -> frulesEnv'
+               _  -> loop $! List.foldl' (\env (srules,selector) -> 
+                             List.foldl' (\env srule             -> convertRule cnc_defs selector srule env) env srules) frulesEnv' todo
+
+convertRule :: TermMap -> TermSelector -> XRule -> FRulesEnv -> FRulesEnv
+convertRule cnc_defs selector (XRule fun args cat ctypes ctype term) frulesEnv =
   foldBM addRule
          frulesEnv
-         (convertTerm selector term [Lin emptyPath []])
-         (let cat : args = map decl2cat (decl : decls)
-          in (initialFCat cat, map (\scat -> (initialFCat scat,[])) args, ctype, ctypes))
+         (convertTerm cnc_defs selector term [([],[])])
+         (initialFCat cat, map (\scat -> (initialFCat scat,[])) args, ctype, ctypes)
   where
     addRule linRec (newCat', newArgs', _, _) env0 =
       let (env1, newCat)          = genFCatHead env0 newCat'
@@ -79,7 +85,7 @@ convertRule selector (Rule (Abs decl decls (Name fun profile)) (Cnc ctype ctypes
                                        in case fcat of
                                             FCat _ _ [] _ -> (env ,        args,             all_args)
                                             _             -> (env1,xargs1++args,(idx,xargs1):all_args)) (env1,[],[]) (zip3 newArgs' ctypes [0..])
-          
+
           newLinRec = listArray (0,length linRec-1) [translateLin idxArgs path linRec | path <- case newCat of {FCat _ _ rcs _ -> rcs}]
 
           (_,newProfile) = List.mapAccumL accumProf 0 newArgs'
@@ -88,16 +94,15 @@ convertRule selector (Rule (Abs decl decls (Name fun profile)) (Cnc ctype ctypes
               accumProf nr (_            ,xpaths) = (nr+cnt+1, Unify [nr..nr+cnt])
                 where cnt = length xpaths
 
-          rule = FRule (Abs newCat newArgs (Name fun newProfile)) newLinRec
+          rule = FRule (Name fun newProfile) newArgs newCat newLinRec
       in addFCatRule env2 rule
-convertRule selector _ frulesEnv = frulesEnv
 
 translateLin idxArgs lbl' []                    = array (0,-1) []
-translateLin idxArgs lbl' (Lin lbl syms : lins)
+translateLin idxArgs lbl' ((lbl,syms) : lins)
   | lbl' == lbl = listArray (0,length syms-1) (map instSym syms)
   | otherwise   = translateLin idxArgs lbl' lins
   where
-    instSym = symbol (\(_, lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok
+    instSym = symbol (\(lbl, nr, xnr) -> instCat lbl nr xnr 0 idxArgs) FSymTok
     instCat lbl nr xnr nr' ((idx,xargs):idxArgs)
       | nr == idx = let arg@(FCat _ _ rcs _) = xargs !! xnr
                     in FSymCat arg (index lbl rcs 0) (nr'+xnr)
@@ -107,139 +112,115 @@ translateLin idxArgs lbl' (Lin lbl syms : lins)
       | lbl' == lbl = idx
       | otherwise   = index lbl' lbls $! (idx+1)
 
+
 ----------------------------------------------------------------------
 -- term conversion
 
 type CnvMonad a = BacktrackM Env a
 
-type Env    = (FCat, [(FCat,[SPath])], SLinType, [SLinType])
-type LinRec = [Lin SCat SPath Token]
-
-data Lin cat lbl tok = Lin lbl [Symbol (cat, lbl, Int, Int) tok]
-
-
-convertTerm :: STermSelector -> STerm -> LinRec -> CnvMonad LinRec
-convertTerm selector (Arg nr cat path) (Lin lbl_path lin : lins) = convertArg selector nr cat path lbl_path lin lins
-convertTerm selector (con   :^   args) (Lin lbl_path lin : lins) = convertCon selector con args lbl_path lin lins
-convertTerm selector (Rec      record) (Lin lbl_path lin : lins) = convertRec selector record lbl_path lin lins
-convertTerm selector (term  :.    lbl)                     lins  = convertTerm (RecPrj lbl selector) term lins
-convertTerm selector (Tbl       table) (Lin lbl_path lin : lins) = convertTbl selector table  lbl_path lin lins
-convertTerm selector (term  :!    sel)                     lins  = do sel <- evalTerm sel
-                                                                      convertTerm (TblPrj sel selector) term lins
-convertTerm selector (Variants   vars)                     lins  = do term <- member vars
-                                                                      convertTerm selector term lins
-convertTerm selector (t1    :++    t2)                     lins  = do lins <- convertTerm selector t2 lins
-                                                                      lins <- convertTerm selector t1 lins
-                                                                      return lins
-convertTerm selector (Token       str) (Lin lbl_path lin : lins) = do projectHead lbl_path
-                                                                      return (Lin lbl_path (Tok str : lin) : lins)
-convertTerm selector (Empty          ) (Lin lbl_path lin : lins) = do projectHead lbl_path
-                                                                      return (Lin lbl_path lin : lins)
-
-convertArg (RecSel record)  nr cat path lbl_path lin lins =
-  foldM (\lins (lbl,  selector) -> convertArg selector nr cat (path ++. lbl)  (lbl_path ++.  lbl) lin lins) lins record
-convertArg (TblSel cases)   nr cat path lbl_path lin lins =
-  foldM (\lins (term, selector) -> convertArg selector nr cat (path ++! term) (lbl_path ++! term) lin lins) lins cases
-convertArg (RecPrj lbl  selector) nr cat path lbl_path lin lins = 
-  convertArg selector nr cat (path ++. lbl ) lbl_path lin lins
-convertArg (TblPrj term selector) nr cat path lbl_path lin lins = 
-  convertArg selector nr cat (path ++! term) lbl_path lin lins
-convertArg (ConSel terms)   nr cat path lbl_path lin lins = do
-  sel <- member terms
-  restrictHead   lbl_path sel
-  restrictArg nr path sel
+type Env     = (FCat, [(FCat,[FPath])], Term, [Term])
+type LinRec  = [(FPath, [Symbol (FPath, FIndex, Int) Token])]
+
+type TermMap = Map.Map CId Term
+
+convertTerm :: TermMap -> TermSelector -> Term -> LinRec -> CnvMonad LinRec
+convertTerm cnc_defs selector (V nr)       ((lbl_path,lin) : lins) = convertArg selector nr []    lbl_path lin lins
+convertTerm cnc_defs selector (C nr)       ((lbl_path,lin) : lins) = convertCon selector nr       lbl_path lin lins
+convertTerm cnc_defs selector (R record)   ((lbl_path,lin) : lins) = convertRec cnc_defs selector 0 record lbl_path lin lins
+convertTerm cnc_defs selector (P term sel)                   lins  = do nr <- evalTerm cnc_defs [] sel
+                                                                        convertTerm cnc_defs (TuplePrj nr selector) term lins
+convertTerm cnc_defs selector (FV vars)                      lins  = do term <- member vars
+                                                                        convertTerm cnc_defs selector term lins
+convertTerm cnc_defs selector (S ts)       ((lbl_path,lin) : lins) = do projectHead lbl_path
+                                                                        foldM (\lins t -> convertTerm cnc_defs selector t lins) ((lbl_path,lin) : lins) (reverse ts)
+convertTerm cnc_defs selector (KS str)     ((lbl_path,lin) : lins) = do projectHead lbl_path
+                                                                        return ((lbl_path,Tok str : lin) : lins)
+convertTerm cnc_defs selector (KP (str:_)_)((lbl_path,lin) : lins) = do projectHead lbl_path
+                                                                        return ((lbl_path,Tok str : lin) : lins)
+convertTerm cnc_defs selector (RP alias _)                   lins  = convertTerm cnc_defs selector alias lins
+convertTerm cnc_defs selector (F id)                         lins  = do term <- Map.lookup id cnc_defs
+                                                                        convertTerm cnc_defs selector term lins
+convertTerm cnc_defs selector (W s ss)     ((lbl_path,lin) : lins) = convertRec cnc_defs selector 0 [KS (s ++ s1) | s1 <- ss] lbl_path lin lins
+convertTerm cnc_defs selector x lins  = error ("convertTerm ("++show x++")")
+
+
+convertArg (TupleSel record)  nr path lbl_path lin lins =
+  foldM (\lins (lbl,  selector) -> convertArg selector nr (lbl:path)  (lbl:lbl_path) lin lins) lins record
+convertArg (TuplePrj lbl selector) nr path lbl_path lin lins = 
+  convertArg selector nr (lbl:path) lbl_path lin lins
+convertArg (ConSel indices) nr path lbl_path lin lins = do
+  index <- member indices
+  restrictHead lbl_path index
+  restrictArg nr path index
   return lins
-convertArg StrSel          nr cat path lbl_path lin lins = do
+convertArg StrSel nr path lbl_path lin lins = do
   projectHead lbl_path
   xnr <- projectArg nr path
-  return (Lin lbl_path (Cat (cat, path, nr, xnr) : lin) : lins)
+  return ((lbl_path, Cat (path, nr, xnr) : lin) : lins)
 
-convertCon (ConSel terms) con args lbl_path lin lins = do
-  args <- mapM evalTerm args
-  let term = con :^ args
-  guard (term `elem` terms)
-  restrictHead lbl_path term
+convertCon (ConSel indices) index lbl_path lin lins = do
+  guard (index `elem` indices)
+  restrictHead lbl_path index
   return lins
 
-convertRec selector                 []                    lbl_path lin lins = return lins
-convertRec selector@(RecSel fields) ((label, val):record) lbl_path lin lins = select fields
+convertRec cnc_defs selector                   index []           lbl_path lin lins = return lins
+convertRec cnc_defs selector@(TupleSel fields) index (val:record) lbl_path lin lins = select fields
   where
-    select []                          = convertRec selector record lbl_path lin lins
-    select ((label',sub_sel) : fields)
-      | label == label'                = do lins <- convertTerm sub_sel val (Lin (lbl_path ++. label) lin : lins)
-                                            convertRec selector record lbl_path lin lins
+    select []                          = convertRec cnc_defs selector (index+1) record lbl_path lin lins
+    select ((index',sub_sel) : fields)
+      | index == index'                = do lins <- convertTerm cnc_defs sub_sel val ((index:lbl_path,lin) : lins)
+                                            convertRec cnc_defs selector (index+1) record lbl_path lin lins
       | otherwise                      = select fields
-convertRec (RecPrj label sub_sel) record lbl_path lin lins = do
-  (label',val) <- member record
-  guard (label==label')
-  convertTerm sub_sel val (Lin lbl_path lin : lins)
-
-convertTbl selector                []                  lbl_path lin lins = return lins
-convertTbl selector@(TblSel cases) ((term, val):table) lbl_path lin lins = case selector of { TblSel cases -> select cases }
-  where
-    select []                          = convertTbl selector table lbl_path lin lins
-    select ((term',sub_sel)  : cases)
-      | term == term'                  = do lins <- convertTerm sub_sel val (Lin (lbl_path ++! term) lin : lins)
-                                            convertTbl selector table lbl_path lin lins
-      | otherwise                      = select cases
-convertTbl (TblPrj term sub_sel) table lbl_path lin lins = do
-  (term',val) <- member table
-  guard (term==term')
-  convertTerm sub_sel val (Lin lbl_path lin : lins)
+convertRec cnc_defs (TuplePrj index' sub_sel) index record lbl_path lin lins = do
+  convertTerm cnc_defs sub_sel (record !! (fromIntegral (index'-index))) ((lbl_path,lin) : lins)
 
 
 ------------------------------------------------------------
 -- eval a term to ground terms
 
-evalTerm :: STerm -> CnvMonad STerm
-evalTerm arg@(Arg nr _ path) = do ctype <- readArgCType nr
-	                          unifyPType arg $ lintypeFollowPath path ctype
-evalTerm (con :^ terms)      = do terms <- mapM evalTerm terms
-                                  return (con :^ terms)
-evalTerm (Rec record)        = do record <- mapM evalAssign record
-                                  return (Rec record)
-evalTerm (term :. lbl)       = do term <- evalTerm term
-                                  evalTerm (term +. lbl)
-evalTerm (Tbl table)         = do table <- mapM evalCase table
-                                  return (Tbl table)
-evalTerm (term :! sel)       = do sel  <- evalTerm sel
-	                          evalTerm (term +! sel)
-evalTerm (Variants terms)    = member terms >>= evalTerm
-evalTerm (t1 :++ t2)         = do t1 <- evalTerm t1
-                                  t2 <- evalTerm t2
-                                  return (t1 :++ t2)
-evalTerm (Token str)         = do return (Token str)
-evalTerm Empty               = do return Empty
-
-evalAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
-evalAssign (lbl, term) = liftM ((,) lbl) $ evalTerm term
-
-evalCase :: (STerm, STerm) -> CnvMonad (STerm, STerm)
-evalCase (pat, term) = liftM2 (,) (evalTerm pat) (evalTerm term)
-
-unifyPType :: STerm -> SLinType -> CnvMonad STerm
-unifyPType arg (RecT prec) = 
-    liftM Rec $
-    sequence [ liftM ((,) lbl) $
-	       unifyPType (arg +. lbl) ptype |
-	       (lbl, ptype) <- prec ]
-unifyPType (Arg nr _ path) (ConT terms) = 
+evalTerm :: TermMap -> FPath -> Term -> CnvMonad FIndex
+evalTerm cnc_defs path (V nr)       = do term <- readArgCType nr
+                                         unifyPType nr (reverse path) (selectTerm path term)
+evalTerm cnc_defs path (C nr)       = return nr
+evalTerm cnc_defs path (R record)   = case path of
+                                        (index:path) -> evalTerm cnc_defs path (record !! (fromIntegral index))
+evalTerm cnc_defs path (P term sel) = do index <- evalTerm cnc_defs [] sel
+                                         evalTerm cnc_defs (index:path) term
+evalTerm cnc_defs path (FV terms)   = member terms >>= evalTerm cnc_defs path
+evalTerm cnc_defs path (RP alias _) = evalTerm cnc_defs path alias
+evalTerm cnc_defs path (F id)       = do term <- Map.lookup id cnc_defs
+                                         evalTerm cnc_defs path term
+evalTerm cnc_defs path x = error ("evalTerm ("++show x++")")
+
+unifyPType :: FIndex -> FPath -> Term -> CnvMonad FIndex
+unifyPType nr path (C max_index) =
     do (_, args, _, _) <- readState
-       let (FCat _ _ _ tcs,_) = args !! nr
+       let (FCat _ _ _ tcs,_) = args !! (fromIntegral nr)
        case lookup path tcs of
-         Just term -> return term
-         Nothing   -> do term <- member terms
-		         restrictArg nr path term
-		         return term
+         Just index -> return index
+         Nothing    -> do index <- member [0..max_index-1]
+		          restrictArg nr path index
+		          return index
+unifyPType nr path (RP alias _) = unifyPType nr path alias
 
+selectTerm :: FPath -> Term -> Term
+selectTerm []           term        = term
+selectTerm (index:path) (R  record) = selectTerm path (record !! fromIntegral index)
+selectTerm path         (RP _ term) = selectTerm path term
 
 ----------------------------------------------------------------------
 -- FRulesEnv
 
 data FRulesEnv = FRulesEnv {-# UNPACK #-} !Int FCatSet [FRule]
 
-type SRulesMap = Map.Map SCat [SRule]
-type FCatSet = Map.Map SCat (Map.Map [SPath] (Map.Map [(SPath,STerm)] (Either FCat FCat)))
+type XRulesMap = Map.Map CId [XRule]
+data XRule     = XRule CId     {- function -}
+                       [CId]   {- argument types -}
+                       CId     {- result   type  -}
+                       [Term]  {- argument lin-types representation -}
+                       Term    {- result   lin-type  representation -}
+                       Term    {- body -}
+type FCatSet   = Map.Map CId (Map.Map [FPath] (Map.Map [(FPath,FIndex)] (Either FCat FCat)))
 
 
 emptyFRulesEnv = FRulesEnv 0 (ins fcatString (ins fcatInt (ins fcatFloat Map.empty))) []
@@ -266,7 +247,7 @@ genFCatHead env@(FRulesEnv last_id fcatSet rules) m1@(FCat _ cat rcs tcs) =
         tmap_s = Map.singleton tcs x_fcat
         rmap_s = Map.singleton rcs tmap_s
 
-genFCatArg :: SLinType -> FRulesEnv -> FCat -> (FRulesEnv, FCat)
+genFCatArg :: Term -> FRulesEnv -> FCat -> (FRulesEnv, FCat)
 genFCatArg ctype env@(FRulesEnv last_id fcatSet rules) m1@(FCat _ cat rcs tcs) =
   case Map.lookup cat fcatSet >>= Map.lookup rcs of
     Just tmap -> case Map.lookup tcs tmap of
@@ -281,13 +262,13 @@ genFCatArg ctype env@(FRulesEnv last_id fcatSet rules) m1@(FCat _ cat rcs tcs) =
           (x_fcat,last_id1,tmap1,rules1)
                   = foldBM (\tcs st (x_fcat,last_id,tmap,rules) ->
                                    let (last_id1,tmap1,fcat_arg) = addArg tcs last_id tmap
-                                       rule = FRule (Abs fcat  [fcat_arg] coercionName)
+                                       rule = FRule (Name (CId "_") [Unify [0]]) [fcat_arg] fcat
                                                     (listArray (0,length rcs-1) [listArray (0,0) [FSymCat fcat_arg lbl 0] | lbl <- [0..length rcs-1]])
                                    in if st
                                         then (Right fcat,last_id1,tmap1,rule:rules)
                                         else (x_fcat,    last_id,  tmap,     rules))
                            (Left fcat,next_id,Map.insert tcs x_fcat tmap,rules)
-                           (gen_tcs ctype emptyPath [])
+                           (gen_tcs ctype [] [])
                            False
           rmap1 = Map.singleton rcs tmap1
       in (FRulesEnv last_id1 (Map.insertWith (\_ -> Map.insert rcs tmap1) cat rmap1 fcatSet) rules1, fcat)
@@ -300,22 +281,22 @@ genFCatArg ctype env@(FRulesEnv last_id fcatSet rules) m1@(FCat _ cat rcs tcs) =
 	                             fcat    = FCat next_id cat rcs tcs
                                  in (next_id, Map.insert tcs (Left fcat) tmap, fcat)
 
-    gen_tcs :: SLinType -> SPath -> [(SPath,STerm)] -> BacktrackM Bool [(SPath,STerm)]
-    gen_tcs (RecT record)      path acc = foldM (\acc (label,ctype) -> gen_tcs ctype (path ++. label) acc) acc record
-    gen_tcs (TblT terms ctype) path acc = foldM (\acc term          -> gen_tcs ctype (path ++! term ) acc) acc terms
-    gen_tcs (StrT)             path acc = return acc
-    gen_tcs (ConT terms)       path acc =
+    gen_tcs :: Term -> FPath -> [(FPath,FIndex)] -> BacktrackM Bool [(FPath,FIndex)]
+    gen_tcs (R record)    path acc = foldM (\acc (label,ctype) -> gen_tcs ctype (label:path) acc) acc (zip [0..] record)
+    gen_tcs (S _)         path acc = return acc
+    gen_tcs (RP alias _)   path acc = gen_tcs alias path acc
+    gen_tcs (C max_index) path acc =
       case List.lookup path tcs of
-        Just term -> return $! addConstraint path term acc
-        Nothing   -> do writeState True
-                        term <- member terms
-                        return $! addConstraint path term acc
+        Just index -> return $! addConstraint path index acc
+        Nothing    -> do writeState True
+                         index <- member [0..max_index-1]
+                         return $! addConstraint path index acc
       where
-        addConstraint path0 term0 (c@(path,term) : cs)
-	  | path0 >  path = c:addConstraint path0 term0 cs
-        addConstraint path0 term0 cs  = (path0,term0) : cs
+        addConstraint path0 index0 (c@(path,index) : cs)
+	  | path0 > path = c:addConstraint path0 index0 cs
+        addConstraint path0 index0 cs  = (path0,index0) : cs
 
-takeToDoRules :: SRulesMap -> FRulesEnv -> ([([SRule], STermSelector)], FRulesEnv)
+takeToDoRules :: XRulesMap -> FRulesEnv -> ([([XRule], TermSelector)], FRulesEnv)
 takeToDoRules srulesMap (FRulesEnv last_id fcatSet rules) = (todo,FRulesEnv last_id fcatSet' rules)
   where
     (todo,fcatSet') =
@@ -343,97 +324,82 @@ getFRules (FRulesEnv last_id fcatSet rules) = rules
 
 
 ------------------------------------------------------------
--- The STermSelector
-
-data STermSelector
-  = RecSel [(Label, STermSelector)]
-  | TblSel [(STerm, STermSelector)]
-  | RecPrj   Label  STermSelector
-  | TblPrj   STerm  STermSelector
-  | ConSel [STerm]
+-- The TermSelector
+
+data TermSelector
+  = TupleSel [(FIndex, TermSelector)]
+  | TuplePrj   FIndex  TermSelector
+  | ConSel   [FIndex]
   | StrSel
+  deriving Show
 
-mkSingletonSelectors :: SLinType -> [STermSelector]
-mkSingletonSelectors ctype = sels0
+mkSingletonSelectors :: Term               -- ^ Type representation term
+                     -> [TermSelector]     -- ^ list of selectors containing just one string field
+mkSingletonSelectors term = sels0
   where
-    (sels0,tcss0) = loop emptyPath ([],[]) ctype
-    
-    loop path st          (RecT record)      = List.foldl' (\st (lbl,ctype) -> loop (path ++. lbl ) st ctype) st record
-    loop path st          (TblT terms ctype) = List.foldl' (\st term        -> loop (path ++! term) st ctype) st terms
-    loop path (sels,tcss) (ConT terms)       = (                          sels,map ((,) path) terms : tcss)
-    loop path (sels,tcss) (StrT)             = (mkSelector [path] tcss0 : sels,                       tcss)
+    (sels0,tcss0) = loop [] ([],[]) term
 
+    loop path st          (R record) = List.foldl' (\st (index,term) -> loop (index:path) st term) st (zip [0..] record)
+    loop path st          (RP t _)   = loop path st t
+    loop path (sels,tcss) (C i)      = (                          sels,map ((,) path) [0..i-1] : tcss)
+    loop path (sels,tcss) (S _)      = (mkSelector [path] tcss0 : sels,                          tcss)
 
-mkSelector :: [SPath] -> [[(SPath,STerm)]] -> STermSelector
+mkSelector :: [FPath] -> [[(FPath,FIndex)]] -> TermSelector
 mkSelector rcs tcss =
   List.foldl' addRestriction (case xs of
                                 (path:xs) -> List.foldl' addProjection (path2selector StrSel path) xs) ys
   where
-    xs = [ reverse path       |               Path path       <- rcs]
-    ys = [(reverse path,term) | tcs <- tcss, (Path path,term) <- tcs]
+    xs = [ reverse path       |               path       <- rcs]
+    ys = [(reverse path,term) | tcs <- tcss, (path,term) <- tcs]
     
-    addProjection :: STermSelector -> [Either Label STerm] -> STermSelector
-    addProjection StrSel          []                 = StrSel
-    addProjection (RecSel fields) (Left  lbl : path) = RecSel (add fields)
+    addRestriction :: TermSelector -> (FPath,FIndex) -> TermSelector
+    addRestriction (ConSel indices)  ([]          ,n_index) = ConSel (add indices)
       where
-        add []                      = [(lbl,path2selector StrSel path)]
-        add (field@(lbl',sub_sel):fields)
-          | lbl == lbl'             = (lbl',addProjection sub_sel path):fields
-          | otherwise               = field : add fields
-    addProjection (TblSel cases)  (Right pat : path) = TblSel (add cases)
+        add []                      = [n_index]
+        add (index':indices)
+          | n_index == index'       = index':    indices
+          | otherwise               = index':add indices
+    addRestriction (TupleSel fields) (index : path,n_index) = TupleSel (add fields)
       where
-        add []                      = [(pat,path2selector StrSel path)]
-        add (cas@(pat',sub_sel):cases)
-          | pat == pat'             = (pat',addProjection sub_sel path):cases
-          | otherwise               = cas : add cases
+        add []                      = [(index,path2selector (ConSel [n_index]) path)]
+        add (field@(index',sub_sel):fields)
+          | index == index'         = (index',addRestriction sub_sel (path,n_index)):fields
+          | otherwise               = field : add fields
 
-    addRestriction :: STermSelector -> ([Either Label STerm],STerm) -> STermSelector
-    addRestriction (ConSel terms)  ([]              ,term) = ConSel (add terms)
-      where
-        add []                      = [term]
-        add (term':terms)
-          | term == term'           = term':    terms
-          | otherwise               = term':add terms
-    addRestriction (RecSel fields) (Left  lbl : path,term) = RecSel (add fields)
+    addProjection :: TermSelector -> FPath -> TermSelector
+    addProjection StrSel            []             = StrSel
+    addProjection (TupleSel fields) (index : path) = TupleSel (add fields)
       where
-        add []                      = [(lbl,path2selector (ConSel [term]) path)]
-        add (field@(lbl',sub_sel):fields)
-          | lbl == lbl'             = (lbl',addRestriction sub_sel (path,term)):fields
+        add []                      = [(index,path2selector StrSel path)]
+        add (field@(index',sub_sel):fields)
+          | index == index'         = (index',addProjection sub_sel path):fields
           | otherwise               = field : add fields
-    addRestriction (TblSel cases)  (Right pat : path,term) = TblSel (add cases)
-      where
-        add []                      = [(pat,path2selector (ConSel [term]) path)]
-        add (field@(pat',sub_sel):cases)
-          | pat == pat'             = (pat',addRestriction sub_sel (path,term)):cases
-          | otherwise               = field : add cases
-
-    path2selector base []                 = base
-    path2selector base (Left  lbl : path) = RecSel [(lbl,path2selector base path)]
-    path2selector base (Right sel : path) = TblSel [(sel,path2selector base path)]
-
+    
+    path2selector base []             = base
+    path2selector base (index : path) = TupleSel [(index,path2selector base path)]
 
 ------------------------------------------------------------
 -- updating the MCF rule
 
-readArgCType :: Int -> CnvMonad SLinType
-readArgCType arg = do (_, _, _, ctypes) <- readState
-		      return (ctypes !! arg)
+readArgCType :: FIndex -> CnvMonad Term
+readArgCType nr = do (_, _, _, ctypes) <- readState
+		     return (ctypes !! fromIntegral nr)
 
-restrictArg :: Int -> SPath -> STerm -> CnvMonad ()
-restrictArg nr path term = do
+restrictArg :: FIndex -> FPath -> FIndex -> CnvMonad ()
+restrictArg nr path index = do
   (head, args, ctype, ctypes) <- readState 
-  args' <- updateNthM (\(fcat,xs) -> do fcat <- restrictFCat path term fcat
-                                        return (fcat,xs)                   ) nr args
+  args' <- updateNthM (\(fcat,xs) -> do fcat <- restrictFCat path index fcat
+                                        return (fcat,xs)                    ) (fromIntegral nr) args
   writeState (head, args', ctype, ctypes)
 
-projectArg :: Int -> SPath -> CnvMonad Int
+projectArg :: FIndex -> FPath -> CnvMonad Int
 projectArg nr path = do
   (head, args, ctype, ctypes) <- readState
   (xnr,args') <- updateArgs nr args
   writeState (head, args', ctype, ctypes)
   return xnr
   where
-    updateArgs :: Int -> [(FCat,[SPath])] -> CnvMonad (Int,[(FCat,[SPath])])
+    updateArgs :: FIndex -> [(FCat,[FPath])] -> CnvMonad (Int,[(FCat,[FPath])])
     updateArgs 0 ((a@(FCat _ _ rcs _),xpaths) : as)
       | path `elem` rcs = return (length xpaths+1,(a,path:xpaths):as)
       | otherwise       = do a <- projectFCat path a
@@ -442,34 +408,34 @@ projectArg nr path = do
       (xnr,as) <- updateArgs (n-1) as
       return (xnr,a:as)
 
-readHeadCType :: CnvMonad SLinType
+readHeadCType :: CnvMonad Term
 readHeadCType = do (_, _, ctype, _) <- readState
 		   return ctype
 
-restrictHead :: SPath -> STerm -> CnvMonad ()
+restrictHead :: FPath -> FIndex -> CnvMonad ()
 restrictHead path term
     = do (head, args, ctype, ctypes) <- readState
 	 head' <- restrictFCat path term head
 	 writeState (head', args, ctype, ctypes)
 
-projectHead :: SPath -> CnvMonad ()
+projectHead :: FPath -> CnvMonad ()
 projectHead path
     = do (head, args, ctype, ctypes) <- readState
 	 head' <- projectFCat path head
 	 writeState (head', args, ctype, ctypes)
 
-restrictFCat :: SPath -> STerm -> FCat -> CnvMonad FCat
-restrictFCat path0 term0 (FCat id cat rcs tcs) = do
+restrictFCat :: FPath -> FIndex -> FCat -> CnvMonad FCat
+restrictFCat path0 index0 (FCat id cat rcs tcs) = do
   tcs <- addConstraint tcs
   return (FCat id cat rcs tcs)
   where
-    addConstraint (c@(path,term) : cs)
+    addConstraint (c@(path,index) : cs)
         | path0 >  path = liftM (c:) (addConstraint cs)
-        | path0 == path = guard (term0 == term) >>
+        | path0 == path = guard (index0 == index) >>
                           return (c : cs)
-    addConstraint cs    = return ((path0,term0) : cs)
+    addConstraint cs    = return ((path0,index0) : cs)
 
-projectFCat :: SPath -> FCat -> CnvMonad FCat
+projectFCat :: FPath -> FCat -> CnvMonad FCat
 projectFCat path0 (FCat id cat rcs tcs) = do
   return (FCat id cat (addConstraint rcs) tcs)
   where
diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs
index ab0b6a6e8..6285468d5 100644
--- a/src/GF/Conversion/Types.hs
+++ b/src/GF/Conversion/Types.hs
@@ -16,8 +16,8 @@ module GF.Conversion.Types where
 
 import qualified GF.Infra.Ident as Ident (Ident(..), wildIdent, isWildIdent)
 import qualified GF.Canon.AbsGFC as AbsGFC (CIdent(..), Label(..))
+import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC (CId(..))
 import qualified GF.Grammar.Grammar as Grammar (Term)
-import qualified GF.Grammar.Values as Values (cString, cInt, cFloat)
 
 import GF.Formalism.GCFG
 import GF.Formalism.SimpleGFC
@@ -110,19 +110,22 @@ mcat2scat = ecat2scat . mcat2ecat
 ----------------------------------------------------------------------
 -- * fast nonerasing MCFG
 
-type FGrammar = FCFGrammar FCat Name Token
-type FRule    = FCFRule    FCat Name Token
-data FCat     = FCat  {-# UNPACK #-} !Int SCat [SPath] [(SPath,STerm)]
+type FIndex   = Int
+type FPath    = [FIndex]
+type FName    = NameProfile AbsGFCC.CId
+type FGrammar = FCFGrammar FCat FName Token
+type FRule    = FCFRule    FCat FName Token
+data FCat     = FCat  {-# UNPACK #-} !Int AbsGFCC.CId [FPath] [(FPath,FIndex)]
 
-initialFCat :: SCat -> FCat
+initialFCat :: AbsGFCC.CId -> FCat
 initialFCat cat = FCat 0 cat [] []
 
-fcatString = FCat (-1) Values.cString [Path [Left (AbsGFC.L (Ident.IC "s"))]] []
-fcatInt    = FCat (-2) Values.cInt    [Path [Left (AbsGFC.L (Ident.IC "s"))]] []
-fcatFloat  = FCat (-3) Values.cFloat  [Path [Left (AbsGFC.L (Ident.IC "s"))]] []
+fcatString = FCat (-1) (AbsGFCC.CId "String") [[0]] []
+fcatInt    = FCat (-2) (AbsGFCC.CId "Int")    [[0]] []
+fcatFloat  = FCat (-3) (AbsGFCC.CId "Float")  [[0]] []
 
-fcat2scat :: FCat -> SCat
-fcat2scat (FCat _ c _ _) = c
+fcat2cid :: FCat -> AbsGFCC.CId
+fcat2cid (FCat _ c _ _) = c
 
 instance Eq FCat where
   (FCat id1 _ _ _) == (FCat id2 _ _ _) = id1 == id2
@@ -130,6 +133,9 @@ instance Eq FCat where
 instance Ord FCat where
   compare (FCat id1 _ _ _) (FCat id2 _ _ _) = compare id1 id2
 
+instance Print AbsGFCC.CId where
+  prt (AbsGFCC.CId s) = s
+
 ----------------------------------------------------------------------
 -- * CFG
 
@@ -158,8 +164,8 @@ instance Print CCat where
     prt (CCat cat label) = prt cat ++ prt label
 
 instance Print FCat where
-    prt (FCat _ cat rcs tcs) = prt cat ++ "{" ++ 
-			       prtSep ";" ([prt path                    |  path       <- rcs] ++
-			                   [prt path ++ "=" ++ prt term | (path,term) <- tcs])
-			               ++ "}"
+    prt (FCat _ (AbsGFCC.CId cat) rcs tcs) = cat ++ "{" ++ 
+			             prtSep ";" ([prt path                    |  path       <- rcs] ++
+			                         [prt path ++ "=" ++ prt term | (path,term) <- tcs])
+			                 ++ "}"
 
diff --git a/src/GF/FCFG/ToFCFG.hs b/src/GF/FCFG/ToFCFG.hs
index 7e19fefc5..a5ecda214 100644
--- a/src/GF/FCFG/ToFCFG.hs
+++ b/src/GF/FCFG/ToFCFG.hs
@@ -30,8 +30,8 @@ import GF.Infra.Print
 
 
 -- this is the main function used
-printFGrammar :: FCFGrammar FCat Name Token -> String
-printFGrammar = printTree . fgrammar
+printFGrammar :: FCFGrammar FCat FName Token -> String
+printFGrammar = undefined {- printTree . fgrammar
 
 fgrammar :: FCFGrammar FCat Name Token -> F.FGrammar
 fgrammar = F.FGr . map frule
@@ -98,3 +98,4 @@ ident :: Ident -> F.Ident
 ident = F.Ident . prIdent --- is information lost?
 
 constr (C.CIQ m c) = F.CIQ (ident m) (ident c)
+-}
\ No newline at end of file
diff --git a/src/GF/Formalism/FCFG.hs b/src/GF/Formalism/FCFG.hs
index a4923038e..2be442a29 100644
--- a/src/GF/Formalism/FCFG.hs
+++ b/src/GF/Formalism/FCFG.hs
@@ -30,13 +30,13 @@ data FSymbol cat tok
   | FSymTok tok
 
 type FCFGrammar cat name tok = [FCFRule cat name tok]
-data FCFRule    cat name tok = FRule (Abstract cat name) (Array FLabel (Array FPointPos (FSymbol cat tok)))
+data FCFRule    cat name tok = FRule name [cat] cat (Array FLabel (Array FPointPos (FSymbol cat tok)))
 
 ------------------------------------------------------------
 -- pretty-printing
 
 instance (Print c, Print t) => Print (FSymbol c t) where
-    prt (FSymCat c l n) = prt c ++ "[" ++ prt n ++ "," ++ prt l ++ "]"
+    prt (FSymCat c l n) = "($" ++ prt n ++ "!" ++ prt l ++ ")"
     prt (FSymTok t)     = simpleShow (prt t)
       where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
             mkEsc '\\' = "\\\\"
@@ -47,5 +47,6 @@ instance (Print c, Print t) => Print (FSymbol c t) where
     prtList = prtSep " "
 
 instance (Print c, Print n, Print t) => Print (FCFRule n c t) where
-    prt (FRule abs lins) = prt abs ++ " := \n" ++ prtSep "\n" ["  | "++prtSep " " [prt sym | (_,sym) <- assocs syms] | (_,syms) <- assocs lins]
+    prt (FRule name args res lins) = prt name ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
+                                     " =\n   [" ++ prtSep "\n    " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
     prtList = prtSep "\n"
diff --git a/src/GF/Parsing/FCFG.hs b/src/GF/Parsing/FCFG.hs
index f4aa806d5..404bb9950 100644
--- a/src/GF/Parsing/FCFG.hs
+++ b/src/GF/Parsing/FCFG.hs
@@ -23,12 +23,12 @@ import GF.Infra.Print
 ----------------------------------------------------------------------
 -- parsing
 
-parseFCF :: (Print c, Ord c, Print n, Ord n, Print t, Ord t) => String -> Err (FCFParser c n t)
+parseFCF :: (Print c, Ord c, Ord n, Print t, Ord t) => String -> Err (FCFParser c n t)
 parseFCF prs | prs `elem` strategies = Ok $ parseFCF' prs
 	     | otherwise = Bad $ "FCFG parsing strategy not defined: " ++ prs 
 
 strategies = words "bottomup topdown"
 
-parseFCF' :: (Print c, Ord c, Print n, Ord n, Print t, Ord t) => String -> FCFParser c n t
+parseFCF' :: (Print c, Ord c, Ord n, Print t, Ord t) => String -> FCFParser c n t
 parseFCF' "bottomup" pinfo starts toks = Active.parse "b" pinfo starts toks 
 parseFCF' "topdown"  pinfo starts toks = Active.parse "t" pinfo starts toks 
diff --git a/src/GF/Parsing/FCFG/Active.hs b/src/GF/Parsing/FCFG/Active.hs
index 1b6673cd7..48c637e18 100644
--- a/src/GF/Parsing/FCFG/Active.hs
+++ b/src/GF/Parsing/FCFG/Active.hs
@@ -20,6 +20,7 @@ import GF.Formalism.MCFG(Lin(..))
 import GF.Formalism.Utilities
 
 import GF.Infra.Ident
+import GF.Infra.Print
 
 import GF.Parsing.FCFG.Range
 import GF.Parsing.FCFG.PInfo
@@ -34,7 +35,7 @@ import Data.Array
 ----------------------------------------------------------------------
 -- * parsing
 
-parse :: (Ord c, Ord n, Ord t) => String -> FCFParser c n t
+parse :: (Print c, Ord c, Ord n, Print t, Ord t) => String -> FCFParser c n t
 parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo
     where chart = process strategy pinfo toks axioms emptyXChart
           axioms | isBU  strategy = literals pinfo toks ++ initialBU pinfo toks
@@ -47,7 +48,7 @@ isTD  s = s=="t"
 emptyChildren :: RuleId -> FCFPInfo c n t -> SyntaxNode RuleId RangeRec
 emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
   where
-    FRule (Abs _ rhs _) _ = allRules pinfo ! ruleid
+    FRule _ rhs _ _ = allRules pinfo ! ruleid
 
 updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> [SyntaxNode RuleId RangeRec]
 updateChildren (SNode ruleid recs) i rec = do
@@ -59,7 +60,7 @@ updateChildren (SNode ruleid recs) i rec = do
 makeMaxRange (Range _ j) = Range j j
 makeMaxRange EmptyRange  = EmptyRange
 
-process :: (Ord c, Ord n, Ord t) => String -> FCFPInfo c n t -> Input t -> [(c,Item)] -> XChart c -> XChart c
+process :: (Print c, Ord c, Ord n, Print t, Ord t) => String -> FCFPInfo c n t -> Input t -> [(c,Item)] -> XChart c -> XChart c
 process strategy pinfo toks []               chart = chart
 process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks items $! univRule c item chart
   where
@@ -86,22 +87,22 @@ process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks
              then univRule cat (Active          (rng:found)  EmptyRange (lbl+1) 0 node) chart
              else univRule cat (Final  (reverse (rng:found))                      node) chart
       where
-        (FRule (Abs cat _ fn) lins) = allRules pinfo ! ruleid
-        lin            = lins ! lbl
+        (FRule fn _ cat lins) = allRules pinfo ! ruleid
+        lin                   = lins ! lbl
     univRule cat item@(Final found' node) chart =
       case insertXChart chart item cat of
         Nothing    -> chart
         Just chart -> let items = do (Active found rng l ppos node@(SNode ruleid _)) <- lookupXChartAct chart cat
-                                     let FRule _ lins    = allRules pinfo ! ruleid
-                                         FSymCat cat r d = lins ! l ! ppos
+                                     let FRule _ _ _ lins = allRules pinfo ! ruleid
+                                         FSymCat cat r d  = lins ! l ! ppos
                                      rng  <- concatRange rng (found' !! r)
                                      node <- updateChildren node d found'
                                      return (cat, Active found rng l (ppos+1) node)
                                   ++
     			          do guard (isBU strategy)
 			             ruleid <- leftcornerCats pinfo ? cat
-			             let FRule _ lins = allRules pinfo ! ruleid
-			                 FSymCat cat r d = lins ! 0 ! 0
+			             let FRule _ _ _ lins = allRules pinfo ! ruleid
+			                 FSymCat cat r d  = lins ! 0 ! 0
 			             node <- updateChildren (emptyChildren ruleid pinfo) d found'
                                      return (cat, Active [] (found' !! r) 0 1 node)
                       in process strategy pinfo toks items chart
@@ -140,7 +141,7 @@ xchart2syntaxchart :: (Ord c, Ord n, Ord t) => XChart c -> FCFPInfo c n t -> Syn
 xchart2syntaxchart (XChart actives finals) pinfo =
   accumAssoc groupSyntaxNodes $
     [ case node of
-        SNode ruleid rrecs -> let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid
+        SNode ruleid rrecs -> let FRule fun rhs cat _ = allRules pinfo ! ruleid
 		              in ((cat,found), SNode fun (zip rhs rrecs))
         SString s          ->    ((cat,found), SString s)
         SInt    n          ->    ((cat,found), SInt    n)
@@ -171,5 +172,5 @@ initialBU pinfo toks =
     do tok <- aElems (inputToken toks)
        ruleid <- leftcornerTokens pinfo ? tok ++
                  epsilonRules pinfo
-       let FRule (Abs cat _ _) _ = allRules pinfo ! ruleid
+       let FRule _ _ cat _ = allRules pinfo ! ruleid
        return (cat,Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo))
diff --git a/src/GF/Parsing/FCFG/PInfo.hs b/src/GF/Parsing/FCFG/PInfo.hs
index 9cc0975b2..c87f0b15c 100644
--- a/src/GF/Parsing/FCFG/PInfo.hs
+++ b/src/GF/Parsing/FCFG/PInfo.hs
@@ -87,18 +87,18 @@ buildFCFPInfo lexer grammar =
 	     }
 
     where allrules = listArray (0,length grammar-1) grammar
-	  topdownrules  = accumAssoc id [(cat,  ruleid) | (ruleid, FRule (Abs cat _ _)  _) <- assocs allrules]
-	  -- emptyrules    = [ruleid | (ruleid, FRule (Abs _ [] _) _) <- assocs allrules]
-	  epsilonrules  = [ ruleid | (ruleid, FRule _ lins) <- assocs allrules,
+	  topdownrules  = accumAssoc id [(cat,  ruleid) | (ruleid, FRule _ _ cat _) <- assocs allrules]
+	  -- emptyrules    = [ruleid | (ruleid, FRule _ [] _ _) <- assocs allrules]
+	  epsilonrules  = [ ruleid | (ruleid, FRule _ _ _ lins) <- assocs allrules,
                             not (inRange (bounds (lins ! 0)) 0) ]
 	  leftcorncats  = accumAssoc id
 			  [ (fromJust (getLeftCornerCat lins), ruleid) | 
-			    (ruleid, FRule _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
+			    (ruleid, FRule _ _ _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
 	  leftcorntoks  = accumAssoc id 
 			  [ (fromJust (getLeftCornerTok lins), ruleid) | 
-			    (ruleid, FRule _ lins) <- assocs allrules, isJust (getLeftCornerTok lins) ]
+			    (ruleid, FRule _ _ _ lins) <- assocs allrules, isJust (getLeftCornerTok lins) ]
 	  grammarcats   = aElems topdownrules
-	  grammartoks   = nubsort [t | (FRule _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]
+	  grammartoks   = nubsort [t | (FRule _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]
 
 ----------------------------------------------------------------------
 -- pretty-printing of statistics
diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs
index d4eaffb56..e1d0d298b 100644
--- a/src/GF/Parsing/GFC.hs
+++ b/src/GF/Parsing/GFC.hs
@@ -24,6 +24,7 @@ import GF.Data.Operations (Err(..))
 import qualified GF.Grammar.Grammar as Grammar
 import qualified GF.Grammar.Macros as Macros
 import qualified GF.Canon.AbsGFC as AbsGFC
+import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC
 import qualified GF.Infra.Ident as Ident
 import GF.CF.CFIdent (CFCat, cfCat2Ident, CFTok, wordsCFTok)
 
@@ -49,7 +50,7 @@ data PInfo = PInfo { mcfPInfo :: MCFPInfo
 		   }
 
 type MCFPInfo = PM.MCFPInfo MCat Name MLabel Token
-type FCFPInfo = PF.FCFPInfo FCat Name Token
+type FCFPInfo = PF.FCFPInfo FCat FName Token
 type CFPInfo  = PC.CFPInfo CCat Name Token
 
 buildPInfo :: MGrammar -> FGrammar -> CGrammar -> PInfo
@@ -128,17 +129,33 @@ selectParser "m" strategy pinfo startCat inTokens
 -- parsing via FCFG
 selectParser "f" strategy pinfo startCat inTokens
     = do let startCats = filter isStart $ PF.grammarCats fcfpi
-	     isStart cat = fcat2scat cat == cfCat2Ident startCat
+	     isStart cat = cat' == cfCat2Ident startCat
+	       where AbsGFCC.CId x = fcat2cid cat
+	             cat'          = Ident.IC x
 	     fcfpi = fcfPInfo pinfo
 	 fcfParser <- PF.parseFCF strategy
 	 let chart = fcfParser fcfpi startCats inTokens
 	     (i,j) = inputBounds inTokens
 	     finalEdges = [PF.makeFinalEdge cat i j | cat <- startCats]
-	 return $ chart2forests chart (const False) finalEdges
+	 return $ map cnv_forests $ chart2forests chart (const False) finalEdges
 
 -- error parser: 
 selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy 
 
+cnv_forests FMeta         = FMeta
+cnv_forests (FNode (Name (AbsGFCC.CId n) p) fss) = FNode (Name (Ident.IC n) (map cnv_profile p)) (map (map cnv_forests) fss)
+cnv_forests (FString x)   = FString x
+cnv_forests (FInt    x)   = FInt    x
+cnv_forests (FFloat  x)   = FFloat  x
+
+cnv_profile (Unify    x) = Unify x
+cnv_profile (Constant x) = Constant (cnv_forests2 x)
+
+cnv_forests2 FMeta         = FMeta
+cnv_forests2 (FNode (AbsGFCC.CId n) fss) = FNode (Ident.IC n) (map (map cnv_forests2) fss)
+cnv_forests2 (FString x)   = FString x
+cnv_forests2 (FInt    x)   = FInt    x
+cnv_forests2 (FFloat  x)   = FFloat  x
 
 ----------------------------------------------------------------------
 -- parse trees to GF terms
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index b1b3995b8..6737247ef 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -298,7 +298,6 @@ customGrammarPrinter =
   ,(strCI "mcfg",     \_ -> Prt.prt . stateMCFG)
   ,(strCI "fcfg",     \_ -> Prt.prt . stateFCFG)
   ,(strCI "bfcfg",    \_ -> printFGrammar . stateFCFG)
-  ,(strCI "mcfg2fcfg",\_ -> Prt.prt . Cnv.mcfg2fcfg . stateMCFG)
   ,(strCI "cfg",      \_ -> Prt.prt . stateCFG)
   ,(strCI "pinfo",    \_ -> Prt.prt . statePInfo)
   ,(strCI "abstract", \_ -> Prt.prtAfter "\n" . Cnv.gfc2abstract . stateGrammarLang)