1 files changed, 40 insertions, 29 deletions

diff --git a/judge/morpion_rec.ml b/judge/morpion_rec.ml
index 19b1623..0741742 100644
--- a/judge/morpion_rec.ml
+++ b/judge/morpion_rec.ml
@@ -17,7 +17,12 @@ module G = struct
       | T
 
   type 'a r = 'a * 'a * 'a
-  type 'a morpion = 'a r * 'a r * 'a r
+  type 'a morpion = ('a r * 'a r * 'a r) * c
+
+  (* On enregistre dans une grille de morpion le résultat
+      pour cette grille : non attribué (Empty), X, O, ou nul (T)
+     Pour y acceder, utiliser reduct : 'a morpion -> c *)
+  let reduct (_, r) = r
 
   type game = game_status * c morpion morpion * loc1 option
 
@@ -48,24 +53,48 @@ module G = struct
     | 1 -> a | 2 -> b | 3 -> c
     | _ -> raise Invalid_pos
   (* getp1 : 'a morpion -> loc1 -> 'a *)
-  let getp1 m (px, py) =
+  let getp1 (m, _) (px, py) =
     getp0 (getp0 m px) py
   (* getp : 'a morpion morpion -> loc2 -> 'a *)
   let getp m (pg, pp) =
     getp1 (getp1 m pg) pp
 
+  (* reduce_m : ('a -> c) -> 'a morpion -> c *)
+  let reduce_m rf m =
+    match
+      all_w_p1l
+      |> List.map (List.map (fun x -> rf (getp1 m x)))
+      |> List.map (function
+            | l when List.for_all ((=) X) l -> X
+            | l when List.for_all ((=) O) l -> O
+            | l when List.exists ((=) X) l && List.exists ((=) O) l -> T
+            | l when List.exists ((=) T) l -> T
+            | _ -> Empty)
+    with
+    | l when List.exists ((=) X) l -> X
+    | l when List.exists ((=) O) l -> O
+    | l when List.exists ((=) Empty) l -> Empty
+    | _ -> T
+
+
   (* setp0 : ('a, 'a, 'a) -> int -> 'a -> ('a, 'a, 'a) *)
   let setp0 (a, b, c) x v = match x with
     | 1 -> (v, b, c)
     | 2 -> (a, v, c)
     | 3 -> (a, b, v)
     | _ -> raise Invalid_pos
-  (* setp1 : 'a morpion -> loc1 -> 'a -> 'a morpion *)
-  let setp1 m (px, py) v =
-    setp0 m px (setp0 (getp0 m px) py v) 
+  (* setp1 : 'a morpion -> loc1 -> 'a -> ('a -> 'c) -> 'a morpion *)
+  let setp1 (m, r) (px, py) v rf =
+    let k = setp0 m px (setp0 (getp0 m px) py v) in
+    (k, if r = Empty then reduce_m rf (k, r) else r)
+    (* pourquoi ce if ? parce que si quelqu'un a déjà gagné un petit morpion,
+      alors même si l'adversaire aligne trois pions, le petit morpion lui
+      reste attribué... *)
   (* setp2 : 'a morpion morpion -> loc2 -> 'a -> 'a morpion morpion *)
   let setp m (pg, pp) v =
-    setp1 m pg (setp1 (getp1 m pg) pp v)
+    let im = setp1 (getp1 m pg) pp v (fun x -> x) in
+    let om = setp1 m pg im reduct in
+    om
 
   (* r : 'a -> ('a, 'a, 'a) *)
   let r x = (x, x, x)
@@ -77,7 +106,7 @@ module G = struct
   let name = "Morpion récursif!"
 
   let new_game = 
-    TurnOf P1, r (r (r (r Empty))), None
+    TurnOf P1, (r (r (r (r Empty), Empty)), Empty), None
 
   let full_pm m =
     List.for_all (fun p -> getp1 m p <> Empty) all_p1
@@ -96,21 +125,6 @@ module G = struct
         pg_poss)
     |> List.map encode
 
-  let reduce_m rf m =
-    match
-      all_w_p1l
-      |> List.map (List.map (fun x -> rf (getp1 m x)))
-      |> List.map (function
-            | l when List.for_all ((=) X) l -> X
-            | l when List.for_all ((=) O) l -> O
-            | l when List.exists ((=) X) l && List.exists ((=) O) l -> T
-            | l when List.exists ((=) T) l -> T
-            | _ -> Empty)
-    with
-    | l when List.exists ((=) X) l -> X
-    | l when List.exists ((=) O) l -> O
-    | l when List.exists ((=) Empty) l -> Empty
-    | _ -> T
 
   let play (gs, m, pgo) act =
     let (pg, pp) = decode act in
@@ -125,7 +139,7 @@ module G = struct
       ->
         let op = other_player player in
         let new_m = setp m (pg, pp) (match player with P1 -> X | P2 -> O) in
-        let new_s = match reduce_m (reduce_m (fun x -> x)) new_m with
+        let new_s = match reduct new_m with
           | Empty -> TurnOf op
           | X -> Won P1
           | O -> Won P2
@@ -168,7 +182,7 @@ module G = struct
       set_line_width 1
     | _ -> ()
 
-  let disp_r rf sdf box mor =
+  let disp_r sdf box mor =
     let x1, y1, x2, y2 = box in
     let dx, dy = (x2 - x1) / 3, (y2 - y1) / 3 in
     let x12, x23 = x1 + dx, x1 + 2 * dx in
@@ -180,15 +194,12 @@ module G = struct
          x1, y12, x2, y12;
          x1, y23, x2, y23 |];
     List.iter (fun p -> sdf (margin (subpos box p) 6) (getp1 mor p)) all_p1;
-    disp_l 2 box (rf mor)
+    disp_l 2 box (reduct mor)
 
   let display_game (s, mor, q) (pn1, pn2) =
     let cx, cy = center() in
     let box = cx - 200, cy - 200, cx + 200, cy + 200 in
-    disp_r
-      (reduce_m (reduce_m (fun x -> x)))
-      (disp_r (reduce_m (fun x -> x)) (disp_l 1))
-      box mor;
+    disp_r (disp_r (disp_l 1)) box mor;
     begin match q, s with
     | Some p, TurnOf player ->
       let x1, y1, x2, y2 = margin (subpos box p) 3 in