GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 13:09:33 -06:00
Code Issues Packages Projects Releases Wiki Activity

semantics extended to questions

Browse Source
This commit is contained in:
aarne
2007-10-20 09:51:26 +00:00
parent e86db4d8c8
commit 192f55e2f5
6 changed files with 187 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
examples/tutorial/semantics/Answer.hs
View File

@@ -12,9 +12,10 @@ main = do
loop :: MultiGrammar -> IO ()
loop gr = do
s <- getLine
let t:_ = parse gr "BaseEng" "S" s
putStrLn $ showTree t
let p = iS $ fg t
putStrLn $ show p
case parse gr "BaseEng" "Question" s of
[] -> putStrLn "no parse"
ts -> mapM_ answer ts
loop gr
where
answer t = putStrLn $ linearize gr "BaseEng" $ gf $ question2answer $ fg t

65
examples/tutorial/semantics/AnswerBase.hs
View File

@@ -5,7 +5,7 @@ import GSyntax
-- interpretation of Base
type Prop = Bool
type Exp = Int
type Ent = Int
domain = [0 .. 100]
iS :: GS -> Prop
@@ -13,21 +13,31 @@ iS s = case s of
GPredAP np ap -> iNP np (iAP ap)
GConjS c s t -> iConj c (iS s) (iS t)
iNP :: GNP -> (Exp -> Prop) -> Prop
iNP :: GNP -> (Ent -> Prop) -> Prop
iNP np p = case np of
GEvery cn -> all (\x -> not (iCN cn x) || p x) domain
GSome cn -> any (\x -> iCN cn x && p x) domain
GNone cn -> not (any (\x -> iCN cn x && p x) domain)
GMany pns -> and (map p (iListPN pns))
GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p)
GUseInt (GInt i) -> p (fromInteger i)
GUsePN a -> p (iPN a)
iAP :: GAP -> Exp -> Prop
iPN :: GPN -> Ent
iPN pn = case pn of
GUseInt i -> iInt i
GSum pns -> sum (iListPN pns)
GProduct pns -> product (iListPN pns)
GGCD pns -> foldl1 gcd (iListPN pns)
iAP :: GAP -> Ent -> Prop
iAP ap e = case ap of
GComplA2 a2 np -> iNP np (iA2 a2 e)
GConjAP c ap1 ap2 -> iConj c (iAP ap1 e) (iAP ap2 e)
GEven -> even e
GOdd -> not (even e)
GEven -> even e
GOdd -> odd e
GPrime -> prime e
iCN :: GCN -> Exp -> Prop
iCN :: GCN -> Ent -> Prop
iCN cn e = case cn of
GModCN ap cn0 -> (iCN cn0 e) && (iAP ap e)
GNumber -> True
@@ -37,8 +47,45 @@ iConj c = case c of
GAnd -> (&&)
GOr -> (||)
iA2 :: GA2 -> Exp -> Exp -> Prop
iA2 :: GA2 -> Ent -> Ent -> Prop
iA2 a2 e1 e2 = case a2 of
GGreater -> e1 > e1
GGreater -> e1 > e2
GSmaller -> e1 < e2
GEqual -> e1 == e2
GDivisible -> e2 /= 0 && mod e1 e2 == 0
iListPN :: GListPN -> [Ent]
iListPN gls = case gls of
GListPN pns -> map iPN pns
iInt :: GInt -> Ent
iInt gi = case gi of
GInt i -> fromInteger i
-- questions and answers
iQuestion :: GQuestion -> Either Bool [Ent]
iQuestion q = case q of
GWhatIs pn -> Right [iPN pn] -- computes the value
GWhichAre cn ap -> Right [e | e <- domain, iCN cn e, iAP ap e]
GQuestS s -> Left (iS s)
question2answer :: GQuestion -> GAnswer
question2answer q = case iQuestion q of
Left True -> GYes
Left False -> GNo
Right [] -> GValue (GNone GNumber)
Right [v] -> GValue (GUsePN (ent2pn v))
Right vs -> GValue (GMany (GListPN (map ent2pn vs)))
ent2pn :: Ent -> GPN
ent2pn e = GUseInt (GInt (toInteger e))
-- auxiliary
prime :: Int -> Bool
prime x = elem x primes where
primes = sieve [2 .. x]
sieve (p:xs) = p : sieve [ n | n <- xs, n `mod` p > 0 ]
sieve [] = []

28
examples/tutorial/semantics/Base.gf
View File

@@ -5,11 +5,14 @@ abstract Base = {
cat
S ;
NP ;
PN ;
CN ;
AP ;
A2 ;
Conj ;
fun
-- sentence syntax
PredAP : NP -> AP -> S ;
ComplA2 : A2 -> NP -> AP ;
@@ -20,18 +23,39 @@ fun
ConjAP : Conj -> AP -> AP -> AP ;
ConjNP : Conj -> NP -> NP -> NP ;
UsePN : PN -> NP ;
Every : CN -> NP ;
Some : CN -> NP ;
None : CN -> NP ;
And, Or : Conj ;
-- lexicon
UseInt : Int -> NP ;
UseInt : Int -> PN ;
Number : CN ;
Even, Odd, Prime : AP ;
Equal, Greater, Smaller, Divisible : A2 ;
}
Sum, Product, GCD : ListPN -> PN ;
-- adding questions
cat
Question ;
Answer ;
ListPN ;
fun
WhatIs : PN -> Question ;
WhichAre : CN -> AP -> Question ;
QuestS : S -> Question ;
Yes : Answer ;
No : Answer ;
Value : NP -> Answer ;
Many : ListPN -> NP ;
BasePN : PN -> PN -> ListPN ;
ConsPN : PN -> ListPN -> ListPN ;
}

19
examples/tutorial/semantics/BaseEng.gf
View File

@@ -17,8 +17,10 @@ lin
ConjAP c = infixSS c.s ;
ConjNP c = infixSS c.s ;
UsePN a = a ;
Every = prefixSS "every" ;
Some = prefixSS "some" ;
None = prefixSS "no" ;
And = ss "and" ;
Or = ss "or" ;
@@ -35,4 +37,21 @@ lin
Smaller = ss ("smaller" ++ "than") ;
Divisible = ss ("divisible" ++ "by") ;
Sum = prefixSS ["the sum of"] ;
Product = prefixSS ["the product of"] ;
GCD = prefixSS ["the greatest common divisor of"] ;
WhatIs = prefixSS ["what is"] ;
WhichAre cn ap = ss ("which" ++ cn.s ++ "is" ++ ap.s) ; ---- are
QuestS s = s ; ---- inversion
Yes = ss "yes" ;
No = ss "no" ;
Value np = np ;
Many list = list ;
BasePN = infixSS "and" ;
ConsPN = infixSS "," ;
}

81
examples/tutorial/semantics/GSyntax.hs
View File

@@ -61,6 +61,12 @@ data GAP =
| GPrime
deriving Show
data GAnswer =
GNo
| GValue GNP
| GYes
deriving Show
data GCN =
GModCN GAP GCN
| GNumber
@@ -71,13 +77,30 @@ data GConj =
| GOr
deriving Show
newtype GListPN = GListPN [GPN] deriving Show
data GNP =
GConjNP GConj GNP GNP
| GEvery GCN
| GMany GListPN
| GNone GCN
| GSome GCN
| GUsePN GPN
deriving Show
data GPN =
GGCD GListPN
| GProduct GListPN
| GSum GListPN
| GUseInt GInt
deriving Show
data GQuestion =
GQuestS GS
| GWhatIs GPN
| GWhichAre GCN GAP
deriving Show
data GS =
GConjS GConj GS GS
| GPredAP GNP GAP
@@ -97,6 +120,11 @@ instance Gf GAP where
gf GOdd = DTr [] (AC (CId "Odd")) []
gf GPrime = DTr [] (AC (CId "Prime")) []
instance Gf GAnswer where
gf GNo = DTr [] (AC (CId "No")) []
gf (GValue x1) = DTr [] (AC (CId "Value")) [gf x1]
gf GYes = DTr [] (AC (CId "Yes")) []
instance Gf GCN where
gf (GModCN x1 x2) = DTr [] (AC (CId "ModCN")) [gf x1, gf x2]
gf GNumber = DTr [] (AC (CId "Number")) []
@@ -105,12 +133,29 @@ instance Gf GConj where
gf GAnd = DTr [] (AC (CId "And")) []
gf GOr = DTr [] (AC (CId "Or")) []
instance Gf GListPN where
gf (GListPN [x1,x2]) = DTr [] (AC (CId "BasePN")) [gf x1, gf x2]
gf (GListPN (x:xs)) = DTr [] (AC (CId "ConsPN")) [gf x, gf (GListPN xs)]
instance Gf GNP where
gf (GConjNP x1 x2 x3) = DTr [] (AC (CId "ConjNP")) [gf x1, gf x2, gf x3]
gf (GEvery x1) = DTr [] (AC (CId "Every")) [gf x1]
gf (GMany x1) = DTr [] (AC (CId "Many")) [gf x1]
gf (GNone x1) = DTr [] (AC (CId "None")) [gf x1]
gf (GSome x1) = DTr [] (AC (CId "Some")) [gf x1]
gf (GUsePN x1) = DTr [] (AC (CId "UsePN")) [gf x1]
instance Gf GPN where
gf (GGCD x1) = DTr [] (AC (CId "GCD")) [gf x1]
gf (GProduct x1) = DTr [] (AC (CId "Product")) [gf x1]
gf (GSum x1) = DTr [] (AC (CId "Sum")) [gf x1]
gf (GUseInt x1) = DTr [] (AC (CId "UseInt")) [gf x1]
instance Gf GQuestion where
gf (GQuestS x1) = DTr [] (AC (CId "QuestS")) [gf x1]
gf (GWhatIs x1) = DTr [] (AC (CId "WhatIs")) [gf x1]
gf (GWhichAre x1 x2) = DTr [] (AC (CId "WhichAre")) [gf x1, gf x2]
instance Gf GS where
gf (GConjS x1 x2 x3) = DTr [] (AC (CId "ConjS")) [gf x1, gf x2, gf x3]
gf (GPredAP x1 x2) = DTr [] (AC (CId "PredAP")) [gf x1, gf x2]
@@ -135,6 +180,14 @@ instance Fg GAP where
DTr [] (AC (CId "Prime")) [] -> GPrime
_ -> error ("no AP " ++ show t)
instance Fg GAnswer where
fg t =
case t of
DTr [] (AC (CId "No")) [] -> GNo
DTr [] (AC (CId "Value")) [x1] -> GValue (fg x1)
DTr [] (AC (CId "Yes")) [] -> GYes
_ -> error ("no Answer " ++ show t)
instance Fg GCN where
fg t =
case t of
@@ -149,15 +202,41 @@ instance Fg GConj where
DTr [] (AC (CId "Or")) [] -> GOr
_ -> error ("no Conj " ++ show t)
instance Fg GListPN where
fg t =
case t of
DTr [] (AC (CId "BasePN")) [x1,x2] -> GListPN [fg x1, fg x2]
DTr [] (AC (CId "ConsPN")) [x1,x2] -> let GListPN xs = fg x2 in GListPN (fg x1:xs)
_ -> error ("no ListPN " ++ show t)
instance Fg GNP where
fg t =
case t of
DTr [] (AC (CId "ConjNP")) [x1,x2,x3] -> GConjNP (fg x1) (fg x2) (fg x3)
DTr [] (AC (CId "Every")) [x1] -> GEvery (fg x1)
DTr [] (AC (CId "Many")) [x1] -> GMany (fg x1)
DTr [] (AC (CId "None")) [x1] -> GNone (fg x1)
DTr [] (AC (CId "Some")) [x1] -> GSome (fg x1)
DTr [] (AC (CId "UseInt")) [x1] -> GUseInt (fg x1)
DTr [] (AC (CId "UsePN")) [x1] -> GUsePN (fg x1)
_ -> error ("no NP " ++ show t)
instance Fg GPN where
fg t =
case t of
DTr [] (AC (CId "GCD")) [x1] -> GGCD (fg x1)
DTr [] (AC (CId "Product")) [x1] -> GProduct (fg x1)
DTr [] (AC (CId "Sum")) [x1] -> GSum (fg x1)
DTr [] (AC (CId "UseInt")) [x1] -> GUseInt (fg x1)
_ -> error ("no PN " ++ show t)
instance Fg GQuestion where
fg t =
case t of
DTr [] (AC (CId "QuestS")) [x1] -> GQuestS (fg x1)
DTr [] (AC (CId "WhatIs")) [x1] -> GWhatIs (fg x1)
DTr [] (AC (CId "WhichAre")) [x1,x2] -> GWhichAre (fg x1) (fg x2)
_ -> error ("no Question " ++ show t)
instance Fg GS where
fg t =
case t of

2
examples/tutorial/semantics/SemBase.hs
View File

@@ -12,7 +12,7 @@ iS s = case s of
iNP :: GNP -> (Exp -> Prop) -> Prop
iNP np p = case np of
GEvery cn -> All (If (iCN cn var) (p var)) ----
GEvery cn -> All (If (iCN cn var) (liftProp 0 (p var))) ----
GSome cn -> Exist (And (iCN cn var) (p var)) ----
GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p)
GUseInt (GInt i) -> p (int i)