1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6(* *) 7(* Copyright 1996 Institut National de Recherche en Informatique et *) 8(* en Automatique. *) 9(* *) 10(* All rights reserved. This file is distributed under the terms of *) 11(* the GNU Lesser General Public License version 2.1, with the *) 12(* special exception on linking described in the file LICENSE. *) 13(* *) 14(**************************************************************************) 15 16("d1": int 0 int 1 17 "d2": int 1 int 0 18 "d3": int 0 int -1 19 "d4": int -1 int 0 20 "dir": val "d1" val "d2" val "d3" val "d4") 21 22("counter": int 0) 23 24(* Out = 0 Empty = 1 Peg = 2 *) 25 26("line0": int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0 27 "line1": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0 28 "line2": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0 29 "line3": int 0 int 2 int 2 int 2 int 2 int 2 int 2 int 2 int 0 30 "line4": int 0 int 2 int 2 int 2 int 1 int 2 int 2 int 2 int 0 31 "line5": int 0 int 2 int 2 int 2 int 2 int 2 int 2 int 2 int 0 32 "line6": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0 33 "line7": int 0 int 0 int 0 int 2 int 2 int 2 int 0 int 0 int 0 34 "line8": int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0 int 0 35 "board": val "line0" val "line1" val "line2" val "line3" 36 val "line4" val "line5" val "line6" val "line7" val "line8") 37 38("format": string "%d\n\000") 39 40(function "solve" (m: int) 41 (store int "counter" (+ (load int "counter") 1)) 42 (if (== m 31) 43 (== (intaref (addraref "board" 4) 4) 2) 44 (try 45 (if (== (mod (load int "counter") 500) 0) 46 (extcall "printf_int" "format" (load int "counter") unit) 47 []) 48 (let i 1 49 (while (<= i 7) 50 (let j 1 51 (while (<= j 7) 52 (if (== (intaref (addraref "board" i) j) 2) 53 (seq 54 (let k 0 55 (while (<= k 3) 56 (let (d1 (intaref (addraref "dir" k) 0) 57 d2 (intaref (addraref "dir" k) 1) 58 i1 (+ i d1) 59 i2 (+ i1 d1) 60 j1 (+ j d2) 61 j2 (+ j1 d2)) 62 (if (== (intaref (addraref "board" i1) j1) 2) 63 (if (== (intaref (addraref "board" i2) j2) 1) 64 (seq 65 (intaset (addraref "board" i) j 1) 66 (intaset (addraref "board" i1) j1 1) 67 (intaset (addraref "board" i2) j2 2) 68 (if (app "solve" (+ m 1) int) 69 (raise_notrace 0a) 70 []) 71 (intaset (addraref "board" i) j 2) 72 (intaset (addraref "board" i1) j1 2) 73 (intaset (addraref "board" i2) j2 1)) 74 []) 75 [])) 76 (assign k (+ k 1))))) 77 []) 78 (assign j (+ j 1)))) 79 (assign i (+ i 1)))) 80 0 81 with bucket 82 1))) 83 84("format_out": string ".\000") 85("format_empty": string " \000") 86("format_peg": string "$\000") 87("format_newline": string "\n\000") 88 89(function "print_board" () 90 (let i 0 91 (while (< i 9) 92 (let j 0 93 (while (< j 9) 94 (switch 3 (intaref (addraref "board" i) j) 95 case 0: 96 (extcall "print_string" "format_out" unit) 97 case 1: 98 (extcall "print_string" "format_empty" unit) 99 case 2: 100 (extcall "print_string" "format_peg" unit)) 101 (assign j (+ j 1)))) 102 (extcall "print_string" "format_newline" unit) 103 (assign i (+ i 1))))) 104 105(function "solitaire" () 106 (seq 107 (if (app "solve" 0 int) 108 (app "print_board" [] unit) 109 []) 110 0)) 111