r5141: Auto commit for Debian build
authorKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 17 Jun 2003 05:47:18 +0000 (05:47 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 17 Jun 2003 05:47:18 +0000 (05:47 +0000)
base.lisp
debian/changelog
edge-table-storage.lisp
edge-table.lisp
io.lisp

index 8a6dd146f494a4a3845eb448a9525893e73c2142..03a628f7846ff12198dd15b2543f1584f311f4de 100644 (file)
--- a/base.lisp
+++ b/base.lisp
@@ -8,7 +8,7 @@
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: base.lisp,v 1.6 2003/06/12 13:28:55 kevin Exp $
+;;;; $Id: base.lisp,v 1.7 2003/06/17 05:47:18 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
 ;;;;
 ;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
 (defun count-difference (player board)
   "Count player's pieces minus opponent's pieces."
   (declare (type board board)
 (defun count-difference (player board)
   "Count player's pieces minus opponent's pieces."
   (declare (type board board)
-          (fixnum player)
+          (type fixnum player)
           (optimize (speed 3) (safety 0) (space 0)))
   (the fixnum (- (the fixnum (count player board))
           (optimize (speed 3) (safety 0) (space 0)))
   (the fixnum (- (the fixnum (count player board))
-                (the fixum (count (opponent player) board)))))
+                (the fixnum (count (opponent player) board)))))
 
 (defun valid-p (move)
   (declare (type move move)
 
 (defun valid-p (move)
   (declare (type move move)
index 81bfa92608a0fae95147c939672fff6381f53f38..a6005c7b5ef6cdab0565ccfce7ae404d4474d9a9 100644 (file)
@@ -1,3 +1,9 @@
+cl-reversi (1.0.8-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon, 16 Jun 2003 23:46:53 -0600
+
 cl-reversi (1.0.7-1) unstable; urgency=low
 
   * New upstream
 cl-reversi (1.0.7-1) unstable; urgency=low
 
   * New upstream
index 366aa90b84d19e75ed8dd4ca1131efc0df2dcb22..035656e732a3806ebe2f9b73c3db0a648f5be329 100644 (file)
@@ -7,7 +7,7 @@
 ;;;;  Programer:      Kevin Rosenberg
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
 ;;;;  Programer:      Kevin Rosenberg
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: edge-table-storage.lisp,v 1.4 2003/06/12 12:42:13 kevin Exp $
+;;;; $Id: edge-table-storage.lisp,v 1.5 2003/06/17 05:47:18 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg
 ;;;;
@@ -35,7 +35,8 @@
                       :name "edge-table"
                       :type "dat"))))
 
                       :name "edge-table"
                       :type "dat"))))
 
-  (defun store-edge-table (et &optional (path *et-path*)) 
+  (defun store-edge-table (et &optional (path *et-path*))
+    (declare (type edge-table et))
     (with-open-file (stream path :direction :output
                            :if-exists :supersede)
       (print (length et) stream)
     (with-open-file (stream path :direction :output
                            :if-exists :supersede)
       (print (length et) stream)
       (with-open-file (stream path :direction :input)
        (let* ((length (read stream))
               (et (make-array length :element-type 'fixnum)))
       (with-open-file (stream path :direction :input)
        (let* ((length (read stream))
               (et (make-array length :element-type 'fixnum)))
-                     (dotimes (i length)
-                       (declare (fixnum i))
-                       (setf (aref et i) (read stream)))
-                     et))))
+         (declare (type (simple-array fixnum (*)) et))
+         (dotimes (i length)
+           (declare (fixnum i))
+           (setf (aref et i) (read stream)))
+         et))))
   
   (unless (probe-file *et-path*)
     (format *trace-output* ";; Recompiling edge-table, this make take several minutes")
   
   (unless (probe-file *et-path*)
     (format *trace-output* ";; Recompiling edge-table, this make take several minutes")
index c8a648e6351756f5709a7f1773d6adabd54ea0bf..521c7f1e3fce458ccd01f4e92459f94d03a15dc1 100644 (file)
@@ -7,7 +7,7 @@
 ;;;;  Programer:      Kevin M. Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
 ;;;;  Programer:      Kevin M. Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: edge-table.lisp,v 1.5 2003/06/12 13:28:55 kevin Exp $
+;;;; $Id: edge-table.lisp,v 1.6 2003/06/17 05:47:18 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
 ;;;;
 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
   (init-edge-table)
   *edge-table*)
 
   (init-edge-table)
   *edge-table*)
 
+(deftype edge-table () '(simple-array fixnum (*)))
+
 
 (defun map-edge-n-pieces (fn player board n squares index)
   "Call fn on all edges with n pieces."
   ;; Index counts 1 for player; 2 for opponent
 
 (defun map-edge-n-pieces (fn player board n squares index)
   "Call fn on all edges with n pieces."
   ;; Index counts 1 for player; 2 for opponent
-  (declare (fixnum index)
+  (declare (fixnum index)
           (type player player)
           (type square index)
           (type (simple-array fixnum (100)) board)
           (type player player)
           (type square index)
           (type (simple-array fixnum (100)) board)
@@ -59,7 +61,7 @@
              (sq (first squares)))
         (declare (fixnum index3 sq))
          (map-edge-n-pieces fn player board n (rest squares) index3)
              (sq (first squares)))
         (declare (fixnum index3 sq))
          (map-edge-n-pieces fn player board n (rest squares) index3)
-         (when (and (> n 0) (eql (bref board sq) empty))
+         (when (and (plusp n) (= (bref board sq) empty))
            (setf (bref board sq) player)
            (map-edge-n-pieces fn player board (- n 1) (rest squares)
                               (+ 1 index3))
            (setf (bref board sq) player)
            (map-edge-n-pieces fn player board (- n 1) (rest squares)
                               (+ 1 index3))
 
 (defun combine-edge-moves (possibilities player)
   "Combine the best moves."
 
 (defun combine-edge-moves (possibilities player)
   "Combine the best moves."
-  (declare (optimize (speed 3) (safety 0) (space 0)))
+  (declare (type player player)
+          (optimize (speed 3) (safety 0) (space 0)))
   (let ((prob 1.0)
         (val 0.0)
         (fn (if (= player black) #'> #'<)))
   (let ((prob 1.0)
         (val 0.0)
         (fn (if (= player black) #'> #'<)))
       for i from 0
       sum (the fixnum 
            (cond
       for i from 0
       sum (the fixnum 
            (cond
-            ((= (bref board sq) empty) 0)
+            ((= (bref board sq) empty) 0d0)
             ((= (bref board sq) player)
              (aref *static-edge-table* i
                    (piece-stability board sq)))
             ((= (bref board sq) player)
              (aref *static-edge-table* i
                    (piece-stability board sq)))
diff --git a/io.lisp b/io.lisp
index 57940c47ae0e6cbab44c7c7372fb0f19a499c767..635f90c0c76aa46ca8dc998d00e503183e804974 100644 (file)
--- a/io.lisp
+++ b/io.lisp
@@ -8,7 +8,7 @@
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
 ;;;;  Date Started:   1 Nov 2001
 ;;;;
-;;;; $Id: io.lisp,v 1.5 2003/06/12 13:28:55 kevin Exp $
+;;;; $Id: io.lisp,v 1.6 2003/06/17 05:47:18 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
 ;;;;
 ;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg 
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
@@ -26,7 +26,7 @@
         (cross-product #'concat-symbol
                        '(? A B C D E F G H ?)
                        '(? 1 2 3 4 5 6 7 8 ?))))
         (cross-product #'concat-symbol
                        '(? A B C D E F G H ?)
                        '(? 1 2 3 4 5 6 7 8 ?))))
-  (declaim (type list square-names))
+  (declare (type list square-names))
 
   (defun h8->88 (str)
     "Convert from alphanumeric to numeric square notation."
 
   (defun h8->88 (str)
     "Convert from alphanumeric to numeric square notation."