107 lines
4.0 KiB
Plaintext
107 lines
4.0 KiB
Plaintext
(***********************************************************************)
|
|
(* *)
|
|
(* Objective Caml *)
|
|
(* *)
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
|
(* Automatique. Distributed only by permission. *)
|
|
(* *)
|
|
(***********************************************************************)
|
|
|
|
(* $Id$ *)
|
|
|
|
("d1": int 0 int 1
|
|
"d2": int 1 int 0
|
|
"d3": int 0 int -1
|
|
"d4": int -1 int 0
|
|
"dir": addr "d1" addr "d2" addr "d3" addr "d4")
|
|
|
|
("counter": int 0)
|
|
|
|
(* Out = 0 Empty = 1 Peg = 2 *)
|
|
|
|
("line0": int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0
|
|
"line1": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0
|
|
"line2": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0
|
|
"line3": int 0 int 2 int 2 int 2 int 2 int 2 int 2 int 2 int 0
|
|
"line4": int 0 int 2 int 2 int 2 int 1 int 2 int 2 int 2 int 0
|
|
"line5": int 0 int 2 int 2 int 2 int 2 int 2 int 2 int 2 int 0
|
|
"line6": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0
|
|
"line7": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0
|
|
"line8": int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0
|
|
"board": addr "line0" addr "line1" addr "line2" addr "line3"
|
|
addr "line4" addr "line5" addr "line6" addr "line7" addr "line8")
|
|
|
|
("format": string "%d\n\000")
|
|
|
|
(function "solve" (m: int)
|
|
(store "counter" (+ (load "counter" int) 1))
|
|
(if (== m 31)
|
|
(== (intaref (addraref "board" 4) 4) 2)
|
|
(try
|
|
(if (== (mod (load "counter" int) 500) 0)
|
|
(extcall "printf" ["format" (load "counter" int)] unit)
|
|
[])
|
|
(let i 1
|
|
(while (<= i 7)
|
|
(let j 1
|
|
(while (<= j 7)
|
|
(if (== (intaref (addraref "board" i) j) 2)
|
|
(seq
|
|
(let k 0
|
|
(while (<= k 3)
|
|
(let (d1 (intaref (addraref "dir" k) 0)
|
|
d2 (intaref (addraref "dir" k) 1)
|
|
i1 (+ i d1)
|
|
i2 (+ i1 d1)
|
|
j1 (+ j d2)
|
|
j2 (+ j1 d2))
|
|
(if (== (intaref (addraref "board" i1) j1) 2)
|
|
(if (== (intaref (addraref "board" i2) j2) 1)
|
|
(seq
|
|
(intaset (addraref "board" i) j 1)
|
|
(intaset (addraref "board" i1) j1 1)
|
|
(intaset (addraref "board" i2) j2 2)
|
|
(if (app "solve" (+ m 1) int)
|
|
(raise 0a)
|
|
[])
|
|
(intaset (addraref "board" i) j 2)
|
|
(intaset (addraref "board" i1) j1 2)
|
|
(intaset (addraref "board" i2) j2 1))
|
|
[])
|
|
[]))
|
|
(assign k (+ k 1)))))
|
|
[])
|
|
(assign j (+ j 1))))
|
|
(assign i (+ i 1))))
|
|
0
|
|
with bucket
|
|
1)))
|
|
|
|
("format_out": string ".\000")
|
|
("format_empty": string " \000")
|
|
("format_peg": string "$\000")
|
|
("format_newline": string "\n\000")
|
|
|
|
(function "print_board" ()
|
|
(let i 0
|
|
(while (< i 9)
|
|
(let j 0
|
|
(while (< j 9)
|
|
(switch 3 (intaref (addraref "board" i) j)
|
|
case 0:
|
|
(extcall "printf" "format_out" unit)
|
|
case 1:
|
|
(extcall "printf" "format_empty" unit)
|
|
case 2:
|
|
(extcall "printf" "format_peg" unit))
|
|
(assign j (+ j 1))))
|
|
(extcall "printf" "format_newline" unit)
|
|
(assign i (+ i 1)))))
|
|
|
|
(function "solitaire" ()
|
|
(if (app "solve" 0 int)
|
|
(app "print_board" [] unit)
|
|
[]))
|