(* TEST
files = "main.c"
arguments = "-DUNIT_INT -DFUN=solitaire main.c"
* asmgen
*)

(**************************************************************************)
(*                                                                        *)
(*                                OCaml                                   *)
(*                                                                        *)
(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
(*                                                                        *)
(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

("d1": int 0 int 1
 "d2": int 1 int 0
 "d3": int 0 int -1
 "d4": int -1 int 0
 "dir": val "d1" val "d2" val "d3" val "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": val "line0" val "line1" val "line2" val "line3"
          val "line4" val "line5" val "line6" val "line7" val "line8")

("format": string "%d\n\000")

(function "solve" (m: int)
  (store int "counter" (+ (load int "counter") 1))
  (if (== m 31)
      (== (intaref (addraref "board" 4) 4) 2)
    (try
     (if (== (mod (load int "counter") 500) 0)
          (extcall "printf_int" "format" (load int "counter") 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_notrace 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 "print_string" "format_out" unit)
            case 1:
              (extcall "print_string" "format_empty" unit)
            case 2:
              (extcall "print_string" "format_peg" unit))
          (assign j (+ j 1))))
      (extcall "print_string" "format_newline" unit)
      (assign i (+ i 1)))))

(function "solitaire" ()
  (seq
    (if (app "solve" 0 int)
        (app "print_board" [] unit)
      [])
    0))