aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorThibaut Horel <thibaut.horel@gmail.com>2011-06-19 17:25:59 +0200
committerThibaut Horel <thibaut.horel@gmail.com>2011-06-19 17:25:59 +0200
commit4f62d5ce18765a5f7376a508a45bdb021e5ca5b8 (patch)
tree49e8d4c2ac262f760f75422012b477a49a2b0511 /src
parent338891c519fba83ccd6c61492082abfa2bb1cf22 (diff)
downloadicfp2011-4f62d5ce18765a5f7376a508a45bdb021e5ca5b8.tar.gz
Organise the directory so that it is compliant with the submission rules
Diffstat (limited to 'src')
-rw-r--r--src/Makefile32
-rw-r--r--src/game.ml311
-rw-r--r--src/ltg.ml56
3 files changed, 399 insertions, 0 deletions
diff --git a/src/Makefile b/src/Makefile
new file mode 100644
index 0000000..da9657a
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,32 @@
+OCAMLC=ocamlc.opt
+OCAMLOPT=ocamlopt.opt
+OCAMLDEP=ocamldep.opt
+INCLUDES=
+OCAMLFLAGS=$(INCLUDES)
+SRCS=game.ml ltg.ml
+BUILDDIR=
+DEPEND=.depend
+
+all: ltg.opt
+
+ltg.opt: ltg.cmx
+ $(OCAMLOPT) $(OCAMLFLAGS) -o ../run game.cmx ltg.cmx
+
+clean:
+ rm -f *.cm? *.cmx? *.o *~
+ rm -f .depend
+
+depend: $(SRCS)
+ $(OCAMLDEP) $(SRCS) > $(DEPEND)
+
+.SUFFIXES: .mli .ml .cmo .cmi .cmx
+
+%.cmo : %.ml
+ $(OCAMLC) -c $(OCAMLFLAGS) $<
+%.cmi : %.mli
+ $(OCAMLC) -c $(OCAMLFLAGS) $<
+%.cmx : %.ml
+ $(OCAMLOPT) -c $(OCAMLFLAGS) $<
+
+-include $(DEPEND)
+
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;;
+*)
diff --git a/src/ltg.ml b/src/ltg.ml
new file mode 100644
index 0000000..c3b7637
--- /dev/null
+++ b/src/ltg.ml
@@ -0,0 +1,56 @@
+open Game
+
+let _ = if Array.length Sys.argv < 2 then begin
+ Printf.printf "You must specify the player number\n";
+ exit 1
+end
+
+let me = int_of_string Sys.argv.(1)
+
+let opponent = match me with
+ | 0 -> 1
+ | 1 -> 0
+ | _ -> failwith "Wrong player_number"
+
+let read_move () = Scanf.scanf "%d\n" (fun d -> match d with
+ | 1 -> Scanf.scanf "%s\n%d\n" (fun s d ->
+ Game.left_apply opponent (card_of_string s) d)
+ | 2 -> Scanf.scanf "%d\n%s\n" (fun d s ->
+ Game.right_apply opponent (card_of_string s) d)
+ | _ -> failwith "Wrong move number"
+)
+
+(* important print newline to flush output *)
+let play_move () =
+ Printf.printf "2";
+ print_newline ();
+ Printf.printf "1";
+ print_newline();
+ Printf.printf "zero";
+ print_newline ()
+
+let automatic player =
+ let aux i slot =
+ if slot.vitality = -1 then begin
+ Game.right_apply_bis player I i;
+ slot.vitality <- 0;
+ slot.field <- id
+ end
+ in
+ if player = 0 then
+ Array.iteri aux player0
+ else
+ Array.iteri aux player1
+
+let do_round =
+ if me = 0
+ then fun () -> automatic 0; play_move (); automatic 1; read_move ()
+ else fun () -> automatic 0; read_move (); automatic 1; play_move ()
+
+
+let _ =
+ let round = ref 1 in
+ while !round <= 100000 do
+ do_round ();
+ incr round
+ done \ No newline at end of file