├── package.lisp ├── lalla.asd ├── LICENSE.txt ├── ui.lisp ├── piece.lisp ├── README.md ├── lalla.lisp ├── score.lisp ├── board.lisp └── move.lisp /package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; package.lisp 2 | 3 | (defpackage #:lalla 4 | (:use #:cl #:defstar)) 5 | 6 | -------------------------------------------------------------------------------- /lalla.asd: -------------------------------------------------------------------------------- 1 | ;;;; lalla.asd 2 | 3 | (asdf:defsystem #:lalla 4 | :serial t 5 | :description "A portable, modern Lisp chess AI" 6 | :author "Mike Vollmer " 7 | :license "Simplified BSD License" 8 | :depends-on (#:defstar) 9 | :components ((:file "package") 10 | (:file "piece") 11 | (:file "board") 12 | (:file "move") 13 | (:file "score") 14 | (:file "ui") 15 | (:file "lalla"))) 16 | 17 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Mike Vollmer 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 14 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 15 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 16 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 17 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 18 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 19 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 20 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 22 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | 24 | The views and conclusions contained in the software and documentation are those 25 | of the authors and should not be interpreted as representing official policies, 26 | either expressed or implied, of the FreeBSD Project. 27 | -------------------------------------------------------------------------------- /ui.lisp: -------------------------------------------------------------------------------- 1 | ;; ui.lisp 2 | 3 | (in-package #:lalla) 4 | 5 | (defun convert-coordinates (r64 f64) 6 | (let ((sq (+ f64 (* 8 r64)))) 7 | (+ sq (logand sq (lognot 7))))) 8 | 9 | (defun parse-string (s) 10 | (let ((from-rank-char (char s 1)) 11 | (from-file-char (char s 0)) 12 | (to-rank-char (char s 3)) 13 | (to-file-char (char s 2)) 14 | (promotion-char (if (= (length s) 5) 15 | (char s 4) 16 | nil))) 17 | (let ((from-rank (position from-rank-char "87654321")) 18 | (from-file (position from-file-char "abcdefgh")) 19 | (to-rank (position to-rank-char "87654321")) 20 | (to-file (position to-file-char "abcdefgh")) 21 | (promotion (if promotion-char 22 | (position promotion-char "___nbrq") 23 | nil))) 24 | (let ((from (convert-coordinates from-rank from-file)) 25 | (to (convert-coordinates to-rank to-file))) 26 | (vector from to promotion (is-ep-move from to) nil))))) 27 | 28 | (defun validate-player-move (mv side) 29 | (let ((valid nil) 30 | (moves (generate-moves side))) 31 | (block find-move 32 | (loop for current-move across moves do 33 | (let ((from (move-from current-move)) 34 | (to (move-to current-move))) 35 | (when (and (= from (elt mv 0)) 36 | (= to (elt mv 1))) 37 | (setf valid t) 38 | (return-from find-move))))) 39 | valid)) 40 | 41 | (defun make-player-move (mv side) 42 | (let ((from (elt mv 0)) 43 | (to (elt mv 1)) 44 | (promotion (elt mv 2)) 45 | (ep (elt mv 3)) 46 | (castle (elt mv 4)) 47 | (move 0)) 48 | (setf move (create-move from to 49 | (if (blank-square to) 0 1) 50 | (if promotion 1 0) 51 | (if ep 1 0) 52 | (if castle 1 0))) 53 | (make-move move) 54 | (when promotion 55 | (setf (aref board to) promotion)))) 56 | -------------------------------------------------------------------------------- /piece.lisp: -------------------------------------------------------------------------------- 1 | ;;;; piece.lisp 2 | ;;;; 3 | ;;;; This file takes care of basic piece handling, and some stuff for move generation. 4 | ;;;; I'm on the fence about whether this file should exist or if it should be merged 5 | ;;;; into move.lisp. 6 | 7 | (in-package #:lalla) 8 | (declaim (optimize speed)) 9 | 10 | ;; Pieces are 4-bit words 11 | ;; They consist of a color bit and a 3-bit piece type 12 | ;; 13 | ;; Piece types: 14 | ;; 1. White pawn 15 | ;; 2. Black pawn 16 | ;; 3. Knight 17 | ;; 4. Bishop 18 | ;; 5. Rook 19 | ;; 6. Queen 20 | ;; 7. King 21 | (defun* (piece-color -> (unsigned-byte 1)) ((p (unsigned-byte 4))) 22 | (ldb (byte 1 3) p)) 23 | (defun* (piece-type -> (unsigned-byte 3)) ((p (unsigned-byte 4))) 24 | (ldb (byte 3 0) p)) 25 | 26 | (declaim (inline piece-color piece-type)) 27 | 28 | ;; Piece steps define the number of steps each piece takes. The move generator 29 | ;; will start on one number and try the next and the next until it hits zero. 30 | ;; So, for example, if the move generator found a rook and wanted to generate 31 | ;; moves for it, it would look up the rook in the step-offset table below 32 | ;; and find that it would start with a step of 1. It would keep adding one to 33 | ;; the initial location of the rook until it hit a square it couldn't pass, 34 | ;; then it would start adding 16, and so on, until it reached a 0 in the 35 | ;; array below. 36 | (defparameter* (piece-steps (simple-array (signed-byte 16) (34))) 37 | (make-array 34 38 | :element-type '(signed-byte 16) 39 | :initial-contents '(-15 -17 0 ;; white pawn 40 | 15 17 0 ;; black pawn 41 | 14 18 31 33 -14 -18 -31 -33 0 ;; knight 42 | 15 17 -15 -17 0 ;; bishop 43 | 1 16 -1 -16 0 ;; rook 44 | 1 16 15 17 -1 -16 -15 -17 0))) ;; king/queen 45 | 46 | ;; This array tells us the index for the above steps array that we should start at. So, a 47 | ;; black pawn is represented by type=2, and it would start at index 3 above (which is the value 15). 48 | (defparameter* (step-offset (simple-array (mod 26) (8))) 49 | (make-array 8 50 | :element-type '(mod 26) 51 | :initial-contents '(0 0 3 6 15 20 25 25))) 52 | 53 | ;; This array tells us whether each piece is a sliding piece. 54 | (defparameter* (sliding-piece (simple-array boolean (8))) 55 | (make-array 8 56 | :element-type 'boolean 57 | :initial-contents '(nil nil nil nil t t t nil))) 58 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This is a chess engine written in portable Common Lisp. 2 | 3 | Design/Approach 4 | --------------- 5 | 6 | Coming in to this project, I was very inexperienced with Common Lisp. I do have some background in Scheme and Clojure (and I have done some research in computer chess), but I had never done anything with CL. I am still obviously inexperienced, but I have found that I can write non-trivial software in it (such as this program). 7 | 8 | Initially, I was worried about approaching a project like this in a dynamically typed language. Like most chess engines, it makes significant use of bitwise operations, packs data into machine-sized words, and so on. It turns out CL is perfectly suited to this task. I used CL's type system extensively in this project, and I have found it to be significantly "stronger" than some other statically typed languages out there. With SBCL, these operations are also very fast. 9 | 10 | Progress 11 | -------- 12 | 13 | I started this project for the [Lisp in Summer Projects](http://lispinsummerprojects.org/welcome) contest, but I ended up being busy for most of the summer (I got an internship, I was working on a research project, and I'm preparing my grad school applications), so the vast majority of this code was written in the last few weeks of September. Nevertheless, it is a program that runs and is capable of playing chess reasonably intelligently, even if it is not as full-featured or well-tested as I had hoped. 14 | 15 | Originally I was developing a bitboard-based board representation, but after I was delayed and resumed the project this month I switched to the easier-to-manage [0x88 board representation](http://chessprogramming.wikispaces.com/0x88). 16 | 17 | Additionally, the program is incomplete or buggy in several areas: checkmate/stalemate detection, under-promotions, and castle captures, for example. 18 | 19 | Future Work 20 | ----------- 21 | 22 | Top of my list for future work is definitely finishing the user interface, ideally with xboard/winboard integration. As it is, a game of chess can be played interactively in the REPL, but that's not very convenient. Beyond that, I plan to add typical features like search extensions and a transposition table, and work on a more extensive static evaluation function. 23 | 24 | References 25 | ---------- 26 | 27 | I used several sources in writing this program. 28 | 29 | * [Micro-max](http://home.hccnet.nl/h.g.muller/max-src2.html) was a major help. I used it as a reference and an inspiration for the overall architecture of the program. 30 | 31 | * [ChessBin](http://www.chessbin.com/) was the source for the piece-square tables in the static evaluation function. It was the most useful Google result on the first page for "chess piece square tables." -------------------------------------------------------------------------------- /lalla.lisp: -------------------------------------------------------------------------------- 1 | ;;;; lalla.lisp 2 | ;;;; 3 | ;;;; This file contains the main search procedures. 4 | 5 | (in-package #:lalla) 6 | (declaim (optimize speed)) 7 | 8 | ;; The fail-amount is an arbitrary big number. It gets used when 9 | ;; we need an arbitrary high (or low) number. 10 | (defparameter* (fail-amount (signed-byte 16)) 8000) 11 | 12 | 13 | 14 | ;; This is the main search procedure for the program. It's where the A.I. magic is. 15 | ;; I'm not going to explain the basics of the minimax algorithm here, so google for it 16 | ;; if you're curious how/why it works. 17 | (defun* (negamax -> (signed-byte 16)) 18 | ((side (unsigned-byte 1)) (alpha (signed-byte 16)) 19 | (beta (signed-byte 16)) (depth-left (unsigned-byte 8))) 20 | 21 | ;; If we're at a leaf (depth-left=0), then return the static evaluation for this node. 22 | (if (= depth-left 0) (static-eval side) 23 | 24 | ;; We're at an internal node of the search tree, so we need to generate children 25 | ;; and recurse on each of them 26 | (*let ((score (signed-byte 16) (- fail-amount)) 27 | (moves (vector (unsigned-byte 18)) 28 | (generate-moves side)) 29 | 30 | ;; temporary variable for saving data from make-move 31 | (saved-state (unsigned-byte 13) 0) 32 | 33 | ;; temporary variable for saving the current score 34 | (temp-score (signed-byte 16) 0)) 35 | 36 | ;; named block for inner loop 37 | (block inner 38 | 39 | ;; loop over all generated moves 40 | (loop for current-move across moves do 41 | 42 | ;; if it's a king capture, the parent node generated an illegal move 43 | (when (king-capture current-move) 44 | (setf score fail-amount) 45 | (return-from inner)) 46 | 47 | ;; make the move and save the state 48 | (setf saved-state (make-move current-move)) 49 | 50 | ;; recurse and save the score to temp-score 51 | (setf temp-score 52 | ;; negate returned score, because it's negamax 53 | (- (negamax 54 | ;; switch side 55 | (if (= side 1) 0 1) 56 | ;; update alpha and beta 57 | (- beta) 58 | (if (> alpha score) 59 | (- alpha) 60 | (- score)) 61 | ;; decrement depth-left 62 | (- depth-left 1)))) 63 | 64 | ;; pass saved-state to unmake-move 65 | (unmake-move current-move saved-state) 66 | 67 | ;; have we improved our best score? 68 | (when (> temp-score score) 69 | (setf score temp-score) 70 | 71 | ;; give up if this node is not worth searching anymore 72 | (when (>= score beta) (return-from inner))))) 73 | 74 | ;; return the score 75 | score))) 76 | 77 | 78 | ;; A depth-limited search uses the above negamax function and searches to a finite 79 | ;; depth, using that information to choose a best move. 80 | (defun* (depth-limited-search -> (unsigned-byte 18)) 81 | ((side (unsigned-byte 1)) (depth (unsigned-byte 8))) 82 | (*let ((moves (vector (unsigned-byte 18)) (generate-moves side)) 83 | (best-move (unsigned-byte 18) 8) 84 | (best-score (signed-byte 16) (- fail-amount)) 85 | (temp-score (signed-byte 16) 0) 86 | (saved-piece (unsigned-byte 4) 0)) 87 | (loop for current-move across moves do 88 | (progn 89 | (setf saved-piece (make-move current-move)) 90 | (setf temp-score 91 | (- (negamax 92 | (if (= side 1) 0 1) 93 | -8000 94 | 8000 95 | depth))) 96 | (unmake-move current-move saved-piece) 97 | (when (> temp-score best-score) 98 | (setf best-score temp-score) 99 | (setf best-move current-move)))) 100 | best-move)) 101 | 102 | ;; How long do we want to search? 103 | ;; NOTE: this isn't actually a time limit for the search, but a time 104 | ;; at which we would not do another search. The actual search might take 105 | ;; several seconds longer than this value. 106 | (defparameter* (max-seconds integer) 8) 107 | 108 | 109 | ;; Iterative deepening searches do incremental depth-limited searches, 110 | ;; increasing the depth each time, up to a certain point. It then uses 111 | ;; the result of the last search as its value. 112 | (defun* (iterative-deepening-search -> (unsigned-byte 18)) 113 | ((side (unsigned-byte 1))) 114 | (*let ((start-time integer (get-internal-real-time)) 115 | (depth (unsigned-byte 8) 3) 116 | (best-move (unsigned-byte 18) 0)) 117 | (loop while (< (/ (- start-time (get-internal-real-time)) 118 | internal-time-units-per-second) 119 | max-seconds) do 120 | (progn 121 | (setf best-move (depth-limited-search side depth)) 122 | (incf depth))) 123 | best-move)) 124 | -------------------------------------------------------------------------------- /score.lisp: -------------------------------------------------------------------------------- 1 | ;;;; score.lisp 2 | 3 | (in-package #:lalla) 4 | (declaim (optimize speed)) 5 | 6 | (defparameter* (piece-scores (simple-array (signed-byte 16) (8))) 7 | (make-array 8 8 | :element-type '(signed-byte 16) 9 | :initial-contents '(0 100 100 320 325 500 975 1500))) 10 | 11 | (defparameter* (pawn-table (simple-array (signed-byte 16) (136))) 12 | (make-array 136 13 | :element-type '(signed-byte 16) 14 | :initial-contents '(0 0 0 0 0 0 0 0 15 | 0 0 0 0 0 0 0 0 16 | 0 0 0 0 0 0 0 0 17 | 50 50 50 50 50 50 50 50 18 | 0 0 0 0 0 0 0 0 19 | 10 10 20 30 30 20 10 10 20 | 0 0 0 0 0 0 0 0 21 | 5 5 10 27 27 10 5 5 22 | 0 0 0 0 0 0 0 0 23 | 0 0 0 25 25 0 0 0 24 | 0 0 0 0 0 0 0 0 25 | 5 -5 -10 0 0 -10 -5 5 26 | 0 0 0 0 0 0 0 0 27 | 5 10 10 -25 -25 10 10 5 28 | 0 0 0 0 0 0 0 0 29 | 0 0 0 0 0 0 0 0 30 | 0 0 0 0 0 0 0 0))) 31 | 32 | (defparameter* (knight-table (simple-array (signed-byte 16) (136))) 33 | (make-array 136 34 | :element-type '(signed-byte 16) 35 | :initial-contents '(0 0 0 0 0 0 0 0 36 | -50 -40 -30 -30 -30 -30 -40 -50 37 | 0 0 0 0 0 0 0 0 38 | -40 -50 0 0 0 0 -20 -40 39 | 0 0 0 0 0 0 0 0 40 | -30 0 10 15 15 10 0 -30 41 | 0 0 0 0 0 0 0 0 42 | -30 5 15 20 20 15 5 -30 43 | 0 0 0 0 0 0 0 0 44 | -30 0 15 20 20 15 0 -30 45 | 0 0 0 0 0 0 0 0 46 | -30 5 10 15 15 10 5 -30 47 | 0 0 0 0 0 0 0 0 48 | -40 -20 0 5 5 0 -20 -40 49 | 0 0 0 0 0 0 0 0 50 | -50 -40 -20 -30 -30 -20 -40 -50 51 | 0 0 0 0 0 0 0 0))) 52 | 53 | (defparameter* (bishop-table (simple-array (signed-byte 16) (136))) 54 | (make-array 136 55 | :element-type '(signed-byte 16) 56 | :initial-contents '(0 0 0 0 0 0 0 0 57 | -20 -10 -10 -10 -10 -10 -10 -20 58 | 0 0 0 0 0 0 0 0 59 | -10 0 0 0 0 0 0 -10 60 | 0 0 0 0 0 0 0 0 61 | -10 0 5 10 10 5 0 -10 62 | 0 0 0 0 0 0 0 0 63 | -10 5 5 10 10 5 5 -10 64 | 0 0 0 0 0 0 0 0 65 | -10 0 10 10 10 10 0 -10 66 | 0 0 0 0 0 0 0 0 67 | -10 10 10 10 10 10 10 -10 68 | 0 0 0 0 0 0 0 0 69 | -10 5 0 0 0 0 5 -10 70 | 0 0 0 0 0 0 0 0 71 | -20 -10 -40 -10 -10 -40 -10 -20 72 | 0 0 0 0 0 0 0 0))) 73 | 74 | (defparameter* (king-table (simple-array (signed-byte 16) (136))) 75 | (make-array 136 76 | :element-type '(signed-byte 16) 77 | :initial-contents '(0 0 0 0 0 0 0 0 78 | -30 -40 -40 -50 -50 -40 -40 -30 79 | 0 0 0 0 0 0 0 0 80 | -30 -40 -40 -50 -50 -40 -40 -30 81 | 0 0 0 0 0 0 0 0 82 | -30 -40 -40 -50 -50 -40 -40 -30 83 | 0 0 0 0 0 0 0 0 84 | -30 -40 -40 -50 -50 -40 -40 -30 85 | 0 0 0 0 0 0 0 0 86 | -20 -30 -30 -40 -40 -30 -30 -20 87 | 0 0 0 0 0 0 0 0 88 | -10 -20 -20 -20 -20 -20 -20 -10 89 | 0 0 0 0 0 0 0 0 90 | 20 20 0 0 0 0 20 20 91 | 0 0 0 0 0 0 0 0 92 | 20 30 10 0 0 10 30 20 93 | 0 0 0 0 0 0 0 0))) 94 | 95 | (defparameter* (king-end-table (simple-array (signed-byte 16) (136))) 96 | (make-array 136 97 | :element-type '(signed-byte 16) 98 | :initial-contents '(0 0 0 0 0 0 0 0 99 | -50 -40 -30 -20 -20 -30 -40 -50 100 | 0 0 0 0 0 0 0 0 101 | -30 -20 -10 0 0 -10 -20 -30 102 | 0 0 0 0 0 0 0 0 103 | -30 -10 20 30 30 20 -10 -30 104 | 0 0 0 0 0 0 0 0 105 | -30 -10 30 40 40 30 -10 -30 106 | 0 0 0 0 0 0 0 0 107 | -30 -10 30 40 40 30 -10 -30 108 | 0 0 0 0 0 0 0 0 109 | -30 -10 20 30 30 20 -10 -30 110 | 0 0 0 0 0 0 0 0 111 | -30 -30 0 0 0 0 -30 -30 112 | 0 0 0 0 0 0 0 0 113 | -50 -30 -30 -30 -30 -30 -30 -50 114 | 0 0 0 0 0 0 0 0))) 115 | 116 | (defun* (score-table-index -> (mod 136)) 117 | ((index (mod 128)) (side (unsigned-byte 1))) 118 | (if (= side 0) (+ index 8) (- 127 index))) 119 | 120 | (defun* (piece-score -> (signed-byte 16)) 121 | ((piece (unsigned-byte 4))) 122 | (aref piece-scores (piece-type piece))) 123 | 124 | (defun* (score-table -> (signed-byte 16)) 125 | ((index (mod 128)) (piece (unsigned-byte 4))) 126 | (*let ((new-index (mod 136) (score-table-index index (piece-color piece))) 127 | (type (unsigned-byte 3) (piece-type piece))) 128 | (cond ((= type 0) 0) 129 | ((or (= type 1) (= type 2)) (aref pawn-table new-index)) 130 | ((= type 3) (aref knight-table new-index)) 131 | ((= type 4) (aref bishop-table new-index)) 132 | ((= type 5) 0) 133 | ((= type 6) 0) 134 | (t (aref king-table new-index))))) 135 | 136 | (declaim (inline score-table piece-score score-table-index)) 137 | 138 | (defun* (score-square -> (signed-byte 16)) ((index (mod 128)) (side (unsigned-byte 1))) 139 | (*let ((piece (unsigned-byte 4) (get-piece index)) 140 | (color (unsigned-byte 1) (piece-color piece)) 141 | (mul (signed-byte 16) (if (= color side) 1 -1))) 142 | (* mul (+ (piece-score piece) 143 | (score-table index piece) 144 | )))) 145 | 146 | (declaim (inline score-square)) 147 | 148 | (defun* (static-eval -> (signed-byte 16)) ((side (unsigned-byte 1))) 149 | (*let ((score (signed-byte 16) 0)) 150 | (loop for square from 0 to 127 151 | when (and (not (blank-square square)) 152 | (not (off-board square))) 153 | do (incf score (score-square square side))) 154 | score)) 155 | 156 | 157 | -------------------------------------------------------------------------------- /board.lisp: -------------------------------------------------------------------------------- 1 | ;;;; board.lisp 2 | ;;;; 3 | ;;;; This file contains functions for manipulating the board. 4 | 5 | (in-package #:lalla) 6 | (declaim (optimize speed)) 7 | 8 | ;; Upper-right corner of the board (A8) is index 0, so black pieces 9 | ;; are inserted at the beginning of the array and white at the end. 10 | ;; Downward moving pieces increase in index, and upward moving pieced 11 | ;; decrease in index. 12 | (defparameter initial-positions 13 | #(13 11 12 14 15 12 11 13 14 | 0 0 0 0 0 0 0 0 15 | 10 10 10 10 10 10 10 10 ;; black pieces 16 | 0 0 0 0 0 0 0 0 17 | 0 0 0 0 0 0 0 0 18 | 0 0 0 0 0 0 0 0 19 | 0 0 0 0 0 0 0 0 20 | 0 0 0 0 0 0 0 0 21 | 0 0 0 0 0 0 0 0 22 | 0 0 0 0 0 0 0 0 23 | 0 0 0 0 0 0 0 0 24 | 0 0 0 0 0 0 0 0 25 | 1 1 1 1 1 1 1 1 26 | 0 0 0 0 0 0 0 0 27 | 5 3 4 6 7 4 3 5 ;; white pieces 28 | 0 0 0 0 0 0 0 0)) 29 | (defparameter* (board (simple-array (unsigned-byte 4) (128))) 30 | (make-array 128 :element-type '(unsigned-byte 4) 31 | :initial-contents initial-positions)) 32 | (defun reset-board () 33 | (loop for i from 0 to 127 do 34 | (setf (aref board i) (aref initial-positions i)))) 35 | 36 | 37 | ;; These global values represent part of the state of the board. 38 | ;; If board-ep is true, then an e.p. capture is possible. Similarly, 39 | ;; the w-castle and b-castle values represent whether either side 40 | ;; has castled. 41 | (defparameter* (w-castle boolean) nil) 42 | (defparameter* (b-castle boolean) nil) 43 | (defparameter* (board-ep boolean) nil) 44 | (defparameter* (square-ep (mod 128)) 0) 45 | 46 | 47 | 48 | ;; These are a bunch of utility functions, and they're marked to be 49 | ;; inlined because they are so short and used so often. 50 | (defun* (convert-128-to-64 -> (mod 64)) ((s (mod 128))) 51 | (+ (logand s 7) (* 8 (ash s -4)))) 52 | (defun* (off-board -> boolean) ((i (mod 128))) 53 | (/= (logand i #x88) 0)) 54 | (defun* (next-square -> (mod 128)) ((i (mod 128))) 55 | (logand (+ i 9) (lognot #x88))) 56 | (defun* (get-piece -> (unsigned-byte 4)) ((i (mod 128))) 57 | (aref board i)) 58 | (defun* (get-rank -> (mod 8)) ((i (mod 128))) 59 | (/ (logand i #x70) 16)) 60 | (defun* (square-color -> (unsigned-byte 1)) ((i (mod 128))) 61 | (piece-color (get-piece i))) 62 | (defun* (square-type -> (unsigned-byte 3)) ((i (mod 128))) 63 | (piece-type (get-piece i))) 64 | (defun* (blank-square -> boolean) ((i (mod 128))) 65 | (= 0 (square-type i))) 66 | (defun* (is-pawn -> boolean) ((i (mod 128))) 67 | (*let ((type (square-type i))) 68 | (or (= type 1) 69 | (= type 2)))) 70 | (defun* (is-ep-move -> boolean) ((from (mod 128)) (to (mod 128))) 71 | (and (is-pawn from) 72 | (or (and (= (get-rank from) 1) 73 | (= (get-rank to) 3)) 74 | (and (= (get-rank from) 6) 75 | (= (get-rank to) 4))))) 76 | (declaim (inline off-board next-square get-piece square-color square-type 77 | blank-square is-pawn)) 78 | 79 | 80 | ;; Make-move and unmake-move are responsible for changing the state of 81 | ;; the board during searching. Everything that's done to the board needs 82 | ;; to be undone, or at least be able to be undone. For that reason, make-move 83 | ;; returns a number with the data necessary to restore the board state. 84 | (defun* (make-move -> (unsigned-byte 13)) ((m (unsigned-byte 18))) 85 | ;; Bind some data to names so it is easier to work with 86 | (*let ((from (unsigned-byte 7) (move-from m)) ;; extract out move positions 87 | (to (unsigned-byte 7) (move-to m)) 88 | (ep (unsigned-byte 1) (move-ep-bit m)) 89 | (moving (unsigned-byte 4) (get-piece from)) 90 | (replaced (unsigned-byte 4) (get-piece to)) 91 | 92 | ;; Some information will have to be restored when this move is unmade, 93 | ;; and all that information is bundled up in the unsigned integer ret. 94 | ;; This data will be an extra parameter to unmake-move. 95 | (ret (unsigned-byte 13) replaced)) 96 | 97 | 98 | ;; Handle e.p. capture 99 | (when (and board-ep 100 | (= to square-ep)) 101 | ;; This is an e.p. capture, on square square-ep 102 | (setf (ldb (byte 1 12) ret) 1) ; set flag in ret for e.p. capture 103 | (if (= (get-rank to) 5) ; set captured square to 0 104 | (setf (aref board (- to 16)) 0) 105 | (setf (aref board (+ to 16)) 0))) 106 | 107 | 108 | ;; Update board with new moved piece 109 | (setf (aref board from) 0) ; zero out moved-from square 110 | (setf (aref board to) moving) ; move piece to new position 111 | 112 | ;; Record old values for board-ep and square-ep to be restored 113 | (setf (ldb (byte 1 4) ret) 114 | (if board-ep 1 0)) 115 | (setf (ldb (byte 7 5) ret) square-ep) 116 | 117 | ;; This was an e.p. move, so set the global states accordingly 118 | (if (= ep 1) 119 | (progn 120 | (setf board-ep t) 121 | ; the square-ep value should be the square that was jumped over 122 | (setf square-ep 123 | (if (= (get-rank to) 4) (+ to 16) (- to 16)))) 124 | 125 | ;; This was not an e.p. move, so the board-ep value needs to 126 | ;; be nil. If it was true previously, it no longer applies, 127 | ;; because e.p. captures must be made immediately after the pawn moves. 128 | (setf board-ep nil)) 129 | 130 | ;; ret has the data needed to restore board state, so it should be returned 131 | ret)) 132 | 133 | ;; Unmake-move is responsible for restoring things to the way they were. 134 | (defun* (unmake-move -> :void) ((m (unsigned-byte 18)) (r (unsigned-byte 13))) 135 | (*let ((from (unsigned-byte 7) (move-from m)) ;; bind these for convenience 136 | (to (unsigned-byte 7) (move-to m)) 137 | (ep (unsigned-byte 1) (ldb (byte 1 4) r)) ;; restore to board-ep 138 | (sqep (unsigned-byte 7) (ldb (byte 7 5) r)) ;; restore to square-ep 139 | (epcap (unsigned-byte 1) (ldb (byte 1 12) r)) ;; was an ep capture done? 140 | (old-piece (unsigned-byte 4) (ldb (byte 4 0) r)) ;; piece replaced in move 141 | (moving (unsigned-byte 4) (get-piece to))) 142 | 143 | ;; trivially "move the piece back" and restore the attacked square 144 | (setf (aref board from) moving) 145 | (setf (aref board to) old-piece) 146 | 147 | ;; restore ep state 148 | (setf board-ep (= ep 1)) 149 | (setf square-ep sqep) 150 | 151 | ;; check if an ep capture occured 152 | (when (= epcap 1) 153 | ;; an ep capture occurred! 154 | ;; we don't need to have a saved copy of the captured square, because 155 | ;; it has to be a pawn. we can also conclude the color of the pawn 156 | ;; based on where on the board the ep capture took place 157 | (if (= (get-rank to) 6) 158 | (setf (aref board (- to 16)) 1) 159 | (setf (aref board (+ to 16)) 10))) 160 | 161 | ;; return nothing 162 | (values))) 163 | 164 | (defparameter* (board-piece-string string) "-p nbrqk PNBRQK") 165 | 166 | (defun* (board->string -> string) () 167 | (with-output-to-string (stream) 168 | (loop for i from 0 to 127 169 | when (not (off-board i)) do 170 | (progn 171 | (when (and (> i 0) (= (mod i 8) 0)) 172 | (write-char #\return stream) 173 | (write-char #\linefeed stream)) 174 | (write-char (char board-piece-string (get-piece i)) stream) )))) 175 | -------------------------------------------------------------------------------- /move.lisp: -------------------------------------------------------------------------------- 1 | ;;;; move.lisp 2 | ;;;; 3 | ;;;; This file contains the procedures that generate and handle moves. Moves are stored in numbers with bitmapping. 4 | 5 | 6 | (in-package #:lalla) 7 | (declaim (optimize speed)) 8 | 9 | ;; Moves are stored in 18-bit words. 10 | ;; They consist of a from square, a to square, and a series of tags. 11 | ;; The following functions are short convenience functions and are marked for inlining. 12 | (defun* (move-from -> (unsigned-byte 7)) ((m (unsigned-byte 18))) 13 | (ldb (byte 7 0) m)) 14 | (defun* (move-to -> (unsigned-byte 7)) ((m (unsigned-byte 18))) 15 | (ldb (byte 7 7) m)) 16 | (defun* (move-tag -> (unsigned-byte 4)) ((m (unsigned-byte 18))) 17 | (ldb (byte 4 14) m)) 18 | (defun* (move-capture-bit -> (unsigned-byte 1)) ((m (unsigned-byte 18))) 19 | (ldb (byte 1 0) (move-tag m))) 20 | (defun* (move-capture -> boolean) ((m (unsigned-byte 18))) 21 | (= (move-capture-bit m) 1)) 22 | (defun* (move-promotion -> boolean) ((m (unsigned-byte 18))) 23 | (= (ldb (byte 1 1) (move-tag m)) 1)) 24 | (defun* (move-ep-bit -> (unsigned-byte 1)) ((m (unsigned-byte 18))) 25 | (ldb (byte 1 2) (move-tag m))) 26 | (defun* (move-ep -> boolean) ((m (unsigned-byte 18))) 27 | (= (move-ep-bit m) 1)) 28 | (defun* (move-castle -> boolean) ((m (unsigned-byte 18))) 29 | (= (ldb (byte 1 3) (move-tag m)) 1)) 30 | 31 | ;; Create a number that represents a move 32 | (defun* (create-move -> (unsigned-byte 18)) 33 | ((from (unsigned-byte 7)) (to (unsigned-byte 7)) 34 | (capture (unsigned-byte 1)) (promotion (unsigned-byte 1)) 35 | (ep (unsigned-byte 1)) (castle (unsigned-byte 1))) 36 | (let ((m 0)) 37 | (declare ((unsigned-byte 18) m)) 38 | (setf (ldb (byte 7 0) m) from) 39 | (setf (ldb (byte 7 7) m) to) 40 | (setf (ldb (byte 1 14) m) capture) 41 | (setf (ldb (byte 1 15) m) promotion) 42 | (setf (ldb (byte 1 16) m) ep) 43 | (setf (ldb (byte 1 17) m) castle) 44 | m)) 45 | (declaim (inline move-from move-to move-tag move-capture move-capture-bit 46 | move-promotion move-ep move-ep-bit move-castle make-move)) 47 | 48 | ;; This is the maximum number of moves that could be generated. 49 | (defconstant max-move-count 218) 50 | 51 | ;; These are some functions for converting stuff to strings 52 | (defparameter* (file-string string) "abcdefgh") ;; use char index of string 53 | 54 | (defun* (position-file -> standard-char) ((index (mod 128))) 55 | (char file-string (logand index 7))) 56 | 57 | (defparameter* (rank-string string) "12345678") 58 | 59 | (defun* (position-rank -> standard-char) ((index (mod 128))) 60 | (char rank-string (- 7 (ash index -4)))) 61 | 62 | ;; Create a string that represents a move (useful for printing to the screen) 63 | (defun* (move->string -> string) ((m (unsigned-byte 18))) 64 | 65 | ;; with-output-to-string is pretty cool 66 | (with-output-to-string (stream) 67 | (princ (position-file (move-from m)) stream) 68 | (princ (position-rank (move-from m)) stream) 69 | (princ (position-file (move-to m)) stream) 70 | (princ (position-rank (move-to m)) stream) 71 | 72 | ;; all generated promotions are queen promotions 73 | (when (move-promotion m) (princ #\q stream)))) 74 | 75 | ;; Generate moves for a certain side! 76 | ;; Just a warning: you're going to need a wide screen/window to read this function. 77 | ;; It gets nested pretty deep (it might help if you listen to Inception music... 78 | ;; do people still tell that joke? "Must go deeper..." Sigh...) 79 | (defun* (generate-moves -> (vector (unsigned-byte 18))) 80 | ((turn-color (unsigned-byte 1))) 81 | 82 | ;; Create a vector for moves, with a fill pointer. When moves are generated 83 | ;; they will be pushed onto the vector. 84 | ;; This is not ideal for performance. It would be better to store moves in 85 | ;; a simple array and manage the fill pointer manually as a separate value. 86 | ;; That would allow SBCL to optimize access to the structure. For now, it has 87 | ;; to do some extra work at runtime to manage access to the vector. 88 | (let ((moves-vector 89 | (make-array max-move-count 90 | :element-type '(unsigned-byte 18) 91 | :fill-pointer 0 92 | :initial-element 0))) 93 | 94 | 95 | ;; Move generation involves one loop nested inside another. The outer loop 96 | ;; goes through every square on the board (which is inefficient---eventually 97 | ;; it should use a list of piece locations), and the inner loop generates 98 | ;; moves for each piece. When moves are generated they're pushed onto 99 | ;; moves-vector. 100 | (loop 101 | for square from 0 to 127 102 | when (and (not (off-board square)) 103 | (not (blank-square square)) 104 | (= turn-color (piece-color (aref board square)))) do 105 | 106 | ;; Now that we've found a square, we extract information about it 107 | ;; and bind it to values in a big let (you know the drill by now). 108 | (*let ((piece (unsigned-byte 4) (aref board square)) 109 | (color (unsigned-byte 1) (piece-color piece)) 110 | (type (unsigned-byte 3) (piece-type piece)) 111 | (sliding boolean (aref sliding-piece type)) 112 | (start (unsigned-byte 8) (aref step-offset type)) 113 | (step (signed-byte 8) (aref piece-steps start)) 114 | (iter-square (mod 128) square)) 115 | 116 | ;; pawns have extra rules, so we check that first 117 | (generate-pawn-special square moves-vector type) 118 | 119 | ;; iterate through each step amount. 120 | ;; there's an array of step offsets in piece.lisp, so see 121 | ;; the values there for each piece if you're curious. they're 122 | ;; pretty self-explanatory. 123 | (loop while (/= step 0) do 124 | 125 | ;; this is the general strategy for generating moves: 126 | ;; each piece is either sliding or non-sliding, and 127 | ;; each piece has a series of "step offsets" associated 128 | ;; with it. for example, the bishop is a sliding piece 129 | ;; and it can go +15, +17, -15, and -17. if you go look 130 | ;; at the board, or remember the layout of the 0x88 board, 131 | ;; you can see that adding these numbers to the current 132 | ;; bishop location will yield one-step jumps for it. 133 | (setf iter-square square) ;; add offset 134 | 135 | ;; start inner block. this cancel be returned from in the loop 136 | (block inner 137 | 138 | (loop while (and (> (+ iter-square step) -1) 139 | (< (+ iter-square step) 128)) do 140 | ;; inner loop for different step amounts 141 | (incf iter-square step) ; make one step 142 | (if (or (off-board iter-square) ; jump off board 143 | (and (not (blank-square iter-square)) ; non-blank square 144 | (= color (square-color iter-square)))) ; hit own piece 145 | (return-from inner) ; break 146 | (progn ; make move 147 | ; generate base move 148 | (unless (and (or (= type 1) ; pawns must capture on 149 | (= type 2)) ; diagonal moves 150 | (blank-square iter-square)) 151 | 152 | ;; time to generate a move! 153 | (vector-push 154 | (create-move square iter-square ; to/from 155 | (if (blank-square iter-square) 0 1) ; capture 156 | (if (and (is-pawn square) 157 | (or (and (= (get-rank iter-square) 7) 158 | (= turn-color 1)) 159 | (and (= (get-rank iter-square) 0) 160 | (= turn-color 0)))) 161 | 1 0) ; promotion if we reach end of board 162 | 0 ; ep 163 | 0) ; castle 164 | moves-vector)) 165 | (unless sliding (return-from inner)))))) ;; break if not sliding pieces 166 | 167 | ;; increment the start value to try the next offset amount 168 | (incf start) 169 | (setf step (aref piece-steps start))))) 170 | 171 | ;; now that the moves have been generated, they need to be sorted. 172 | ;; currently this just uses a very simple sort procedure. all captures 173 | ;; go first, then everything else 174 | (sort moves-vector #'> :key #'move-capture-bit))) 175 | 176 | 177 | ;; Pawns have weird rules. This function handles moving forward. 178 | (defun* (generate-pawn-special -> :void) 179 | ((square (mod 128)) (moves-vector (vector (unsigned-byte 18))) 180 | (type (unsigned-byte 3))) 181 | ;; needs to be a pawn! 182 | (when (or (and (= type 1) (= (get-rank square) 6)) 183 | (and (= type 2) (= (get-rank square) 1))) 184 | 185 | ;; come up with an increment value. either positive and negative 186 | ;; depending on whether we're moving up or down 187 | (let ((increment (if (= type 1) -16 16))) 188 | 189 | ;; generate one step up 190 | (when (blank-square (+ square increment)) 191 | (vector-push 192 | (create-move square (+ square increment) 193 | 0 194 | 0 195 | 0 196 | 0) 197 | moves-vector) 198 | 199 | ;; generate two steps up 200 | ;; we can't go two steps if the first step wasn't possible, so 201 | ;; we nest this inside the above when clause. 202 | (when (blank-square (+ square (* 2 increment))) 203 | (vector-push 204 | (create-move square (+ square (* 2 increment)) 205 | 0 206 | 0 207 | 1 ; ep move 208 | 0) 209 | moves-vector))))) 210 | (values)) ; return nothing 211 | 212 | 213 | ;; this determines if a move is a king capture. it's useful later in the search process 214 | (defun* (king-capture -> boolean) ((m (unsigned-byte 18))) 215 | (*let ((to (unsigned-byte 7) (move-to m)) 216 | (replaced (unsigned-byte 4) (aref board to)) 217 | (type (unsigned-byte 3) (piece-type replaced))) 218 | (= type 7))) 219 | (declaim (inline king-capture)) 220 | 221 | --------------------------------------------------------------------------------