----------------------------------------------------------------------
-- |
-- Module      : PGFtoPython
-- Maintainer  : Peter Ljunglöf
--
-- exports a GF grammar into a Python module
-----------------------------------------------------------------------------

{-# LANGUAGE FlexibleContexts #-}
module GF.Compile.PGFtoPython (pgf2python) where

import PGF(showCId)
import PGF.Internal as M

import GF.Data.Operations

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 -> String
pgf2python PGF
pgf = (String
"# -*- coding: utf-8 -*-" String -> String -> String
++++
                  String
"# This file was automatically generated by GF" String -> String -> String
+++++
                  CId -> String
showCId CId
name String -> String -> String
+++ String
"=" String -> String -> String
+++ 
                  Int
-> (String -> String)
-> (String -> String)
-> [(String, String)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
1 String -> String
pyStr String -> String
forall a. a -> a
id [
                              (String
"flags", Int
-> (CId -> String)
-> (Literal -> String)
-> [(CId, Literal)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
2 CId -> String
pyCId Literal -> String
pyLiteral (Map CId Literal -> [(CId, Literal)]
forall k a. Map k a -> [(k, a)]
Map.assocs (PGF -> Map CId Literal
gflags PGF
pgf))),
                              (String
"abstract", Int
-> (String -> String)
-> (String -> String)
-> [(String, String)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
2 String -> String
pyStr String -> String
forall a. a -> a
id [
                                              (String
"name", CId -> String
pyCId CId
name), 
                                              (String
"start", CId -> String
pyCId CId
start), 
                                              (String
"flags", Int
-> (CId -> String)
-> (Literal -> String)
-> [(CId, Literal)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
3 CId -> String
pyCId Literal -> String
pyLiteral (Map CId Literal -> [(CId, Literal)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Abstr -> Map CId Literal
aflags Abstr
abs))),
                                              (String
"funs", Int
-> (CId -> String)
-> ((Type, Int, Maybe ([Equation], [[Instr]]), Double) -> String)
-> [(CId, (Type, Int, Maybe ([Equation], [[Instr]]), Double))]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
3 CId -> String
pyCId (Type, Int, Maybe ([Equation], [[Instr]]), Double) -> String
pyAbsdef (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
abs)))
                                             ]),
                              (String
"concretes", Int
-> (CId -> String) -> (Concr -> String) -> [(CId, Concr)] -> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
2 CId -> String
pyCId Concr -> String
pyConcrete (Map CId Concr -> [(CId, Concr)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map CId Concr
cncs))
                             ] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")
    where
      name :: CId
name  = PGF -> CId
absname PGF
pgf
      start :: CId
start = PGF -> CId
M.lookStartCat PGF
pgf
      abs :: Abstr
abs = PGF -> Abstr
abstract PGF
pgf
      cncs :: Map CId Concr
cncs = PGF -> Map CId Concr
concretes PGF
pgf

pyAbsdef :: (Type, Int, Maybe ([Equation], [[M.Instr]]), Double) -> String
pyAbsdef :: (Type, Int, Maybe ([Equation], [[Instr]]), Double) -> String
pyAbsdef (Type
typ, Int
_, Maybe ([Equation], [[Instr]])
_, Double
_) = Int -> (String -> String) -> [String] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 String -> String
forall a. a -> a
id [CId -> String
pyCId CId
cat, Int -> (CId -> String) -> [CId] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 CId -> String
pyCId [CId]
args]
    where ([CId]
args, CId
cat) = Type -> ([CId], CId)
M.catSkeleton Type
typ 

pyLiteral :: Literal -> String
pyLiteral :: Literal -> String
pyLiteral (LStr String
s) = String -> String
pyStr String
s
pyLiteral (LInt Int
n) = Int -> String
forall a. Show a => a -> String
show Int
n
pyLiteral (LFlt Double
d) = Double -> String
forall a. Show a => a -> String
show Double
d

pyConcrete :: Concr -> String
pyConcrete :: Concr -> String
pyConcrete Concr
cnc = Int
-> (String -> String)
-> (String -> String)
-> [(String, String)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
3 String -> String
pyStr String -> String
forall a. a -> a
id [
                  (String
"flags", Int
-> (CId -> String)
-> (Literal -> String)
-> [(CId, Literal)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
0 CId -> String
pyCId Literal -> String
pyLiteral (Map CId Literal -> [(CId, Literal)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Concr -> Map CId Literal
cflags Concr
cnc))),
                  (String
"printnames", Int
-> (CId -> String)
-> (String -> String)
-> [(CId, String)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
4 CId -> String
pyCId String -> String
pyStr (Map CId String -> [(CId, String)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Concr -> Map CId String
printnames Concr
cnc))),
                  (String
"lindefs", Int
-> (Int -> String) -> ([Int] -> String) -> [(Int, [Int])] -> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
4 Int -> String
pyCat (Int -> (Int -> String) -> [Int] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 Int -> String
pyFun) (IntMap [Int] -> [(Int, [Int])]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs (Concr -> IntMap [Int]
lindefs Concr
cnc))),
                  (String
"productions", Int
-> (Int -> String)
-> (Set Production -> String)
-> [(Int, Set Production)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
4 Int -> String
pyCat Set Production -> String
pyProds (IntMap (Set Production) -> [(Int, Set Production)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs (Concr -> IntMap (Set Production)
productions Concr
cnc))),
                  (String
"cncfuns", Int
-> (Int -> String)
-> (CncFun -> String)
-> [(Int, CncFun)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
4 Int -> String
pyFun CncFun -> String
pyCncFun (Array Int CncFun -> [(Int, CncFun)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs (Concr -> Array Int CncFun
cncfuns Concr
cnc))),
                  (String
"sequences",  Int
-> (Int -> String)
-> (Array Int Symbol -> String)
-> [(Int, Array Int Symbol)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
4 Int -> String
pySeq Array Int Symbol -> String
forall (a :: * -> * -> *) i.
(IArray a Symbol, Ix i) =>
a i Symbol -> String
pySymbols (Array Int (Array Int Symbol) -> [(Int, Array Int Symbol)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
Array.assocs (Concr -> Array Int (Array Int Symbol)
sequences Concr
cnc))),
                  (String
"cnccats", Int
-> (CId -> String)
-> (CncCat -> String)
-> [(CId, CncCat)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
4 CId -> String
pyCId CncCat -> String
pyCncCat (Map CId CncCat -> [(CId, CncCat)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Concr -> Map CId CncCat
cnccats Concr
cnc))),
                  (String
"size",  Int -> String
forall a. Show a => a -> String
show (Concr -> Int
totalCats Concr
cnc))
                 ]
    where pyProds :: Set Production -> String
pyProds Set Production
prods = Int -> (Production -> String) -> [Production] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
5 Production -> String
pyProduction (Set Production -> [Production]
forall a. Set a -> [a]
Set.toList Set Production
prods)
          pyCncCat :: CncCat -> String
pyCncCat (CncCat Int
start Int
end Array Int String
_) = Int -> (Int -> String) -> [Int] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 Int -> String
pyCat [Int
start..Int
end]
          pyCncFun :: CncFun -> String
pyCncFun (CncFun CId
f UArray Int Int
lins) = Int -> (String -> String) -> [String] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 String -> String
forall a. a -> a
id [Int -> (Int -> String) -> [Int] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 Int -> String
pySeq (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems UArray Int Int
lins), CId -> String
pyCId CId
f]
          pySymbols :: a i Symbol -> String
pySymbols a i Symbol
syms = Int -> (Symbol -> String) -> [Symbol] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 Symbol -> String
pySymbol (a i Symbol -> [Symbol]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems a i Symbol
syms)

pyProduction :: Production -> String
pyProduction :: Production -> String
pyProduction (PCoerce Int
arg)       = Int -> (String -> String) -> [String] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 String -> String
forall a. a -> a
id [String -> String
pyStr String
"", Int -> (Int -> String) -> [Int] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 Int -> String
pyCat [Int
arg]]
pyProduction (PApply Int
funid [PArg]
args) = Int -> (String -> String) -> [String] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 String -> String
forall a. a -> a
id [Int -> String
pyFun Int
funid, Int -> (PArg -> String) -> [PArg] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 PArg -> String
pyPArg [PArg]
args]
    where pyPArg :: PArg -> String
pyPArg (PArg [] Int
fid) = Int -> String
pyCat Int
fid
          pyPArg (PArg [(Int, Int)]
hypos Int
fid) = Int -> (Int -> String) -> [Int] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 Int -> String
pyCat (Int
fid Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
hypos)

pySymbol :: Symbol -> String
pySymbol :: Symbol -> String
pySymbol (SymCat Int
n Int
l)    = Int -> (Int -> String) -> [Int] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 Int -> String
forall a. Show a => a -> String
show [Int
n, Int
l]
pySymbol (SymLit Int
n Int
l)    = Int
-> (String -> String)
-> (String -> String)
-> [(String, String)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
0 String -> String
pyStr String -> String
forall a. a -> a
id [(String
"lit", Int -> (Int -> String) -> [Int] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 Int -> String
forall a. Show a => a -> String
show [Int
n, Int
l])]
pySymbol (SymVar Int
n Int
l)    = Int
-> (String -> String)
-> (String -> String)
-> [(String, String)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
0 String -> String
pyStr String -> String
forall a. a -> a
id [(String
"var", Int -> (Int -> String) -> [Int] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 Int -> String
forall a. Show a => a -> String
show [Int
n, Int
l])]
pySymbol (SymKS String
t)       = String -> String
pyStr String
t
pySymbol (SymKP [Symbol]
ts [([Symbol], [String])]
alts) = Int
-> (String -> String)
-> (String -> String)
-> [(String, String)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
0 String -> String
pyStr String -> String
forall a. a -> a
id [(String
"pre", Int -> (Symbol -> String) -> [Symbol] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 Symbol -> String
pySymbol [Symbol]
ts), (String
"alts", Int
-> (([Symbol], [String]) -> String)
-> [([Symbol], [String])]
-> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 ([Symbol], [String]) -> String
alt2py [([Symbol], [String])]
alts)]
    where alt2py :: ([Symbol], [String]) -> String
alt2py ([Symbol]
ps,[String]
ts) = Int -> ([String] -> String) -> [[String]] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 (Int -> (String -> String) -> [String] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyList Int
0 String -> String
pyStr) [(Symbol -> String) -> [Symbol] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> String
pySymbol [Symbol]
ps, [String]
ts]
pySymbol Symbol
SymBIND         = String -> String
pyStr String
"&+"
pySymbol Symbol
SymSOFT_BIND    = String -> String
pyStr String
"&+"
pySymbol Symbol
SymSOFT_SPACE   = String -> String
pyStr String
"&+"
pySymbol Symbol
SymCAPIT        = String -> String
pyStr String
"&|"
pySymbol Symbol
SymALL_CAPIT    = String -> String
pyStr String
"&|"
pySymbol Symbol
SymNE           = Int
-> (String -> String)
-> (String -> String)
-> [(String, String)]
-> String
forall k v.
Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
0 String -> String
pyStr String -> String
forall a. a -> a
id [(String
"nonExist", Int -> (String -> String) -> [String] -> String
forall v. Int -> (v -> String) -> [v] -> String
pyTuple Int
0 String -> String
forall a. a -> a
id [])]

----------------------------------------------------------------------
-- python helpers 

pyDict :: Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict :: Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
pyDict Int
n k -> String
pk v -> String
pv [] = String
"{}"
pyDict Int
n k -> String
pk v -> String
pv [(k, v)]
kvlist = String -> String
prCurly (Int -> String
pyIndent Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
prTList (String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
pyIndent Int
n) (((k, v) -> String) -> [(k, v)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> String
pyKV [(k, v)]
kvlist) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
pyIndent Int
n)
    where pyKV :: (k, v) -> String
pyKV (k
k, v
v) = k -> String
pk k
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ v -> String
pv v
v

pyList :: Int -> (v -> String) -> [v] -> String
pyList :: Int -> (v -> String) -> [v] -> String
pyList Int
n v -> String
pv [] = String
"[]"
pyList Int
n v -> String
pv [v]
xs = String -> String
prBracket (Int -> String
pyIndent Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
prTList (String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
pyIndent Int
n) ((v -> String) -> [v] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map v -> String
pv [v]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
pyIndent Int
n)

pyTuple :: Int -> (v -> String) -> [v] -> String
pyTuple :: Int -> (v -> String) -> [v] -> String
pyTuple Int
n v -> String
pv [] = String
"()"
pyTuple Int
n v -> String
pv [v
x] = String -> String
prParenth (Int -> String
pyIndent Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ v -> String
pv v
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
pyIndent Int
n)
pyTuple Int
n v -> String
pv [v]
xs = String -> String
prParenth (Int -> String
pyIndent Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
prTList (String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
pyIndent Int
n) ((v -> String) -> [v] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map v -> String
pv [v]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
pyIndent Int
n)

pyCat :: Int -> String
pyCat :: Int -> String
pyCat Int
n = String -> String
pyStr (Char
'C' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n)

pyFun :: Int -> String
pyFun :: Int -> String
pyFun Int
n = String -> String
pyStr (Char
'F' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n)

pySeq :: Int -> String
pySeq :: Int -> String
pySeq Int
n = String -> String
pyStr (Char
'S' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n)

pyStr :: String -> String
pyStr :: String -> String
pyStr String
s = Char
'u' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
prQuotedString String
s

pyCId :: CId -> String
pyCId :: CId -> String
pyCId = String -> String
pyStr (String -> String) -> (CId -> String) -> CId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CId -> String
showCId

pyIndent :: Int -> String
pyIndent :: Int -> String
pyIndent Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '
           | Bool
otherwise = String
""