(* 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 ;;