1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
module GF.Compile.ToAPI
(stringToAPI,exprToAPI)
where
import PGF.Data
import PGF(showCId)
import Data.Maybe
--import System.IO
--import Control.Monad
--import Data.Set as Set (fromList,toList)
import Data.List
--import Data.Map(Map)
import qualified Data.Map as Map
import PGF.Signature
-- intermediate structure for representing the translated expression
data APIfunc = BasicFunc String | AppFunc String [APIfunc] | NoAPI
deriving (Show,Eq)
-- translates a GF expression/tree into an equivalent one which uses functions from the GF
-- API instead of the syntactic modules
exprToAPI :: Expr -> String
exprToAPI expr =
let ffs = exprToFunc expr
in printAPIfunc ffs
-- translates a GF expression/tree written as a string to its correspondent which uses API functions
-- the string is parsed into a GF expression/tree first
stringToAPI :: String -> String
stringToAPI expressionToRead =
case readExpr expressionToRead of
Just ex -> exprToAPI ex
_ -> error "incorrect expression given as input "
-- function for translating an expression into APIFunc with type inference for
-- the type of the expression
exprToFunc :: Expr -> APIfunc
exprToFunc expr =
case unApp expr of
Just (cid,l) ->
case Map.lookup (showCId cid) syntaxFuncs of
Just sig -> mkAPI True (fst sig,expr)
_ -> case l of
[] -> BasicFunc (showCId cid)
_ -> let es = map exprToFunc l
in AppFunc (showCId cid) es
_ -> BasicFunc (showExpr [] expr)
-- main function for translating an expression along with its type into an APIFunc
-- the boolean controls the need to optimize the result
mkAPI :: Bool -> (String, Expr) -> APIfunc
mkAPI opt (ty,expr) =
if elem ty rephraseable then rephraseSentence ty expr
else if opt then if elem ty optimizable then optimize expr else computeAPI (ty,expr)
else computeAPI (ty,expr)
where
rephraseSentence ty expr =
case unApp expr of
Just (cid,es) -> if isPrefixOf "Use" (showCId cid) then
let newCat = drop 3 (showCId cid)
afClause = mkAPI True (newCat, es !! 2)
afPol = mkAPI True ("Pol",es !! 1)
lTense = mkAPI True ("Temp", head es)
in case lTense of
AppFunc _ [BasicFunc s1, BasicFunc s2] ->
let (r1,r2) = getTemporalParam s1 s2 in
AppFunc ("mk"++newCat) [r1,r2,afPol,afClause]
_ -> error "erroneous tense"
else (mkAPI False) (ty,expr)
_ -> error $ "incorrect for for expression "++ showExpr [] expr
getTemporalParam s1 s2 =
let r1 = case s1 of
"TPres" -> NoAPI
"TPast" -> BasicFunc "pastTense"
"TFut" -> BasicFunc "futureTense"
"TCond" -> BasicFunc "conditionalTense"
r2 = case s2 of
"ASimul" -> NoAPI
"AAnter" -> BasicFunc "anteriorAnt"
in (r1,r2)
computeAPI :: (String,Expr) -> APIfunc
computeAPI (ty,expr) =
case (unApp expr) of
Just (cid,[]) -> getSimpCat (showCId cid) ty
Just (cid,es) ->
let p = specFunction (showCId cid) es
in if isJust p then fromJust p
else case Map.lookup (show cid) syntaxFuncs of
Nothing -> exprToFunc expr
Just (nameCat,typesExps) ->
if elem nameCat hiddenCats && length es == 1 then (mkAPI True) (head typesExps,head es)
else if elem nameCat hiddenCats then error $ "incorrect coercion "++nameCat++" - "++show es
else let afs = map (mkAPI True) (zip typesExps es)
in AppFunc ("mk" ++ nameCat) afs
_ -> error "error"
where
getSimpCat "IdRP" _ = BasicFunc "which_RP"
getSimpCat "DefArt" _ = BasicFunc "the_Art"
getSimpCat "IndefArt" _ = BasicFunc "a_Art"
getSimpCat "NumSg" _ = NoAPI
getSimpCat "NumPl" _ = BasicFunc "plNum"
getSimpCat "PPos" _ = NoAPI
getSimpCat "PNeg" _ = BasicFunc "negativePol"
getSimpCat cid ty = if elem ty ["PConj","Voc"] && isInfixOf "No" cid
then NoAPI
else BasicFunc cid
specFunction "PassV2" es = rephraseUnary "passiveVP" "V2" es
specFunction "ReflA2" es = rephraseUnary "reflAP" "A2" es
specFunction "UseComparA" es = rephraseUnary "comparAP" "A" es
specFunction "TFullStop" es = rephraseText "fullStopPunct" es
specFunction "TExclMark" es = rephraseText "exclMarkPunct" es
specFunction "TQuestMark" es = rephraseText "questMarkPunct" es
specFunction _ _ = Nothing
rephraseUnary ss ty es =
let afs = mkAPI True (ty,head es)
in Just (AppFunc ss [afs])
rephraseText ss es =
let afs = map (mkAPI True) (zip ["Phr","Text"] es) in
if afs !! 1 == BasicFunc "TEmpty" then Just (AppFunc "mkText" [head afs,BasicFunc ss])
else Just (AppFunc "mkText" [head afs, BasicFunc ss, last afs])
-- optimizations for the translation of some categories
optimize expr = optimizeNP expr
optimizeNP expr =
case unApp expr of
Just (cid,es) ->
if showCId cid == "MassNP" then let afs = nounAsCN (head es)
in AppFunc "mkNP" [afs]
else if showCId cid == "DetCN" then let quants = quantAsDet (head es)
ns = nounAsCN (head $ tail es)
in AppFunc "mkNP" (quants ++ [ns])
else mkAPI False ("NP",expr)
_ -> error $ "incorrect expression " ++ (showExpr [] expr)
where
nounAsCN expr =
case unApp expr of
Just (cid,es) -> if showCId cid == "UseN" then (mkAPI False) ("N",head es)
else (mkAPI False) ("CN",expr)
_ -> error $ "incorrect expression "++ (showExpr [] expr)
quantAsDet expr =
case unApp expr of
Just (cid,es) -> if showCId cid == "DetQuant" then map (mkAPI False) [("Quant", head es),("Num",head $ tail es)]
else [mkAPI False ("Det",expr)]
_ -> error $ "incorrect expression "++ (showExpr [] expr)
-- categories not present in the API - rephrasing needed
hiddenCats :: [String]
hiddenCats = ["N2","V2","Comp","SC"]
-- categories for which optimization of the translation is provided at the moment
optimizable :: [String]
optimizable = ["NP"]
-- categories for which the compositional translation needs to be rephrased
rephraseable :: [String]
rephraseable = ["S","QS","RS"]
-- converts the intermediate structure APIFunc to plain string
printAPIfunc :: APIfunc -> String
printAPIfunc (BasicFunc f) = f
printAPIfunc NoAPI = ""
printAPIfunc (AppFunc f es) = unwords (f : map (\x -> printAPIArgfunc x ) es)
where
printAPIArgfunc (BasicFunc f) = f
printAPIArgfunc NoAPI = ""
printAPIArgfunc f = "(" ++ printAPIfunc f ++ ")"
|
