emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] 01/01: * chess-pos.el (chess-pos-en-passant, chess-pos-status) (c


From: Mario Lang
Subject: [elpa] 01/01: * chess-pos.el (chess-pos-en-passant, chess-pos-status) (chess-pos-side-to-move, chess-pos-annotations) (chess-pos-preceding-ply): Enable use as generalized variables. (chess-pos-p): New function.
Date: Fri, 13 Jun 2014 21:39:14 +0000

mlang pushed a commit to branch externals/chess
in repository elpa.

commit 9295c19fcd9ea1148fa2ecb43ee3a8197a1ec8bc
Author: Mario Lang <address@hidden>
Date:   Fri Jun 13 23:37:23 2014 +0200

    * chess-pos.el (chess-pos-en-passant, chess-pos-status)
    (chess-pos-side-to-move, chess-pos-annotations)
    (chess-pos-preceding-ply): Enable use as generalized variables.
    (chess-pos-p): New function.
    
    * chess-ply.el (chess-ply-pos, chess-ply-changes)
    (chess-ply-keyword): Enable use as generalized variables.
    (chess-ply-castling-changes): Convert to using
    `chess-next-index'.
    
    * chess-polyglot.el (chess-polyglot-pos-to-key): Use logxor to invert
    rank instead of two loops to keep rank/file apart.
---
 ChangeLog          |   15 ++++
 chess-ai.el        |    2 +-
 chess-algebraic.el |    6 +-
 chess-fen.el       |    4 +-
 chess-ply.el       |   34 ++++++----
 chess-polyglot.el  |   35 +++++-----
 chess-pos.el       |  191 ++++++++++++++++++++++++++--------------------------
 7 files changed, 154 insertions(+), 133 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 05c0d9c..1a073c7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2014-06-13  Mario Lang  <address@hidden>
+
+       * chess-pos.el (chess-pos-en-passant, chess-pos-status)
+       (chess-pos-side-to-move, chess-pos-annotations)
+       (chess-pos-preceding-ply): Enable use as generalized variables.
+       (chess-pos-p): New function.
+
+       * chess-ply.el (chess-ply-pos, chess-ply-changes)
+       (chess-ply-keyword): Enable use as generalized variables.
+       (chess-ply-castling-changes): Convert to using
+       `chess-next-index'.
+
+       * chess-polyglot.el (chess-polyglot-pos-to-key): Use logxor to invert
+       rank instead of two loops to keep rank/file apart.
+
 2014-06-11  Mario Lang  <address@hidden>
 
        * chess-pos.el (chess-ply-castling-changes): Declare.
diff --git a/chess-ai.el b/chess-ai.el
index d3a1e5c..06cee58 100644
--- a/chess-ai.el
+++ b/chess-ai.el
@@ -102,7 +102,7 @@ this ply depth limit has been reached."
 
 (defun chess-ai-eval-static (position)
   "Calculate the static score for POSITION."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (let ((v 0)
        (status (chess-pos-status position)))
     (if (eq status :checkmate)
diff --git a/chess-algebraic.el b/chess-algebraic.el
index c0951cf..49a95d6 100644
--- a/chess-algebraic.el
+++ b/chess-algebraic.el
@@ -93,8 +93,8 @@ notation.")
   "Convert the (short or long) algebraic notation MOVE for POSITION to a ply.
 
 Figurine notation is currently not supported."
-  (cl-assert (vectorp position))
-  (cl-assert (stringp move))
+  (cl-check-type position chess-pos)
+  (cl-check-type move string)
   (let ((case-fold-search nil))
     (when (string-match chess-algebraic-regexp-entire move)
       (let ((color (chess-pos-side-to-move position))
@@ -168,7 +168,7 @@ Optional argument TYPE specifies the kind of algebraic 
notation to generate.
 `:san' (the default) generates short (or standard) algebraic notation.
 `:lan' generates long algebraic notation (like \"Nb1-c3\".
 `:fan' generates figurine algebraic notation (like \"♘c3\"."
-  (cl-assert (listp ply))
+  (cl-check-type ply (and list (not null)))
   (cl-check-type type (member nil :san :fan :lan))
   (unless type (setq type :san))
   (or (chess-ply-keyword ply type)
diff --git a/chess-fen.el b/chess-fen.el
index 001c2c4..f3a2eb0 100644
--- a/chess-fen.el
+++ b/chess-fen.el
@@ -65,7 +65,7 @@
 
 (defun chess-fen-to-pos (fen)
   "Convert a FEN-like notation string to a chess position."
-  (cl-assert (stringp fen))
+  (cl-check-type fen string)
   (let ((i 0) (l (length fen))
        (rank 0) (file 0) (c ?0)
        (position (chess-pos-create t))
@@ -118,7 +118,7 @@
 (defun chess-pos-to-fen (position &optional full)
   "Convert a chess POSITION to FEN-like notation.
 If FULL is non-nil, represent trailing spaces as well."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (let ((blank 0) (str "") output)
     (dotimes (rank 8)
       (dotimes (file 8)
diff --git a/chess-ply.el b/chess-ply.el
index 0f2bc2c..cf463cb 100644
--- a/chess-ply.el
+++ b/chess-ply.el
@@ -78,6 +78,8 @@
   (cl-assert (vectorp position))
   (setcar ply position))
 
+(gv-define-simple-setter chess-ply-pos chess-ply-set-pos)
+
 (defsubst chess-ply-changes (ply)
   (cl-assert (listp ply))
   (cdr ply))
@@ -87,7 +89,11 @@
   (cl-assert (listp changes))
   (setcdr ply changes))
 
+(gv-define-simple-setter chess-ply-changes chess-ply-set-changes)
+
 (defun chess-ply-any-keyword (ply &rest keywords)
+  "Return non-nil if PLY contains at least one of KEYWORDS."
+  (declare (side-effect-free t))
   (cl-assert (listp ply))
   (catch 'found
     (dolist (keyword keywords)
@@ -95,13 +101,11 @@
          (throw 'found keyword)))))
 
 (defun chess-ply-keyword (ply keyword)
+  (declare (side-effect-free t))
   (cl-assert (listp ply))
   (cl-assert (symbolp keyword))
   (let ((item (memq keyword (chess-ply-changes ply))))
-    (if item
-       (if (eq item (last (chess-ply-changes ply)))
-           t
-         (cadr item)))))
+    (and item (if (not (cdr item)) t (cadr item)))))
 
 (defun chess-ply-set-keyword (ply keyword &optional value)
   (cl-assert (listp ply))
@@ -109,13 +113,15 @@
   (let* ((changes (chess-ply-changes ply))
         (item (memq keyword changes)))
     (if item
-       (if value
-           (setcar (cdr item) value))
+       (when value
+         (setcar (cdr item) value))
       (nconc changes (if value
                         (list keyword value)
                       (list keyword))))
     value))
 
+(gv-define-simple-setter chess-ply-keyword chess-ply-set-keyword)
+
 (defsubst chess-ply-source (ply)
   "Returns the source square index value of PLY."
   (cl-assert (listp ply))
@@ -148,19 +154,19 @@
         (rook (chess-pos-can-castle position (if color
                                                  (if long ?Q ?K)
                                                (if long ?q ?k))))
-        (bias (if long -1 1)) pos)
+        (direction (if long chess-direction-west chess-direction-east)) pos)
     (when rook
-      (setq pos (chess-incr-index king 0 bias))
-      (while (and pos (not (equal pos rook))
+      (setq pos (chess-next-index king direction))
+      (while (and pos (/= pos rook)
                  (chess-pos-piece-p position pos ? )
                  (or (and long (< (chess-index-file pos) 2))
                      (chess-pos-legal-candidates
                       position color pos (list king))))
-       (setq pos (chess-incr-index pos 0 bias)))
-      (if (equal pos rook)
-         (list king (chess-rf-to-index (if color 7 0) (if long 2 6))
-               rook (chess-rf-to-index (if color 7 0) (if long 3 5))
-               (if long :long-castle :castle))))))
+       (setq pos (chess-next-index pos direction)))
+      (when (equal pos rook)
+       (list king (if color (if long #o72 #o76) (if long #o02 #o06))
+             rook (if color (if long #o73 #o75) (if long #o03 #o05))
+             (if long :long-castle :castle))))))
 
 (chess-message-catalog 'english
   '((ambiguous-promotion . "Promotion without :promote keyword")))
diff --git a/chess-polyglot.el b/chess-polyglot.el
index a6be4ae..717e1c4 100644
--- a/chess-polyglot.el
+++ b/chess-polyglot.el
@@ -97,11 +97,11 @@ The result is a list of the form (FROM-INDEX TO-INDEX 
PROMOTION WEIGHT)."
 FROM and TO are integers indicating the square indices.
 PROMOTION, if non-nil, indicates the piece to promote to.
 WEIGHT (an integer) is the relative weight of the move."
-  (cl-assert (vectorp position))
-  (cl-assert (and (integerp from) (>= from 0) (< from 64)))
-  (cl-assert (and (integerp to) (>= to 0) (< to 64)))
-  (cl-assert (memq promotion '(nil ?N ?B ?R ?Q)))
-  (cl-assert (integerp weight))
+  (cl-check-type position chess-pos)
+  (cl-check-type from (integer 0 63))
+  (cl-check-type to (integer 0 63))
+  (cl-check-type promotion (member nil ?N ?B ?R ?Q))
+  (cl-check-type weight integer)
   (let* ((color (chess-pos-side-to-move position))
         (ply (apply #'chess-ply-create position nil
                     (if (and (= from (chess-rf-to-index (if color 7 0) 4))
@@ -429,20 +429,19 @@ On reaching end or beginning of buffer, stop and signal 
error."
 (defun chess-polyglot-pos-to-key (position)
   "Calculate the polyglot zorbist hash for POSITION.
 Uses 781 predefined hash values from `chess-polyglot-zorbist-keys'."
-  (cl-assert (vectorp position))
+  (declare (side-effect-free t))
+  (cl-check-type position chess-pos)
   (let ((a16 0) (b16 0) (c16 0) (d16 0))
-    (dotimes (rank 8)
-      (dotimes (file 8)
-       (let ((piece (cl-position (chess-pos-piece position (chess-rf-to-index
-                                                            rank file))
-                                 chess-polyglot-zorbist-piece-type)))
-         (when piece
-           (let ((piece-key (aref chess-polyglot-zorbist-keys
-                                  (+ (* 64 piece) (* (- 7 rank) 8) file))))
-             (setq a16 (logxor a16 (nth 0 piece-key))
-                   b16 (logxor b16 (nth 1 piece-key))
-                   c16 (logxor c16 (nth 2 piece-key))
-                   d16 (logxor d16 (nth 3 piece-key))))))))
+    (dotimes (index 64)
+      (let ((piece (cl-position (chess-pos-piece position index)
+                               chess-polyglot-zorbist-piece-type)))
+       (when piece
+         (let ((piece-key (aref chess-polyglot-zorbist-keys
+                                (+ (* 64 piece) (logxor index #o70)))))
+           (setq a16 (logxor a16 (nth 0 piece-key))
+                 b16 (logxor b16 (nth 1 piece-key))
+                 c16 (logxor c16 (nth 2 piece-key))
+                 d16 (logxor d16 (nth 3 piece-key)))))))
     (let ((sides '(?K ?Q ?k ?q)))
       (dolist (side sides)
        (when (chess-pos-can-castle position side)
diff --git a/chess-pos.el b/chess-pos.el
index 831c4b8..e369866 100644
--- a/chess-pos.el
+++ b/chess-pos.el
@@ -85,8 +85,9 @@
 
 (require 'chess-message)
 (require 'cl-lib)
-(eval-when-compile
-  (cl-proclaim '(optimize (speed 3) (safety 2))))
+
+;; Elides cl-check-type and cl-assert
+(eval-when-compile (cl-proclaim '(optimize (speed 3) (safety 2))))
 
 (defgroup chess-pos nil
   "Routines for manipulating chess positions."
@@ -126,6 +127,10 @@ This variable automatically becomes buffer-local when 
changed.")
    nil]
   "Starting position of a regular chess game.")
 
+(defsubst chess-pos-p (position)
+  "Return non-nil if POSITION is a chess position object."
+  (and (vectorp position) (= (length position) 75)))
+
 (chess-message-catalog 'english
   '((chess-nag-1   . "good move [traditional \"!\"]")
     (chess-nag-2   . "poor move [traditional \"?\"]")
@@ -269,18 +274,17 @@ This variable automatically becomes buffer-local when 
changed.")
 
 (defsubst chess-pos-piece (position index)
   "Return the piece on POSITION at INDEX."
-  (cl-assert (vectorp position))
-  (cl-assert (and (>= index 0) (< index 64)))
+  (cl-check-type position chess-pos)
+  (cl-check-type index (integer 0 63))
   (aref position index))
 
 (defsubst chess-pos-piece-p (position index piece-or-color)
   "Return non-nil if at POSITION/INDEX there is the given PIECE-OR-COLOR.
 If PIECE-OR-COLOR is t for white or nil for black, any piece of that
 color will do."
-  (cl-assert (vectorp position))
-  (cl-assert (and (>= index 0) (< index 64)))
-  (cl-assert (memq piece-or-color
-               '(t nil ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
+  (cl-check-type position chess-pos)
+  (cl-check-type index (integer 0 63))
+  (cl-check-type piece-or-color (member t nil ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b 
?r ?p))
   (let ((p (chess-pos-piece position index)))
     (cond
      ((= p ? ) (eq p piece-or-color))
@@ -306,7 +310,7 @@ color will do."
 
 (defsubst chess-coord-to-index (coord)
   "Convert a COORD string (such as \"e4\" into an index value."
-  (cl-assert (stringp coord))
+  (cl-check-type coord string)
   (cl-assert (= (length coord) 2))
   (chess-rf-to-index (- 7 (- (aref coord 1) ?1)) (- (aref coord 0) ?a)))
 
@@ -317,9 +321,9 @@ color will do."
 
 (defsubst chess-incr-index (index rank-move file-move)
   "Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE."
-  (cl-assert (and (>= index 0) (< index 64)))
-  (cl-assert (and (>= rank-move -7) (<= rank-move 7)))
-  (cl-assert (and (>= file-move -7) (<= file-move 7)))
+  (cl-check-type index (integer 0 63))
+  (cl-check-type rank-move (integer -7 7))
+  (cl-check-type file-move (integer -7 7))
   (let ((newrank (+ (chess-index-rank index) rank-move))
        (newfile (+ (chess-index-file index) file-move)))
     (if (and (>= newrank 0) (< newrank 8)
@@ -330,9 +334,9 @@ color will do."
   "Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE.
 This differs from `chess-incr-index' by performing no safety checks,
 in order to execute faster."
-  (cl-assert (and (>= index 0) (< index 64)))
-  (cl-assert (and (>= rank-move -7) (<= rank-move 7)))
-  (cl-assert (and (>= file-move -7) (<= file-move 7)))
+  (cl-check-type index (integer 0 63))
+  (cl-check-type rank-move (integer -7 7))
+  (cl-check-type file-move (integer -7 7))
   (chess-rf-to-index (+ (chess-index-rank index) rank-move)
                     (+ (chess-index-file index) file-move)))
 
@@ -464,9 +468,8 @@ If the new index is not on the board, nil is returned."
   "Look on POSITION anywhere for PIECE-OR-COLOR, returning all coordinates.
 If PIECE-OR-COLOR is t for white or nil for black, any piece of that
 color will do.  See also `chess-pos-search*'."
-  (cl-assert (vectorp position))
-  (cl-assert (memq piece-or-color
-               '(t nil ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
+  (cl-check-type position chess-pos)
+  (cl-check-type piece-or-color (member t nil ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b 
?r ?p))
   (let (found)
     (dotimes (i 64)
       (if (chess-pos-piece-p position i piece-or-color)
@@ -494,18 +497,18 @@ alist, but the `cdr' of their entries will be nil."
 
 (defsubst chess-pos-set-king-index (position color index)
   "Set the known index of the king on POSITION for COLOR, to INDEX.
-It is never necessary to call this function."
-  (cl-assert (vectorp position))
-  (cl-assert (memq color '(nil t)))
-  (cl-assert (and (>= index 0) (< index 64)))
+It is never necessary to call this function manually."
+  (cl-check-type position chess-pos)
+  (cl-check-type color (member nil t))
+  (cl-check-type index (integer 0 63))
   (aset position (if color 72 73) index))
 
 (defsubst chess-pos-king-index (position color)
   "Return the index on POSITION of the king.
 If COLOR is non-nil, return the position of the white king, otherwise
 return the position of the black king."
-  (cl-assert (vectorp position))
-  (cl-assert (memq color '(nil t)))
+  (cl-check-type position chess-pos)
+  (cl-check-type color (member nil t))
   (or (aref position (if color 72 73))
       (chess-pos-set-king-index position color
                                (chess-pos-search position (if color ?K ?k)))))
@@ -513,41 +516,37 @@ return the position of the black king."
 (defsubst chess-pos-set-piece (position index piece)
   "Set the piece on POSITION at INDEX to PIECE.
 PIECE must be one of K Q N B R or P.  Use lowercase to set black
-pieces."
-  (cl-assert (vectorp position))
-  (cl-assert (and (>= index 0) (< index 64)))
-  (cl-assert (memq piece '(?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
+pieces.  A space `? ' clears the square."
+  (cl-check-type position chess-pos)
+  (cl-check-type index (integer 0 63))
+  (cl-check-type piece (member ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p))
   (aset position index piece)
-  (if (= piece ?K)
-      (chess-pos-set-king-index position t index)
-    (if (= piece ?k)
-       (chess-pos-set-king-index position nil index))))
+  (when (memq piece '(?K ?k))
+    (chess-pos-set-king-index position (< piece ?a) index)))
 
 (defun chess-pos-can-castle (position side)
   "Return whether the king on POSITION can castle on SIDE.
 SIDE must be either ?K for the kingside, or ?Q for the queenside (use
 lowercase to query if black can castle)."
-  (cl-assert (vectorp position))
-  (cl-assert (memq side '(?K ?Q ?k ?q)))
-  (let* ((index (+ 65 (if (< side ?a)
-                         (if (= side ?K) 0 1)
-                       (if (= side ?k) 2 3))))
+  (cl-check-type position chess-pos)
+  (cl-check-type side (member ?K ?Q ?k ?q))
+  (let* ((index (+ 65 (pcase side (?K 0) (?Q 1) (?k 2) (?q 3))))
         (value (aref position index)))
     (if (or (eq value nil) (integerp value))
        value
-      (when (chess-pos-king-index position (< side ?a))
-       (let* ((color (< side ?a))
-              (long (= ?Q (upcase side)))
-              (file (if long 0 7))
-              (king-file (chess-index-file
-                          (chess-pos-king-index position color)))
-              rook)
-         (while (funcall (if long '< '>) file king-file)
-           (let ((index (chess-rf-to-index (if color 7 0) file)))
-             (if (chess-pos-piece-p position index (if color ?R ?r))
-                 (setq rook index file king-file)
-               (setq file (funcall (if long '1+ '1-) file)))))
-         (aset position index rook))))))
+      (let* ((color (< side ?a))
+            (king-index (chess-pos-king-index position color)))
+       (when king-index
+         (let* ((long (= ?Q (upcase side)))
+                (file (if long 0 7))
+                (king-file (chess-index-file king-index))
+                rook)
+           (while (funcall (if long '< '>) file king-file)
+             (let ((index (chess-rf-to-index (if color 7 0) file)))
+               (if (chess-pos-piece-p position index (if color ?R ?r))
+                   (setq rook index file king-file)
+                 (setq file (funcall (if long #'1+ #'1-) file)))))
+           (aset position index rook)))))))
 
 (defsubst chess-pos-set-can-castle (position side value)
   "Set whether the king can castle on the given POSITION on SIDE.
@@ -558,9 +557,9 @@ It is only necessary to call this function if setting up a 
position
 manually.  Note that all newly created positions have full castling
 priveleges set, unless the position is created blank, in which case
 castling priveleges are unset.  See `chess-pos-copy'."
-  (cl-assert (vectorp position))
-  (cl-assert (memq side '(?K ?Q ?k ?q)))
-  (cl-assert (memq value '(nil t)))
+  (cl-check-type position chess-pos)
+  (cl-check-type side (member ?K ?Q ?k ?q))
+  (cl-check-type value (member nil t))
   (aset position (+ 65 (if (< side ?a)
                           (if (= side ?K) 0 1)
                         (if (= side ?k) 2 3))) value))
@@ -568,57 +567,64 @@ castling priveleges are unset.  See `chess-pos-copy'."
 (defsubst chess-pos-en-passant (position)
   "Return the index of any pawn on POSITION that can be captured en passant.
 Returns nil if en passant is unavailable."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (aref position 64))
 
 (defsubst chess-pos-set-en-passant (position index)
   "Set the INDEX of any pawn on POSITION that can be captured en passant."
-  (cl-assert (vectorp position))
-  (cl-assert (or (eq index nil)
-             (and (>= index 0) (< index 64))))
+  (cl-check-type position chess-pos)
+  (cl-check-type index (or null (integer 0 63)))
   (aset position 64 index))
 
+(gv-define-simple-setter chess-pos-en-passant chess-pos-set-en-passant)
+
 (defsubst chess-pos-status (position)
   "Return whether the side to move in the POSITION is in a special state.
-nil is returned if not, otherwise one of the symbols: `check',
-`checkmate', `stalemate'."
-  (cl-assert (vectorp position))
+nil is returned if not, otherwise one of the keywords: `:check',
+`:checkmate', `:stalemate'."
+  (cl-check-type position chess-pos)
   (aref position 69))
 
 (defsubst chess-pos-set-status (position value)
   "Set whether the side to move in POSITION is in a special state.
 VALUE should either be nil, to indicate that the POSITION is normal,
-or one of the symbols: `check', `checkmate', `stalemate'."
-  (cl-assert (vectorp position))
-  (cl-assert (or (eq value nil) (symbolp value)))
+or one of the keywords: `:check', `:checkmate' or `:stalemate'."
+  (cl-check-type position chess-pos)
+  (cl-check-type value (or null keyword))
   (aset position 69 value))
 
+(gv-define-simple-setter chess-pos-status chess-pos-set-status)
+
 (defsubst chess-pos-side-to-move (position)
   "Return the color whose move it is in POSITION."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (aref position 70))
 
 (defsubst chess-pos-set-side-to-move (position color)
   "Set the COLOR whose move it is in POSITION."
-  (cl-assert (vectorp position))
-  (cl-assert (memq color '(nil t)))
+  (cl-check-type position chess-pos)
+  (cl-check-type color (member nil t))
   (aset position 70 color))
 
+(gv-define-simple-setter chess-pos-side-to-move chess-pos-set-side-to-move)
+
 (defsubst chess-pos-annotations (position)
   "Return the list of annotations for this POSITION."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (aref position 71))
 
 (defsubst chess-pos-set-annotations (position annotations)
   "Set the list of ANNOTATIONS for this POSITION."
-  (cl-assert (vectorp position))
-  (cl-assert (listp annotations))
+  (cl-check-type position chess-pos)
+  (cl-check-type annotations list)
   (aset position 71 annotations))
 
+(gv-define-simple-setter chess-pos-annotations chess-pos-set-annotations)
+
 (defun chess-pos-add-annotation (position annotation)
   "Add an ANNOTATION for this POSITION."
-  (cl-assert (vectorp position))
-  (cl-assert (or (stringp annotation) (listp annotation)))
+  (cl-check-type position chess-pos)
+  (cl-check-type annotation (or string list))
   (let ((ann (chess-pos-annotations position)))
     (if ann
        (nconc ann (list annotation))
@@ -626,13 +632,13 @@ or one of the symbols: `check', `checkmate', `stalemate'."
 
 (defsubst chess-pos-epd (position opcode)
   "Return the value of the given EPD OPCODE, or nil if not set."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (cl-assert opcode)
   (cdr (assq opcode (chess-pos-annotations position))))
 
 (defun chess-pos-set-epd (position opcode &optional value)
   "Set the given EPD OPCODE to VALUE, or t if VALUE is not specified."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (cl-assert opcode)
   (let ((entry (assq opcode (chess-pos-annotations position))))
     (if entry
@@ -641,30 +647,31 @@ or one of the symbols: `check', `checkmate', `stalemate'."
 
 (defun chess-pos-del-epd (position opcode)
   "Delete the given EPD OPCODE."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (cl-assert opcode)
   (chess-pos-set-annotations
    position (assq-delete-all opcode (chess-pos-annotations position))))
 
-(defun chess-pos-preceding-ply (position)
+(defsubst chess-pos-preceding-ply (position)
   "Return the ply that preceds POSITION."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (aref position 74))
 
 (defun chess-pos-set-preceding-ply (position ply)
   "Set the preceding PLY for POSITION."
-  (cl-assert (vectorp position))
+  (cl-check-type position chess-pos)
   (cl-assert (listp ply))
   (aset position 74 ply))
 
+(gv-define-simple-setter chess-pos-preceding-ply chess-pos-set-preceding-ply)
+
 (defsubst chess-pos-copy (position)
   "Copy the given chess POSITION.
 If there are annotations or EPD opcodes set, these lists are copied as
 well, so that the two positions do not share the same lists."
-  (cl-assert (vectorp position))
-  (let ((copy (vconcat position)) i)
-    (setq i (chess-pos-annotations position))
-    (if i (chess-pos-set-annotations copy (copy-alist i)))
+  (cl-check-type position chess-pos)
+  (let ((copy (vconcat position)))
+    (chess-pos-set-annotations copy (copy-alist (chess-pos-annotations 
position)))
     copy))
 
 (defsubst chess-pos-create (&optional blank)
@@ -737,10 +744,8 @@ on an adjoining file is called a passed Pawn."
   "Move a piece on the POSITION directly, using the indices in CHANGES.
 This function does not check any rules, it only makes sure you are not
 trying to move a blank square."
-  (cl-assert (vectorp position))
-  (cl-assert (listp changes))
-  (cl-assert (> (length changes) 0))
-
+  (cl-check-type position chess-pos)
+  (cl-check-type changes (and list (not null)))
   (let* ((color (chess-pos-side-to-move position))
         (can-castle-kingside (chess-pos-can-castle position (if color ?K ?k)))
         (can-castle-queenside (chess-pos-can-castle position (if color ?Q 
?q))))
@@ -817,16 +822,11 @@ trying to move a blank square."
                                 (downcase new-piece)))))
 
     ;; did we leave the position in check, mate or stalemate?
-    (cond
-     ((memq :check changes)
-      (chess-pos-set-status position :check))
-     ((memq :checkmate changes)
-      (chess-pos-set-status position :checkmate))
-     ((memq :stalemate changes)
-      (chess-pos-set-status position :stalemate))
-     (t (chess-pos-set-status position nil)))
-
-    ;; return the final position
+    (chess-pos-set-status position
+                         (car-safe (or (memq :check changes)
+                                       (memq :checkmate changes)
+                                       (memq :stalemate changes))))
+
     position))
 
 (chess-message-catalog 'english
@@ -852,6 +852,7 @@ trying to move a blank square."
                                          do (setq first nil)))
                     when ray collect ray)))
     squares))
+
 (defconst chess-black-can-slide-to
   (let ((squares (make-vector 64 nil)))
     (dotimes (index 64)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]