msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

no more IO in the syntax to API translator

Browse Source
This commit is contained in:
ra.monique
2010-12-06 10:15:14 +00:00
parent 86bc73cb03
commit 1e5a0c9d9e
2 changed files with 54 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/compiler/GF/Command/Commands.hs
View File

@@ -854,7 +854,7 @@ allCommands env@(pgf, mos) = Map.fromList [
then return $ fromString $ unlines $ map (tree2mk pgf) es
else if isOpt "api" opts
then do
ss <- mapM exprToAPIIO es
let ss = map exprToAPI es
mapM_ putStrLn ss
return void
else do

112
src/runtime/haskell/PGF/ToApi.hs
View File

@@ -1,5 +1,5 @@
module PGF.ToAPI
(stringToAPI,exprToAPI,exprToAPIIO)
(stringToAPI,exprToAPI)
where
import PGF.Expr
@@ -14,11 +14,6 @@ import qualified Data.Map as Map
import PGF.Signature
--- this will be changed
exprToAPIIO :: Expr -> IO String
exprToAPIIO = exprToAPI -- return . exprToAPI
-- intermediate structure for representing the translated expression
data APIfunc = BasicFunc String | AppFunc String [APIfunc] | NoAPI
deriving (Show,Eq)
@@ -28,38 +23,38 @@ data APIfunc = BasicFunc String | AppFunc String [APIfunc] | NoAPI
-- translates a GF expression/tree into an equivalent one which uses functions from the GF
-- API instead of the syntactic modules
exprToAPI :: Expr -> IO String
exprToAPI :: Expr -> String
exprToAPI expr =
do ffs <- exprToFunc expr
return $ printAPIfunc ffs
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 -> IO String
stringToAPI :: String -> String
stringToAPI expressionToRead =
case readExpr expressionToRead of
Just ex -> exprToAPI ex
_ -> fail "incorrect expression given as input "
_ -> error "incorrect expression given as input "
-- function for translating an expression into APIFunc with type inference for
-- the type of the expression
exprToFunc :: Expr -> IO APIfunc
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
[] -> return $ BasicFunc (showCId cid)
_ -> do es <- mapM exprToFunc l
return $ AppFunc (showCId cid) es
_ -> return $ BasicFunc (showExpr [] expr)
[] -> BasicFunc (showCId cid)
_ -> let es = map exprToFunc l
in AppFunc (showCId cid) es
_ -> BasicFunc (showExpr [] expr)
@@ -67,7 +62,7 @@ exprToFunc 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) -> IO APIfunc
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)
@@ -76,17 +71,17 @@ mkAPI opt (ty,expr) =
rephraseSentence ty expr =
case unApp expr of
Just (cid,es) -> if isPrefixOf "Use" (showCId cid) then
do let newCat = drop 3 (showCId cid)
afClause <- mkAPI True (newCat, es !! 2)
afPol <- mkAPI True ("Pol",es !! 1)
lTense <- mkAPI True ("Temp", head es)
case lTense of
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
return $ AppFunc ("mk"++newCat) [r1,r2,afPol,afClause]
_ -> fail $ "erroneous tense"
AppFunc ("mk"++newCat) [r1,r2,afPol,afClause]
_ -> error "erroneous tense"
else (mkAPI False) (ty,expr)
_ -> fail $ "incorrect for for expression "++ showExpr [] expr
_ -> error $ "incorrect for for expression "++ showExpr [] expr
getTemporalParam s1 s2 =
let r1 = case s1 of
@@ -101,33 +96,32 @@ mkAPI opt (ty,expr) =
computeAPI :: (String,Expr) -> IO APIfunc
computeAPI :: (String,Expr) -> APIfunc
computeAPI (ty,expr) =
case (unApp expr) of
Just (cid,[]) -> getSimpCat (showCId cid) ty
Just (cid,es) ->
do p <- specFunction (showCId cid) es
if isJust p then return $ fromJust p
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 fail $ "incorrect coercion "++nameCat++" - "++show es
else do afs <- mapM (mkAPI True) (zip typesExps es)
return $ AppFunc ("mk" ++ nameCat) afs
_ -> fail "error"
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" _ = return $ BasicFunc "which_RP"
getSimpCat "DefArt" _ = return $ BasicFunc "the_Art"
getSimpCat "IndefArt" _ = return $ BasicFunc "a_Art"
getSimpCat "NumSg" _ = return $ NoAPI
getSimpCat "NumPl" _ = return $ BasicFunc "plNum"
getSimpCat "PPos" _ = return $ NoAPI
getSimpCat "PNeg" _ = return $ BasicFunc "negativePol"
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 return NoAPI
else return $ BasicFunc cid
then NoAPI
else BasicFunc cid
specFunction "PassV2" es = rephraseUnary "passiveVP" "V2" es
specFunction "ReflA2" es = rephraseUnary "reflAP" "A2" es
@@ -135,16 +129,16 @@ computeAPI (ty,expr) =
specFunction "TFullStop" es = rephraseText "fullStopPunct" es
specFunction "TExclMark" es = rephraseText "exclMarkPunct" es
specFunction "TQuestMark" es = rephraseText "questMarkPunct" es
specFunction _ _ = return Nothing
specFunction _ _ = Nothing
rephraseUnary ss ty es =
do afs <- mkAPI True (ty,head es)
return $ Just (AppFunc ss [afs])
let afs = mkAPI True (ty,head es)
in Just (AppFunc ss [afs])
rephraseText ss es =
do afs <- mapM (mkAPI True) (zip ["Phr","Text"] es)
if afs !! 1 == BasicFunc "TEmpty" then return $ Just (AppFunc "mkText" [head afs,BasicFunc ss])
else return $ Just (AppFunc "mkText" [head afs, BasicFunc ss, last afs])
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])
@@ -154,26 +148,26 @@ optimize expr = optimizeNP expr
optimizeNP expr =
case unApp expr of
Just (cid,es) ->
if showCId cid == "MassNP" then do afs <- nounAsCN (head es)
return $ AppFunc "mkNP" [afs]
else if showCId cid == "DetCN" then do quants <- quantAsDet (head es)
ns <- nounAsCN (head $ tail es)
return $ AppFunc "mkNP" (quants ++ [ns])
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)
_ -> fail $ "incorrect expression " ++ (showExpr [] 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)
_ -> fail $ "incorrect expression "++ (showExpr [] expr)
_ -> error $ "incorrect expression "++ (showExpr [] expr)
quantAsDet expr =
case unApp expr of
Just (cid,es) -> if showCId cid == "DetQuant" then mapM (mkAPI False) [("Quant", head es),("Num",head $ tail es)]
else do l <- (mkAPI False) ("Det",expr)
return [l]
_ -> fail $ "incorrect expression "++ (showExpr [] expr)
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)