diff options
| author | aarne <aarne@cs.chalmers.se> | 2007-10-20 09:51:26 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2007-10-20 09:51:26 +0000 |
| commit | 192f55e2f579d5f736f442287cc237da353a6991 (patch) | |
| tree | 42368c7ca4f716e997e140685b4e63273b0bc399 /examples/tutorial/semantics/AnswerBase.hs | |
| parent | e86db4d8c8287790a90955fefec10b7a64988ff8 (diff) | |
semantics extended to questions
Diffstat (limited to 'examples/tutorial/semantics/AnswerBase.hs')
| -rw-r--r-- | examples/tutorial/semantics/AnswerBase.hs | 65 |
1 files changed, 56 insertions, 9 deletions
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 [] = [] |
