semantics extended to questions

6 files changed, 187 insertions, 17 deletions

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)