module GF.Compile.PGFtoJS (pgf2js) where
import PGF(showCId)
import PGF.Internal as M
import qualified GF.JavaScript.AbsJS as JS
import qualified GF.JavaScript.PrintJS as JS
import qualified Data.Array.IArray as Array
import Data.Map (Map)
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
pgf2js :: PGF -> String
pgf2js :: PGF -> String
pgf2js PGF
pgf =
Program -> String
forall a. Print a => a -> String
JS.printTree (Program -> String) -> Program -> String
forall a b. (a -> b) -> a -> b
$ [Element] -> Program
JS.Program [Stmt -> Element
JS.ElStmt (Stmt -> Element) -> Stmt -> Element
forall a b. (a -> b) -> a -> b
$ DeclOrExpr -> Stmt
JS.SDeclOrExpr (DeclOrExpr -> Stmt) -> DeclOrExpr -> Stmt
forall a b. (a -> b) -> a -> b
$ [DeclVar] -> DeclOrExpr
JS.Decl [Ident -> Expr -> DeclVar
JS.DInit (String -> Ident
JS.Ident String
n) Expr
grammar]]
where
n :: String
n = CId -> String
showCId (CId -> String) -> CId -> String
forall a b. (a -> b) -> a -> b
$ PGF -> CId
absname PGF
pgf
as :: Abstr
as = PGF -> Abstr
abstract PGF
pgf
cs :: [(CId, Concr)]
cs = Map CId Concr -> [(CId, Concr)]
forall k a. Map k a -> [(k, a)]
Map.assocs (PGF -> Map CId Concr
concretes PGF
pgf)
start :: String
start = CId -> String
showCId (CId -> String) -> CId -> String
forall a b. (a -> b) -> a -> b
$ PGF -> CId
M.lookStartCat PGF
pgf
grammar :: Expr
grammar = String -> [Expr] -> Expr
new String
"GFGrammar" [Expr
js_abstract, Expr
js_concrete]
js_abstract :: Expr
js_abstract = String -> Abstr -> Expr
abstract2js String
start Abstr
as
js_concrete :: Expr
js_concrete = [Property] -> Expr
JS.EObj ([Property] -> Expr) -> [Property] -> Expr
forall a b. (a -> b) -> a -> b
$ ((CId, Concr) -> Property) -> [(CId, Concr)] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
map (CId, Concr) -> Property
concrete2js [(CId, Concr)]
cs
abstract2js :: String -> Abstr -> JS.Expr
abstract2js :: String -> Abstr -> Expr
abstract2js String
start Abstr
ds = String -> [Expr] -> Expr
new String
"GFAbstract" [String -> Expr
JS.EStr String
start, [Property] -> Expr
JS.EObj ([Property] -> Expr) -> [Property] -> Expr
forall a b. (a -> b) -> a -> b
$ ((CId, (Type, Int, Maybe ([Equation], [[Instr]]), Double))
-> Property)
-> [(CId, (Type, Int, Maybe ([Equation], [[Instr]]), Double))]
-> [Property]
forall a b. (a -> b) -> [a] -> [b]
map (CId, (Type, Int, Maybe ([Equation], [[Instr]]), Double))
-> Property
absdef2js (Map CId (Type, Int, Maybe ([Equation], [[Instr]]), Double)
-> [(CId, (Type, Int, Maybe ([Equation], [[Instr]]), Double))]
forall k a. Map k a -> [(k, a)]
Map.assocs (Abstr -> Map CId (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs Abstr
ds))]
absdef2js :: (CId,(Type,Int,Maybe ([Equation],[[M.Instr]]),Double)) -> JS.Property
absdef2js :: (CId, (Type, Int, Maybe ([Equation], [[Instr]]), Double))
-> Property
absdef2js (CId
f,(Type
typ,Int
_,Maybe ([Equation], [[Instr]])
_,Double
_)) =
let ([CId]
args,CId
cat) = Type -> ([CId], CId)
M.catSkeleton Type
typ in
PropertyName -> Expr -> Property
JS.Prop (Ident -> PropertyName
JS.IdentPropName (String -> Ident
JS.Ident (CId -> String
showCId CId
f))) (String -> [Expr] -> Expr
new String
"Type" [[Expr] -> Expr
JS.EArray [String -> Expr
JS.EStr (CId -> String
showCId CId
x) | CId
x <- [CId]
args], String -> Expr
JS.EStr (CId -> String
showCId CId
cat)])
lit2js :: Literal -> Expr
lit2js (LStr String
s) = String -> Expr
JS.EStr String
s
lit2js (LInt Int
n) = Int -> Expr
JS.EInt Int
n
lit2js (LFlt Double
d) = Double -> Expr
JS.EDbl Double
d
concrete2js :: (CId,Concr) -> JS.Property
concrete2js :: (CId, Concr) -> Property
concrete2js (CId
c,Concr
cnc) =
PropertyName -> Expr -> Property
JS.Prop PropertyName
l (String -> [Expr] -> Expr
new String
"GFConcrete" [(Literal -> Expr) -> Map CId Literal -> Expr
forall a. (a -> Expr) -> Map CId a -> Expr
mapToJSObj (Literal -> Expr
lit2js) (Map CId Literal -> Expr) -> Map CId Literal -> Expr
forall a b. (a -> b) -> a -> b
$ Concr -> Map CId Literal
cflags Concr
cnc,
[Property] -> Expr
JS.EObj ([Property] -> Expr) -> [Property] -> Expr
forall a b. (a -> b) -> a -> b
$ [PropertyName -> Expr -> Property
JS.Prop (Int -> PropertyName
JS.IntPropName Int
cat) ([Expr] -> Expr
JS.EArray ((Production -> Expr) -> [Production] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Production -> Expr
frule2js (Set Production -> [Production]
forall a. Set a -> [a]
Set.toList Set Production
set))) | (Int
cat,Set Production
set) <- IntMap (Set Production) -> [(Int, Set Production)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList (Concr -> IntMap (Set Production)
productions Concr
cnc)],
[Expr] -> Expr
JS.EArray ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ ((CncFun -> Expr) -> [CncFun] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map CncFun -> Expr
ffun2js (Array Int CncFun -> [CncFun]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems (Concr -> Array Int CncFun
cncfuns Concr
cnc))),
[Expr] -> Expr
JS.EArray ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ ((Array Int Symbol -> Expr) -> [Array Int Symbol] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Array Int Symbol -> Expr
seq2js (Array Int (Array Int Symbol) -> [Array Int Symbol]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems (Concr -> Array Int (Array Int Symbol)
sequences Concr
cnc))),
[Property] -> Expr
JS.EObj ([Property] -> Expr) -> [Property] -> Expr
forall a b. (a -> b) -> a -> b
$ ((CId, CncCat) -> Property) -> [(CId, CncCat)] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
map (CId, CncCat) -> Property
cats (Map CId CncCat -> [(CId, CncCat)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Concr -> Map CId CncCat
cnccats Concr
cnc)),
Int -> Expr
JS.EInt (Concr -> Int
totalCats Concr
cnc)])
where
l :: PropertyName
l = Ident -> PropertyName
JS.IdentPropName (String -> Ident
JS.Ident (CId -> String
showCId CId
c))
cats :: (CId, CncCat) -> Property
cats (CId
c,CncCat Int
start Int
end Array Int String
_) = PropertyName -> Expr -> Property
JS.Prop (Ident -> PropertyName
JS.IdentPropName (String -> Ident
JS.Ident (CId -> String
showCId CId
c))) ([Property] -> Expr
JS.EObj [PropertyName -> Expr -> Property
JS.Prop (Ident -> PropertyName
JS.IdentPropName (String -> Ident
JS.Ident String
"s")) (Int -> Expr
JS.EInt Int
start)
,PropertyName -> Expr -> Property
JS.Prop (Ident -> PropertyName
JS.IdentPropName (String -> Ident
JS.Ident String
"e")) (Int -> Expr
JS.EInt Int
end)])
children :: JS.Ident
children :: Ident
children = String -> Ident
JS.Ident String
"cs"
frule2js :: Production -> JS.Expr
frule2js :: Production -> Expr
frule2js (PApply Int
funid [PArg]
args) = String -> [Expr] -> Expr
new String
"Apply" [Int -> Expr
JS.EInt Int
funid, [Expr] -> Expr
JS.EArray ((PArg -> Expr) -> [PArg] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map PArg -> Expr
farg2js [PArg]
args)]
frule2js (PCoerce Int
arg) = String -> [Expr] -> Expr
new String
"Coerce" [Int -> Expr
JS.EInt Int
arg]
farg2js :: PArg -> Expr
farg2js (PArg [(Int, Int)]
hypos Int
fid) = String -> [Expr] -> Expr
new String
"PArg" (((Int, Int) -> Expr) -> [(Int, Int)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Expr
JS.EInt (Int -> Expr) -> ((Int, Int) -> Int) -> (Int, Int) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd) [(Int, Int)]
hypos [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Int -> Expr
JS.EInt Int
fid])
ffun2js :: CncFun -> Expr
ffun2js (CncFun CId
f UArray Int Int
lins) = String -> [Expr] -> Expr
new String
"CncFun" [String -> Expr
JS.EStr (CId -> String
showCId CId
f), [Expr] -> Expr
JS.EArray ((Int -> Expr) -> [Int] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Expr
JS.EInt (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems UArray Int Int
lins))]
seq2js :: Array.Array DotPos Symbol -> JS.Expr
seq2js :: Array Int Symbol -> Expr
seq2js Array Int Symbol
seq = [Expr] -> Expr
JS.EArray [Symbol -> Expr
sym2js Symbol
s | Symbol
s <- Array Int Symbol -> [Symbol]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems Array Int Symbol
seq]
sym2js :: Symbol -> JS.Expr
sym2js :: Symbol -> Expr
sym2js (SymCat Int
n Int
l) = String -> [Expr] -> Expr
new String
"SymCat" [Int -> Expr
JS.EInt Int
n, Int -> Expr
JS.EInt Int
l]
sym2js (SymLit Int
n Int
l) = String -> [Expr] -> Expr
new String
"SymLit" [Int -> Expr
JS.EInt Int
n, Int -> Expr
JS.EInt Int
l]
sym2js (SymVar Int
n Int
l) = String -> [Expr] -> Expr
new String
"SymVar" [Int -> Expr
JS.EInt Int
n, Int -> Expr
JS.EInt Int
l]
sym2js (SymKS String
t) = String -> [Expr] -> Expr
new String
"SymKS" [String -> Expr
JS.EStr String
t]
sym2js (SymKP [Symbol]
ts [([Symbol], [String])]
alts) = String -> [Expr] -> Expr
new String
"SymKP" [[Expr] -> Expr
JS.EArray ((Symbol -> Expr) -> [Symbol] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Expr
sym2js [Symbol]
ts), [Expr] -> Expr
JS.EArray ((([Symbol], [String]) -> Expr) -> [([Symbol], [String])] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map ([Symbol], [String]) -> Expr
alt2js [([Symbol], [String])]
alts)]
sym2js Symbol
SymBIND = String -> [Expr] -> Expr
new String
"SymKS" [String -> Expr
JS.EStr String
"&+"]
sym2js Symbol
SymSOFT_BIND = String -> [Expr] -> Expr
new String
"SymKS" [String -> Expr
JS.EStr String
"&+"]
sym2js Symbol
SymSOFT_SPACE = String -> [Expr] -> Expr
new String
"SymKS" [String -> Expr
JS.EStr String
"&+"]
sym2js Symbol
SymCAPIT = String -> [Expr] -> Expr
new String
"SymKS" [String -> Expr
JS.EStr String
"&|"]
sym2js Symbol
SymALL_CAPIT = String -> [Expr] -> Expr
new String
"SymKS" [String -> Expr
JS.EStr String
"&|"]
sym2js Symbol
SymNE = String -> [Expr] -> Expr
new String
"SymNE" []
alt2js :: ([Symbol], [String]) -> Expr
alt2js ([Symbol]
ps,[String]
ts) = String -> [Expr] -> Expr
new String
"Alt" [[Expr] -> Expr
JS.EArray ((Symbol -> Expr) -> [Symbol] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Expr
sym2js [Symbol]
ps), [Expr] -> Expr
JS.EArray ((String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map String -> Expr
JS.EStr [String]
ts)]
new :: String -> [JS.Expr] -> JS.Expr
new :: String -> [Expr] -> Expr
new String
f [Expr]
xs = Ident -> [Expr] -> Expr
JS.ENew (String -> Ident
JS.Ident String
f) [Expr]
xs
mapToJSObj :: (a -> JS.Expr) -> Map CId a -> JS.Expr
mapToJSObj :: (a -> Expr) -> Map CId a -> Expr
mapToJSObj a -> Expr
f Map CId a
m = [Property] -> Expr
JS.EObj [ PropertyName -> Expr -> Property
JS.Prop (Ident -> PropertyName
JS.IdentPropName (String -> Ident
JS.Ident (CId -> String
showCId CId
k))) (a -> Expr
f a
v) | (CId
k,a
v) <- Map CId a -> [(CId, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map CId a
m ]