From 20c849f483c381f84eae22eee807280c8d00e554 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Thu, 12 Jun 2003 12:42:13 +0000
Subject: [PATCH] r5103: *** empty log message ***

---
 base.lisp               | 40 ++++++--------------
 edge-table-storage.lisp |  6 +--
 edge-table.lisp         | 82 +++++++++++++++++++++--------------------
 io-clim.lisp            |  4 +-
 io.lisp                 |  7 +---
 package.lisp            |  4 +-
 strategies.lisp         | 36 +++++++++++-------
 utils.lisp              |  6 +--
 8 files changed, 88 insertions(+), 97 deletions(-)

diff --git a/base.lisp b/base.lisp
index ac4fb55..bbcd872 100644
--- a/base.lisp
+++ b/base.lisp
@@ -8,7 +8,7 @@
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: base.lisp,v 1.3 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: base.lisp,v 1.4 2003/06/12 12:42:13 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
@@ -20,9 +20,6 @@
 
 (in-package #:reversi)
 
-(eval-when (:compile-toplevel)
-  (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
-
 (defparameter +all-directions+ '(-11 -10 -9 -1 1 9 10 11))
 (defconstant +default-max-minutes+ 30)
 
@@ -113,7 +110,7 @@
   `(the piece (aref (the board ,board) (the square ,square))))
 
 (defparameter all-squares
-    (loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i)
+    (loop for i fixum from 11 to 88 when (<= 1 (mod i 10) 8) collect i)
   "A list of all squares")
 
 (defun initial-board ()
@@ -155,12 +152,14 @@
 (defun count-difference (player board)
   "Count player's pieces minus opponent's pieces."
   (declare (type board board)
-	   (fixnum player))
-  (- (count player board)
-     (count (opponent player) board)))
+	   (fixnum player)
+	   (optimize (speed 3) (safety 0) (space 0)))
+  (the fixnum (- (the fixnum (count player board))
+		 (the fixum (count (opponent player) board)))))
 
 (defun valid-p (move)
-  (declare (type move move))
+  (declare (type move move)
+	   (optimize (speed 3) (safety 0) (space 0)))
   "Valid moves are numbers in the range 11-88 that end in 1-8."
   (and (typep move 'move) (<= 11 move 88) (<= 1 (mod move 10) 8)))
 
@@ -202,8 +201,7 @@
   (declare (type board board)
 	   (type move move)
 	   (type player player)
-	   (optimize (speed 3) (safety 0))
-)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (if (= (the piece (bref board move)) empty)
       (block search
 	(dolist (dir +all-directions+)
@@ -246,8 +244,7 @@
   (declare (type board board)
 	   (type move move)
 	   (type player)
-	   (optimize (speed 3) (safety 0))
-)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (setf (bref board move) player)
   (dolist (dir +all-directions+)
     (declare (type dir dir))
@@ -260,8 +257,7 @@
 	   (type move move)
 	   (type player player)
 	   (type dir dir)
-	   (optimize (speed 3) (safety 0))
-)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (let ((bracketer (would-flip? move player board dir)))
     (when bracketer
       (loop for c from (+ move dir) by dir until (= c (the fixnum bracketer))
@@ -277,8 +273,7 @@
 	   (type move move)
 	   (type player player)
 	   (type dir dir)
-	   (optimize (speed 3) (safety 0))
-)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (let ((c (+ move dir)))
     (declare (type square c))
     (and (= (the piece (bref board c)) (the player (opponent player)))
@@ -331,16 +326,6 @@
 (defun replace-board (to from)
   (replace to from))
 
-#+ignore
-(defun replace-board (to from)
-  (declare (type board to from)
-           (optimize (safety 0) (debug 0) (speed 3))
-)
-  (dotimes (i 100)
-    (declare (type 'fixnum i))
-    (setf (aref to i) (aref from i)))
-  to)
-
 #+allegro
 (defun replace-board (to from)
   (declare (type board to from))
@@ -351,7 +336,6 @@
   (apply #'vector (loop repeat 40 collect (initial-board))))
 
 
-
 (defvar *move-number* 1 "The number of the move to be played")
 (declaim (type fixnum *move-number*))
 
diff --git a/edge-table-storage.lisp b/edge-table-storage.lisp
index d09f416..366aa90 100644
--- a/edge-table-storage.lisp
+++ b/edge-table-storage.lisp
@@ -7,16 +7,16 @@
 ;;;;  Programer:      Kevin Rosenberg
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: edge-table-storage.lisp,v 1.3 2002/10/25 12:39:15 kevin Exp $
+;;;; $Id: edge-table-storage.lisp,v 1.4 2003/06/12 12:42:13 kevin Exp $
 ;;;;
-;;;; This file is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
 ;;;;
 ;;;; Reversi users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;;***************************************************************************
 
-(in-package :reversi)
+(in-package #:reversi)
 
 (defparameter *et-path* nil)
 
diff --git a/edge-table.lisp b/edge-table.lisp
index 653c0c1..9b2f949 100644
--- a/edge-table.lisp
+++ b/edge-table.lisp
@@ -7,9 +7,9 @@
 ;;;;  Programer:      Kevin M. Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: edge-table.lisp,v 1.3 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: edge-table.lisp,v 1.4 2003/06/12 12:42:13 kevin Exp $
 ;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
 ;;;;
 ;;;; Reversi users are granted the rights to distribute and use this software
@@ -20,8 +20,6 @@
 
 (in-package #:reversi)
 
-(eval-when (:compile-toplevel)
-  (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defparameter *edge-and-x-lists*
@@ -52,7 +50,8 @@
 	   (type player player)
 	   (type square index)
 	   (type (simple-array fixnum (100)) board)
-	   (list squares))
+	   (list squares)
+	   (optimize (speed 3) (space 0) (safety 0)))
   (cond
     ((< (length squares) n) nil)
     ((null squares) (funcall fn board index))
@@ -92,7 +91,7 @@
   (declare (type board board)
 	   (type player player)
 	   (type cons squares)
-	   (optimize (speed 3) (safety 1)))
+	   (optimize (speed 3) (safety 0) (space 0)))
   (let ((index 0))
     (declare (fixnum index))
     (dolist (sq squares)
@@ -120,6 +119,7 @@
 
 (defun combine-edge-moves (possibilities player)
   "Combine the best moves."
+  (declare (optimize (speed 3) (safety 0) (space 0)))
   (let ((prob 1.0)
         (val 0.0)
         (fn (if (= player black) #'> #'<)))
@@ -142,7 +142,8 @@
   "What's the probability that player can move to this square?"
   (declare (type board board)
 	   (type player player)
-	   (type square square))
+	   (type square square)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (cond
     ((x-square-p square) .5) ;; X-squares
     ((legal-p square player board) 1.0) ;; immediate capture
@@ -189,7 +190,8 @@
 (defun static-edge-stability (player board)
   "Compute this edge's static stability"
   (declare (type board board)
-	   (type player player))
+	   (type player player)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (loop for sq in *top-edge*
       for i from 0
       sum (the fixnum 
@@ -207,39 +209,41 @@
     
     (defun piece-stability (board sq)
       (declare (type board board)
-	       (fixnum sq))
-    (cond
-      ((corner-p sq) stable)
-      ((x-square-p sq)
-       (if (eql (bref board (corner-for sq)) empty)
-           unstable semi-stable))
-      (t (let* ((player (bref board sq))
-                (opp (opponent player))
-                (p1 (find player board :test-not #'eql
-                          :start sq :end 19))
-                (p2 (find player board :test-not #'eql
-                          :start 11 :end sq
-                          :from-end t)))
-	   (declare (fixnum player opp))
-           (cond
-             ;; unstable pieces can be captured immediately
-             ;; by playing in the empty square
-             ((or (and (eql p1 empty) (eql p2 opp))
-                  (and (eql p2 empty) (eql p1 opp)))
-              unstable)
-             ;; Semi-stable pieces might be captured
-             ((and (eql p1 opp) (eql p2 opp)
-                   (find empty board :start 11 :end 19))
-              semi-stable)
-             ((and (eql p1 empty) (eql p2 empty))
-              semi-stable)
-             ;; Stable pieces can never be captured
-             (t stable))))))))
+	       (fixnum sq)
+	       (optimize (speed 3) (safety 0) (space 0)))
+      (cond
+	((corner-p sq) stable)
+	((x-square-p sq)
+	 (if (eql (bref board (corner-for sq)) empty)
+	     unstable semi-stable))
+	(t (let* ((player (bref board sq))
+		  (opp (opponent player))
+		  (p1 (find player board :test-not #'eql
+			    :start sq :end 19))
+		  (p2 (find player board :test-not #'eql
+			    :start 11 :end sq
+			    :from-end t)))
+	     (declare (fixnum player opp))
+	     (cond
+	       ;; unstable pieces can be captured immediately
+	       ;; by playing in the empty square
+	       ((or (and (eql p1 empty) (eql p2 opp))
+		    (and (eql p2 empty) (eql p1 opp)))
+		unstable)
+	       ;; Semi-stable pieces might be captured
+	       ((and (eql p1 opp) (eql p2 opp)
+		     (find empty board :start 11 :end 19))
+		semi-stable)
+	       ((and (eql p1 empty) (eql p2 empty))
+		semi-stable)
+	       ;; Stable pieces can never be captured
+	       (t stable))))))))
 
 
 (defun init-edge-table ()
   "Initialize *edge-table*, starting from the empty board."
   ;; Initialize the static values
+  (declare (optimize (speed 3) (safety 0) (space 0)))
   (loop for n-pieces from 0 to 10 do 
         (map-edge-n-pieces
 	 #'(lambda (board index)
@@ -252,11 +256,11 @@
   (dotimes (i 5) 
     (declare (fixnum i))
     ;; Do the indexes with most pieces first
-    (loop for n-pieces from 9 downto 1 do 
+    (loop for n-pieces fixnum from 9 downto 1 do 
           (map-edge-n-pieces
             #'(lambda (board index)
-	     (declare (type board board)
-		      (fixnum index))
+		(declare (type board board)
+			 (fixnum index))
                 (setf (aref *edge-table* index)
                       (the fixnum (possible-edge-moves-value black board index))))
             black (initial-board) n-pieces *top-edge* 0))))
diff --git a/io-clim.lisp b/io-clim.lisp
index 7516869..12ea49b 100644
--- a/io-clim.lisp
+++ b/io-clim.lisp
@@ -8,9 +8,9 @@
 ;;;;  Programer:      Kevin M. Rosenberg
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: io-clim.lisp,v 1.12 2003/05/06 15:53:47 kevin Exp $
+;;;; $Id: io-clim.lisp,v 1.13 2003/06/12 12:42:13 kevin Exp $
 ;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;;
 ;;;; Reversi users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
diff --git a/io.lisp b/io.lisp
index 26872ec..1d3d2c8 100644
--- a/io.lisp
+++ b/io.lisp
@@ -8,9 +8,9 @@
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: io.lisp,v 1.3 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: io.lisp,v 1.4 2003/06/12 12:42:13 kevin Exp $
 ;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
 ;;;;
 ;;;; Reversi users are granted the rights to distribute and use this software
@@ -20,9 +20,6 @@
 
 (in-package #:reversi)
 
-(eval-when (:compile-toplevel)
-  (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
-
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (let ((square-names 
diff --git a/package.lisp b/package.lisp
index ee2cd6a..5abbd7c 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,9 +7,9 @@
 ;;;;  Programer:      Kevin M. Rosenberg
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: package.lisp,v 1.5 2003/05/06 16:17:53 kevin Exp $
+;;;; $Id: package.lisp,v 1.6 2003/06/12 12:42:13 kevin Exp $
 ;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;;
 ;;;; Reversi users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
diff --git a/strategies.lisp b/strategies.lisp
index e7d2fe6..c2cade7 100644
--- a/strategies.lisp
+++ b/strategies.lisp
@@ -8,9 +8,9 @@
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: strategies.lisp,v 1.5 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: strategies.lisp,v 1.6 2003/06/12 12:42:13 kevin Exp $
 ;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
 ;;;;
 ;;;; Reversi users are granted the rights to distribute and use this software
@@ -20,9 +20,6 @@
 
 (in-package #:reversi)
 
-(eval-when (:compile-toplevel)
-  (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
-
 (defun random-strategy (player board)
   "Make any legal move."
   (declare (type player player)
@@ -119,7 +116,8 @@
   searching PLY levels deep and backing up values."
   (declare (type player player)
 	   (type board board)
-	   (fixnum ply))
+	   (fixnum ply)
+	   (optimize (speed 3) (space 0) (safety 0)))
   (if (= ply 0)
       (funcall eval-fn player board)
       (let ((moves (legal-moves player board)))
@@ -158,7 +156,8 @@
   using cutoffs whenever possible."
   (declare (type player player)
 	   (type board board)
-	   (fixnum achievable cutoff ply))
+	   (fixnum achievable cutoff ply)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (if (= ply 0)
       (funcall eval-fn player board)
       (let ((moves (legal-moves player board)))
@@ -199,7 +198,8 @@
   "Like WEIGHTED-SQUARES, but don't take off for moving
   near an occupied corner."
   (declare (type player player)
-	   (type board board))
+	   (type board board)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (let ((w (weighted-squares player board)))
     (declare (fixnum w))
     (dolist (corner '(11 18 81 88))
@@ -256,6 +256,8 @@
 (defun alpha-beta2 (player node achievable cutoff ply eval-fn)
   "A-B search, sorting moves by eval-fn"
   ;; Returns two values: achievable-value and move-to-make
+  (declare (fixnum ply)
+	   (optimize (speed 3) (space 0) (safety 0)))
   (if (= ply 0)
       (values (node-value node) node)
       (let* ((board (node-board node))
@@ -283,6 +285,8 @@
 
 (defun negate-value (node)
   "Set the value of a node to its negative."
+  (declare (fixnum node)
+	   (speed 3) (safety 0) (space 0))
   (setf (node-value node) (- (node-value node)))
   node)
 
@@ -304,7 +308,8 @@
                     killer)
   (declare (type board board)
 	   (type player player)
-	   (type fixnum achievable cutoff ply))
+	   (type fixnum achievable cutoff ply)
+	   (optimize (speed 3) (space 0) (safety 0)))
   "A-B search, putting killer move first."
   (if (= ply 0)
       (funcall eval-fn player board)
@@ -345,7 +350,8 @@
   (declare (type board board)
 	   (type player player)
 	   (type fixnum achievable cutoff ply)
-	   (type move killer))
+	   (type move killer)
+	   (optimize (speed 3) (safety 0) (space 0)))
   "A-B search, putting killer move first."
   (if (= ply 0)
       (funcall eval-fn player board)
@@ -416,7 +422,7 @@
   Returns current and potential mobility for player."
   (declare (type board board)
 	   (type player player)
-	   (optimize (speed 3) (safety 0 )))
+	   (optimize (speed 3) (safety 0) (space 0)))
   (let ((opp (opponent player))
         (current 0)    ; player's current mobility
         (potential 0))			; player's potential mobility
@@ -437,7 +443,7 @@
   (declare (type board board)
 	   (type player opp)
 	   (type cons neighbors)
-	   (optimize (speed 3) (safety 0)))
+	   (optimize (speed 3) (safety 0) (space 0)))
   (block search
     (dolist (sq neighbors)
       (declare (type square sq))
@@ -448,7 +454,8 @@
 (defun edge-stability (player board)
   "Total edge evaluation for player to move on board."
   (declare (type board board)
-	   (type player player))
+	   (type player player)
+	   (optimize (speed 3) (safety 0) (space 0))
   (loop for edge-list in *edge-and-x-lists*
         sum (aref *edge-table*
                   (edge-index player board edge-list))))
@@ -459,7 +466,8 @@
   ;; The three factors are multiplied by coefficients
   ;; that vary by move number:
   (declare (type board board)
-	   (type player player))
+	   (type player player)
+	   (optimize (speed 3) (safety 0) (space 0)))
   (let ((c-edg  (+ 312000 (* 6240 *move-number*)))
         (c-cur (if (< *move-number* 25)
 		   (+ 50000 (* 2000 *move-number*))
diff --git a/utils.lisp b/utils.lisp
index 2477224..8a3ac40 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -7,9 +7,9 @@
 ;;;;  Programer:      Kevin M. Rosenberg
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: utils.lisp,v 1.4 2003/05/06 15:51:20 kevin Exp $
+;;;; $Id: utils.lisp,v 1.5 2003/06/12 12:42:13 kevin Exp $
 ;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
+;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;;
 ;;;; Reversi users are granted the rights to distribute and use this software
 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
@@ -18,8 +18,6 @@
 
 (in-package #:reversi)
 
-(eval-when (:compile-toplevel)
-  (declaim (optimize (safety 1) (space 0) (speed 3) (compilation-speed 0))))
 
 (defmacro missing-argument ()
   `(error "Missing an argument to a constructor"))
-- 
2.34.1