gf works with the new gfcc format

2007-10-05 12:54:29 +00:00
parent 945a49214b
commit 48623470cd
12 changed files with 118 additions and 185 deletions
--- a/src/GF/Canon/CanonToGFCC.hs
+++ b/src/GF/Canon/CanonToGFCC.hs
@@ -19,8 +19,12 @@ import GF.Canon.AbsGFC
 import qualified GF.Canon.GFC as GFC
 import qualified GF.Canon.Look as Look
 import qualified GF.Canon.Subexpressions as Sub
-import qualified GF.Canon.GFCC.AbsGFCC as C
-import qualified GF.Canon.GFCC.PrintGFCC as Pr
+
+import qualified GF.GFCC.Macros as CM
+import qualified GF.GFCC.AbsGFCC as C
+import qualified GF.GFCC.DataGFCC as D
+import GF.GFCC.OptimizeGFCC
+
 import GF.Canon.GFC
 import GF.Canon.Share
 import qualified GF.Grammar.Abstract as A
@@ -42,56 +46,71 @@ import Debug.Trace ----
 -- the main function: generate GFCC from GFCM.

 prCanon2gfcc :: CanonGrammar -> String
-prCanon2gfcc = Pr.printTree . mkCanon2gfcc
+prCanon2gfcc = D.printGFCC . mkCanon2gfcc

 -- this variant makes utf8 conversion; used in back ends
-mkCanon2gfcc :: CanonGrammar -> C.Grammar
-mkCanon2gfcc = canon2gfcc . reorder . utf8Conv . canon2canon . normalize
+mkCanon2gfcc :: CanonGrammar -> D.GFCC
+mkCanon2gfcc = 
+-- canon2gfcc . reorder abs . utf8Conv . canon2canon abs
+  optGFCC . canon2gfcc . reorder . utf8Conv . canon2canon . normalize

 -- this variant makes no utf8 conversion; used in ShellState
-mkCanon2gfccNoUTF8 :: CanonGrammar -> C.Grammar
-mkCanon2gfccNoUTF8 = canon2gfcc . reorder . canon2canon . normalize
+mkCanon2gfccNoUTF8 :: CanonGrammar -> D.GFCC
+mkCanon2gfccNoUTF8 = optGFCC . canon2gfcc . reorder . canon2canon . normalize

-- This is needed to reorganize the grammar. GFCC has its own back-end optimization.
+-- This is needed to reorganize the grammar. 
+-- GFCC has its own back-end optimization.
 -- But we need to have the canonical order in tables, created by valOpt
 normalize :: CanonGrammar -> CanonGrammar
 normalize = share . unoptimizeCanon . Sub.unSubelimCanon where
  share = M.MGrammar . map (shareModule valOpt) . M.modules --- allOpt

 -- Generate GFCC from GFCM.
-- this assumes a grammar translated by canon2canon
+-- this assumes a grammar normalized and transformed by canon2canon

-canon2gfcc :: CanonGrammar -> C.Grammar
+canon2gfcc :: CanonGrammar -> D.GFCC
 canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = 
-     C.Grm (C.Hdr (i2i a) cs) (C.Abs adefs) cncs where
-  cs  = map (i2i . fst) cms
-  adefs = [C.Fun f' (mkType ty) (C.Tr (C.AC f') []) | 
-            (f,GFC.AbsFun ty _) <- tree2list (M.jments abm), let f' = i2i f]
-  cncs  = [C.Cnc (i2i lang) (concr m) | (lang,M.ModMod m) <- cms]
-  concr mo = cats mo ++ lindefs mo ++ 
-               optConcrete 
-                 [C.Lin (i2i f) (mkTerm tr) | 
-                   (f,GFC.CncFun _ _ tr _) <- tree2list (M.jments mo)]
-  cats mo = [C.Lin (i2ic c) (mkCType ty) | 
-                   (c,GFC.CncCat ty _ _) <- tree2list (M.jments mo)]
-  lindefs mo = [C.Lin (i2id c) (mkTerm tr) | 
-                   (c,GFC.CncCat _ tr _) <- tree2list (M.jments mo)]
+     D.GFCC an cns abs cncs 
+ where
+  an  = (i2i a)
+  cns = map (i2i . fst) cms
+  abs = D.Abstr aflags funs cats catfuns
+  aflags = Map.fromAscList [] ---- flags
+  lfuns = [(f', (mkType ty,CM.primNotion)) | ---- defs 
+             (f,GFC.AbsFun ty _) <- tree2list (M.jments abm), let f' = i2i f]
+  funs = Map.fromAscList lfuns
+  lcats = [(i2i c,[]) | ---- context
+            (c,GFC.AbsCat _ _) <- tree2list (M.jments abm)]
+  cats = Map.fromAscList lcats
+  catfuns = Map.fromAscList 
+    [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
+
+  cncs  = Map.fromList [mkConcr (i2i lang) mo | (lang,M.ModMod mo) <- cms]
+  mkConcr lang mo = (lang,D.Concr flags lins opers lincats lindefs printnames)
+    where
+      flags   = Map.fromAscList [] ---- flags
+      opers   = Map.fromAscList [] -- opers will be created as optimization
+      lins    = Map.fromAscList 
+        [(i2i f, mkTerm tr) | (f,GFC.CncFun _ _ tr _) <- tree2list (M.jments mo)]
+      lincats = Map.fromAscList 
+        [(i2i c, mkCType ty) | (c,GFC.CncCat ty _ _) <- tree2list (M.jments mo)]
+      lindefs = Map.fromAscList 
+        [(i2i c, mkTerm tr) | (c,GFC.CncCat _ tr _) <- tree2list (M.jments mo)]
+      printnames = Map.fromAscList [] ---- printnames

 i2i :: Ident -> C.CId
 i2i (IC c) = C.CId c
-i2ic (IC c) = C.CId ("__" ++ c) -- for lincat of category symbols
-i2id (IC c) = C.CId ("_d" ++ c) -- for lindef of category symbols

 mkType :: A.Type -> C.Type
 mkType t = case GM.catSkeleton t of
-  Ok (cs,c) -> C.Typ (map (i2i . snd) cs) (i2i $ snd c)
+  Ok (cs,c) -> CM.cftype (map (i2i . snd) cs) (i2i $ snd c)

 mkCType :: CType -> C.Term
 mkCType t = case t of
  TInts i      -> C.C $ fromInteger i
  -- record parameter alias - created in gfc preprocessing
  RecType [Lbg (L (IC "_")) i, Lbg (L (IC "__")) t] -> C.RP (mkCType i) (mkCType t)
-  RecType rs     -> C.R [mkCType t | Lbg _ t <- rs]
+  RecType rs  -> C.R [mkCType t | Lbg _ t <- rs]
  Table pt vt -> C.R $ replicate (getI (mkCType pt)) $ mkCType vt
  TStr     -> C.S []
 where
@@ -109,9 +128,6 @@ mkTerm tr = case tr of
  R rs     -> C.R [mkTerm t | Ass _ t <- rs]
  P t l    -> C.P (mkTerm t) (C.C (mkLab l))

-  LI x     -> C.BV $ i2i x
-  T _ [Cas [PV x] t] -> C.L (i2i x) (mkTerm t)
-
  T _ cs   -> error $ "improper optimization for gfcc in" +++ A.prt tr
  V _ cs   -> C.R [mkTerm t | t <- cs]
  S t p    -> C.P (mkTerm t) (mkTerm p)
@@ -401,102 +417,3 @@ unlockTyp = filter notlock where
 prtTrace tr n = n ----trace ("-- ERROR" +++ A.prt tr +++ show n +++ show tr) n
 prTrace  tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n

-- back-end optimization: 
-- suffix analysis followed by common subexpression elimination
-
-optConcrete :: [C.CncDef] -> [C.CncDef]
-optConcrete defs = subex 
-  [C.Lin f (optTerm t) | C.Lin f t <- defs]
-
-- analyse word form lists into prefix + suffixes
-- suffix sets can later be shared by subex elim
-
-optTerm :: C.Term -> C.Term  
-optTerm tr = case tr of
-    C.R ts@(_:_:_) | all isK ts -> mkSuff $ optToks [s | C.K (C.KS s) <- ts]
-    C.R ts  -> C.R $ map optTerm ts
-    C.P t v -> C.P (optTerm t) v
-    C.L x t -> C.L x (optTerm t)
-    _ -> tr
- where
-  optToks ss = prf : suffs where
-    prf = pref (head ss) (tail ss)
-    suffs = map (drop (length prf)) ss
-    pref cand ss = case ss of
-      s1:ss2 -> if isPrefixOf cand s1 then pref cand ss2 else pref (init cand) ss
-      _ -> cand
-  isK t = case t of
-    C.K (C.KS _) -> True
-    _ -> False
-  mkSuff ("":ws) = C.R (map (C.K . C.KS) ws)
-  mkSuff (p:ws) = C.W p (C.R (map (C.K . C.KS) ws))
-
-
-- common subexpression elimination; see ./Subexpression.hs for the idea
-
-subex :: [C.CncDef] -> [C.CncDef]
-subex js = errVal js $ do
-  (tree,_) <- appSTM (getSubtermsMod js) (Map.empty,0)
-  return $ addSubexpConsts tree js
-
-type TermList = Map.Map C.Term (Int,Int) -- number of occs, id
-type TermM a = STM (TermList,Int) a
-
-addSubexpConsts :: TermList -> [C.CncDef] -> [C.CncDef]
-addSubexpConsts tree lins =
-  let opers = sortBy (\ (C.Lin f _) (C.Lin g _) -> compare f g)
-                [C.Lin (fid id) trm | (trm,(_,id)) <- list]
-  in map mkOne $ opers ++ lins
- where
-   mkOne (C.Lin f trm) = (C.Lin f (recomp f trm))
-   recomp f t = case Map.lookup t tree of
-     Just (_,id) | fid id /= f -> C.F $ fid id -- not to replace oper itself
-     _ -> case t of
-       C.R ts   -> C.R $ map (recomp f) ts
-       C.S ts   -> C.S $ map (recomp f) ts
-       C.W s t  -> C.W s (recomp f t)
-       C.P t p  -> C.P (recomp f t) (recomp f p)
-       C.RP t p -> C.RP (recomp f t) (recomp f p)
-       C.L x t  -> C.L x (recomp f t)
-       _ -> t
-   fid n = C.CId $ "_" ++ show n
-   list = Map.toList tree
-
-getSubtermsMod :: [C.CncDef] -> TermM TermList
-getSubtermsMod js = do
-  mapM (getInfo collectSubterms) js
-  (tree0,_) <- readSTM
-  return $ Map.filter (\ (nu,_) -> nu > 1) tree0
- where
-   getInfo get (C.Lin f trm) = do
-     get trm
-     return ()
-
-collectSubterms :: C.Term -> TermM ()
-collectSubterms t = case t of
-  C.R ts -> do
-    mapM collectSubterms ts
-    add t
-  C.RP u v -> do
-    collectSubterms v
-    add t
-  C.S ts -> do
-    mapM collectSubterms ts
-    add t
-  C.W s u -> do
-    collectSubterms u
-    add t
-  C.P p u -> do
-    collectSubterms p
-    collectSubterms u
-    add t
-  _ -> return ()
- where
-   add t = do
-     (ts,i) <- readSTM
-     let 
-       ((count,id),next) = case Map.lookup t ts of
-         Just (nu,id) -> ((nu+1,id), i)
-         _ ->            ((1,   i ), i+1)
-     writeSTM (Map.insert t (count,id) ts, next)
-
--- a/src/GF/Canon/CanonToJS.hs
+++ b/src/GF/Canon/CanonToJS.hs
@@ -5,13 +5,16 @@ import GF.Canon.CanonToGFCC
 import GF.Canon.Look
 import GF.Data.ErrM
 import GF.Infra.Option
-import qualified GF.Canon.GFCC.AbsGFCC as C
+import qualified GF.GFCC.Macros as M
+import qualified GF.GFCC.DataGFCC as D
+import qualified GF.GFCC.AbsGFCC as C
 import qualified GF.JavaScript.AbsJS as JS
 import qualified GF.JavaScript.PrintJS as JS


 import Control.Monad (mplus)
 import Data.Maybe (fromMaybe)
+import qualified Data.Map as Map

 prCanon2js :: Options -> CanonGrammar -> String
 prCanon2js opts gr = gfcc2js start $ mkCanon2gfcc gr
@@ -20,29 +23,37 @@ prCanon2js opts gr = gfcc2js start $ mkCanon2gfcc gr
                           `mplus` getOptVal grOpts gStartCat)
    grOpts = errVal noOptions $ lookupOptionsCan gr

-gfcc2js :: String -> C.Grammar -> String
-gfcc2js start (C.Grm (C.Hdr n _) as cs) = 
-  JS.printTree $ JS.Program $ abstract2js start n as ++ concatMap (concrete2js n) cs
+gfcc2js :: String -> D.GFCC -> String
+gfcc2js start gfcc =
+  JS.printTree $ JS.Program $ abstract2js start n as ++ 
+  concatMap (concrete2js n) cs
+ where
+   n  = D.absname gfcc
+   as = D.abstract gfcc
+   cs = Map.assocs (D.concretes gfcc)

-abstract2js :: String -> C.CId -> C.Abstract -> [JS.Element]
-abstract2js start (C.CId n) (C.Abs ds) = 
+abstract2js :: String -> C.CId -> D.Abstr -> [JS.Element]
+abstract2js start (C.CId n) ds = 
    [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit a (new "Abstract" [JS.EStr start])]] 
-    ++ concatMap (absdef2js a) ds
+    ++ concatMap (absdef2js a) (Map.assocs (D.funs ds))
  where a = JS.Ident n

-absdef2js :: JS.Ident -> C.AbsDef -> [JS.Element]
-absdef2js a (C.Fun (C.CId f) (C.Typ args (C.CId cat)) _) = 
+absdef2js :: JS.Ident -> (C.CId,(C.Type,C.Exp)) -> [JS.Element]
+absdef2js a (C.CId f,(typ,_)) =
+  let (args,C.CId cat) = M.catSkeleton typ in 
    [JS.ElStmt $ JS.SDeclOrExpr $ JS.DExpr $ JS.ECall (JS.EMember (JS.EVar a) (JS.Ident "addType")) 
           [JS.EStr f, JS.EArray [JS.EStr x | C.CId x <- args], JS.EStr cat]]

-concrete2js :: C.CId -> C.Concrete -> [JS.Element]
-concrete2js (C.CId a) (C.Cnc (C.CId c) ds) = 
+concrete2js :: C.CId -> (C.CId,D.Concr) -> [JS.Element]
+concrete2js (C.CId a) (C.CId c, cnc) =
    [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit l (new "Concrete" [JS.EVar (JS.Ident a)])]] 
    ++ concatMap (cncdef2js l) ds
-  where l = JS.Ident c
+  where 
+   l  = JS.Ident c
+   ds = Map.assocs $ D.lins cnc

-cncdef2js :: JS.Ident -> C.CncDef -> [JS.Element]
-cncdef2js l (C.Lin (C.CId f) t) = 
+cncdef2js :: JS.Ident -> (C.CId,C.Term) -> [JS.Element]
+cncdef2js l (C.CId f, t) = 
    [JS.ElStmt $ JS.SDeclOrExpr $ JS.DExpr $ JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "addRule")) [JS.EStr f, JS.EFun [children] [JS.SReturn (term2js l t)]]]

 term2js :: JS.Ident -> C.Term -> JS.Expr
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -17,8 +17,8 @@ module GF.Compile.ShellState where
 import GF.Data.Operations
 import GF.Canon.GFC
 import GF.Canon.AbsGFC
-import GF.Canon.GFCC.AbsGFCC(CId(CId))
-import GF.Canon.GFCC.DataGFCC(mkGFCC)
+import GF.GFCC.AbsGFCC(CId(CId))
+--import GF.GFCC.DataGFCC(mkGFCC)
 import GF.Canon.CanonToGFCC as C2GFCC
 import GF.Grammar.Macros
 import GF.Grammar.MMacros
@@ -264,7 +264,7 @@ updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do
  let fromGFC       = snd . snd . Cnv.convertGFC opts
      (mcfgs, cfgs) = unzip $ map (curry fromGFC cgr) concrs
      fcfgs0        = [(IC id,g) | (CId id,g) <- 
-        FCnv.convertGrammar (mkGFCC (C2GFCC.mkCanon2gfccNoUTF8 cgr))]
+        FCnv.convertGrammar (C2GFCC.mkCanon2gfccNoUTF8 cgr)]
      fcfgs         = [(c,g) | c <- concrs, Just g <- [lookup c fcfgs0]]
      pInfos        = zipWith3 Prs.buildPInfo mcfgs (map snd fcfgs) cfgs
      
--- a/src/GF/Conversion/SimpleToFCFG.hs
+++ b/src/GF/Conversion/SimpleToFCFG.hs
@@ -21,8 +21,10 @@ import Control.Monad

 import GF.Formalism.Utilities
 import GF.Formalism.FCFG
-import GF.Canon.GFCC.AbsGFCC
-import GF.Canon.GFCC.DataGFCC
+
+import GF.GFCC.Macros hiding (prt)
+import GF.GFCC.DataGFCC
+import GF.GFCC.AbsGFCC

 import GF.Data.BacktrackM
 import GF.Data.SortedList
@@ -38,21 +40,24 @@ import Data.Maybe
 -- main conversion function

 convertGrammar :: GFCC -> [(CId,FGrammar)]
-convertGrammar gfcc = [(cncname,convert abs_defs conc) | 
-    cncname <- cncnames gfcc, conc <- Map.lookup cncname (concretes gfcc)]
+convertGrammar gfcc = [(cncname,convert abs_defs conc cats) | 
+    cncname <- cncnames gfcc, 
+    cnc <- Map.lookup cncname (concretes gfcc),
+    let conc = Map.union (opers cnc) (lins cnc), -- "union big+small most efficient"
+    let cats = lincats cnc]
  where

    abs_defs = Map.assocs (funs (abstract gfcc))

-    convert :: [(CId,Type)] -> TermMap -> FGrammar
-    convert abs_defs cnc_defs = getFRules (loop frulesEnv)
+    convert :: [(CId,(Type,Exp))] -> TermMap -> TermMap -> FGrammar
+    convert abs_defs cnc_defs cat_defs = getFRules (loop frulesEnv)
      where
        srules = [
          (XRule id args res (map findLinType args) (findLinType res) term) | 
-            (id, Typ args res) <- abs_defs, 
+            (id, (ty,_)) <- abs_defs, let (args,res) = catSkeleton ty, 
            term <- Map.lookup id cnc_defs]
        
-        findLinType (CId id) = fromJust (Map.lookup (CId ("__"++id)) cnc_defs)
+        findLinType id = fromJust (Map.lookup id cat_defs)

        (srulesMap,frulesEnv) = List.foldl' helper (Map.empty,emptyFRulesEnv) srules
           where
@@ -128,9 +133,6 @@ convertTerm cnc_defs selector (V nr)       ((lbl_path,lin) : lins) = convertArg
 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 (R ts)) lins = 
----  convertTerm cnc_defs selector (foldl P term ts) lins  ---- ?? AR 2/10/2007
-
 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
@@ -169,7 +171,7 @@ convertArg (ConSel indices) nr path lbl_path lin lins = do
 convertArg StrSel nr path lbl_path lin lins = do
  projectHead lbl_path
  xnr <- projectArg nr path
-  return ((lbl_path, Cat (path, nr, xnr) : lin) : lins)
+  return ((lbl_path, GF.Formalism.Utilities.Cat (path, nr, xnr) : lin) : lins)

 convertCon (ConSel indices) index lbl_path lin lins = do
  guard (index `elem` indices)
--- a/src/GF/Devel/GFC.hs
+++ b/src/GF/Devel/GFC.hs
@@ -2,7 +2,7 @@ module Main where

 import GF.Devel.Compile
 import GF.Devel.GrammarToGFCC
-import GF.Devel.OptimizeGFCC
+import GF.GFCC.OptimizeGFCC
 import GF.GFCC.CheckGFCC
 import GF.GFCC.DataGFCC
 import GF.Devel.UseIO
--- a/src/GF/Formalism/FCFG.hs
+++ b/src/GF/Formalism/FCFG.hs
@@ -39,7 +39,7 @@ import Data.List (groupBy)
 import Data.Array

 import GF.Formalism.Utilities
-import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC
+import qualified GF.GFCC.AbsGFCC as AbsGFCC
 import GF.Infra.PrintClass


--- a/src/GF/Devel/OptimizeGFCC.hs
+++ b/src/GF/Devel/OptimizeGFCC.hs
@@ -1,4 +1,4 @@
-module GF.Devel.OptimizeGFCC where
+module GF.GFCC.OptimizeGFCC where

 import GF.GFCC.AbsGFCC
 import GF.GFCC.DataGFCC
--- a/src/GF/Parsing/FCFG.hs
+++ b/src/GF/Parsing/FCFG.hs
@@ -21,8 +21,9 @@ import GF.Formalism.Utilities
 import qualified GF.Parsing.FCFG.Active as Active
 import GF.Parsing.FCFG.PInfo

-import GF.Canon.GFCC.AbsGFCC
-import GF.Canon.GFCC.ErrM
+import GF.GFCC.AbsGFCC
+import GF.GFCC.Macros
+import GF.GFCC.ErrM


 ----------------------------------------------------------------------
@@ -74,12 +75,12 @@ cnv_forests2 (FFloat  x)   = FFloat  x
 -- parse trees to GFCC terms

 tree2term :: SyntaxTree CId -> Exp
-tree2term (TNode f ts) = Tr (AC f) (map tree2term ts)
+tree2term (TNode f ts) = tree (AC f) (map tree2term ts)

-tree2term (TString  s) = Tr (AS s) []
-tree2term (TInt     n) = Tr (AI n) []
-tree2term (TFloat   f) = Tr (AF f) []
-tree2term (TMeta)      = Tr AM []
+tree2term (TString  s) = tree (AS s) []
+tree2term (TInt     n) = tree (AI n) []
+tree2term (TFloat   f) = tree (AF f) []
+tree2term (TMeta)      = exp0

 ----------------------------------------------------------------------
 -- conversion and unification of forests
--- a/src/GF/Parsing/GFC.hs
+++ b/src/GF/Parsing/GFC.hs
@@ -24,8 +24,8 @@ 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.Canon.GFCC.ErrM as ErrM
+import qualified GF.GFCC.AbsGFCC as AbsGFCC
+import qualified GF.GFCC.ErrM as ErrM
 import qualified GF.Infra.Ident as Ident
 import GF.CF.CFIdent (CFCat, cfCat2Ident, CFTok, wordsCFTok, prCFTok)

@@ -169,14 +169,15 @@ tree2term abs (TFloat   f) = Macros.float2term  f
 tree2term abs (TMeta)      = Macros.mkMeta 0

 exp2term :: Ident.Ident -> AbsGFCC.Exp -> Grammar.Term
-exp2term abs (AbsGFCC.Tr a es) = Macros.mkApp (atom2term abs a) (map (exp2term abs) es)
+exp2term abs (AbsGFCC.DTr _ a es) =  ---- TODO: bindings
+  Macros.mkApp (atom2term abs a) (map (exp2term abs) es)

 atom2term :: Ident.Ident -> AbsGFCC.Atom -> Grammar.Term
 atom2term abs (AbsGFCC.AC (AbsGFCC.CId f)) = Macros.qq (abs,Ident.IC f)
 atom2term abs (AbsGFCC.AS s) = Macros.string2term s
 atom2term abs (AbsGFCC.AI n) = Macros.int2term    n
 atom2term abs (AbsGFCC.AF f) = Macros.float2term  f
-atom2term abs AbsGFCC.AM     = Macros.mkMeta 0
+atom2term abs (AbsGFCC.AM i) = Macros.mkMeta (fromInteger i)

 ----------------------------------------------------------------------
 -- conversion and unification of forests
--- a/src/GF/Speech/GrammarToVoiceXML.hs
+++ b/src/GF/Speech/GrammarToVoiceXML.hs
@@ -11,9 +11,9 @@
 module GF.Speech.GrammarToVoiceXML (grammar2vxml) where

 import GF.Canon.CanonToGFCC (mkCanon2gfcc)
-import qualified GF.Canon.GFCC.AbsGFCC as C
-import GF.Canon.GFCC.DataGFCC (GFCC(..), Abstr(..), mkGFCC, lookMap)
-
+import qualified GF.GFCC.AbsGFCC as C
+import GF.GFCC.DataGFCC (GFCC(..), Abstr(..), mkGFCC)
+import GF.GFCC.Macros
 import qualified GF.Canon.GFC as GFC
 import GF.Canon.AbsGFC (Term)
 import GF.Canon.PrintGFC (printTree)
@@ -65,14 +65,14 @@ prid :: VIdent -> String
 prid (C.CId x) = x

 vSkeleton :: GFC.CanonGrammar -> (VIdent,VSkeleton)
-vSkeleton = gfccSkeleton . mkGFCC . mkCanon2gfcc
+vSkeleton = gfccSkeleton . mkCanon2gfcc

 gfccSkeleton :: GFCC -> (VIdent,VSkeleton)
 gfccSkeleton gfcc = (absname gfcc, ts)
  where a = abstract gfcc
-        ts = [(c,[(f,ft f) | f <- fs]) | (c,fs) <- Map.toList (cats a)]
+        ts = [(c,[(f,ft f) | f <- fs]) | (c,fs) <- Map.toList (catfuns a)]
        ft f = case lookMap (error $ prid f) f (funs a) of
-                 C.Typ args _ -> args
+                 (ty,_) -> fst $ GF.GFCC.Macros.catSkeleton ty

 --
 -- * Questions to ask 
--- a/src/GF/Speech/TransformCFG.hs
+++ b/src/GF/Speech/TransformCFG.hs
@@ -17,8 +17,9 @@
 module GF.Speech.TransformCFG where

 import GF.Canon.CanonToGFCC (mkCanon2gfcc)
-import qualified GF.Canon.GFCC.AbsGFCC as C
-import GF.Canon.GFCC.DataGFCC (GFCC, mkGFCC, lookType)
+import qualified GF.GFCC.AbsGFCC as C
+import GF.GFCC.Macros (lookType,catSkeleton)
+import GF.GFCC.DataGFCC (GFCC)
 import GF.Conversion.Types
 import GF.CF.PPrCF (prCFCat)
 import GF.Data.Utilities
@@ -70,7 +71,7 @@ cfgToCFRules s =
          nameToTerm (Name IW [Unify [n]]) = CFRes n
          nameToTerm (Name f@(IC c) prs) = 
              CFObj f (zipWith profileToTerm args prs)
-            where C.Typ args _ = lookType gfcc (C.CId c)
+            where (args,_) = catSkeleton $ lookType gfcc (C.CId c)
          nameToTerm n = error $ "cfgToCFRules.nameToTerm" ++ show n
          profileToTerm (C.CId t) (Unify []) = CFMeta t
          profileToTerm _ (Unify xs) = CFRes (last xs) -- FIXME: unify
@@ -84,7 +85,7 @@ getStartCatCF :: Options -> StateGrammar -> String
 getStartCatCF opts sgr = getStartCat opts sgr ++ "{}.s"

 stateGFCC :: StateGrammar -> GFCC
-stateGFCC = mkGFCC . mkCanon2gfcc . stateGrammarST
+stateGFCC = mkCanon2gfcc . stateGrammarST

 -- * Grammar filtering

--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -35,8 +35,8 @@ import qualified GF.Grammar.Grammar as G
 import qualified GF.Canon.AbsGFC as A
 import qualified GF.Canon.GFC as C
 import qualified GF.Canon.CanonToGFCC as GFCC
-import qualified GF.Canon.GFCC.GFCCToHaskell as CCH
-import qualified GF.Canon.GFCC.DataGFCC as DataGFCC
+import qualified GF.Devel.GFCCtoHaskell as CCH
+import qualified GF.GFCC.DataGFCC as DataGFCC
 import qualified GF.Canon.CanonToJS as JS (prCanon2js)
 import qualified GF.Source.AbsGF as GF
 import qualified GF.Grammar.MMacros as MM
@@ -274,7 +274,7 @@ customGrammarPrinter =
  ,(strCI "bnf",     \_ -> prBNF False)
  ,(strCI "absbnf",  \_ -> abstract2bnf . stateGrammarST)
  ,(strCI "haskell", \_ -> grammar2haskell . stateGrammarST)
-  ,(strCI "gfcc_haskell", \_ -> CCH.grammar2haskell . DataGFCC.mkGFCC .
+  ,(strCI "gfcc_haskell", \_ -> CCH.grammar2haskell . 
                                GFCC.mkCanon2gfcc . stateGrammarST)
  ,(strCI "haskell_gadt", \_ -> grammar2haskellGADT . stateGrammarST)
  ,(strCI "transfer", \_ -> grammar2transfer . stateGrammarST)