(* Queens problem from Eff 3.1 *)
(* Eff 3.1 code
type choice = effect
operation fail : unit -> empty
operation decide : unit -> bool
end
let c = new choice
let fail () = match c#fail () with
let choose_left =
handler
| c#decide () k -> k true
let choose_max =
handler
| c#decide () k -> max (k true) (k false)
let choose_all =
handler
| val x -> [x]
| c#fail () _ -> []
| c#decide () k -> (k true) @ (k false)
;;
(* Try also "choose_max" and "choose_all" *)
with choose_left handle
let x = (if c#decide () then 10 else 20) in
let y = (if c#decide () then 0 else 5) in
x - y
;;
let rec choose_int m n =
if m > n then
fail ()
else if c#decide () then
m
else
choose_int (m + 1) n
let backtrack = handler
| c#decide () k ->
handle k false with
| c#fail () _ -> k true
;;
let rec choose xs =
match xs with
| [] -> fail ()
| x :: xs -> if c#decide () then x else choose xs
let no_attack (x, y) (x', y') =
x <> x' && y <> y' && abs (x - x') <> abs (y - y');;
let available x qs =
filter (fun y -> forall (no_attack (x, y)) qs) [1; 2; 3; 4; 5; 6; 7; 8];;
let rec place x qs =
if x = 9 then qs else
let y = choose (available x qs) in
place (x + 1) ((x, y) :: qs)
let backtrack = handler
| c#decide () k ->
handle k true with
| c#fail () _ -> k false
;;
with backtrack handle
place 1 []
;;
- : (int × int) list = [(8, 4); (7, 2); (6, 7); (5, 3); (4, 6); (3, 8);
(2, 5); (1, 1)]
*)
(*
#directory "/home/oleg/Cache/ncaml4/lib";;
#load "delimcc.cma";;
#use "eff1.ml";;
*)
type choice =
| Fail of unit * (empty -> choice result)
| Decide of unit * (bool -> choice result)
let c = new_prompt ()
let fail () = match
shift0 c (fun k -> Eff (Fail ((),k))) with _ -> failwith "unreachable"
let decide p arg = shift0 p (fun k -> Eff (Decide (arg,k)))
let choose_left loop = function
| Decide ((),k) -> loop @@ k true
let choose_max loop = function
| Decide ((),k) -> max (loop @@ k true) (loop @@ k false)
let choose_all loop = function
(* | Done x -> [x] *)
| Fail ((),_) -> []
| Decide ((),k) -> (loop @@ k true) @ (loop @@ k false)
;;
(*
let _ = handle_it c
(fun () ->
let x = (if decide c () then 10 else 20) in
let y = (if decide c () then 0 else 5) in
x - y)
(fun x -> x)
choose_left
;;
10
*)
(* Almost the same syntax as Eff *)
let rec choose xs =
match xs with
| [] -> fail ()
| [x] -> x
| x :: xs -> if decide c () then x else choose xs
let no_attack (x, y) (x', y') =
x <> x' && y <> y' && abs (x - x') <> abs (y - y')
let available x qs =
List.filter (fun y -> List.for_all
(no_attack (x, y)) qs) [1; 2; 3; 4; 5; 6; 7; 8];;
let rec place x qs =
if x = 9 then qs else
let y = choose (available x qs) in
place (x + 1) ((x, y) :: qs)
(* This is quite inefficient, but it faithfully represents
the Eff code, with the relay of the Fail effect.
The better version, which also lets us efficiently cout all
solutions, should use separate Decide and Fail effects.
*)
let backtrack loop = function
| Fail ((),_) -> fail ()
| Decide ((),k) ->
handle_it c (fun () -> loop @@ k true) (fun x -> x)
(fun _ -> function Fail ((),_) -> loop @@ k false)
;;
let main =
handle_it c (fun () ->
place 1 [])
(fun x -> x)
backtrack
;;