summaryrefslogtreecommitdiff
path: root/testsuite/tests/asmgen/soli.cmm
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/asmgen/soli.cmm')
-rw-r--r--testsuite/tests/asmgen/soli.cmm110
1 files changed, 110 insertions, 0 deletions
diff --git a/testsuite/tests/asmgen/soli.cmm b/testsuite/tests/asmgen/soli.cmm
new file mode 100644
index 0000000000..c8ffc5d684
--- /dev/null
+++ b/testsuite/tests/asmgen/soli.cmm
@@ -0,0 +1,110 @@
+(**************************************************************************)
+(* *)
+(* 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))