type lambda =
  |Const of int
  |Lambda of (lambda -> lambda);;

let unfold (Lambda x) = x

let (@) a1 a2 = unfold a1 a2;;

let id  = Lambda(fun x -> x)

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 proponent = ref player0
let opponent = ref player1

let zero = Const 0
let succ = Lambda(fun (Const n) -> if n < 65535 then Const (n+1) else Const n)
let dbl = Lambda(fun (Const n) -> if n<32768 then Const(2*n) else Const n)
let get = Lambda(fun (Const i) -> if !proponent.(i).vitality > 0 then !proponent.(i).field else failwith "dead")
let put = Lambda(fun x -> id)
let s = Lambda(fun f -> Lambda(fun g -> Lambda(fun x -> (f @ x) @ (g @ x))))
let k = Lambda(fun x -> Lambda(fun y -> x))
let inc = Lambda(fun (Const i) -> 
  let v = !proponent.(i) .vitality in
  if ( v < 65535 ) & ( v > 0 ) then
    !proponent.(i).vitality <- v + 1;
  id)

let dec = Lambda(fun (Const i) -> 
  let v = !opponent.(255-i).vitality in
  if v > 0 then
    !opponent.(255-1).vitality <- v - 1;
  id)

let attack = Lambda(fun (Const i) -> Lambda(fun (Const j) -> Lambda(fun (Const n) -> 
    let v = !proponent.(i).vitality in
    if v - n > 0 then
      !proponent.(i).vitality <- v - n
    else
      failwith "not enough life";
    let w = !opponent.(255-j).vitality in
    if w > 0 then
      !opponent.(255-j).vitality <- max 0  (w - 9/10 *n);
    id)))

let help = Lambda(fun (Const i) -> Lambda(fun  (Const j) -> Lambda(fun (Const n) ->
  let v = !proponent.(i).vitality in
  if v - n > 0 then
    !proponent.(i).vitality <- v - n
  else
    failwith "not enough life";
  let w = !proponent.(j).vitality in
  if w > 0 then
    !proponent.(j).vitality <- min (w + n*11/10) 65535;
  id)))

let copy = Lambda(fun (Const i) -> !opponent.(i).field)

let revive = Lambda(fun (Const i) ->
  let v = !proponent.(i).vitality in
  if v <= 0 then
    !proponent.(i).vitality <- 1;
  id)

let zombie = Lambda(fun (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
    failwith "slot is alive";
  id))

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
;;

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 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 <- (cardfun_of_card card) @ slot.field

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 <- slot.field @ (cardfun_of_card card)
    
(*
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;;
*)