Export PGF in Python format

src/compiler/GF/Compile/Export.hs

@@ -6,6 +6,7 @@ import GF.Compile.PGFtoHaskell
 import GF.Compile.PGFtoProlog
 import GF.Compile.PGFtoLProlog
 import GF.Compile.PGFtoJS
+import GF.Compile.PGFtoPython
 import GF.Infra.Option
 import GF.Speech.CFG
 import GF.Speech.PGFToCFG
@@ -32,6 +33,7 @@ exportPGF opts fmt pgf =
     case fmt of
       FmtPGFPretty    -> multi "txt" (render . ppPGF)
       FmtJavaScript   -> multi "js"  pgf2js
+      FmtPython       -> multi "py"  pgf2python
       FmtHaskell      -> multi "hs"  (grammar2haskell opts name)
       FmtProlog       -> multi "pl"  grammar2prolog
       FmtProlog_Abs   -> multi "pl"  grammar2prolog_abs

src/compiler/GF/Compile/PGFtoPython.hs

@@ -0,0 +1,108 @@
+----------------------------------------------------------------------
+-- 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)

src/compiler/GF/Infra/Option.hs

@@ -85,6 +85,7 @@ data Phase = Preproc | Convert | Compile | Link
 
 data OutputFormat = FmtPGFPretty
                   | FmtJavaScript 
+                  | FmtPython 
                   | FmtHaskell 
                   | FmtProlog
                   | FmtProlog_Abs
@@ -432,6 +433,7 @@ outputFormatsExpl :: [((String,OutputFormat),String)]
 outputFormatsExpl = 
     [(("pgf_pretty",   FmtPGFPretty),"human-readable pgf"),
      (("js",           FmtJavaScript),"JavaScript (whole grammar)"),
+     (("python",       FmtPython),"Python (whole grammar)"),
      (("haskell",      FmtHaskell),"Haskell (abstract syntax)"),
      (("prolog",       FmtProlog),"Prolog (whole grammar)"),
      (("prolog_abs",   FmtProlog_Abs),"Prolog (abstract syntax)"),