summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2007-10-05 12:54:29 +0000
committeraarne <aarne@cs.chalmers.se>2007-10-05 12:54:29 +0000
commit48623470cdba12f03f914c19677c6f7dc2072035 (patch)
treec46daa2cbe4cb9fe9016181fba3e1aff183fd00c
parent945a49214bd49fb082e8f613fc68d192a1b38743 (diff)
gf works with the new gfcc format
-rw-r--r--src/GF/Canon/CanonToGFCC.hs175
-rw-r--r--src/GF/Canon/CanonToJS.hs39
-rw-r--r--src/GF/Compile/ShellState.hs6
-rw-r--r--src/GF/Conversion/SimpleToFCFG.hs26
-rw-r--r--src/GF/Devel/GFC.hs2
-rw-r--r--src/GF/Formalism/FCFG.hs2
-rw-r--r--src/GF/GFCC/OptimizeGFCC.hs (renamed from src/GF/Devel/OptimizeGFCC.hs)2
-rw-r--r--src/GF/Parsing/FCFG.hs15
-rw-r--r--src/GF/Parsing/GFC.hs9
-rw-r--r--src/GF/Speech/GrammarToVoiceXML.hs12
-rw-r--r--src/GF/Speech/TransformCFG.hs9
-rw-r--r--src/GF/UseGrammar/Custom.hs6
12 files changed, 118 insertions, 185 deletions
diff --git a/src/GF/Canon/CanonToGFCC.hs b/src/GF/Canon/CanonToGFCC.hs
index 280094023..1262505a1 100644
--- 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)
-
diff --git a/src/GF/Canon/CanonToJS.hs b/src/GF/Canon/CanonToJS.hs
index 6280b870e..47d900c9d 100644
--- 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
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 9746c011e..afc3d61f9 100644
--- 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
diff --git a/src/GF/Conversion/SimpleToFCFG.hs b/src/GF/Conversion/SimpleToFCFG.hs
index b70a15786..8b0337dd1 100644
--- 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)
diff --git a/src/GF/Devel/GFC.hs b/src/GF/Devel/GFC.hs
index eb3046b18..0d8df98a1 100644
--- 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
diff --git a/src/GF/Formalism/FCFG.hs b/src/GF/Formalism/FCFG.hs
index 5b8edc434..f8e3b6509 100644
--- 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
diff --git a/src/GF/Devel/OptimizeGFCC.hs b/src/GF/GFCC/OptimizeGFCC.hs
index 78d03911f..68ee66c42 100644
--- a/src/GF/Devel/OptimizeGFCC.hs
+++ b/src/GF/GFCC/OptimizeGFCC.hs
@@ -1,4 +1,4 @@
-module GF.Devel.OptimizeGFCC where
+module GF.GFCC.OptimizeGFCC where
import GF.GFCC.AbsGFCC
import GF.GFCC.DataGFCC
diff --git a/src/GF/Parsing/FCFG.hs b/src/GF/Parsing/FCFG.hs
index 7784285e1..cf7f0d986 100644
--- 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
diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs
index 8d9257ebc..e84a2ec90 100644
--- 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
diff --git a/src/GF/Speech/GrammarToVoiceXML.hs b/src/GF/Speech/GrammarToVoiceXML.hs
index 5415c8184..f84033e9c 100644
--- 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
diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs
index bca42d4fe..bcd61f428 100644
--- 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
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index c1b9caa19..aad580a63 100644
--- 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)