mlang pushed a commit to branch externals/chess
in repository elpa.
commit 95d1decf4ca8e3830a50c5095ae7ff69bd577e3f
Author: Mario Lang <ml...@delysid.org>
Date: Tue Jun 24 01:01:39 2014 +0200
Remove obsolete arguments and use more cl-check-type.
* chess-ply.el (chess-ply-p): New function.
Change `cl-assert' to `cl-check-type' based on this predicate.
(chess-ply-final-p): Only call `chess-ply-any-keyword' if we actually
found a preceding ply.
(chess-ply--add): Remove obsolte and unused arguments RANK-ADJ and
FILE-ADJ.
(chess-legal-plies): Adjust for `chess-ply--add' argument removal.
---
ChangeLog | 10 ++++++
chess-ply.el | 99 +++++++++++++++++++++++++++++----------------------------
2 files changed, 60 insertions(+), 49 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 6d042ec..e5b9a71 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2014-06-24 Mario Lang <ml...@delysid.org>
+
+ * chess-ply.el (chess-ply-p): New function.
+ Change `cl-assert' to `cl-check-type' based on this predicate.
+ (chess-ply-final-p): Only call `chess-ply-any-keyword' if we actually
+ found a preceding ply.
+ (chess-ply--add): Remove obsolte and unused arguments RANK-ADJ and
+ FILE-ADJ.
+ (chess-legal-plies): Adjust for `chess-ply--add' argument removal.
+
2014-06-19 Eli Zaretskii <e...@gnu.org>
* chess.texi: Proofread and fix the manual. All the Next, Prev,
diff --git a/chess-ply.el b/chess-ply.el
index fd5dc21..46cba39 100644
--- a/chess-ply.el
+++ b/chess-ply.el
@@ -67,26 +67,29 @@
"Routines for manipulating chess plies."
:group 'chess)
+(defsubst chess-ply-p (ply)
+ (and (consp ply) (chess-pos-p (car ply))))
+
(defsubst chess-ply-pos (ply)
"Returns the base position associated with PLY."
- (cl-assert (listp ply))
+ (cl-check-type ply chess-ply)
(car ply))
(defsubst chess-ply-set-pos (ply position)
"Set the base position of PLY."
- (cl-assert (listp ply))
- (cl-assert (vectorp position))
+ (cl-check-type ply chess-ply)
+ (cl-check-type position chess-pos)
(setcar ply position))
(gv-define-simple-setter chess-ply-pos chess-ply-set-pos)
(defsubst chess-ply-changes (ply)
- (cl-assert (listp ply))
+ (cl-check-type ply chess-ply)
(cdr ply))
(defsubst chess-ply-set-changes (ply changes)
- (cl-assert (listp ply))
- (cl-assert (listp changes))
+ (cl-check-type ply chess-ply)
+ (cl-check-type changes list)
(setcdr ply changes))
(gv-define-simple-setter chess-ply-changes chess-ply-set-changes)
@@ -94,7 +97,7 @@
(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))
+ (cl-check-type ply chess-ply)
(catch 'found
(dolist (keyword keywords)
(if (memq keyword (chess-ply-changes ply))
@@ -102,14 +105,14 @@
(defun chess-ply-keyword (ply keyword)
(declare (side-effect-free t))
- (cl-assert (listp ply))
- (cl-assert (symbolp keyword))
+ (cl-check-type ply chess-ply)
+ (cl-check-type keyword symbol)
(let ((item (memq keyword (chess-ply-changes ply))))
(and item (if (not (cdr item)) t (cadr item)))))
(defun chess-ply-set-keyword (ply keyword &optional value)
- (cl-assert (listp ply))
- (cl-assert (symbolp keyword))
+ (cl-check-type ply chess-ply)
+ (cl-check-type keyword symbol)
(let* ((changes (chess-ply-changes ply))
(item (memq keyword changes)))
(if item
@@ -124,21 +127,21 @@
(defsubst chess-ply-source (ply)
"Returns the source square index value of PLY."
- (cl-assert (listp ply))
+ (cl-check-type ply chess-ply)
(let ((changes (chess-ply-changes ply)))
(and (listp changes) (not (symbolp (car changes)))
(car changes))))
(defsubst chess-ply-target (ply)
"Returns the target square index value of PLY."
- (cl-assert (listp ply))
+ (cl-check-type ply chess-ply)
(let ((changes (chess-ply-changes ply)))
(and (listp changes) (not (symbolp (car changes)))
(cadr changes))))
(defsubst chess-ply-next-pos (ply)
"Return the position that results from executing PLY."
- (cl-assert (listp ply))
+ (cl-check-type ply chess-ply)
(or (chess-ply-keyword ply :next-pos)
(let ((position (apply 'chess-pos-move
(chess-pos-copy (chess-ply-pos ply))
@@ -148,7 +151,7 @@
(defun chess-ply-castling-changes (position &optional long king-index)
"Create castling changes; this function supports Fischer Random castling."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(let* ((color (chess-pos-side-to-move position))
(king (or king-index (chess-pos-king-index position color)))
(rook (chess-pos-can-castle position (if color
@@ -174,7 +177,7 @@
(defvar chess-ply-checking-mate nil)
(defsubst chess-ply-create* (position)
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(list position))
(defun chess-ply-create (position &optional valid-p &rest changes)
@@ -185,7 +188,7 @@ also extend castling, and will prompt for a promotion piece.
Note: Do not pass in the rook move if CHANGES represents a castling
maneuver."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(let* ((ply (cons position changes))
(color (chess-pos-side-to-move position))
piece)
@@ -272,31 +275,29 @@ maneuver."
"Return non-nil if this is the last ply of a game/variation."
(or (chess-ply-any-keyword ply :drawn :perpetual :repetition
:flag-fell :resign :aborted)
- (chess-ply-any-keyword (chess-pos-preceding-ply
- (chess-ply-pos ply)) :stalemate :checkmate)))
+ (let ((preceding-ply (chess-pos-preceding-ply (chess-ply-pos ply))))
+ (when preceding-ply
+ (chess-ply-any-keyword preceding-ply :stalemate :checkmate)))))
(defvar chess-ply-throw-if-any nil)
-(defmacro chess-ply--add (rank-adj file-adj &optional pos)
+(defmacro chess-ply--add (target)
"This is totally a shortcut."
- `(let ((target (or ,pos (chess-incr-index candidate ,rank-adj ,file-adj))))
- (if (and (or (not specific-target)
- (= target specific-target))
- (chess-pos-legal-candidates position color target
- (list candidate)))
- (if chess-ply-throw-if-any
- (throw 'any-found t)
- (let ((promotion (and (chess-pos-piece-p position candidate
- (if color ?P ?p))
- (= (chess-index-rank target)
- (if color 0 7)))))
- (if promotion
- (dolist (promote '(?Q ?R ?B ?N))
- (let ((ply (chess-ply-create position t candidate target
- :promote promote)))
- (when ply (push ply plies))))
- (let ((ply (chess-ply-create position t candidate target)))
- (when ply (push ply plies)))))))))
+ `(let ((target ,target))
+ (if (and (or (not specific-target) (= target specific-target))
+ (chess-pos-legal-candidates position color target (list candidate)))
+ (if chess-ply-throw-if-any
+ (throw 'any-found t)
+ (let ((promotion (and (chess-pos-piece-p position candidate
+ (if color ?P ?p))
+ (= (chess-index-rank target) (if color 0 7)))))
+ (if promotion
+ (dolist (promote '(?Q ?R ?B ?N))
+ (let ((ply (chess-ply-create position t candidate target
+ :promote promote)))
+ (when ply (push ply plies))))
+ (let ((ply (chess-ply-create position t candidate target)))
+ (when ply (push ply plies)))))))))
(defun chess-legal-plies (position &rest keywords)
"Return a list of all legal plies in POSITION.
@@ -315,7 +316,7 @@ criteria.
NOTE: All of the returned plies will reference the same copy of the
position object passed in."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(cond
((null keywords)
(let ((plies (list t)))
@@ -374,28 +375,28 @@ position object passed in."
chess-direction-north
chess-direction-south)))))
(when (chess-pos-piece-p position ahead ? )
- (chess-ply--add nil nil ahead)
+ (chess-ply--add ahead)
(if (and (= (if color 6 1) (chess-index-rank candidate))
2ahead (chess-pos-piece-p position 2ahead ? ))
- (chess-ply--add nil nil 2ahead)))
+ (chess-ply--add 2ahead)))
(when (setq pos (chess-next-index candidate
(if color
chess-direction-northeast
chess-direction-southwest)))
(if (chess-pos-piece-p position pos (not color))
- (chess-ply--add nil nil pos)
+ (chess-ply--add pos)
;; check for en passant capture toward kingside
(when (and ep (= ep (funcall (if color #'+ #'-) pos 8)))
- (chess-ply--add nil nil pos))))
+ (chess-ply--add pos))))
(when (setq pos (chess-next-index candidate
(if color
chess-direction-northwest
chess-direction-southeast)))
(if (chess-pos-piece-p position pos (not color))
- (chess-ply--add nil nil pos)
+ (chess-ply--add pos)
;; check for en passant capture toward queenside
(when (and ep (eq ep (funcall (if color #'+ #'-) pos 8)))
- (chess-ply--add nil nil pos))))))
+ (chess-ply--add pos))))))
;; the rook, bishop and queen are the easiest; just look along
;; rank and file and/or diagonal for the nearest pieces!
@@ -408,10 +409,10 @@ position object passed in."
(while pos
(if (chess-pos-piece-p position pos ? )
(progn
- (chess-ply--add nil nil pos)
+ (chess-ply--add pos)
(setq pos (chess-next-index pos dir)))
(if (chess-pos-piece-p position pos (not color))
- (chess-ply--add nil nil pos))
+ (chess-ply--add pos))
(setq pos nil)))))
;; the king is a trivial case of the queen, except when castling
@@ -420,7 +421,7 @@ position object passed in."
(setq pos (chess-next-index candidate dir))
(if (and pos (or (chess-pos-piece-p position pos ? )
(chess-pos-piece-p position pos (not color))))
- (chess-ply--add nil nil pos)))
+ (chess-ply--add pos)))
(unless (chess-search-position position candidate (not color) nil t)
(if (chess-pos-can-castle position (if color ?K ?k))
@@ -447,7 +448,7 @@ position object passed in."
(if (and (setq pos (chess-next-index candidate dir))
(or (chess-pos-piece-p position pos ? )
(chess-pos-piece-p position pos (not color))))
- (chess-ply--add nil nil pos))))
+ (chess-ply--add pos))))
(t (chess-error 'piece-unrecognized))))
