mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-19 01:39:32 -06:00
3814841d7d
+ References to modules under src/compiler have been eliminated from the PGF library (under src/runtime/haskell). Only two functions had to be moved (from GF.Data.Utilities to PGF.Utilities) to make this possible, other apparent dependencies turned out to be vacuous. + In gf.cabal, the GF executable no longer directly depends on the PGF library source directory, but only on the exposed library modules. This means that there is less duplication in gf.cabal and that the 30 modules in the PGF library will no longer be compiled twice while building GF. To make this possible, additional PGF library modules have been exposed, even though they should probably be considered for internal use only. They could be collected in a PGF.Internal module, or marked as "unstable", to make this explicit. + Also, by using the -fwarn-unused-imports flag, ~220 redundant imports were found and removed, reducing the total number of imports by ~15%.
100 lines
4.2 KiB
Haskell
100 lines
4.2 KiB
Haskell
module GF.Compile.PGFtoJS (pgf2js) where
|
|
|
|
import PGF(showCId)
|
|
import PGF.Data hiding (mkStr)
|
|
import qualified PGF.Macros as M
|
|
import qualified GF.JavaScript.AbsJS as JS
|
|
import qualified GF.JavaScript.PrintJS as JS
|
|
|
|
--import GF.Data.ErrM
|
|
--import GF.Infra.Option
|
|
|
|
--import Control.Monad (mplus)
|
|
--import Data.Array.Unboxed (UArray)
|
|
import qualified Data.Array.IArray as Array
|
|
--import Data.Maybe (fromMaybe)
|
|
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 =
|
|
JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]]
|
|
where
|
|
n = showCId $ absname pgf
|
|
as = abstract pgf
|
|
cs = Map.assocs (concretes pgf)
|
|
start = showCId $ M.lookStartCat pgf
|
|
grammar = new "GFGrammar" [js_abstract, js_concrete]
|
|
js_abstract = abstract2js start as
|
|
js_concrete = JS.EObj $ map concrete2js cs
|
|
|
|
abstract2js :: String -> Abstr -> JS.Expr
|
|
abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]
|
|
|
|
absdef2js :: (CId,(Type,Int,Maybe [Equation],Double,BCAddr)) -> JS.Property
|
|
absdef2js (f,(typ,_,_,_,_)) =
|
|
let (args,cat) = M.catSkeleton typ in
|
|
JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)])
|
|
|
|
lit2js (LStr s) = JS.EStr s
|
|
lit2js (LInt n) = JS.EInt n
|
|
lit2js (LFlt d) = JS.EDbl d
|
|
|
|
concrete2js :: (CId,Concr) -> JS.Property
|
|
concrete2js (c,cnc) =
|
|
JS.Prop l (new "GFConcrete" [mapToJSObj (lit2js) $ cflags cnc,
|
|
JS.EObj $ [JS.Prop (JS.IntPropName cat) (JS.EArray (map frule2js (Set.toList set))) | (cat,set) <- IntMap.toList (productions cnc)],
|
|
JS.EArray $ (map ffun2js (Array.elems (cncfuns cnc))),
|
|
JS.EArray $ (map seq2js (Array.elems (sequences cnc))),
|
|
JS.EObj $ map cats (Map.assocs (cnccats cnc)),
|
|
JS.EInt (totalCats cnc)])
|
|
where
|
|
l = JS.IdentPropName (JS.Ident (showCId c))
|
|
litslins = [JS.Prop (JS.StringPropName "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
|
|
JS.Prop (JS.StringPropName "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
|
|
JS.Prop (JS.StringPropName "String") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]])]
|
|
cats (c,CncCat start end _) = JS.Prop (JS.IdentPropName (JS.Ident (showCId c))) (JS.EObj [JS.Prop (JS.IdentPropName (JS.Ident "s")) (JS.EInt start)
|
|
,JS.Prop (JS.IdentPropName (JS.Ident "e")) (JS.EInt end)])
|
|
mkStr :: String -> JS.Expr
|
|
mkStr s = new "Str" [JS.EStr s]
|
|
|
|
mkSeq :: [JS.Expr] -> JS.Expr
|
|
mkSeq [x] = x
|
|
mkSeq xs = new "Seq" xs
|
|
|
|
argIdent :: Integer -> JS.Ident
|
|
argIdent n = JS.Ident ("x" ++ show n)
|
|
|
|
children :: JS.Ident
|
|
children = JS.Ident "cs"
|
|
|
|
frule2js :: Production -> JS.Expr
|
|
frule2js (PApply funid args) = new "Apply" [JS.EInt funid, JS.EArray (map farg2js args)]
|
|
frule2js (PCoerce arg) = new "Coerce" [JS.EInt arg]
|
|
|
|
farg2js (PArg hypos fid) = new "PArg" (map (JS.EInt . snd) hypos ++ [JS.EInt fid])
|
|
|
|
ffun2js (CncFun f lins) = new "CncFun" [JS.EStr (showCId f), JS.EArray (map JS.EInt (Array.elems lins))]
|
|
|
|
seq2js :: Array.Array DotPos Symbol -> JS.Expr
|
|
seq2js seq = JS.EArray [sym2js s | s <- Array.elems seq]
|
|
|
|
sym2js :: Symbol -> JS.Expr
|
|
sym2js (SymCat n l) = new "SymCat" [JS.EInt n, JS.EInt l]
|
|
sym2js (SymLit n l) = new "SymLit" [JS.EInt n, JS.EInt l]
|
|
sym2js (SymVar n l) = new "SymVar" [JS.EInt n, JS.EInt l]
|
|
sym2js (SymKS t) = new "SymKS" [JS.EStr t]
|
|
sym2js (SymKP ts alts) = new "SymKP" [JS.EArray (map sym2js ts), JS.EArray (map alt2js alts)]
|
|
sym2js SymNE = new "SymNE" []
|
|
sym2js SymBIND = new "SymKS" [JS.EStr "&+"]
|
|
|
|
alt2js (ps,ts) = new "Alt" [JS.EArray (map sym2js ps), JS.EArray (map JS.EStr ts)]
|
|
|
|
new :: String -> [JS.Expr] -> JS.Expr
|
|
new f xs = JS.ENew (JS.Ident f) xs
|
|
|
|
mapToJSObj :: (a -> JS.Expr) -> Map CId a -> JS.Expr
|
|
mapToJSObj f m = JS.EObj [ JS.Prop (JS.IdentPropName (JS.Ident (showCId k))) (f v) | (k,v) <- Map.toList m ]
|