Anonymous avatar Anonymous committed 19ec101

initial import

Comments (0)

Files changed (4)

+_build/
+.native
+<**/*.{ml,mli}>: warn_A, annotate
+<**/*>: pkg_core, pkg_threads, pkg_ssl, pkg_pcre
+<test.*>: pkg_oUnit
+open Ocamlbuild_plugin
+open Command (* no longer needed for OCaml >= 3.10.2 *)
+
+(* these functions are not really officially exported *)
+let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
+let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings
+
+(* this lists all supported packages *)
+let find_packages () =
+  blank_sep_strings &
+    Lexing.from_string &
+      run_and_read "ocamlfind list | cut -d ' ' -f 1"
+
+(* this is supposed to list available syntaxes, but I don't know how to do it. *)
+let find_syntaxes () = ["camlp4o"; "camlp4r"]
+
+(* ocamlfind command *)
+let ocamlfind x = S[A"ocamlfind"; x]
+
+let _ = dispatch begin function
+   | Before_options ->
+       (* by using Before_options one let command line options have an higher priority *)
+       (* on the contrary using After_options will guarantee to have the higher priority *)
+
+       (* override default commands by ocamlfind ones *)
+       Options.ocamlc   := ocamlfind & A"ocamlc";
+       Options.ocamlopt := ocamlfind & A"ocamlopt";
+       Options.ocamldep := ocamlfind & A"ocamldep";
+       Options.ocamldoc := ocamlfind & A"ocamldoc"
+
+   | After_rules ->
+
+       (* When one link an OCaml library/binary/package, one should use -linkpkg *)
+       flag ["ocaml"; "link"] & A"-linkpkg";
+
+       (* For each ocamlfind package one inject the -package option when
+       	* compiling, computing dependencies, generating documentation and
+       	* linking. *)
+       List.iter begin fun pkg ->
+         flag ["ocaml"; "compile";  "pkg_"^pkg] & S[A"-package"; A pkg];
+         flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg];
+         flag ["ocaml"; "doc";      "pkg_"^pkg] & S[A"-package"; A pkg];
+         flag ["ocaml"; "link";     "pkg_"^pkg] & S[A"-package"; A pkg];
+       end (find_packages ());
+
+       (* Like -package but for extensions syntax. Morover -syntax is useless
+       	* when linking. *)
+       List.iter begin fun syntax ->
+         flag ["ocaml"; "compile";  "syntax_"^syntax] & S[A"-syntax"; A syntax];
+         flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+         flag ["ocaml"; "doc";      "syntax_"^syntax] & S[A"-syntax"; A syntax];
+       end (find_syntaxes ());
+       
+       (* The default "thread" tag is not compatible with ocamlfind.
+          Indeed, the default rules add the "threads.cma" or "threads.cmxa"
+          options when using this tag. When using the "-linkpkg" option with
+          ocamlfind, this module will then be added twice on the command line.
+       
+          To solve this, one approach is to add the "-thread" option when using
+          the "threads" package using the previous plugin.
+        *)
+       flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
+       flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"])
+       
+   | _ -> ()
+end
+open Core.Std
+
+module Stats : sig
+  val log_war : unit -> unit
+  val log_round : unit -> unit
+  val to_string : unit -> string
+end = struct
+  type t = {
+    mutable wars: int;
+    mutable rounds: int
+  }
+
+  let stats = { wars = 0; rounds = 0 }
+
+  let to_string () = sprintf "rounds: %i\nwars: %i" stats.rounds stats.wars
+  let log_war () = stats.wars <- stats.wars + 1
+  let log_round () = stats.rounds <- stats.rounds + 1
+end
+
+module Suit = struct
+  type t =
+    | Hearts
+    | Clubs
+    | Diamonds
+    | Spades
+
+  let all = [Hearts; Clubs; Diamonds; Spades]
+
+  let of_int i =
+    match i with
+    | 0 -> Hearts
+    | 1 -> Clubs
+    | 2 -> Diamonds
+    | 3 -> Spades
+    | _ -> raise (Invalid_argument "Suit.of_int i must be between 0 and 3 (inclusive)")
+  ;;
+
+  let to_string t =
+    match t with
+    | Hearts   -> "hearts"
+    | Clubs    -> "clubs"
+    | Diamonds -> "diamonds"
+    | Spades   -> "spades"
+  ;;
+end
+
+module Card : sig
+  type t
+  
+  val create : Suit.t -> int -> t
+  val compare : t -> t -> int
+  val to_string : t -> string
+end = struct
+  type t = Suit.t * int
+
+  let compare (_,v1) (_,v2) = compare v1 v2
+
+  let to_string (s,v) =
+    let v_string =
+      match v with
+      | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 -> Int.to_string v
+      | 11 -> "jack"
+      | 12 -> "queen"
+      | 13 -> "king"
+      | 14 -> "ace"
+      | _  -> assert false
+    in
+    sprintf "%s of %s" v_string (Suit.to_string s)
+  ;;
+
+  let create suit value =
+    match value with
+    | 1 -> (suit, 14)
+    | v -> 
+        if 2 <= v && v <= 13 then (suit, value)
+        else raise (Invalid_argument "value must be between 1 and 13 (inclusive)")
+  ;;
+end
+
+module Deck = struct
+  Random.self_init ();;
+
+  type t = Card.t list
+
+  let default =
+    let values = [1;2;3;4;5;6;7;8;9;10;11;12;13] in
+    List.map Suit.all ~f:(fun s -> List.map values ~f:(fun v -> Card.create s v)) 
+    |! List.flatten
+  ;;
+
+  let shuffle t =
+    List.map t ~f:(fun c -> Random.float 1., c)
+    |! List.sort ~cmp:(fun (r1,_) (r2,_) -> compare r1 r2)
+    |! List.map ~f:snd
+  ;;
+
+  let to_string t = String.concat ~sep:"\n" (List.map t ~f:Card.to_string)
+end
+
+let rec war pile p1 p2 =
+  Stats.log_war ();
+  match p1,p2 with
+  | p1 :: p2 :: p3 :: w1 :: rest1, p4 :: p5 :: p6 :: w2 :: rest2 ->
+      let pile = Deck.shuffle [p1;p2;p3;p4;p5;p6;w1;w2] @ pile in
+      begin match Card.compare w1 w2 with
+      | -1 -> rest1, rest2 @ pile 
+      | 1  -> rest1 @ pile, rest2
+      | 0  -> war pile rest1 rest2
+      | _  -> assert false
+      end
+  | _ :: _ :: _ :: _ :: _, _ -> pile @ p1 @ p2, []
+  | _, _ :: _ :: _ :: _ :: _ -> [], pile @ p1 @ p2
+  | _ -> assert false
+;;
+
+let rec play p1 p2 =
+  Stats.log_round ();
+  match p1,p2 with
+  | [],_ -> `Two
+  | _,[] -> `One
+  | c1 :: rest1, c2 :: rest2 ->
+      match Card.compare c1 c2 with
+      | -1 -> play rest1 (rest2 @ Deck.shuffle [c1; c2])
+      | 1  -> play (rest1 @ Deck.shuffle [c1; c2]) rest2
+      | 0  -> 
+          let p1,p2 = war [c1;c2] rest1 rest2 in
+          play p1 p2
+      | _  -> assert false
+;;
+
+let main () =
+  let deck = Deck.shuffle Deck.default in
+  let p1,p2 = 
+    List.fold_left deck ~init:([],[]) ~f:(fun (cur,next) c -> (next, c :: cur))
+  in
+  let result = play p1 p2 in
+  printf "%s\n" (Stats.to_string ());
+  match result with
+  | `One -> printf "player 1 wins!\n%!"
+  | `Two -> printf "player 2 wins!\n%!"
+;;
+
+let () = main ()
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.