;;;-*-mode:lisp;package:bench-triang;base:10; source->source-optimizations:(t cspecials) -*-
;;; From the "Dick Gabriel" Benchmark Series.
;;; Enhancements (C) Copyright 1983, Lisp Machine, Inc.

;;;BEGIN
;;;TRIANG
(declare (special answer final))

(eval-when (compile load eval)
	   (setq base 10. ibase 10.))

(defarray board fixnum 16.)
(defarray sequence fixnum 14.)
(defarray a fixnum 37.)
(defarray b fixnum 37.)
(defarray c fixnum 37.)

(fillarray board '(1))
(setf (board 5) 0)

(fillarray a '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4
		  4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6))

(fillarray b '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5
		  2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5))

(fillarray c '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6
		  1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4))

(defun last-position ()
       (do ((i 1 (1+ i)))
	   ((= i 16.) 0)
	   (cond ((= 1 (board i)) (return i)))))

(defun try (i depth)
       (cond ((= depth 14) 
	      (let ((lp (last-position)))
		   (cond ((member lp final))
			 (t (push lp final))))
	      (push (cdr (listarray sequence)) answer) t)
	     ((and (= 1 (board (a i)))
		   (= 1 (board (b i)))
		   (= 0 (board (c i))))
	      (setf (board (a i)) 0)
	      (setf (board (b i)) 0)
	      (setf (board (c i)) 1)
	      (setf (sequence depth) i)
	      (do ((j 0 (1+ j))
		   (depth (1+ depth)))
		  ((or (= j 36.)
		       (try j depth)) ()))
	      (setf (board (a i)) 1)
	      (setf (board (b i)) 1)
	      (setf (board (c i)) 0)())))

(defun gogogo (i)
       (let ((answer ())
	     (final ()))
	    (try i 1)))

;(include "timer.lsp")

(timer timit 
	(gogogo 22.))

(defun test ()
       (let ((answer ())
	     (final ()))
	    (try 22. 1)
	    (= (length answer) 775.)))
;;;END