1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
(** {1 Useful functions to test running relational queries } *)
open Printf
open OCanren
(** {3 Helper functions to provide names for top-level variables } *)
let wrap onOK i (name, x) =
onOK i name x
let qh onOK = fun q () ->
List.iteri (wrap onOK) @@ ["q", q]
let qrh onOK = fun q r () ->
List.iteri (wrap onOK) @@ ["q", q; "r", r]
let qrsh onOK = fun q r s () ->
List.iteri (wrap onOK) @@ ["q", q; "r", r; "s", s]
let qrsth onOK = fun q r s t () ->
List.iteri (wrap onOK) @@ ["q", q; "r", r; "s", s; "t", t]
let make_title n msg =
printf "%s, %s answer%s {\n%!"
msg
(if n = (-1) then "all" else string_of_int n)
(if n <> 1 then "s" else "")
exception NoMoreAnswers
let run_gen onFree n num handler (repr, goal) =
make_title n repr;
let rec loop st = function
| k when (k > n) && (n >= 0) -> ()
| k ->
match Stream.retrieve ~n:1 st with
| [],_ -> raise NoMoreAnswers
| [f],tl ->
f ();
printf "\n%!";
loop tl (k+1)
| _ -> assert false
in
let handler = handler onFree in
let () = try loop (run num goal handler) 1 with NoMoreAnswers -> () in
printf "}\n%!"
let run_r reifier printerR = run_gen
(fun i name (func : _ OCanren.reified) ->
let ans = func#reify reifier in
printf "%s%s=%s;%!" (if i<>0 then " " else "") name (printerR ans)
)