X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fintensionality-monad.ml;h=b5dc9f52cd90c64b893f882ac3fc3ba8982d8168;hp=b05d3fedf5da9e30ca0935176e52847dc1cbc72e;hb=f747612ad27e9facc7c92c04e4c6981b40a561ad;hpb=4ee37acfccfcdd55e523a8bfa2f6b8d67124ead6

diff --git a/code/intensionality-monad.ml b/code/intensionality-monad.ml
index b05d3fed..b5dc9f52 100644
--- a/code/intensionality-monad.ml
+++ b/code/intensionality-monad.ml
@@ -1,4 +1,4 @@
-(* This is the intensionality monad discussed in the lecture notes for week 7. *)
+(* This is the intensionality monad discussed in the lecture notes for week 8. *)
 
 type s = int;; (* integers model possible worlds *)
 type e = char;; (* chars model individuals *)
@@ -11,9 +11,9 @@ let cam = 'c';;
 let left1 (x : e) = true;; (* Everyone left *)
 let saw1 (y : e) (x : e) = x < y;; (* Ann saw Bill and Cam, and Bill saw Cam *)
 
-left1 ann;;
-saw1 bill ann;;
-saw1 ann bill;;
+left1 ann;;      (* true *)
+saw1 bill ann;;  (* true *)
+saw1 ann bill;;  (* false *)
 
 (* Now we make the extension of "leave" sensitive to the world of evaluation *)
 let left (x : e) (w : s) = match (x, w) with ('c', 2) -> false | _ -> true;;
@@ -31,15 +31,17 @@ let mid x (w : s) = x;;
 let (>>=) xx k (w : s) = k (xx w) w;;
 let map2' f xx yy = xx >>= (fun x -> yy >>= (fun y -> f x y));;
 
-(mid ann >>= left) 1;;
-(mid cam >>= left) 2;;
+(mid ann >>= left) 1;;              (* true *)
+(mid cam >>= left) 2;;              (* false *)
 
-map2' saw (mid bill) (mid ann) 1;; 
-map2' saw (mid bill) (mid ann) 2;;
+map2' saw (mid bill) (mid ann) 1;;  (* true *)
+map2' saw (mid bill) (mid ann) 2;;  (* false *)
 
 let thinks (p : s->t) (x : e) (w : s) = 
   match (x, p 2) with ('a', false) -> false | _ -> p w;;
 
-(mid ann >>= thinks (mid bill >>= left)) 1;;
-(mid ann >>= thinks (mid cam >>= left)) 1;;
+(mid bill >>= left) 1;; (* true *)
+(mid cam >>= left) 1;;  (* true *)
+(mid ann >>= thinks (mid bill >>= left)) 1;; (* true *)
+(mid ann >>= thinks (mid cam >>= left)) 1;;  (* false *)