blob: 56e2b5451d46db34a6b61cc1a0e89d7df8f274f4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
module AnswerBase where
import GSyntax
-- interpretation of Base
type Prop = Bool
type Ent = Int
domain = [0 .. 100]
iS :: GS -> Prop
iS s = case s of
GPredAP np ap -> iNP np (iAP ap)
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 -> not (any (\x -> p x) domain)
GMany pns -> and (map p (iListPN pns))
GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p)
GUsePN a -> p (iPN a)
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 -> odd e
GPrime -> prime e
iCN :: GCN -> Ent -> Prop
iCN cn e = case cn of
GModCN ap cn0 -> (iCN cn0 e) && (iAP ap e)
GNumber -> True
iConj :: GConj -> Prop -> Prop -> Prop
iConj c = case c of
GAnd -> (&&)
GOr -> (||)
iA2 :: GA2 -> Ent -> Ent -> Prop
iA2 a2 e1 e2 = case a2 of
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
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 [] = []
|
