msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

new GFCC concrete syntax in place everywhere

Browse Source
This commit is contained in:
aarne
2007-12-13 20:19:47 +00:00
parent a311dda539
commit b447cf1a04
32 changed files with 189 additions and 1745 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/GF/Canon/CanonToGFCC.hs
View File

@@ -21,8 +21,10 @@ import qualified GF.Canon.Look as Look
import qualified GF.Canon.Subexpressions as Sub
import qualified GF.GFCC.Macros as CM
import qualified GF.GFCC.AbsGFCC as C
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import qualified GF.GFCC.DataGFCC as C
import qualified GF.GFCC.DataGFCC as D
import GF.Devel.PrintGFCC
import GF.GFCC.OptimizeGFCC
import GF.Canon.GFC
@@ -46,7 +48,7 @@ import Debug.Trace ----
-- the main function: generate GFCC from GFCM.
prCanon2gfcc :: CanonGrammar -> String
prCanon2gfcc = D.printGFCC . mkCanon2gfcc
prCanon2gfcc = printGFCC . mkCanon2gfcc
-- this variant makes utf8 conversion; used in back ends
mkCanon2gfcc :: CanonGrammar -> D.GFCC
@@ -99,8 +101,8 @@ canon2gfcc cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
printnames = Map.fromAscList [] ---- printnames
params = Map.fromAscList [] ---- params
i2i :: Ident -> C.CId
i2i (IC c) = C.CId c
i2i :: Ident -> CId
i2i (IC c) = CId c
mkType :: A.Type -> C.Type
mkType t = case GM.catSkeleton t of

25
src/GF/Canon/CanonToJS.hs
View File

@@ -7,7 +7,8 @@ import GF.Data.ErrM
import GF.Infra.Option
import qualified GF.GFCC.Macros as M
import qualified GF.GFCC.DataGFCC as D
import qualified GF.GFCC.AbsGFCC as C
import qualified GF.GFCC.DataGFCC as C
import GF.GFCC.Raw.AbsGFCCRaw (CId(CId))
import qualified GF.JavaScript.AbsJS as JS
import qualified GF.JavaScript.PrintJS as JS
@@ -32,28 +33,28 @@ gfcc2js start gfcc =
as = D.abstract gfcc
cs = Map.assocs (D.concretes gfcc)
abstract2js :: String -> C.CId -> D.Abstr -> [JS.Element]
abstract2js start (C.CId n) ds =
abstract2js :: String -> CId -> D.Abstr -> [JS.Element]
abstract2js start (CId n) ds =
[JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit a (new "Abstract" [JS.EStr start])]]
++ concatMap (absdef2js a) (Map.assocs (D.funs ds))
where a = JS.Ident n
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
absdef2js :: JS.Ident -> (CId,(C.Type,C.Exp)) -> [JS.Element]
absdef2js a (CId f,(typ,_)) =
let (args,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]]
[JS.EStr f, JS.EArray [JS.EStr x | CId x <- args], JS.EStr cat]]
concrete2js :: C.CId -> (C.CId,D.Concr) -> [JS.Element]
concrete2js (C.CId a) (C.CId c, cnc) =
concrete2js :: CId -> (CId,D.Concr) -> [JS.Element]
concrete2js (CId a) (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
ds = concatMap Map.assocs [D.lins cnc, D.opers cnc, D.lindefs cnc]
cncdef2js :: JS.Ident -> (C.CId,C.Term) -> [JS.Element]
cncdef2js l (C.CId f, t) =
cncdef2js :: JS.Ident -> (CId,C.Term) -> [JS.Element]
cncdef2js l (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
@@ -67,7 +68,7 @@ term2js l t = f t
C.K t -> tokn2js t
C.V i -> JS.EIndex (JS.EVar children) (JS.EInt i)
C.C i -> new "Int" [JS.EInt i]
C.F (C.CId f) -> JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "rule")) [JS.EStr f, JS.EVar children]
C.F (CId f) -> JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "rule")) [JS.EStr f, JS.EVar children]
C.FV xs -> new "Variants" (map f xs)
C.W str x -> new "Suffix" [JS.EStr str, f x]
C.RP x y -> new "Rp" [f x, f y]

2
src/GF/Command/Commands.hs
View File

@@ -16,7 +16,7 @@ import GF.GFCC.ShowLinearize
import GF.GFCC.API
import GF.GFCC.Macros
import GF.Devel.PrintGFCC
import GF.GFCC.AbsGFCC ----
import GF.GFCC.DataGFCC ----
import GF.Command.ErrM ----

1
src/GF/Command/Importing.hs
View File

@@ -5,7 +5,6 @@ import GF.Devel.GrammarToGFCC
import GF.GFCC.OptimizeGFCC
import GF.GFCC.CheckGFCC
import GF.GFCC.DataGFCC
import GF.GFCC.ParGFCC
import GF.GFCC.API
import qualified GF.Command.AbsGFShell as C

2
src/GF/Command/Interpreter.hs
View File

@@ -9,7 +9,7 @@ import GF.Command.PPrTree
import GF.Command.ParGFShell
import GF.GFCC.API
import GF.GFCC.Macros
import GF.GFCC.AbsGFCC ----
import GF.GFCC.DataGFCC
import GF.Command.ErrM ----

3
src/GF/Command/PPrTree.hs
View File

@@ -1,6 +1,7 @@
module GF.Command.PPrTree (pTree, prExp, tree2exp) where
import GF.GFCC.AbsGFCC
import GF.GFCC.DataGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.GFCC.Macros
import qualified GF.Command.ParGFShell as P
import GF.Command.PrintGFShell

2
src/GF/Compile/ShellState.hs
View File

@@ -17,7 +17,7 @@ module GF.Compile.ShellState where
import GF.Data.Operations
import GF.Canon.GFC
import GF.Canon.AbsGFC
import GF.GFCC.AbsGFCC(CId(CId))
import GF.GFCC.Raw.AbsGFCCRaw(CId(CId))
--import GF.GFCC.DataGFCC(mkGFCC)
import GF.Canon.CanonToGFCC as C2GFCC
import GF.Grammar.Macros

4
src/GF/Conversion/SimpleToFCFG.hs
View File

@@ -22,9 +22,9 @@ import Control.Monad
import GF.Formalism.Utilities
import GF.Formalism.FCFG
import GF.GFCC.Macros hiding (prt)
import GF.GFCC.Macros --hiding (prt)
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.Data.BacktrackM
import GF.Data.SortedList

2
src/GF/Conversion/Types.hs
View File

@@ -18,7 +18,7 @@ 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.GFCC.AbsGFCC as AbsGFCC (CId(..))
import qualified GF.GFCC.Raw.AbsGFCCRaw as AbsGFCC (CId(..))
import qualified GF.Grammar.Grammar as Grammar (Term)
import GF.Formalism.GCFG

10
src/GF/Devel/GFC.hs
View File

@@ -7,9 +7,11 @@ import GF.Devel.GrammarToGFCC
import GF.GFCC.OptimizeGFCC
import GF.GFCC.CheckGFCC
import GF.GFCC.DataGFCC
import GF.GFCC.ParGFCC
import GF.GFCC.Raw.ParGFCCRaw
import GF.GFCC.Raw.ConvertGFCC
import GF.Devel.UseIO
import GF.Infra.Option
import GF.GFCC.API
import GF.GFCC.ErrM
mainGFC :: [String] -> IO ()
@@ -44,12 +46,6 @@ mainGFC xx = do
mapM_ (batchCompile opts) (map return fs)
putStrLn "Done."
file2gfcc f = do
f <- readFileIf f
case pGrammar (myLexer f) of
Ok g -> return (mkGFCC g)
Bad s -> error s
targetName opts abs = case getOptVal opts (aOpt "target") of
Just n -> n
_ -> abs

2
src/GF/Devel/GFCCtoHaskell.hs
View File

@@ -18,7 +18,7 @@ module GF.Devel.GFCCtoHaskell (grammar2haskell, grammar2haskellGADT) where
import GF.GFCC.Macros
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.Data.Operations
import GF.Text.UTF8

56
src/GF/Devel/GFCCtoJS.hs
View File

@@ -2,7 +2,7 @@ module GF.Devel.GFCCtoJS (gfcc2js,gfcc2grammarRef) where
import qualified GF.GFCC.Macros as M
import qualified GF.GFCC.DataGFCC as D
import qualified GF.GFCC.AbsGFCC as C
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import qualified GF.JavaScript.AbsJS as JS
import qualified GF.JavaScript.PrintJS as JS
@@ -24,50 +24,50 @@ gfcc2js gfcc =
cs = Map.assocs (D.concretes gfcc)
start = M.lookAbsFlag gfcc (M.cid "startcat")
abstract2js :: String -> C.CId -> D.Abstr -> [JS.Element]
abstract2js start (C.CId n) ds =
abstract2js :: String -> CId -> D.Abstr -> [JS.Element]
abstract2js start (CId n) ds =
[JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit a (new "Abstract" [JS.EStr start])]]
++ concatMap (absdef2js a) (Map.assocs (D.funs ds))
where a = JS.Ident n
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
absdef2js :: JS.Ident -> (CId,(D.Type,D.Exp)) -> [JS.Element]
absdef2js a (CId f,(typ,_)) =
let (args,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]]
[JS.EStr f, JS.EArray [JS.EStr x | CId x <- args], JS.EStr cat]]
concrete2js :: C.CId -> (C.CId,D.Concr) -> [JS.Element]
concrete2js (C.CId a) (C.CId c, cnc) =
concrete2js :: CId -> (CId,D.Concr) -> [JS.Element]
concrete2js (CId a) (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
ds = concatMap Map.assocs [D.lins cnc, D.opers cnc, D.lindefs cnc]
cncdef2js :: JS.Ident -> (C.CId,C.Term) -> [JS.Element]
cncdef2js l (C.CId f, t) =
cncdef2js :: JS.Ident -> (CId,D.Term) -> [JS.Element]
cncdef2js l (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
term2js :: JS.Ident -> D.Term -> JS.Expr
term2js l t = f t
where
f t =
case t of
C.R xs -> new "Arr" (map f xs)
C.P x y -> JS.ECall (JS.EMember (f x) (JS.Ident "sel")) [f y]
C.S xs -> mkSeq (map f xs)
C.K t -> tokn2js t
C.V i -> JS.EIndex (JS.EVar children) (JS.EInt i)
C.C i -> new "Int" [JS.EInt i]
C.F (C.CId f) -> JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "rule")) [JS.EStr f, JS.EVar children]
C.FV xs -> new "Variants" (map f xs)
C.W str x -> new "Suffix" [JS.EStr str, f x]
C.RP x y -> new "Rp" [f x, f y]
C.TM -> new "Meta" []
D.R xs -> new "Arr" (map f xs)
D.P x y -> JS.ECall (JS.EMember (f x) (JS.Ident "sel")) [f y]
D.S xs -> mkSeq (map f xs)
D.K t -> tokn2js t
D.V i -> JS.EIndex (JS.EVar children) (JS.EInt i)
D.C i -> new "Int" [JS.EInt i]
D.F (CId f) -> JS.ECall (JS.EMember (JS.EVar l) (JS.Ident "rule")) [JS.EStr f, JS.EVar children]
D.FV xs -> new "Variants" (map f xs)
D.W str x -> new "Suffix" [JS.EStr str, f x]
D.RP x y -> new "Rp" [f x, f y]
D.TM -> new "Meta" []
tokn2js :: C.Tokn -> JS.Expr
tokn2js (C.KS s) = mkStr s
tokn2js (C.KP ss vs) = mkSeq (map mkStr ss) -- FIXME
tokn2js :: D.Tokn -> JS.Expr
tokn2js (D.KS s) = mkStr s
tokn2js (D.KP ss vs) = mkSeq (map mkStr ss) -- FIXME
mkStr :: String -> JS.Expr
mkStr s = new "Str" [JS.EStr s]
@@ -91,7 +91,7 @@ gfcc2grammarRef :: D.GFCC -> String
gfcc2grammarRef gfcc =
encodeUTF8 $ refs
where
C.CId abstr = D.absname gfcc
CId abstr = D.absname gfcc
refs = unlines $ [
"// Grammar Reference",
"function concreteReference(concreteSyntax, concreteSyntaxName) {",
@@ -102,5 +102,5 @@ gfcc2grammarRef gfcc =
"var myConcrete = new Array();"
] ++ [
"myConcrete.push(new concreteReference(" ++ c ++ ",\"" ++ c ++ "\"));"
| C.CId c <- D.cncnames gfcc]
| CId c <- D.cncnames gfcc]

16
src/GF/Devel/GrammarToGFCC.hs
View File

@@ -6,8 +6,9 @@ import GF.Grammar.Grammar
import qualified GF.Grammar.Lookup as Look
import qualified GF.GFCC.Macros as CM
import qualified GF.GFCC.AbsGFCC as C
import qualified GF.GFCC.DataGFCC as C
import qualified GF.GFCC.DataGFCC as D
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import qualified GF.Grammar.Abstract as A
import qualified GF.Grammar.Macros as GM
--import qualified GF.Grammar.Compute as Compute
@@ -15,6 +16,7 @@ import qualified GF.Infra.Modules as M
import qualified GF.Infra.Option as O
import GF.Devel.PrGrammar
import GF.Devel.PrintGFCC
import GF.Devel.ModDeps
import GF.Infra.Ident
import GF.Infra.Option
@@ -29,7 +31,7 @@ import Debug.Trace ----
-- the main function: generate GFCC from GF.
prGrammar2gfcc :: Options -> String -> SourceGrammar -> (String,String)
prGrammar2gfcc opts cnc gr = (abs, D.printGFCC gc) where
prGrammar2gfcc opts cnc gr = (abs,printGFCC gc) where
(abs,gc) = mkCanon2gfcc opts cnc gr
mkCanon2gfcc :: Options -> String -> SourceGrammar -> (String,D.GFCC)
@@ -51,9 +53,9 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
an = (i2i a)
cns = map (i2i . fst) cms
abs = D.Abstr aflags funs cats catfuns
gflags = Map.fromList [(C.CId fg,x) | Just x <- [getOptVal opts (aOpt fg)]]
gflags = Map.fromList [(CId fg,x) | Just x <- [getOptVal opts (aOpt fg)]]
where fg = "firstlang"
aflags = Map.fromList [(C.CId f,x) | Opt (f,[x]) <- M.flags abm]
aflags = Map.fromList [(CId f,x) | Opt (f,[x]) <- M.flags abm]
mkDef pty = case pty of
Yes t -> mkExp t
_ -> CM.primNotion
@@ -73,7 +75,7 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
(lang,D.Concr flags lins opers lincats lindefs printnames params)
where
js = tree2list (M.jments mo)
flags = Map.fromList [(C.CId f,x) | Opt (f,[x]) <- M.flags mo]
flags = Map.fromList [(CId f,x) | Opt (f,[x]) <- M.flags mo]
opers = Map.fromAscList [] -- opers will be created as optimization
utf = if elem (Opt ("coding",["utf8"])) (M.flags mo)
then D.convertStringsInTerm decodeUTF8 else id
@@ -89,8 +91,8 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
params = Map.fromAscList
[(i2i c, pars lang0 c) | (c,CncCat (Yes ty) _ _) <- js]
i2i :: Ident -> C.CId
i2i = C.CId . prIdent
i2i :: Ident -> CId
i2i = CId . prIdent
mkType :: A.Type -> C.Type
mkType t = case GM.typeForm t of

7
src/GF/Devel/PrintGFCC.hs
View File

@@ -1,6 +1,8 @@
module GF.Devel.PrintGFCC where
import GF.GFCC.DataGFCC (GFCC,printGFCC)
import GF.GFCC.DataGFCC (GFCC)
import GF.GFCC.Raw.ConvertGFCC (fromGFCC)
import GF.GFCC.Raw.PrintGFCCRaw (printTree)
import GF.Devel.GFCCtoHaskell
import GF.Devel.GFCCtoJS
@@ -14,3 +16,6 @@ prGFCC printer gr = case printer of
"jsref" -> gfcc2grammarRef gr
_ -> printGFCC gr
printGFCC :: GFCC -> String
printGFCC = printTree . fromGFCC

2
src/GF/Formalism/FCFG.hs
View File

@@ -38,7 +38,7 @@ import Data.Array
import qualified Data.Map as Map
import GF.Formalism.Utilities
import qualified GF.GFCC.AbsGFCC as AbsGFCC
import qualified GF.GFCC.Raw.AbsGFCCRaw as AbsGFCC
import GF.Infra.PrintClass

11
src/GF/GFCC/API.hs
View File

@@ -19,8 +19,9 @@ import GF.GFCC.Linearize
import GF.GFCC.Generate
import GF.GFCC.Macros
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
import GF.GFCC.ParGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.GFCC.Raw.ConvertGFCC
import GF.GFCC.Raw.ParGFCCRaw
import GF.Command.PPrTree
import GF.GFCC.ErrM
@@ -81,8 +82,10 @@ file2grammar f = do
gfcc2parsers gfcc =
[(lang, buildFCFPInfo fcfg) | (CId lang,fcfg) <- convertGrammar gfcc]
file2gfcc f =
readFileIf f >>= err (error) (return . mkGFCC) . pGrammar . myLexer
file2gfcc f = do
s <- readFileIf f
g <- parseGrammar s
return $ toGFCC g
linearize mgr lang = GF.GFCC.Linearize.linearize (gfcc mgr) (CId lang)

82
src/GF/GFCC/AbsGFCC.hs
View File

@@ -1,82 +0,0 @@
module GF.GFCC.AbsGFCC where
-- Haskell module generated by the BNF converter
newtype CId = CId String deriving (Eq,Ord,Show)
data Grammar =
Grm CId [CId] [Flag] Abstract [Concrete]
deriving (Eq,Ord,Show)
data Abstract =
Abs [Flag] [FunDef] [CatDef]
deriving (Eq,Ord,Show)
data Concrete =
Cnc CId [Flag] [LinDef] [LinDef] [LinDef] [LinDef] [LinDef] [LinDef]
deriving (Eq,Ord,Show)
data Flag =
Flg CId String
deriving (Eq,Ord,Show)
data CatDef =
Cat CId [Hypo]
deriving (Eq,Ord,Show)
data FunDef =
Fun CId Type Exp
deriving (Eq,Ord,Show)
data LinDef =
Lin CId Term
deriving (Eq,Ord,Show)
data Type =
DTyp [Hypo] CId [Exp]
deriving (Eq,Ord,Show)
data Exp =
DTr [CId] Atom [Exp]
| EEq [Equation]
deriving (Eq,Ord,Show)
data Atom =
AC CId
| AS String
| AI Integer
| AF Double
| AM Integer
| AV CId
deriving (Eq,Ord,Show)
data Term =
R [Term]
| P Term Term
| S [Term]
| K Tokn
| V Int --H
| C Int --H
| F CId
| FV [Term]
| W String Term
| TM
| RP Term Term
deriving (Eq,Ord,Show)
data Tokn =
KS String
| KP [String] [Variant]
deriving (Eq,Ord,Show)
data Variant =
Var [String] [String]
deriving (Eq,Ord,Show)
data Hypo =
Hyp CId Type
deriving (Eq,Ord,Show)
data Equation =
Equ [Exp] Exp
deriving (Eq,Ord,Show)

24
src/GF/GFCC/CheckGFCC.hs
View File

@@ -1,8 +1,8 @@
module GF.GFCC.CheckGFCC (checkGFCC, checkGFCCio) where
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.GFCC.Macros
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
import GF.GFCC.ErrM
import qualified Data.Map as Map
@@ -39,7 +39,7 @@ labelBoolErr ms iob = do
checkConcrete :: GFCC -> (CId,Concr) -> Err ((CId,Concr),Bool)
checkConcrete gfcc (lang,cnc) =
labelBoolErr ("happened in language " ++ prt lang) $ do
labelBoolErr ("happened in language " ++ printCId lang) $ do
(rs,bs) <- mapM checkl (Map.assocs (lins cnc)) >>= return . unzip
return ((lang,cnc{lins = Map.fromAscList rs}),and bs)
where
@@ -47,7 +47,7 @@ checkConcrete gfcc (lang,cnc) =
checkLin :: GFCC -> CId -> (CId,Term) -> Err ((CId,Term),Bool)
checkLin gfcc lang (f,t) =
labelBoolErr ("happened in function " ++ prt f) $ do
labelBoolErr ("happened in function " ++ printCId f) $ do
(t',b) <- checkTerm (lintype gfcc lang f) t --- $ inline gfcc lang t
return ((f,t'),b)
@@ -62,7 +62,7 @@ inferTerm args trm = case trm of
(ts',tys) <- mapM infer ts >>= return . unzip
let tys' = filter (/=str) tys
testErr (null tys')
("expected Str in " ++ prt trm ++ " not " ++ unwords (map prt tys'))
("expected Str in " ++ show trm ++ " not " ++ unwords (map show tys'))
return (S ts',str)
R ts -> do
(ts',tys) <- mapM infer ts >>= return . unzip
@@ -78,21 +78,21 @@ inferTerm args trm = case trm of
C i -> do
testErr (i < length tys)
("required more than " ++ show i ++ " fields in " ++ prt (R tys))
("required more than " ++ show i ++ " fields in " ++ show (R tys))
return (P t' u', tys !! i) -- record: index must be known
_ -> do
let typ = head tys
testErr (all (==typ) tys) ("different types in table " ++ prt trm)
testErr (all (==typ) tys) ("different types in table " ++ show trm)
return (P t' u', typ) -- table: types must be same
_ -> Bad $ "projection from " ++ prt t ++ " : " ++ prt tt
_ -> Bad $ "projection from " ++ show t ++ " : " ++ show tt
FV [] -> returnt TM ----
FV (t:ts) -> do
(t',ty) <- infer t
(ts',tys) <- mapM infer ts >>= return . unzip
testErr (all (eqType ty) tys) ("different types in variants " ++ prt trm)
testErr (all (eqType ty) tys) ("different types in variants " ++ show trm)
return (FV (t':ts'),ty)
W s r -> infer r
_ -> Bad ("no type inference for " ++ prt trm)
_ -> Bad ("no type inference for " ++ show trm)
where
returnt ty = return (trm,ty)
infer = inferTerm args
@@ -102,9 +102,9 @@ checkTerm (args,val) trm = case inferTerm args trm of
Ok (t,ty) -> if eqType ty val
then return (t,True)
else do
msg ("term: " ++ prt trm ++
"\nexpected type: " ++ prt val ++
"\ninferred type: " ++ prt ty)
msg ("term: " ++ show trm ++
"\nexpected type: " ++ show val ++
"\ninferred type: " ++ show ty)
return (t,False)
Bad s -> do
msg s

1
src/GF/GFCC/DataGFCC.hs
View File

@@ -1,7 +1,6 @@
module GF.GFCC.DataGFCC where
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.GFCC.PrintGFCC
import GF.Infra.CompactPrint
import GF.Text.UTF8

2
src/GF/GFCC/Generate.hs
View File

@@ -2,7 +2,7 @@ module GF.GFCC.Generate where
import GF.GFCC.Macros
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import qualified Data.Map as M
import System.Random

4
src/GF/GFCC/Linearize.hs
View File

@@ -2,7 +2,7 @@ module GF.GFCC.Linearize where
import GF.GFCC.Macros
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import Data.Map
import Data.List
@@ -56,7 +56,7 @@ compute mcfg lang args = comp where
idx xs i = if i > length xs - 1
then trace
("too large " ++ show i ++ " for\n" ++ unlines (lmap prt xs) ++ "\n") TM
("too large " ++ show i ++ " for\n" ++ unlines (lmap show xs) ++ "\n") TM
else xs !! i
proj r p = case (r,p) of

7
src/GF/GFCC/Macros.hs
View File

@@ -1,8 +1,8 @@
module GF.GFCC.Macros where
import GF.GFCC.AbsGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.GFCC.DataGFCC
import GF.GFCC.PrintGFCC
----import GF.GFCC.PrintGFCC
import Data.Map
import Data.List
@@ -83,9 +83,6 @@ term0 _ = TM
kks :: String -> Term
kks = K . KS
prt :: Print a => a -> String
prt = printTree
-- lookup with default value
lookMap :: (Show i, Ord i) => a -> i -> Map i a -> a
lookMap d c m = maybe d id $ Data.Map.lookup c m

2
src/GF/GFCC/OptimizeGFCC.hs
View File

@@ -1,6 +1,6 @@
module GF.GFCC.OptimizeGFCC where
import GF.GFCC.AbsGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.GFCC.DataGFCC
import GF.Data.Operations

1305
src/GF/GFCC/ParGFCC.hs
View File

File diff suppressed because it is too large Load Diff

217
src/GF/GFCC/PrintGFCC.hs
View File

@@ -1,217 +0,0 @@
{-# OPTIONS -fno-warn-incomplete-patterns #-}
module GF.GFCC.PrintGFCC where
-- pretty-printer generated by the BNF converter
import GF.GFCC.AbsGFCC
import Char
-- the top-level printing method
printTree :: Print a => a -> String
printTree = render . prt 0
type Doc = [ShowS] -> [ShowS]
doc :: ShowS -> Doc
doc = (:)
render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of
"[" :ts -> showChar '[' . rend i ts
"(" :ts -> showChar '(' . rend i ts
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
"}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
"}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
";" :ts -> showChar ';' . new i . rend i ts
t : "," :ts -> showString t . space "," . rend i ts
t : ")" :ts -> showString t . showChar ')' . rend i ts
t : "]" :ts -> showString t . showChar ']' . rend i ts
t :ts -> space t . rend i ts
_ -> id
new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
space t = showString t . (\s -> if null s then "" else (' ':s))
parenth :: Doc -> Doc
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
concatS :: [ShowS] -> ShowS
concatS = foldr (.) id
concatD :: [Doc] -> Doc
concatD = foldr (.) id
replicateS :: Int -> ShowS -> ShowS
replicateS n f = concatS (replicate n f)
-- the printer class does the job
class Print a where
prt :: Int -> a -> Doc
prtList :: [a] -> Doc
prtList = concatD . map (prt 0)
instance Print a => Print [a] where
prt _ = prtList
instance Print Char where
prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
mkEsc :: Char -> Char -> ShowS
mkEsc q s = case s of
_ | s == q -> showChar '\\' . showChar s
'\\'-> showString "\\\\"
'\n' -> showString "\\n"
'\t' -> showString "\\t"
_ -> showChar s
prPrec :: Int -> Int -> Doc -> Doc
prPrec i j = if j<i then parenth else id
instance Print Integer where
prt _ x = doc (shows x)
instance Print Int where --H
prt _ x = doc (shows x) --H
instance Print Double where
prt _ x = doc (shows x)
instance Print CId where
prt _ (CId i) = doc (showString i)
prtList es = case es of
[] -> (concatD [])
[x] -> (concatD [prt 0 x])
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Grammar where
prt i e = case e of
Grm cid cids flags abstract concretes -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 cid , doc (showString "(") , prt 0 cids , doc (showString ")") , doc (showString "(") , prt 0 flags , doc (showString ")") , doc (showString ";") , prt 0 abstract , doc (showString ";") , prt 0 concretes])
instance Print Abstract where
prt i e = case e of
Abs flags fundefs catdefs -> prPrec i 0 (concatD [doc (showString "abstract") , doc (showString "{") , doc (showString "flags") , prt 0 flags , doc (showString "fun") , prt 0 fundefs , doc (showString "cat") , prt 0 catdefs , doc (showString "}")])
instance Print Concrete where
prt i e = case e of
Cnc cid flags lindefs0 lindefs1 lindefs2 lindefs3 lindefs4 lindefs -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 cid , doc (showString "{") , doc (showString "flags") , prt 0 flags , doc (showString "lin") , prt 0 lindefs0 , doc (showString "oper") , prt 0 lindefs1 , doc (showString "lincat") , prt 0 lindefs2 , doc (showString "lindef") , prt 0 lindefs3 , doc (showString "printname") , prt 0 lindefs4 , doc (showString "param") , prt 0 lindefs , doc (showString "}")])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Flag where
prt i e = case e of
Flg cid str -> prPrec i 0 (concatD [prt 0 cid , doc (showString "=") , prt 0 str])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print CatDef where
prt i e = case e of
Cat cid hypos -> prPrec i 0 (concatD [prt 0 cid , doc (showString "[") , prt 0 hypos , doc (showString "]")])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print FunDef where
prt i e = case e of
Fun cid type' exp -> prPrec i 0 (concatD [prt 0 cid , doc (showString ":") , prt 0 type' , doc (showString "=") , prt 0 exp])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print LinDef where
prt i e = case e of
Lin cid term -> prPrec i 0 (concatD [prt 0 cid , doc (showString "=") , prt 0 term])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Type where
prt i e = case e of
DTyp hypos cid exps -> prPrec i 0 (concatD [doc (showString "[") , prt 0 hypos , doc (showString "]") , prt 0 cid , prt 0 exps])
instance Print Exp where
prt i e = case e of
DTr cids atom exps -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "(") , prt 0 cids , doc (showString ")") , prt 0 atom , prt 0 exps , doc (showString "]")])
EEq equations -> prPrec i 0 (concatD [doc (showString "{") , prt 0 equations , doc (showString "}")])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print Atom where
prt i e = case e of
AC cid -> prPrec i 0 (concatD [prt 0 cid])
AS str -> prPrec i 0 (concatD [prt 0 str])
AI n -> prPrec i 0 (concatD [prt 0 n])
AF d -> prPrec i 0 (concatD [prt 0 d])
AM n -> prPrec i 0 (concatD [doc (showString "?") , prt 0 n])
AV cid -> prPrec i 0 (concatD [doc (showString "$") , prt 0 cid])
instance Print Term where
prt i e = case e of
R terms -> prPrec i 0 (concatD [doc (showString "[") , prt 0 terms , doc (showString "]")])
P term0 term -> prPrec i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "!") , prt 0 term , doc (showString ")")])
S terms -> prPrec i 0 (concatD [doc (showString "(") , prt 0 terms , doc (showString ")")])
K tokn -> prPrec i 0 (concatD [prt 0 tokn])
V n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
C n -> prPrec i 0 (concatD [prt 0 n])
F cid -> prPrec i 0 (concatD [prt 0 cid])
FV terms -> prPrec i 0 (concatD [doc (showString "[|") , prt 0 terms , doc (showString "|]")])
W str term -> prPrec i 0 (concatD [doc (showString "(") , prt 0 str , doc (showString "+") , prt 0 term , doc (showString ")")])
TM -> prPrec i 0 (concatD [doc (showString "?")])
RP term0 term -> prPrec i 0 (concatD [doc (showString "(") , prt 0 term0 , doc (showString "@") , prt 0 term , doc (showString ")")])
prtList es = case es of
[] -> (concatD [])
[x] -> (concatD [prt 0 x])
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Tokn where
prt i e = case e of
KS str -> prPrec i 0 (concatD [prt 0 str])
KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "[") , prt 0 variants , doc (showString "]") , doc (showString "]")])
instance Print Variant where
prt i e = case e of
Var strs0 strs -> prPrec i 0 (concatD [prt 0 strs0 , doc (showString "/") , prt 0 strs])
prtList es = case es of
[] -> (concatD [])
[x] -> (concatD [prt 0 x])
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Hypo where
prt i e = case e of
Hyp cid type' -> prPrec i 0 (concatD [prt 0 cid , doc (showString ":") , prt 0 type'])
prtList es = case es of
[] -> (concatD [])
[x] -> (concatD [prt 0 x])
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Equation where
prt i e = case e of
Equ exps exp -> prPrec i 0 (concatD [prt 0 exps , doc (showString "->") , prt 0 exp])
prtList es = case es of
[] -> (concatD [])
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])

103
src/GF/GFCC/Raw/ConvertGFCC.hs
View File

@@ -1,4 +1,4 @@
module GF.GFCC.Raw.ConvertGFCC where
module GF.GFCC.Raw.ConvertGFCC (toGFCC,fromGFCC) where
import GF.GFCC.DataGFCC
import GF.GFCC.Raw.AbsGFCCRaw
@@ -7,9 +7,9 @@ import Data.Map
-- convert parsed grammar to internal GFCC
mkGFCC :: Grammar -> GFCC
mkGFCC (Grm [
App (CId "abstract") [AId a],
toGFCC :: Grammar -> GFCC
toGFCC (Grm [
AId a,
App (CId "concrete") cs,
App (CId "flags") gfs,
ab@(
@@ -37,8 +37,7 @@ mkGFCC (Grm [
}
where
mkCnc (
App (CId "concrete") [
AId lang,
App lang [
App (CId "flags") fls,
App (CId "lin") ls,
App (CId "oper") ops,
@@ -72,7 +71,9 @@ toHypo e = case e of
toExp :: RExp -> Exp
toExp e = case e of
App fun [App (CId "abs") xs, App (CId "arg") exps] ->
DTr [x | AId x <- xs] (AC fun) (lmap toExp exps)
DTr [x | AId x <- xs] (AC fun) (lmap toExp exps)
App (CId "Eq") _ -> EEq [] ----
AMet -> DTr [] (AM 0) []
_ -> error $ "exp " ++ show e
toTerm :: RExp -> Term
@@ -90,29 +91,69 @@ toTerm e = case e of
AStr s -> K (KS s) ----
_ -> error $ "term " ++ show e
------------------------------
--- from internal to parser --
------------------------------
{-
-- convert internal GFCC and pretty-print it
printGFCC :: GFCC -> String
printGFCC gfcc0 = compactPrintGFCC $ printTree $ Grm
(absname gfcc)
(cncnames gfcc)
[Flg f v | (f,v) <- assocs (gflags gfcc)]
(Abs
[Flg f v | (f,v) <- assocs (aflags (abstract gfcc))]
[Fun f ty df | (f,(ty,df)) <- assocs (funs (abstract gfcc))]
[Cat f v | (f,v) <- assocs (cats (abstract gfcc))]
)
[fromCnc lang cnc | (lang,cnc) <- assocs (concretes gfcc)]
fromGFCC :: GFCC -> Grammar
fromGFCC gfcc0 = Grm [
AId (absname gfcc),
app "concrete" (lmap AId (cncnames gfcc)),
app "flags" [App f [AStr v] | (f,v) <- toList (gflags gfcc)],
app "abstract" [
app "flags" [App f [AStr v] | (f,v) <- toList (aflags agfcc)],
app "fun" [App f [fromType t,fromExp d] | (f,(t,d)) <- toList (funs agfcc)],
app "cat" [App f (lmap fromHypo hs) | (f,hs) <- toList (cats agfcc)]
],
app "concrete" [App lang (fromConcrete c) | (lang,c) <- toList (concretes gfcc)]
]
where
fromCnc lang cnc = Cnc lang
[Flg f v | (f,v) <- assocs (cflags cnc)]
[Lin f v | (f,v) <- assocs (lins cnc)]
[Lin f v | (f,v) <- assocs (opers cnc)]
[Lin f v | (f,v) <- assocs (lincats cnc)]
[Lin f v | (f,v) <- assocs (lindefs cnc)]
[Lin f v | (f,v) <- assocs (printnames cnc)]
[Lin f v | (f,v) <- assocs (paramlincats cnc)]
gfcc = utf8GFCC gfcc0
-}
gfcc = utf8GFCC gfcc0
app s = App (CId s)
agfcc = abstract gfcc
fromConcrete cnc = [
app "flags" [App f [AStr v] | (f,v) <- toList (cflags cnc)],
app "lin" [App f [fromTerm v] | (f,v) <- toList (lins cnc)],
app "oper" [App f [fromTerm v] | (f,v) <- toList (opers cnc)],
app "lincat" [App f [fromTerm v] | (f,v) <- toList (lincats cnc)],
app "lindef" [App f [fromTerm v] | (f,v) <- toList (lindefs cnc)],
app "printname" [App f [fromTerm v] | (f,v) <- toList (printnames cnc)],
app "param" [App f [fromTerm v] | (f,v) <- toList (paramlincats cnc)]
]
fromType :: Type -> RExp
fromType e = case e of
DTyp hypos cat exps ->
App cat [
App (CId "hypo") (lmap fromHypo hypos),
App (CId "arg") (lmap fromExp exps)]
fromHypo :: Hypo -> RExp
fromHypo e = case e of
Hyp x typ -> App x [fromType typ]
fromExp :: Exp -> RExp
fromExp e = case e of
DTr xs (AC fun) exps ->
App fun [App (CId "abs") (lmap AId xs), App (CId "arg") (lmap fromExp exps)]
DTr xs (AM _) exps -> AMet ----
EEq _ -> App (CId "Eq") [] ----
_ -> error $ "exp " ++ show e
fromTerm :: Term -> RExp
fromTerm e = case e of
R es -> app "R" (lmap fromTerm es)
S es -> app "S" (lmap fromTerm es)
FV es -> app "FV" (lmap fromTerm es)
P e v -> app "P" [fromTerm e, fromTerm v]
RP e v -> app "RP" [fromTerm e, fromTerm v] ----
W s v -> app "W" [AStr s, fromTerm v]
C i -> AInt (toInteger i)
TM -> AMet
F f -> AId f
V i -> App (CId "A") [AInt (toInteger i)]
K (KS s) -> AStr s ----
K (KP d vs) -> app "FV" (str d : [str v | Var v _ <- vs]) ----
where
app = App . CId
str v = app "S" (lmap AStr v)

8
src/GF/GFCC/ShowLinearize.hs
View File

@@ -8,8 +8,8 @@ module GF.GFCC.ShowLinearize (
import GF.GFCC.Linearize
import GF.GFCC.Macros
import GF.GFCC.DataGFCC
import GF.GFCC.AbsGFCC
import GF.GFCC.PrintGFCC ----
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
--import GF.GFCC.PrintGFCC ----
import GF.Data.Operations
import Data.List
@@ -46,7 +46,7 @@ mkRecord typ trm = case (typ,trm) of
(_,W s (R ts)) -> mkRecord typ (R [K (KS (s ++ u)) | K (KS u) <- ts])
(FV ps, C i) -> RCon $ str $ ps !! i
(S [], _) -> RS $ realize trm
_ -> RS $ printTree trm
_ -> RS $ show trm ---- printTree trm
where
str = realize
@@ -82,6 +82,6 @@ recLinearize gfcc lang exp = mkRecord typ $ linExp gfcc lang exp where
-- show GFCC term
termLinearize :: GFCC -> CId -> Exp -> String
termLinearize gfcc lang = printTree . linExp gfcc lang
termLinearize gfcc lang = show . linExp gfcc lang

3
src/GF/Parsing/FCFG.hs
View File

@@ -21,7 +21,8 @@ import GF.Formalism.Utilities
import qualified GF.Parsing.FCFG.Active as Active
import GF.Parsing.FCFG.PInfo
import GF.GFCC.AbsGFCC
import GF.GFCC.DataGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import GF.GFCC.Macros
import GF.GFCC.ErrM

2
src/GF/Parsing/FCFG/PInfo.hs
View File

@@ -15,7 +15,7 @@ import GF.Formalism.FCFG
import GF.Data.SortedList
import GF.Data.Assoc
import GF.Parsing.FCFG.Range
import qualified GF.GFCC.AbsGFCC as AbsGFCC
import qualified GF.GFCC.Raw.AbsGFCCRaw as AbsGFCC
import Data.Array
import Data.Maybe

11
src/GF/Parsing/GFC.hs
View File

@@ -24,7 +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.GFCC.AbsGFCC as AbsGFCC
import qualified GF.GFCC.DataGFCC as AbsGFCC
import GF.GFCC.Raw.AbsGFCCRaw (CId (..))
import qualified GF.GFCC.ErrM as ErrM
import qualified GF.Infra.Ident as Ident
import GF.CF.CFIdent (CFCat, cfCat2Ident, CFTok, wordsCFTok, prCFTok)
@@ -134,7 +135,7 @@ parse "m" strategy pinfo abs startCat inString
-- parsing via FCFG
parse "f" strategy pinfo abs startCat inString =
let Ident.IC x = cfCat2Ident startCat
cat' = AbsGFCC.CId x
cat' = CId x
in case PF.parseFCF strategy (fcfPInfo pinfo) cat' (map prCFTok inString) of
ErrM.Ok es -> Ok (map (exp2term abs) es)
ErrM.Bad msg -> Bad msg
@@ -144,7 +145,7 @@ parse "f" strategy pinfo abs startCat inString =
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 (FNode (Name (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
@@ -153,7 +154,7 @@ 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 (FNode (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
@@ -173,7 +174,7 @@ 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.AC (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

6
src/GF/Speech/GrammarToVoiceXML.hs
View File

@@ -11,8 +11,8 @@
module GF.Speech.GrammarToVoiceXML (grammar2vxml) where
import GF.Canon.CanonToGFCC (mkCanon2gfcc)
import qualified GF.GFCC.AbsGFCC as C
import GF.GFCC.DataGFCC (GFCC(..), Abstr(..), mkGFCC)
import qualified GF.GFCC.Raw.AbsGFCCRaw as C
import GF.GFCC.DataGFCC (GFCC(..), Abstr(..))
import GF.GFCC.Macros
import qualified GF.Canon.GFC as GFC
import GF.Canon.AbsGFC (Term)
@@ -281,4 +281,4 @@ isConsFun f = "Cons" `isPrefixOf` prIdent f
baseSize :: (VIdent, [(VIdent, [VIdent])]) -> Int
baseSize (_,rules) = length bs
where Just (_,bs) = find (isBaseFun . fst) rules
-}
-}

2
src/GF/Speech/TransformCFG.hs
View File

@@ -17,7 +17,7 @@
module GF.Speech.TransformCFG where
import GF.Canon.CanonToGFCC (mkCanon2gfcc)
import qualified GF.GFCC.AbsGFCC as C
import qualified GF.GFCC.Raw.AbsGFCCRaw as C
import GF.GFCC.Macros (lookType,catSkeleton)
import GF.GFCC.DataGFCC (GFCC)
import GF.Conversion.Types