1. Sébastien Ferré
  2. ocaml-lib

Source

ocaml-lib / sumonad / essai.ml


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 range a b = u_def
  if _ = u_guard (a <= b) then (u_return a | range (a+1) b)
*)

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