mirror of
https://github.com/GrammaticalFramework/gf-rgl.git
synced 2026-06-15 18:10:12 -06:00
140 lines
3.5 KiB
Haskell
140 lines
3.5 KiB
Haskell
{-# LANGUAGE GADTs #-}
|
|
|
|
module Main where
|
|
|
|
import Infinitive
|
|
import PGF
|
|
import Data.List
|
|
|
|
data Fact = Fact {
|
|
content :: [Fact],
|
|
tense :: Maybe GTemp,
|
|
polarity :: Maybe GPol,
|
|
agent :: Maybe GNP,
|
|
action :: Either GVS GVP
|
|
}
|
|
|
|
initFact = Fact [] Nothing Nothing Nothing (Left undefined)
|
|
|
|
factTree fact = GUseCl mtense mpolarity (GPredVP magent mvp)
|
|
where
|
|
mvp = case action fact of
|
|
Left vs -> GComplVS vs (factTree (head (content fact))) ---- head -> ambiguity
|
|
Right vp -> vp
|
|
mtense = maybe presentTense id (tense fact)
|
|
mpolarity = maybe positivePol id (polarity fact)
|
|
magent = maybe GX_NP id (agent fact)
|
|
|
|
presentTense = GTTAnt GTPres GASimul
|
|
pastTense = GTTAnt GTPast GASimul
|
|
perfectTense = GTTAnt GTPres GAAnter
|
|
pluperfectTense = GTTAnt GTPast GAAnter
|
|
positivePol = GPPos
|
|
negativePol = GPNeg
|
|
|
|
|
|
facts :: Infinitive.Tree a -> [Fact]
|
|
facts t = case t of
|
|
GUseCl temp pol s ->
|
|
[f{
|
|
tense = Just temp,
|
|
polarity = Just pol
|
|
} | f <- facts s]
|
|
GAdjCN (GAgentPartAP np vpslash) cn ->
|
|
[initFact{
|
|
tense = Just perfectTense,
|
|
agent = Just np,
|
|
action = Right (GComplSlash vpslash (GMassNP cn))}]
|
|
GPredVP ag (GUseComp (GCompAP (GAgentPartAP np vpslash))) ->
|
|
[initFact{
|
|
tense = Just perfectTense,
|
|
agent = Just np,
|
|
action = Right (GComplSlash vpslash ag)}]
|
|
GPredVP np (GComplPresPartActReflVS vs vp) ->
|
|
[initFact{
|
|
agent = Just np,
|
|
action = Left vs,
|
|
content = [
|
|
initFact{
|
|
agent = Just np,
|
|
action = Right vp
|
|
}]}]
|
|
GPredVP np (GComplPastPartActReflVS vs vp) ->
|
|
[initFact{
|
|
agent = Just np,
|
|
action = Left vs,
|
|
content = [
|
|
initFact{
|
|
tense = Just perfectTense,
|
|
agent = Just np,
|
|
action = Right vp
|
|
}]}]
|
|
GPredVP np (GAdvVP vp adv) ->
|
|
[f{agent = Just np} | f <- facts vp ++ facts adv]
|
|
---- GPredVP np (GRAdvVP vp (GInf1LongRAdv vpa)) ->
|
|
---- [f{agent = Just np, action = } | f <- facts vp ++ facts adv]
|
|
GPredVP np vp ->
|
|
[f{agent = Just np} | f <- facts vp]
|
|
GUseV v ->
|
|
[initFact{
|
|
action = Right t}]
|
|
GUseV2 v ->
|
|
[initFact{
|
|
action = Right (GComplSlash (GSlashV2a v) GY_NP)}]
|
|
{-
|
|
GComplPresPartActVS vs np vp ->
|
|
[initFact{
|
|
attitude =
|
|
Just vs,
|
|
agent = Just np,
|
|
action = Just vp}]
|
|
GComplPastPartActVS vs np vp ->
|
|
[initFact{
|
|
tense = Just perfectTense,
|
|
attitude = Just vs,
|
|
agent = Just np,
|
|
action = Just vp}]
|
|
GInf3AbessAdv vp ->
|
|
[initFact{
|
|
polarity = Just negativePol,
|
|
action = Just vp}]
|
|
GComplPresPartPassVS vs np vpslash ->
|
|
[initFact{
|
|
attitude = Just vs,
|
|
action = Just (GComplSlash vpslash np)}]
|
|
GComplPastPartPassVS vs np vpslash ->
|
|
[initFact{
|
|
tense = Just perfectTense,
|
|
attitude = Just vs,
|
|
action = Just (GComplSlash vpslash np)}]
|
|
-}
|
|
_ -> composOpMPlus facts t
|
|
|
|
|
|
shortest = take 1 . sortOn treesize
|
|
|
|
treesize t = case unApp t of
|
|
Just (f, xs) -> 1 + sum (map treesize xs)
|
|
_ -> 1
|
|
|
|
|
|
treat gr fin cat s = [
|
|
(showExpr [] t ++ "\t" ++ linearize gr fin t)
|
|
| pt <- shortest (parse gr fin cat s),
|
|
let gt = map (gf . factTree) (facts (fg pt :: GUtt)),
|
|
t <- gt
|
|
]
|
|
|
|
|
|
main = do
|
|
gr <- readPGF "Infinitive.pgf"
|
|
putStrLn "gr"
|
|
let Just fin = readLanguage "InfinitiveFin"
|
|
let typ = startCat gr
|
|
flip mapM_ [0..] $ \_ -> do
|
|
putStr "> "
|
|
s <- getLine
|
|
let ss = treat gr fin typ s
|
|
putStrLn $ unlines ss
|
|
|