Organise the directory so that it is compliant with the submission rules

1 files changed, 311 insertions, 0 deletions

diff --git a/src/game.ml b/src/game.ml
new file mode 100644
index 0000000..f25240f
--- /dev/null
+++ b/src/game.ml
@@ -0,0 +1,311 @@
+exception Rule_error of string
+
+type lambda =
+  |Const of int
+  |Lambda of (lambda -> lambda);;
+
+let unfold x = match x with
+  | Lambda y -> y
+  | _ -> raise( Rule_error "wrong unfolding")
+
+let id  = Lambda(fun x -> x)
+
+let (@) a1 a2 = unfold a1 a2
+
+type slot = {
+    mutable vitality: int;
+    mutable field: lambda
+}
+
+let player0 = Array.init 256 (fun _ -> {vitality = 10000; field = id})
+let player1 = Array.init 256 (fun _ -> {vitality = 10000; field = id})
+let card_count = ref 0
+let proponent = ref player0
+let opponent = ref player1
+
+let increase card_count =
+  if !card_count >= 1000 then
+    raise( Rule_error "apply limit exceeded")
+  else
+    card_count:=!card_count+1
+
+let zero = Const 0
+
+let succ = Lambda(fun a -> increase card_count;
+  match a with
+    | Const n -> if n < 65535 then Const (n+1) else Const n
+    | _ -> raise( Rule_error "not an integer"))
+
+let dbl = Lambda(fun a -> increase card_count;
+    match a with
+      | Const n -> if n < 32768 then Const(2*n) else Const n
+      | _ -> raise( Rule_error "not an integer"))
+
+let get = Lambda(fun a -> increase card_count;
+  match a with
+    | (Const i) -> if !proponent.(i).vitality > 0 then !proponent.(i).field else raise( Rule_error "not a valid slot number")
+    | _ ->  raise( Rule_error "not an integer" ))
+
+let put = Lambda(fun x -> increase card_count;id)
+
+let s = Lambda(fun f -> increase card_count;Lambda(fun g -> Lambda(fun x -> (f @ x) @ (g @ x))))
+
+let k = Lambda(fun x -> increase card_count;Lambda(fun y -> x))
+
+let inc = Lambda(fun a -> increase card_count;
+  match a with
+    | Const i -> let v = !proponent.(i) .vitality in
+		if ( v < 65535 ) & ( v > 0 ) then
+		  !proponent.(i).vitality <- v + 1;
+		id
+    | _ -> raise( Rule_error "not an integer"))
+
+let inc_bis = Lambda(fun a -> increase card_count;
+  match a with
+    | Const i -> let v = !proponent.(i) .vitality in
+		 if ( v < 65535 ) & ( v > 0 ) then
+		   !proponent.(i).vitality <- v - 1;
+		 id
+    | _ -> raise( Rule_error "not an integer"))
+
+
+let dec = Lambda(fun a -> increase card_count;
+  match a with
+    | Const i -> let v = !opponent.(255-i).vitality in
+		 if v > 0 then
+		   !opponent.(255-1).vitality <- v - 1;
+		 id
+    | _ -> raise( Rule_error "not an integer"))
+
+let dec_bis = Lambda(fun a -> increase card_count;
+  match a with
+    | (Const i) -> let v = !opponent.(255-i).vitality in
+		   if v > 0 then
+		     !opponent.(255-1).vitality <- v + 1;
+		   id
+    | _ -> raise( Rule_error "not an integer"))
+  
+let attack = Lambda(fun a -> increase card_count;
+  Lambda(fun b -> Lambda(fun c -> match a, b, c with
+    | Const i, Const j, Const n -> 
+      let v = !proponent.(i).vitality in
+      if v - n > 0 then
+	!proponent.(i).vitality <- v - n
+      else
+	raise( Rule_error "not enough life left");
+      let w = !opponent.(255-j).vitality in
+      if w > 0 then
+	!opponent.(255-j).vitality <- max 0  (w - 9/10 *n);
+      id
+    | _ -> raise( Rule_error "not an integer"))))
+
+let attack_bis = Lambda(fun a -> increase card_count;
+  Lambda(fun b -> Lambda(fun c -> match a, b, c with
+    | Const i, Const j, Const n ->
+      let v = !proponent.(i).vitality in
+      if v - n > 0 then
+	!proponent.(i).vitality <- v - n
+      else
+	raise( Rule_error "not enought life left");
+      let w = !opponent.(255-j).vitality in
+      if w > 0 then
+	!opponent.(255-j).vitality <- min 65535  (w + 9/10 *n);
+      id
+    | _ -> raise( Rule_error "not an integer"))))
+    
+let help = Lambda(fun a -> increase card_count;
+  Lambda(fun b -> Lambda(fun c -> match a, b, c with
+    | Const i, Const j, Const n ->
+      let v = !proponent.(i).vitality in
+      if v - n > 0 then
+	!proponent.(i).vitality <- v - n
+      else
+	raise( Rule_error "not enough life left");
+      let w = !proponent.(j).vitality in
+      if w > 0 then
+	!proponent.(j).vitality <- max (w - n*11/10) 0;
+      id
+    | _ -> raise( Rule_error "not an integer"))))
+    
+let help_bis = Lambda(fun a -> increase card_count;
+  Lambda(fun b -> Lambda(fun c -> match a, b, c with
+    | Const i, Const j, Const n ->
+      let v = !proponent.(i).vitality in
+      if v - n > 0 then
+	!proponent.(i).vitality <- v - n
+      else
+      raise( Rule_error "not enough life left");
+      let w = !proponent.(j).vitality in
+      if w > 0 then
+	!proponent.(j).vitality <- min (w + n*11/10) 65535;
+      id
+    | _ -> raise( Rule_error "not an integer"))))
+
+let copy = Lambda(fun a -> increase card_count;
+  match a with
+    | Const i -> !opponent.(i).field
+    | _ -> raise( Rule_error "not an integer"))
+  
+let revive = Lambda(fun a -> increase card_count;
+  match a with
+    | Const i -> let v = !proponent.(i).vitality in
+		 if v <= 0 then
+		   !proponent.(i).vitality <- 1;
+		 id
+    | _ -> raise( Rule_error "not an integer"))
+  
+let zombie = Lambda(fun a -> increase card_count;
+  match a with
+    | Const i -> Lambda(fun x -> 
+      let v = !opponent.(255-i).vitality in
+      if v <= 0 then
+	begin
+	  !opponent.(255-i).field <- x;
+	  !opponent.(255-i).vitality <- -1
+	end
+      else
+	raise( Rule_error "slot is alive");
+      id)
+    | _ -> raise( Rule_error "not an integer"))
+
+type card =
+    | I
+    | Zero
+    | Succ
+    | Dbl
+    | Get
+    | Put
+    | S
+    | K
+    | Inc
+    | Dec
+    | Attack
+    | Help
+    | Copy
+    | Revive
+    | Zombie
+
+let card_of_string s = match s with
+    | "I" -> I
+    | "zero" -> Zero
+    | "Succ" -> Succ
+    | "dbl" -> Dbl
+    | "get" -> Get
+    | "put" -> Put
+    | "S" -> S
+    | "K" -> K
+    | "inc" -> Inc
+    | "dec" -> Dec
+    | "attack" -> Attack
+    | "help" -> Help
+    | "copy" -> Copy
+    | "revive" -> Revive
+    | "zombie" -> Zombie
+    | _ -> raise( Rule_error "not a valid card name")
+
+let cardfun_of_card c = match c with
+  | I -> id
+  | Zero -> zero
+  | Succ -> succ
+  | Dbl -> dbl
+  | Get -> get
+  | Put -> put
+  | S -> s
+  | K -> k
+  | Inc -> inc
+  | Dec -> dec
+  | Attack -> attack
+  | Help -> help
+  | Copy -> copy
+  | Revive -> revive
+  | Zombie -> zombie
+
+let cardfun_of_card_bis c = match c with
+  | I -> id
+  | Zero -> zero
+  | Succ -> succ
+  | Dbl -> dbl
+  | Get -> get
+  | Put -> put
+  | S -> s
+  | K -> k
+  | Inc -> inc_bis
+  | Dec -> dec_bis
+  | Attack -> attack_bis
+  | Help -> help_bis
+  | Copy -> copy
+  | Revive -> revive
+  | Zombie -> zombie
+
+let left_apply player card number =
+  if player = 0 then begin
+    proponent := player0;
+    opponent := player1
+  end
+  else
+    begin
+      proponent := player1;
+      opponent := player0
+    end;
+  let slot = !proponent.(number) in
+  slot.field <-
+    try
+      (cardfun_of_card card) @ slot.field
+    with
+      | Rule_error _ | Invalid_argument _ -> card_count:=0; id
+
+let right_apply player card number =
+  if player = 0 then begin
+    proponent := player0;
+    opponent := player1
+  end
+  else
+    begin
+      proponent := player1;
+      opponent := player0
+    end;
+  let slot = !proponent.(number) in
+  slot.field <-
+    try
+      slot.field @ (cardfun_of_card card)
+    with
+      | Rule_error _ | Invalid_argument _ -> card_count:=0; id
+
+let right_apply_bis player card number =
+  if player = 0 then begin
+    proponent := player0;
+    opponent := player1
+  end
+  else
+    begin
+      proponent := player1;
+      opponent := player0
+    end;
+  let slot = !proponent.(number) in
+  slot.field <-
+    try
+      slot.field @ (cardfun_of_card_bis card)
+    with
+      | Rule_error _ | Invalid_argument _ -> card_count:=0; id
+
+(*
+right_apply !proponent.(0) Help;;
+right_apply !proponent.(0) Zero;;
+left_apply K !proponent.(0);;
+left_apply S !proponent.(0);;
+right_apply !proponent.(0) Succ;;
+right_apply !proponent.(0) Zero;;
+right_apply !proponent.(1) Zero;;
+left_apply Succ !proponent.(1);;
+left_apply Dbl !proponent.(1);;
+left_apply Dbl !proponent.(1);;
+left_apply Dbl !proponent.(1);;
+left_apply Dbl !proponent.(1);;
+left_apply K !proponent.(0);;
+left_apply S !proponent.(0);;
+right_apply !proponent.(0) Get;;
+left_apply K !proponent.(0);;
+left_apply S !proponent.(0);;
+right_apply !proponent.(0) Succ;;
+right_apply !proponent.(0) Zero;;
+*)