diff --git a/examples/tutorial/semantics/Answer.hs b/examples/tutorial/semantics/Answer.hs index b874b8bd2..08a76c5f1 100644 --- a/examples/tutorial/semantics/Answer.hs +++ b/examples/tutorial/semantics/Answer.hs @@ -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 diff --git a/examples/tutorial/semantics/AnswerBase.hs b/examples/tutorial/semantics/AnswerBase.hs index dbad37e5e..28c73a384 100644 --- a/examples/tutorial/semantics/AnswerBase.hs +++ b/examples/tutorial/semantics/AnswerBase.hs @@ -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 [] = [] diff --git a/examples/tutorial/semantics/Base.gf b/examples/tutorial/semantics/Base.gf index b99587e96..74528d31d 100644 --- a/examples/tutorial/semantics/Base.gf +++ b/examples/tutorial/semantics/Base.gf @@ -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 ; +} diff --git a/examples/tutorial/semantics/BaseEng.gf b/examples/tutorial/semantics/BaseEng.gf index 71b2b91dc..582c2e279 100644 --- a/examples/tutorial/semantics/BaseEng.gf +++ b/examples/tutorial/semantics/BaseEng.gf @@ -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 "," ; + } diff --git a/examples/tutorial/semantics/GSyntax.hs b/examples/tutorial/semantics/GSyntax.hs index c16a0b97c..48634d2e9 100644 --- a/examples/tutorial/semantics/GSyntax.hs +++ b/examples/tutorial/semantics/GSyntax.hs @@ -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 diff --git a/examples/tutorial/semantics/SemBase.hs b/examples/tutorial/semantics/SemBase.hs index 699c4942c..24073894b 100644 --- a/examples/tutorial/semantics/SemBase.hs +++ b/examples/tutorial/semantics/SemBase.hs @@ -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)