diff options
| -rw-r--r-- | cards.ml | 158 | ||||
| -rw-r--r-- | game.ml | 181 |
2 files changed, 181 insertions, 158 deletions
diff --git a/cards.ml b/cards.ml deleted file mode 100644 index 352d825..0000000 --- a/cards.ml +++ /dev/null @@ -1,158 +0,0 @@ -type lambda = - |Const of int - |Lambda of (lambda -> lambda);; -let unfold (Lambda x) = x -let (@) a1 a2 = unfold a1 a2;; -let (!) x = Lambda x - -let id = !(fun x -> x) -type slot = { - mutable vitality: int; - mutable field: lambda -} -;; -let proponent = Array.init 256 (fun _ -> {vitality = 10000; field = id}) -let opponent = Array.init 256 (fun _ -> {vitality = 10000; field = id}) - -let zero = Const 0 -let succ = !(fun (Const n) -> if n < 65535 then Const (n+1) else Const n) -let dbl = !(fun (Const n) -> if n<32768 then Const(2*n) else Const n) -let get = !(fun (Const i) -> if proponent.(i).vitality > 0 then proponent.(i).field else failwith "dead") -let put = !(fun x -> id) -let s = !(fun f -> !(fun g -> !(fun x -> (f @ x) @ (g @ x)))) -let k = !(fun x -> !(fun y -> x)) -let inc = !(fun (Const i) -> - let v = proponent.(i).vitality in - if ( v < 65535 ) & ( v > 0 ) then - proponent.(i).vitality <- proponent.(i).vitality + 1; - id) - -let dec = !(fun (Const i) -> - let v = opponent.(255-i).vitality in - if v>0 then - opponent.(255-1).vitality <-opponent.(255-1).vitality-1; - id) - -let attack = !(fun (Const i) -> !(fun (Const j) -> !(fun (Const n) -> - let v = proponent.(i).vitality in - if v - n > 0 then - proponent.(i).vitality <- proponent.(i).vitality - n - else - failwith "not enough life"; - let w = opponent.(255-j).vitality in - if w > 0 then - proponent.(255-j).vitality <- max 0 (w - 9/10 *n); - id))) - -let help = !(fun (Const i) -> !(fun (Const j) -> !(fun (Const n) -> - let v = proponent.(i).vitality in - if v - n > 0 then - proponent.(i).vitality <- proponent.(i).vitality - 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 = !(fun (Const i) -> opponent.(i).field) - -let revive = !(fun (Const i) -> - let v = proponent.(i).vitality in - if v <= 0 then - proponent.(i).vitality <- 1; - id) - -let zombie = !(fun (Const i) -> !(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 card slot = - slot.field <- (cardfun_of_card card) @ slot.field - -let right_apply slot card = - slot.field <- slot.field @ (cardfun_of_card card) - -let proponent = Array.init 256 (fun _ -> {vitality = 10000; field = id}) - -let opponent = proponent = -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;; - @@ -0,0 +1,181 @@ +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;; +*) |