Monad Transformers step by step
[lambda.git] / code / gsv.hs
1 type Predicate = String
2 data Ent = Alice | Bob | Carl deriving (Eq, Show)
3 data World = W1 | W2 | Hungry | Full deriving (Eq, Show)
4 type Variable = String
5 data Term = Constant Ent | Var Variable deriving (Eq, Show)
6 data Clause =   Pred Predicate Term 
7               | Eq Term Term
8               | Conj Clause Clause
9               | Neg Clause
10               | Poss Clause
11               | Ex String Clause
12               deriving (Eq, Show)
13 type Assignment = [(Variable, Ent)]
14 type Poss = (World, Assignment)
15 type Infostate = [Poss]
16
17 referent :: Poss -> Term -> Ent
18 referent (w,g) (Constant c) = c
19 referent (w,(v',a):g) (Var v) = if v == v' then a else referent (w,g) (Var v)
20
21 extension :: World -> Predicate -> Ent -> Bool
22 extension _ "woman" Alice = True
23 extension _ "man" Bob = True
24 extension _ "man" Carl = True
25 extension Hungry "hungry" Alice = True
26 extension _ "enter" Bob = True
27 extension _ "enter" Carl = True
28 extension _ "sit" Alice = True
29 extension _ "sit" Bob = True
30 extension W1 "closet" Alice = True
31 extension W1 "guilty" Bob = True
32 extension W2 "closet" Carl = True
33 extension W2 "guilty" Carl = True
34 extension _ _ _ = False
35
36 update :: Infostate -> Clause -> Infostate
37 update s (Pred p t) = [i | i@(w,g) <- s, extension w p (referent i t)]
38 update s (Eq t1 t2) = [i | i <- s, referent i t1 == referent i t2]
39 update s (Conj c1 c2) = update (update s c1) c2
40 update s (Neg c) = [i | i <- s, length (update [i] c) == 0]
41 update s (Poss c) = [i | i <- s, length (update s c) > 0]
42 update s (Ex v c) = 
43   concat [update [(w, (v,a):g) | (w,g) <- s] c | a <- domain]
44
45 domain = [Alice, Bob, Carl]
46
47 test1 = update [(W1, [])] (Ex "x" (Pred "man" (Var "x")))
48 test2 = update [(W1, [])] (Ex "x" (Pred "woman" (Var "x")))
49 test3 = update [(W1, [])] (Ex "x" (Ex "y" (Conj (Pred "man" (Var "x"))
50                                                 (Pred "man" (Var "y")))))
51 test4 = update [(W1, [])] (Ex "x" (Ex "y" (Eq (Var "x") (Var "y"))))
52 test5 = update [(Hungry,[]),(Full,[])] (Neg (Pred "hungry" (Constant Alice)))
53
54 test6 = update [(Hungry,[]),(Full,[])] 
55                (Conj (Neg (Pred "hungry" (Constant Alice)))
56                      (Poss (Pred "hungry" (Constant Alice))))
57
58 test7 = update [(Hungry,[]),(Full,[])] 
59                (Conj (Poss (Pred "hungry" (Constant Alice)))
60                      (Neg (Pred "hungry" (Constant Alice))))
61  
62 test8 = update [(W1,[("x",Bob)])] 
63                (Conj (Ex "x" (Pred "enter" (Var "x")))
64                      (Pred "sit" (Var "x")))
65
66 test9 = update [(W1,[("x",Bob)])] 
67                (Conj (Pred "sit" (Var "x"))
68                      (Ex "x" (Pred "enter" (Var "x"))))
69 test10 = update [(W1,[]),(W2,[])]
70                 (Conj (Ex "x" (Pred "closet" (Var "x")))
71                       (Poss (Pred "guilty" (Var "x"))))
72
73 test11 = update [(W1,[]),(W2,[])]
74                 (Ex "x" (Conj (Pred "closet" (Var "x"))
75                               (Poss (Pred "guilty" (Var "x")))))
76
77