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 8de623d11e
commit 095018c8e4
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]