module GF.Speech.SISR (SISRFormat(..), SISRTag, prSISR,
topCatSISR, profileInitSISR, catSISR, profileFinalSISR) where
import Data.List
import GF.Infra.Option (SISRFormat(..))
import GF.Grammar.CFG
import GF.Speech.SRG (SRGNT)
import PGF(showCId)
import qualified GF.JavaScript.AbsJS as JS
import qualified GF.JavaScript.PrintJS as JS
type SISRTag = [JS.DeclOrExpr]
prSISR :: SISRTag -> String
prSISR :: SISRTag -> String
prSISR = SISRTag -> String
forall a. Print a => a -> String
JS.printTree
topCatSISR :: String -> SISRFormat -> SISRTag
topCatSISR :: String -> SISRFormat -> SISRTag
topCatSISR String
c SISRFormat
fmt = (Expr -> DeclOrExpr) -> [Expr] -> SISRTag
forall a b. (a -> b) -> [a] -> [b]
map Expr -> DeclOrExpr
JS.DExpr [SISRFormat -> Expr
fmtOut SISRFormat
fmt Expr -> Expr -> Expr
`ass` SISRFormat -> String -> Expr
fmtRef SISRFormat
fmt String
c]
profileInitSISR :: CFTerm -> SISRFormat -> SISRTag
profileInitSISR :: CFTerm -> SISRFormat -> SISRTag
profileInitSISR CFTerm
t SISRFormat
fmt
| [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CFTerm -> [Int]
usedArgs CFTerm
t) = []
| Bool
otherwise = [[DeclVar] -> DeclOrExpr
JS.Decl [Ident -> Expr -> DeclVar
JS.DInit Ident
args ([Expr] -> Expr
JS.EArray [])]]
usedArgs :: CFTerm -> [Int]
usedArgs :: CFTerm -> [Int]
usedArgs (CFObj CId
_ [CFTerm]
ts) = ([Int] -> [Int] -> [Int]) -> [Int] -> [[Int]] -> [Int]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
union [] ((CFTerm -> [Int]) -> [CFTerm] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map CFTerm -> [Int]
usedArgs [CFTerm]
ts)
usedArgs (CFAbs Int
_ CFTerm
x) = CFTerm -> [Int]
usedArgs CFTerm
x
usedArgs (CFApp CFTerm
x CFTerm
y) = CFTerm -> [Int]
usedArgs CFTerm
x [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
`union` CFTerm -> [Int]
usedArgs CFTerm
y
usedArgs (CFRes Int
i) = [Int
i]
usedArgs CFTerm
_ = []
catSISR :: CFTerm -> SRGNT -> SISRFormat -> SISRTag
catSISR :: CFTerm -> SRGNT -> SISRFormat -> SISRTag
catSISR CFTerm
t (String
c,Int
i) SISRFormat
fmt
| Int
i Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CFTerm -> [Int]
usedArgs CFTerm
t = (Expr -> DeclOrExpr) -> [Expr] -> SISRTag
forall a b. (a -> b) -> [a] -> [b]
map Expr -> DeclOrExpr
JS.DExpr
[Expr -> Expr -> Expr
JS.EIndex (Ident -> Expr
JS.EVar Ident
args) (Int -> Expr
JS.EInt (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)) Expr -> Expr -> Expr
`ass` SISRFormat -> String -> Expr
fmtRef SISRFormat
fmt String
c]
| Bool
otherwise = []
profileFinalSISR :: CFTerm -> SISRFormat -> SISRTag
profileFinalSISR :: CFTerm -> SISRFormat -> SISRTag
profileFinalSISR CFTerm
term SISRFormat
fmt = [Expr -> DeclOrExpr
JS.DExpr (Expr -> DeclOrExpr) -> Expr -> DeclOrExpr
forall a b. (a -> b) -> a -> b
$ SISRFormat -> Expr
fmtOut SISRFormat
fmt Expr -> Expr -> Expr
`ass` CFTerm -> Expr
f CFTerm
term]
where
f :: CFTerm -> Expr
f (CFObj CId
n [CFTerm]
ts) = String -> [Expr] -> Expr
tree (CId -> String
showCId CId
n) ((CFTerm -> Expr) -> [CFTerm] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map CFTerm -> Expr
f [CFTerm]
ts)
f (CFAbs Int
v CFTerm
x) = [Ident] -> [Stmt] -> Expr
JS.EFun [Int -> Ident
forall a. Show a => a -> Ident
var Int
v] [Expr -> Stmt
JS.SReturn (CFTerm -> Expr
f CFTerm
x)]
f (CFApp CFTerm
x CFTerm
y) = Expr -> [Expr] -> Expr
JS.ECall (CFTerm -> Expr
f CFTerm
x) [CFTerm -> Expr
f CFTerm
y]
f (CFRes Int
i) = Expr -> Expr -> Expr
JS.EIndex (Ident -> Expr
JS.EVar Ident
args) (Int -> Expr
JS.EInt (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i))
f (CFVar Int
v) = Ident -> Expr
JS.EVar (Int -> Ident
forall a. Show a => a -> Ident
var Int
v)
f (CFMeta CId
typ) = [(String, Expr)] -> Expr
obj [(String
"name",String -> Expr
JS.EStr String
"?"), (String
"type",String -> Expr
JS.EStr (CId -> String
showCId CId
typ))]
fmtOut :: SISRFormat -> Expr
fmtOut SISRFormat
SISR_WD20030401 = Ident -> Expr
JS.EVar (String -> Ident
JS.Ident String
"$")
fmtOut SISRFormat
SISR_1_0 = Ident -> Expr
JS.EVar (String -> Ident
JS.Ident String
"out")
fmtRef :: SISRFormat -> String -> Expr
fmtRef SISRFormat
SISR_WD20030401 String
c = Ident -> Expr
JS.EVar (String -> Ident
JS.Ident (String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c))
fmtRef SISRFormat
SISR_1_0 String
c = Expr -> String -> Expr
field (Ident -> Expr
JS.EVar (String -> Ident
JS.Ident String
"rules")) String
c
args :: Ident
args = String -> Ident
JS.Ident String
"a"
var :: a -> Ident
var a
v = String -> Ident
JS.Ident (String
"x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v)
field :: Expr -> String -> Expr
field Expr
x String
y = Expr -> Ident -> Expr
JS.EMember Expr
x (String -> Ident
JS.Ident String
y)
ass :: Expr -> Expr -> Expr
ass = Expr -> Expr -> Expr
JS.EAssign
tree :: String -> [Expr] -> Expr
tree String
n [Expr]
xs = [(String, Expr)] -> Expr
obj [(String
"name", String -> Expr
JS.EStr String
n), (String
"args", [Expr] -> Expr
JS.EArray [Expr]
xs)]
obj :: [(String, Expr)] -> Expr
obj [(String, Expr)]
ps = [Property] -> Expr
JS.EObj [PropertyName -> Expr -> Property
JS.Prop (String -> PropertyName
JS.StringPropName String
x) Expr
y | (String
x,Expr
y) <- [(String, Expr)]
ps]