mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Got GFCC to JavaScript compilation working. Variants are still printed in a weird way.
This commit is contained in:
bringert
@@ -8,41 +8,120 @@ import qualified GF.JavaScript.PrintJS as JS
|
||||
|
||||
|
||||
prCanon2js :: CanonGrammar -> String
|
||||
prCanon2js = JS.printTree . gfcc2js . mkCanon2gfcc
|
||||
prCanon2js gr = unlines [trees, terms, linearize, utils, (gfcc2js $ mkCanon2gfcc gr)]
|
||||
|
||||
gfcc2js :: C.Grammar -> JS.Program
|
||||
gfcc2js (C.Grm _ _ cs) = concrete2js (head cs) -- FIXME
|
||||
gfcc2js :: C.Grammar -> String
|
||||
gfcc2js (C.Grm _ _ cs) = JS.printTree (concrete2js (head cs)) -- FIXME
|
||||
|
||||
concrete2js :: C.Concrete -> JS.Program
|
||||
concrete2js (C.Cnc c ds) = JS.Program (map cncdef2js ds)
|
||||
concrete2js (C.Cnc c ds) = JS.Program ([JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident "lin") (new "Array" [])]]
|
||||
++ concatMap cncdef2js ds)
|
||||
|
||||
cncdef2js :: C.CncDef -> JS.Element
|
||||
cncdef2js :: C.CncDef -> [JS.Element]
|
||||
cncdef2js (C.Lin (C.CId f) t) =
|
||||
JS.FunDef (JS.Ident ("lin_"++f)) [children] [JS.Return (term2js t)]
|
||||
[JS.ElStmt $ JS.SDeclOrExpr $ JS.DExpr $ JS.EAssign (lin (JS.EStr f)) (JS.EFun [children] [JS.SReturn (term2js t)])]
|
||||
|
||||
term2js :: C.Term -> JS.Expr
|
||||
term2js t =
|
||||
case t of
|
||||
C.R xs -> call "arr" (map term2js xs)
|
||||
C.P x y -> JS.EMember (term2js x) (term2js y)
|
||||
C.S xs -> call "seq" (map term2js xs)
|
||||
C.R xs -> new "Arr" (map term2js xs)
|
||||
C.P x y -> JS.ECall (JS.EMember (term2js x) (JS.Ident "sel")) [term2js y]
|
||||
C.S xs -> new "Seq" (map term2js xs)
|
||||
C.K t -> tokn2js t
|
||||
C.V i -> JS.EIndex (JS.EVar children) (JS.EInt i)
|
||||
C.C i -> JS.EInt i
|
||||
C.F (C.CId f) -> call ("lin_"++f) [JS.EVar children]
|
||||
C.FV xs -> call "variants" (map term2js xs)
|
||||
C.W str x -> call "suffix" [JS.EStr str, term2js x]
|
||||
C.RP x y -> call "rp" [term2js x, term2js y]
|
||||
C.TM -> call "meta" []
|
||||
|
||||
C.C i -> new "Int" [JS.EInt i]
|
||||
C.F (C.CId f) -> JS.ECall (lin (JS.EStr f)) [JS.EVar children]
|
||||
C.FV xs -> new "Variants" (map term2js xs)
|
||||
C.W str x -> new "Suffix" [JS.EStr str, term2js x]
|
||||
C.RP x y -> new "Rp" [term2js x, term2js y]
|
||||
C.TM -> new "Meta" []
|
||||
|
||||
argIdent :: Integer -> JS.Ident
|
||||
argIdent n = JS.Ident ("x" ++ show n)
|
||||
|
||||
tokn2js :: C.Tokn -> JS.Expr
|
||||
tokn2js (C.KS s) = JS.EStr s
|
||||
tokn2js (C.KS s) = new "Str" [JS.EStr s]
|
||||
tokn2js (C.KP ss vs) = new "Seq" (map JS.EStr ss) -- FIXME
|
||||
|
||||
children :: JS.Ident
|
||||
children = JS.Ident "cs"
|
||||
|
||||
call :: String -> [JS.Expr] -> JS.Expr
|
||||
call f xs = JS.ECall (JS.EVar (JS.Ident f)) xs
|
||||
lin :: JS.Expr -> JS.Expr
|
||||
lin = JS.EIndex (JS.EVar (JS.Ident "lin"))
|
||||
|
||||
new :: String -> [JS.Expr] -> JS.Expr
|
||||
new f xs = JS.ENew (JS.Ident f) xs
|
||||
|
||||
trees :: String
|
||||
trees = unlines
|
||||
[
|
||||
"function Fun(name) {",
|
||||
" this.name = name;",
|
||||
" this.children = copy_arguments(arguments, 1);",
|
||||
"}"
|
||||
]
|
||||
|
||||
terms :: String
|
||||
terms = unlines
|
||||
[
|
||||
"function Arr() { this.values = copy_arguments(arguments, 0); }",
|
||||
"Arr.prototype.print = function() { return this.values[0].print(); }",
|
||||
"Arr.prototype.sel = function(i) { return this.values[i.toIndex()]; }",
|
||||
"function Seq() { this.values = copy_arguments(arguments, 0); }",
|
||||
"Seq.prototype.print = function() { return join_print(this.values, \" \"); }",
|
||||
"function Variants() { this.values = copy_arguments(arguments, 0); }",
|
||||
"Variants.prototype.print = function() { return join_print(this.values, \"/\"); }",
|
||||
"function Glue() { this.values = copy_arguments(arguments, 0); }",
|
||||
"Glue.prototype.print = function() { return join_print(this.values, \"\"); }",
|
||||
"function Rp(index,value) { this.index = index; this.value = value; }",
|
||||
"Rp.prototype.print = function() { return this.index; }",
|
||||
"Rp.prototype.toIndex = function() { return this.index.toIndex(); }",
|
||||
"function Suffix(prefix,suffix) { this.prefix = prefix; this.suffix = suffix; }",
|
||||
"Suffix.prototype.print = function() { return this.prefix.print() + this.suffix.print(); }",
|
||||
"Suffix.prototype.sel = function(i) { new Glue(this.prefix, this.suffix.sel(i)); }",
|
||||
"function Meta() { }",
|
||||
"Meta.prototype.print = function() { return \"?\"; }",
|
||||
"Meta.prototype.toIndex = function() { return 0; }",
|
||||
"Meta.prototype.sel = function(i) { return this; }",
|
||||
"function Str(value) { this.value = value; }",
|
||||
"Str.prototype.print = function() { return this.value; }",
|
||||
"function Int(value) { this.value = value; }",
|
||||
"Int.prototype.print = function() { return this.value; }",
|
||||
"Int.prototype.toIndex = function() { return this.value; }"
|
||||
]
|
||||
|
||||
linearize :: String
|
||||
linearize = unlines
|
||||
[
|
||||
"function linearize(tree) { return linearizeToTerm(tree).print(); }",
|
||||
"function linearizeToTerm(tree) {",
|
||||
" var cs = new Array();",
|
||||
" for (var i = 0; i < tree.children.length; i++) {",
|
||||
" cs[i] = linearizeToTerm(tree.children[i]);",
|
||||
" }",
|
||||
" return lin[tree.name](cs);",
|
||||
"}"
|
||||
]
|
||||
|
||||
utils :: String
|
||||
utils = unlines
|
||||
[
|
||||
"function copy_arguments(args, start) {",
|
||||
" var arr = new Array();",
|
||||
" for (var i = 0; i < args.length - start; i++) {",
|
||||
" arr[i] = args[i + start];",
|
||||
" }",
|
||||
" return arr;",
|
||||
"}",
|
||||
"",
|
||||
"function join_print(values, glue) {",
|
||||
" var str = \"\";",
|
||||
" for (var i = 0; i < values.length; i++) {",
|
||||
" str += values[i].print();",
|
||||
" if (i < values.length - 1) {",
|
||||
" str += glue;",
|
||||
" }",
|
||||
" }",
|
||||
" return str;",
|
||||
"}"
|
||||
]
|
||||
|
||||
@@ -13,14 +13,26 @@ data Element =
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Stmt =
|
||||
Compound [Stmt]
|
||||
| ReturnVoid
|
||||
| Return Expr
|
||||
SCompound [Stmt]
|
||||
| SReturnVoid
|
||||
| SReturn Expr
|
||||
| SDeclOrExpr DeclOrExpr
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DeclOrExpr =
|
||||
Decl [DeclVar]
|
||||
| DExpr Expr
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data DeclVar =
|
||||
DVar Ident
|
||||
| DInit Ident Expr
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
data Expr =
|
||||
ENew Ident [Expr]
|
||||
| EMember Expr Expr
|
||||
EAssign Expr Expr
|
||||
| ENew Ident [Expr]
|
||||
| EMember Expr Ident
|
||||
| EIndex Expr Expr
|
||||
| ECall Expr [Expr]
|
||||
| EVar Ident
|
||||
@@ -31,5 +43,6 @@ data Expr =
|
||||
| EFalse
|
||||
| ENull
|
||||
| EThis
|
||||
| EFun [Ident] [Stmt]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
|
||||
@@ -8,14 +8,24 @@ separator Element "" ;
|
||||
|
||||
separator Ident "," ;
|
||||
|
||||
Compound. Stmt ::= "{" [Stmt] "}" ;
|
||||
ReturnVoid. Stmt ::= "return" ";" ;
|
||||
Return. Stmt ::= "return" Expr ";" ;
|
||||
SCompound. Stmt ::= "{" [Stmt] "}" ;
|
||||
SReturnVoid. Stmt ::= "return" ";" ;
|
||||
SReturn. Stmt ::= "return" Expr ";" ;
|
||||
SDeclOrExpr. Stmt ::= DeclOrExpr ";" ;
|
||||
separator Stmt "" ;
|
||||
|
||||
Decl. DeclOrExpr ::= "var" [DeclVar];
|
||||
DExpr. DeclOrExpr ::= Expr ;
|
||||
|
||||
DVar. DeclVar ::= Ident ;
|
||||
DInit. DeclVar ::= Ident "=" Expr ;
|
||||
separator DeclVar "," ;
|
||||
|
||||
EAssign. Expr13 ::= Expr14 "=" Expr13 ;
|
||||
|
||||
ENew. Expr14 ::= "new" Ident "(" [Expr] ")" ;
|
||||
|
||||
EMember. Expr15 ::= Expr15 "." Expr16 ;
|
||||
EMember. Expr15 ::= Expr15 "." Ident ;
|
||||
EIndex. Expr15 ::= Expr15 "[" Expr "]" ;
|
||||
ECall. Expr15 ::= Expr15 "(" [Expr] ")" ;
|
||||
|
||||
@@ -27,6 +37,7 @@ ETrue. Expr16 ::= "true" ;
|
||||
EFalse. Expr16 ::= "false" ;
|
||||
ENull. Expr16 ::= "null" ;
|
||||
EThis. Expr16 ::= "this" ;
|
||||
EFun. Expr16 ::= "function" "(" [Ident] ")" "{" [Stmt] "}" ;
|
||||
|
||||
separator Expr "," ;
|
||||
coercions Expr 16 ;
|
||||
|
||||
@@ -16,7 +16,7 @@ $i = [$l $d _ '] -- identifier character
|
||||
$u = [\0-\255] -- universal: any character
|
||||
|
||||
@rsyms = -- symbols and non-identifier-like reserved words
|
||||
\( | \) | \{ | \} | \, | \; | \. | \[ | \]
|
||||
\( | \) | \{ | \} | \, | \; | \= | \. | \[ | \]
|
||||
|
||||
:-
|
||||
|
||||
@@ -77,7 +77,7 @@ eitherResIdent tv s = treeFind resWords
|
||||
| s > a = treeFind right
|
||||
| s == a = t
|
||||
|
||||
resWords = b "null" (b "function" (b "false" N N) (b "new" N N)) (b "this" (b "return" N N) (b "true" N N))
|
||||
resWords = b "return" (b "new" (b "function" (b "false" N N) N) (b "null" N N)) (b "true" (b "this" N N) (b "var" N N))
|
||||
where b s = B s (TS s)
|
||||
|
||||
unescapeInitTail :: String -> String
|
||||
|
||||
@@ -20,6 +20,7 @@ import GF.JavaScript.ErrM
|
||||
'}' { PT _ (TS "}") }
|
||||
',' { PT _ (TS ",") }
|
||||
';' { PT _ (TS ";") }
|
||||
'=' { PT _ (TS "=") }
|
||||
'.' { PT _ (TS ".") }
|
||||
'[' { PT _ (TS "[") }
|
||||
']' { PT _ (TS "]") }
|
||||
@@ -30,6 +31,7 @@ import GF.JavaScript.ErrM
|
||||
'return' { PT _ (TS "return") }
|
||||
'this' { PT _ (TS "this") }
|
||||
'true' { PT _ (TS "true") }
|
||||
'var' { PT _ (TS "var") }
|
||||
|
||||
L_ident { PT _ (TV $$) }
|
||||
L_integ { PT _ (TI $$) }
|
||||
@@ -66,9 +68,10 @@ ListIdent : {- empty -} { [] }
|
||||
|
||||
|
||||
Stmt :: { Stmt }
|
||||
Stmt : '{' ListStmt '}' { Compound (reverse $2) }
|
||||
| 'return' ';' { ReturnVoid }
|
||||
| 'return' Expr ';' { Return $2 }
|
||||
Stmt : '{' ListStmt '}' { SCompound (reverse $2) }
|
||||
| 'return' ';' { SReturnVoid }
|
||||
| 'return' Expr ';' { SReturn $2 }
|
||||
| DeclOrExpr ';' { SDeclOrExpr $1 }
|
||||
|
||||
|
||||
ListStmt :: { [Stmt] }
|
||||
@@ -76,13 +79,34 @@ ListStmt : {- empty -} { [] }
|
||||
| ListStmt Stmt { flip (:) $1 $2 }
|
||||
|
||||
|
||||
DeclOrExpr :: { DeclOrExpr }
|
||||
DeclOrExpr : 'var' ListDeclVar { Decl $2 }
|
||||
| Expr { DExpr $1 }
|
||||
|
||||
|
||||
DeclVar :: { DeclVar }
|
||||
DeclVar : Ident { DVar $1 }
|
||||
| Ident '=' Expr { DInit $1 $3 }
|
||||
|
||||
|
||||
ListDeclVar :: { [DeclVar] }
|
||||
ListDeclVar : {- empty -} { [] }
|
||||
| DeclVar { (:[]) $1 }
|
||||
| DeclVar ',' ListDeclVar { (:) $1 $3 }
|
||||
|
||||
|
||||
Expr13 :: { Expr }
|
||||
Expr13 : Expr14 '=' Expr13 { EAssign $1 $3 }
|
||||
| Expr14 { $1 }
|
||||
|
||||
|
||||
Expr14 :: { Expr }
|
||||
Expr14 : 'new' Ident '(' ListExpr ')' { ENew $2 $4 }
|
||||
| Expr15 { $1 }
|
||||
|
||||
|
||||
Expr15 :: { Expr }
|
||||
Expr15 : Expr15 '.' Expr16 { EMember $1 $3 }
|
||||
Expr15 : Expr15 '.' Ident { EMember $1 $3 }
|
||||
| Expr15 '[' Expr ']' { EIndex $1 $3 }
|
||||
| Expr15 '(' ListExpr ')' { ECall $1 $3 }
|
||||
| Expr16 { $1 }
|
||||
@@ -97,6 +121,7 @@ Expr16 : Ident { EVar $1 }
|
||||
| 'false' { EFalse }
|
||||
| 'null' { ENull }
|
||||
| 'this' { EThis }
|
||||
| 'function' '(' ListIdent ')' '{' ListStmt '}' { EFun $3 (reverse $6) }
|
||||
| '(' Expr ')' { $2 }
|
||||
|
||||
|
||||
@@ -158,10 +183,6 @@ Expr12 :: { Expr }
|
||||
Expr12 : Expr13 { $1 }
|
||||
|
||||
|
||||
Expr13 :: { Expr }
|
||||
Expr13 : Expr14 { $1 }
|
||||
|
||||
|
||||
|
||||
{
|
||||
|
||||
|
||||
@@ -102,18 +102,36 @@ instance Print Element where
|
||||
|
||||
instance Print Stmt where
|
||||
prt i e = case e of
|
||||
Compound stmts -> prPrec i 0 (concatD [doc (showString "{") , prt 0 stmts , doc (showString "}")])
|
||||
ReturnVoid -> prPrec i 0 (concatD [doc (showString "return") , doc (showString ";")])
|
||||
Return expr -> prPrec i 0 (concatD [doc (showString "return") , prt 0 expr , doc (showString ";")])
|
||||
SCompound stmts -> prPrec i 0 (concatD [doc (showString "{") , prt 0 stmts , doc (showString "}")])
|
||||
SReturnVoid -> prPrec i 0 (concatD [doc (showString "return") , doc (showString ";")])
|
||||
SReturn expr -> prPrec i 0 (concatD [doc (showString "return") , prt 0 expr , doc (showString ";")])
|
||||
SDeclOrExpr declorexpr -> prPrec i 0 (concatD [prt 0 declorexpr , doc (showString ";")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print DeclOrExpr where
|
||||
prt i e = case e of
|
||||
Decl declvars -> prPrec i 0 (concatD [doc (showString "var") , prt 0 declvars])
|
||||
DExpr expr -> prPrec i 0 (concatD [prt 0 expr])
|
||||
|
||||
|
||||
instance Print DeclVar where
|
||||
prt i e = case e of
|
||||
DVar id -> prPrec i 0 (concatD [prt 0 id])
|
||||
DInit id expr -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 expr])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print Expr where
|
||||
prt i e = case e of
|
||||
EAssign expr0 expr -> prPrec i 13 (concatD [prt 14 expr0 , doc (showString "=") , prt 13 expr])
|
||||
ENew id exprs -> prPrec i 14 (concatD [doc (showString "new") , prt 0 id , doc (showString "(") , prt 0 exprs , doc (showString ")")])
|
||||
EMember expr0 expr -> prPrec i 15 (concatD [prt 15 expr0 , doc (showString ".") , prt 16 expr])
|
||||
EMember expr id -> prPrec i 15 (concatD [prt 15 expr , doc (showString ".") , prt 0 id])
|
||||
EIndex expr0 expr -> prPrec i 15 (concatD [prt 15 expr0 , doc (showString "[") , prt 0 expr , doc (showString "]")])
|
||||
ECall expr exprs -> prPrec i 15 (concatD [prt 15 expr , doc (showString "(") , prt 0 exprs , doc (showString ")")])
|
||||
EVar id -> prPrec i 16 (concatD [prt 0 id])
|
||||
@@ -124,6 +142,7 @@ instance Print Expr where
|
||||
EFalse -> prPrec i 16 (concatD [doc (showString "false")])
|
||||
ENull -> prPrec i 16 (concatD [doc (showString "null")])
|
||||
EThis -> prPrec i 16 (concatD [doc (showString "this")])
|
||||
EFun ids stmts -> prPrec i 16 (concatD [doc (showString "function") , doc (showString "(") , prt 0 ids , doc (showString ")") , doc (showString "{") , prt 0 stmts , doc (showString "}")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concatD [])
|
||||
|
||||
@@ -27,15 +27,29 @@ transElement x = case x of
|
||||
|
||||
transStmt :: Stmt -> Result
|
||||
transStmt x = case x of
|
||||
Compound stmts -> failure x
|
||||
ReturnVoid -> failure x
|
||||
Return expr -> failure x
|
||||
SCompound stmts -> failure x
|
||||
SReturnVoid -> failure x
|
||||
SReturn expr -> failure x
|
||||
SDeclOrExpr declorexpr -> failure x
|
||||
|
||||
|
||||
transDeclOrExpr :: DeclOrExpr -> Result
|
||||
transDeclOrExpr x = case x of
|
||||
Decl declvars -> failure x
|
||||
DExpr expr -> failure x
|
||||
|
||||
|
||||
transDeclVar :: DeclVar -> Result
|
||||
transDeclVar x = case x of
|
||||
DVar id -> failure x
|
||||
DInit id expr -> failure x
|
||||
|
||||
|
||||
transExpr :: Expr -> Result
|
||||
transExpr x = case x of
|
||||
EAssign expr0 expr -> failure x
|
||||
ENew id exprs -> failure x
|
||||
EMember expr0 expr -> failure x
|
||||
EMember expr id -> failure x
|
||||
EIndex expr0 expr -> failure x
|
||||
ECall expr exprs -> failure x
|
||||
EVar id -> failure x
|
||||
@@ -46,6 +60,7 @@ transExpr x = case x of
|
||||
EFalse -> failure x
|
||||
ENull -> failure x
|
||||
EThis -> failure x
|
||||
EFun ids stmts -> failure x
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user