Source

ocaml-lib / monad / essai.ml

Full commit

let rec safe_aux (p1,p2,p3) = (* low diagonal, line, high diagonal *)
  function
    | [] -> true
    | p::ps1 -> p <> p1 && p <> p2 && safe_aux (p1-1,p2,p3+1) ps1
let safe p ps1 = safe_aux (p-1,p,p+1) ps1

module State =
struct
  type t = { cpt : int }

  let init = { cpt = 0 }
    
  let get = u_def (let s = u_state in u_return s.cpt)
  let incr = u_def (let s = u_state in u_state <- { cpt = s.cpt + 1 })
  let print_line str = u_def (u_return (print_endline str))
end

let rec range a b =
  if a <= b
  then u_def (u_return a | range (a+1) b)
  else u_def u_fail

let rec nqueens n k =
  if k=0
  then u_def (
    let i = State.get in
    State.print_line ("k=" ^ string_of_int i);
    u_return [])
  else u_def (
    let ps1 = State.incr; nqueens n (k-1) in
    let p = range 1 n in
    u_guard safe p ps1;
    u_return p::ps1)

let _ =
  let n = try int_of_string Sys.argv.(1) with _ -> 4 in
  let k = try int_of_string Sys.argv.(2) with _ -> 10 in
  if u_run with u_state = State.init
    u_exists ps = nqueens n n
  then print_endline "There are solutions!";
  u_run with u_state = State.init
    for ps = nqueens n n to k do
      List.iter
	(fun p -> print_int p; print_char ' ')
	ps; 
      print_newline ()
    done

(* ----- *)

let generator_of_iterator (iter : (int,_,unit) Sumonad.t) : (int,int,int) Sumonad.t = u_def (
  u_state <- 0;
  for x = iter do
    let sum = u_state in
    u_yield (sum+x);
    u_state <- (sum+x)
  done;
  u_state)

let iterator_of_generator (gen : (_,'e,'s) Sumonad.t) : ('e,_,'s) Sumonad.t = u_def (
  try gen; u_fail
  with x -> u_return x)

let _ = u_run with u_state = 0
  for i = iterator_of_generator (generator_of_iterator (range 0 9)) do print_int i done

let rec sums = function
  | [] -> u_def u_return 0
  | x::l -> u_def (
    let s = sums l in
    u_yield (x+s);
    u_return (x+s))

let _ = u_run for i = u_def (try sums [2;3;5;7;11]; u_fail with i -> u_return (print_int i)) do print_string "\n" done

(* ---------------- *)

let rec parse_add = u_def
  let v1 = parse_mult in
  let f = parse_add_aux in
  u_return (f v1)
and parse_add_aux = u_def
  begin
    | #look "+";
      let v2 = parse_mult in
      let f = parse_add_aux in
      u_return (fun v1 -> f (v1 + v2))
    | u_return (fun v1 -> v1)
  end
and parse_mult = u_def
  let v1 = parse_atom in
  let f = parse_mult_aux in
  u_return (f v1)
and parse_mult_aux = u_def
  begin
    | #look "*";
      let v2 = parse_atom in
      let f = parse_mult_aux in
      u_return (fun v1 -> f (v1 * v2))
    | u_return (fun v1 -> v1)
  end
and parse_atom = u_def
  begin
    | let s = #get "[0-9]+" in
      u_return (int_of_string s)
    | #look "(";
      let v = parse_add in
      #look ")";
      u_return v
  end