forked from GitHub/gf-core
109 lines
4.6 KiB
Haskell
109 lines
4.6 KiB
Haskell
----------------------------------------------------------------------
|
|
-- Module : PGFtoPython
|
|
-- Maintainer : Peter Ljunglöf
|
|
--
|
|
-- exports a GF grammar into a Python module
|
|
-----------------------------------------------------------------------------
|
|
|
|
module GF.Compile.PGFtoPython (pgf2python) where
|
|
|
|
import PGF.CId
|
|
import PGF.Data
|
|
import qualified PGF.Macros as M
|
|
|
|
import qualified Data.Array.IArray as Array
|
|
import qualified Data.Set as Set
|
|
import qualified Data.Map as Map
|
|
import qualified Data.IntMap as IntMap
|
|
import Data.List (intersperse)
|
|
|
|
pgf2python :: PGF -> String
|
|
pgf2python pgf = "# -*- coding: UTF-8 -*-\n" ++
|
|
"# This file was automatically generated by GF\n\n" ++
|
|
showCId name ++ " = " ++ grammar ++ "\n"
|
|
where
|
|
name = absname pgf
|
|
start = M.lookStartCat pgf
|
|
abs = abstract pgf
|
|
cncs = concretes pgf
|
|
grammar = pyDict 1 [(qs "abstract", pyDict 2 [(qs "name", qcid name),
|
|
(qs "start", qcid start),
|
|
(qs "flags", pyDict 0 [(qcid k, lit2py v) |
|
|
(k, v) <- Map.toList (aflags abs)]),
|
|
(qs "funs", pyDict 3 [(qcid f, absdef2py def) |
|
|
(f, def) <- Map.assocs (funs abs)])]),
|
|
(qs "concretes", pyDict 2 [(qcid cname, concrete2py cnc) |
|
|
(cname, cnc) <- Map.assocs cncs])]
|
|
|
|
absdef2py :: (Type, Int, Maybe [Equation], Double) -> String
|
|
absdef2py (typ, _, _, _) = pyTuple 0 [qcid cat, pyList 0 (map qcid args)]
|
|
where (args, cat) = M.catSkeleton typ
|
|
|
|
lit2py :: Literal -> String
|
|
lit2py (LStr s) = qs s
|
|
lit2py (LInt n) = show n
|
|
lit2py (LFlt d) = show d
|
|
|
|
concrete2py :: Concr -> String
|
|
concrete2py cnc = pyDict 3 [(qs "flags", pyDict 0 [(qcid k, lit2py v) | (k, v) <- Map.toList (cflags cnc)]),
|
|
(qs "prods", pyDict 4 [(show cat, pyList 0 (map frule2py (Set.toList set))) |
|
|
(cat, set) <- IntMap.toList (productions cnc)]),
|
|
(qs "cfuns", pyList 4 [ffun2py f | f <- Array.elems (cncfuns cnc)]),
|
|
(qs "seqs", pyList 4 [seq2py s | s <- Array.elems (sequences cnc)]),
|
|
(qs "ccats", pyDict 4 [(qcid cat, pyTuple 0 [show start, show end]) |
|
|
(cat, CncCat start end _) <- Map.assocs (cnccats cnc)]),
|
|
(qs "size", show (totalCats cnc))]
|
|
|
|
frule2py :: Production -> String
|
|
frule2py (PApply funid args) = pyTuple 0 [show funid, pyList 0 (map parg2py args)]
|
|
frule2py (PCoerce arg) = show arg
|
|
|
|
parg2py :: PArg -> String
|
|
parg2py (PArg [] fid) = show fid
|
|
parg2py (PArg hypos fid) = pyTuple 0 (show fid : map (show . snd) hypos)
|
|
|
|
ffun2py :: CncFun -> String
|
|
ffun2py (CncFun f lins) = pyTuple 0 [pyList 0 (map show (Array.elems lins)), qcid f]
|
|
|
|
seq2py :: Array.Array DotPos Symbol -> String
|
|
seq2py seq = pyList 0 [sym2py s | s <- Array.elems seq]
|
|
|
|
sym2py :: Symbol -> String
|
|
sym2py (SymCat n l) = pyTuple 0 [show n, show l]
|
|
sym2py (SymLit n l) = pyDict 0 [(qs "lit", pyTuple 0 [show n, show l])]
|
|
sym2py (SymVar n l) = pyDict 0 [(qs "var", pyTuple 0 [show n, show l])]
|
|
sym2py (SymKS ts) = join "," (map qs ts)
|
|
sym2py (SymKP ts alts) = pyDict 0 [(qs "pre", pyList 0 (map show ts)),
|
|
(qs "alts", pyList 0 (map alt2py alts))]
|
|
where alt2py (Alt ps ts) = pyTuple 0 [pyList 0 (map show ps), pyList 0 (map show ts)]
|
|
|
|
----------------------------------------------------------------------
|
|
-- python helpers
|
|
|
|
pyDict :: Int -> [(String, String)] -> String
|
|
pyDict n xys = "{" ++ indent n ++ join ("," ++ indent n) [x ++ ":" ++ y | (x, y) <- xys] ++ indent n ++ "}"
|
|
|
|
pyList :: Int -> [String] -> String
|
|
pyList n xs = "[" ++ indent n ++ join ("," ++ indent n) xs ++ indent n ++ "]"
|
|
|
|
pyTuple :: Int -> [String] -> String
|
|
pyTuple n [x] = "(" ++ indent n ++ x ++ "," ++ indent n ++ ")"
|
|
pyTuple n xs = "(" ++ indent n ++ join ("," ++ indent n) xs ++ indent n ++ ")"
|
|
|
|
qs :: String -> String
|
|
qs s = "u\"" ++ qs' s
|
|
where qs' ('"':s) = "\\\"" ++ qs' s
|
|
qs' ('\\':s) = "\\\\" ++ qs' s
|
|
qs' (c:s) = c : qs' s
|
|
qs' [] = "\""
|
|
|
|
qcid :: CId -> String
|
|
qcid = qs . showCId
|
|
|
|
indent :: Int -> String
|
|
indent n | n > 0 = "\n" ++ replicate n ' '
|
|
| otherwise = ""
|
|
|
|
join :: String -> [String] -> String
|
|
join a bs = concat (intersperse a bs)
|