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 = increase card_count;Const 0
let succ = increase card_count;
  Lambda(fun a -> match a with
    | Const n -> if n < 65535 then Const (n+1) else Const n
    | _ -> raise( Rule_error "not an integer"))
let dbl = increase card_count;
  Lambda(fun a -> match a with
  | Const n -> if n < 32768 then Const(2*n) else Const n
  | _ -> raise( Rule_error "not an integer"))
let get = increase card_count;
  Lambda(fun a -> 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 = increase card_count;Lambda(fun x -> id)
let s = increase card_count;Lambda(fun f -> Lambda(fun g -> Lambda(fun x -> (f @ x) @ (g @ x))))
let k = increase card_count;Lambda(fun x -> Lambda(fun y -> x))

let inc = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> match a with
    | Const i -> !opponent.(i).field
    | _ -> raise( Rule_error "not an integer"))
    
let revive = increase card_count;
  Lambda(fun a -> 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 = increase card_count;
  Lambda(fun a -> 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;;
*)