From dd6e0b17307475a614b3d36d7f0f0816968bfa40 Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 7 Dec 2010 18:05:13 +0000 Subject: moved PGF.ToApi to GF.Compile.ToAPI --- src/compiler/GF/Command/Commands.hs | 2 +- src/compiler/GF/Compile/ExampleBased.hs | 2 +- src/compiler/GF/Compile/ToAPI.hs | 206 ++++++++++++++++++++++++++++++++ src/runtime/haskell/PGF.hs | 6 +- src/runtime/haskell/PGF/ToApi.hs | 206 -------------------------------- 5 files changed, 209 insertions(+), 213 deletions(-) create mode 100644 src/compiler/GF/Compile/ToAPI.hs delete mode 100644 src/runtime/haskell/PGF/ToApi.hs (limited to 'src') diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 17099be68..530dc236f 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -20,11 +20,11 @@ import PGF.Macros import PGF.Data ---- import PGF.Morphology import PGF.Printer -import PGF.ToAPI import PGF.Probabilistic -- (getProbsFromFile,prProbabilities,defaultProbabilities) import PGF.Generate (generateRandomFrom) ---- import PGF.Tree (Tree(Fun), expr2tree, tree2expr) import GF.Compile.Export +import GF.Compile.ToAPI import GF.Compile.ExampleBased import GF.Infra.Option (noOptions, readOutputFormat) import GF.Infra.UseIO diff --git a/src/compiler/GF/Compile/ExampleBased.hs b/src/compiler/GF/Compile/ExampleBased.hs index b4c0caf75..39d88ae49 100644 --- a/src/compiler/GF/Compile/ExampleBased.hs +++ b/src/compiler/GF/Compile/ExampleBased.hs @@ -6,7 +6,7 @@ module GF.Compile.ExampleBased ( import PGF import PGF.Probabilistic import PGF.Morphology -import PGF.ToAPI +import GF.Compile.ToAPI import Data.List diff --git a/src/compiler/GF/Compile/ToAPI.hs b/src/compiler/GF/Compile/ToAPI.hs new file mode 100644 index 000000000..e118ea208 --- /dev/null +++ b/src/compiler/GF/Compile/ToAPI.hs @@ -0,0 +1,206 @@ +module GF.Compile.ToAPI + (stringToAPI,exprToAPI) + where + +import PGF.Expr +import PGF.CId +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 ++ ")" + + + + + + diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index 197f10ab9..42ef8aaff 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -126,10 +126,7 @@ module PGF( readProbabilitiesFromFile, -- * Browsing - browse, - -- * ToAPI - exprToAPI, - stringToAPI + browse ) where import PGF.CId @@ -144,7 +141,6 @@ import PGF.Expr (Tree) import PGF.Morphology import PGF.Data import PGF.Binary -import PGF.ToAPI import qualified PGF.Forest as Forest import qualified PGF.Parse as Parse diff --git a/src/runtime/haskell/PGF/ToApi.hs b/src/runtime/haskell/PGF/ToApi.hs deleted file mode 100644 index c11aa7341..000000000 --- a/src/runtime/haskell/PGF/ToApi.hs +++ /dev/null @@ -1,206 +0,0 @@ -module PGF.ToAPI - (stringToAPI,exprToAPI) - where - -import PGF.Expr -import PGF.CId -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 ++ ")" - - - - - - -- cgit v1.2.3