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/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