How common is Common Lisp?

[sje]

Code: Select all

(defun calc-sq-sq-dir (my-sq0-index my-sq1-index)
  "Calculate the direction from the first square to the second square."
  (let
    (
      (result nil)
      (f-delta (- (map-sq-to-file my-sq1-index) (map-sq-to-file my-sq0-index)))
      (r-delta (- (map-sq-to-rank my-sq1-index) (map-sq-to-rank my-sq0-index)))
    )
    (cond
      ((and (zerop f-delta) (zerop r-delta))
        (setf result nil))
      ((and (plusp f-delta) (zerop r-delta))
        (setf result dir-e))
      ((and (zerop f-delta) (plusp r-delta))
        (setf result dir-n))
      ((and (minusp f-delta) (zerop r-delta))
        (setf result dir-w))
      ((and (zerop f-delta) (minusp r-delta))
        (setf result dir-s))
      ((and (= f-delta r-delta) (plusp f-delta))
        (setf result dir-ne))
      ((and (= f-delta (- r-delta)) (minusp f-delta))
        (setf result dir-nw))
      ((and (= f-delta r-delta) (minusp f-delta))
        (setf result dir-sw))
      ((and (= f-delta (- r-delta)) (plusp f-delta))
        (setf result dir-se))
      ((and (= f-delta file-delta-ene) (= r-delta rank-delta-ene))
        (setf result dir-ene))
      ((and (= f-delta file-delta-nne) (= r-delta rank-delta-nne))
        (setf result dir-nne))
      ((and (= f-delta file-delta-nnw) (= r-delta rank-delta-nnw))
        (setf result dir-nnw))
      ((and (= f-delta file-delta-wnw) (= r-delta rank-delta-wnw))
        (setf result dir-wnw))
      ((and (= f-delta file-delta-wsw) (= r-delta rank-delta-wsw))
        (setf result dir-wsw))
      ((and (= f-delta file-delta-ssw) (= r-delta rank-delta-ssw))
        (setf result dir-ssw))
      ((and (= f-delta file-delta-sse) (= r-delta rank-delta-sse))
        (setf result dir-sse))
      ((and (= f-delta file-delta-ese) (= r-delta rank-delta-ese))
        (setf result dir-ese))
      (t
        (setf result nil)))
    result))

(defun initialize-sq-sq-dir-vec ()
  "Calculate the initial value of the intersquare direction array."
  (let ((result (make-array (list sq-limit sq-limit))))
    (dotimes (sq0-index sq-limit)
      (dotimes (sq1-index sq-limit)
        (setf (aref result sq0-index sq1-index)
          (calc-sq-sq-dir sq0-index sq1-index))))
    result))

(defconstant sq-sq-dir-vec (initialize-sq-sq-dir-vec))

[sje]

Code: Select all

(defun calc-next-sq (my-sq my-dir)
  "Calculate the next square along a direction; return nil if off the board."
  (let
    (
      (result nil)
      (new-file (+ (map-sq-to-file my-sq) (svref mc-dir-to-file-delta-vec my-dir)))
      (new-rank (+ (map-sq-to-rank my-sq) (svref mc-dir-to-rank-delta-vec my-dir)))
    )
    (when (and (in-file-range? new-file) (in-rank-range? new-rank))
      (setf result (map-file-rank-to-sq new-file new-rank)))
    result))

(defun initialize-next-sq-vec ()
  "Calculate the initial value of the next squares array."
  (let ((result (make-array (list sq-limit dir-limit))))
    (dotimes (sq-index sq-limit)
      (dolist (dir-index dir-list)
        (setf (aref result sq-index dir-index) (calc-next-sq sq-index dir-index))))
    result))

(defconstant next-sq-vec (initialize-next-sq-vec))

[sje]

Code: Select all

(defun initialize-scan-sqs (my-result my-sq-index my-dir-index)
  "Calculate a single element of the sweep scan squares list array."
  (when (eq (aref my-result my-sq-index my-dir-index) t)
    (let ((next-sq (aref next-sq-vec my-sq-index my-dir-index)))
      (if next-sq
        (progn
          (initialize-scan-sqs my-result next-sq my-dir-index)
          (setf (aref my-result my-sq-index my-dir-index)
            (cons next-sq (aref my-result next-sq my-dir-index))))
        (setf (aref my-result my-sq-index my-dir-index) nil)))))

(defun initialize-scan-sqs-vec ()
  "Calculate the initial value of the sweep scan squares list array."
  (let ((result (make-array (list sq-limit dir-slimit) :initial-element t)))
    (dotimes (sq-index sq-limit)
      (dolist (dir-index sweep-dir-list)
        (initialize-scan-sqs result sq-index dir-index)))
    result))

(defconstant scan-sqs-vec (initialize-scan-sqs-vec))

[sje]

Note: Non-Lispers can safely ignore this post.

I will likely be looking for one or two CIL beta testers later this month. The main requirement is having a Common Lisp interpreter or compiler.

From the alpha version of the new CIL package, here are a few bitboard database update functions. The use of these poorly commented routines should not be too cryptic for an author of a bitboard program.

Code: Select all

;;; Bitboard database add/delete/propagate/cut attacks

(defun add-attacks (my-sq my-man my-bbdb)
  "Add the attacks of a man on a square in a bitboard database."
  (let ((atk-sqs (calc-attack-sqs-bbdb my-sq my-man my-bbdb)))
    (add-color-attacks-bbdb (svref mc-man-to-color-vec my-man) atk-sqs my-bbdb)
    (add-attacks-bbdb my-sq atk-sqs my-bbdb))
  my-bbdb)

(defun del-attacks (my-sq my-man my-bbdb)
  "Delete the attacks from a man on a square in a bitboard database."
  (let*
    (
      (attacker-bb (copy-seq (svref (bbdb-atk-fr-sq-bb-vec my-bbdb) my-sq)))
      (attacker-color (svref mc-man-to-color-vec my-man))
      (attacker-loc-bb (svref (bbdb-loc-color-bb-vec my-bbdb) attacker-color))
      (atk-by-color-bb (svref (bbdb-atk-by-color-bb-vec my-bbdb) attacker-color))
    )
    (reset-bb (svref (bbdb-atk-fr-sq-bb-vec my-bbdb) my-sq))
    (do ((attacker-sq sq-a1)) ((not attacker-sq))
      (setf attacker-sq (first1-sq attacker-bb attacker-sq))
      (when attacker-sq
        (reset-sq (svref (bbdb-atk-to-sq-bb-vec my-bbdb) attacker-sq) my-sq)
        (when
          (bb-reset?
            (bit-and
              attacker-loc-bb
              (svref (bbdb-atk-to-sq-bb-vec my-bbdb) my-sq)))
          (reset-sq atk-by-color-bb my-sq))
        (reset-sq attacker-bb attacker-sq))))
  my-bbdb)

(defun pro-attacks (my-sq my-bbdb)
  "Propagate the attacks through a square in a bitboard database."
  (let
    (
      (merge-bb (bbdb-loc-merge-bb my-bbdb))
      (sweep-bb (bbdb-loc-sweep-bb my-bbdb))
      (attacker-bb (copy-seq (svref (bbdb-atk-to-sq-bb-vec my-bbdb) my-sq)))
    )
    (do ((attacker-sq sq-a1)) ((not attacker-sq))
      (setf attacker-sq (first1-sq attacker-bb attacker-sq))
      (when attacker-sq
        (when (sq-set? sweep-bb attacker-sq)
          (let*
            (
              (attacker-color (calc-occ-color-bbdb attacker-sq my-bbdb))
              (attacker-loc-bb (svref (bbdb-loc-color-bb-vec my-bbdb) attacker-color))
              (atk-by-color-bb (svref (bbdb-atk-by-color-bb-vec my-bbdb) attacker-color))
              (atk-fr-sq-bb (svref (bbdb-atk-fr-sq-bb-vec my-bbdb) attacker-sq))
              (dir (aref sq-sq-dir-vec attacker-sq my-sq))
            )
            (do ((ext-sq (aref next-sq-vec my-sq dir))) ((not ext-sq))
              (when ext-sq
                (set-sq atk-fr-sq-bb ext-sq)
                (set-sq (svref (bbdb-atk-to-sq-bb-vec my-bbdb) ext-sq) attacker-sq)
                (set-sq atk-by-color-bb ext-sq)
                (if (sq-set? merge-bb ext-sq)
                  (setf ext-sq nil)
                  (setf ext-sq (aref next-sq-vec ext-sq dir)))))))
        (reset-sq attacker-bb attacker-sq))))
  my-bbdb)

(defun cut-attacks (my-sq my-bbdb)
  "Cut the attacks through a square in a bitboard database."
  (let
    (
      (merge-bb (bbdb-loc-merge-bb my-bbdb))
      (sweep-bb (bbdb-loc-sweep-bb my-bbdb))
      (attacker-bb (copy-seq (svref (bbdb-atk-to-sq-bb-vec my-bbdb) my-sq)))
    )
    (do ((attacker-sq sq-a1)) ((not attacker-sq))
      (setf attacker-sq (first1-sq attacker-bb attacker-sq))
      (when attacker-sq
        (when (sq-set? sweep-bb attacker-sq)
          (let*
            (
              (attacker-color (calc-occ-color-bbdb attacker-sq my-bbdb))
              (attacker-loc-bb (svref (bbdb-loc-color-bb-vec my-bbdb) attacker-color))
              (atk-by-color-bb (svref (bbdb-atk-by-color-bb-vec my-bbdb) attacker-color))
              (atk-fr-sq-bb (svref (bbdb-atk-fr-sq-bb-vec my-bbdb) attacker-sq))
              (dir (aref sq-sq-dir-vec attacker-sq my-sq))
            )
            (do ((ext-sq (aref next-sq-vec my-sq dir))) ((not ext-sq))
              (when ext-sq
                (reset-sq atk-fr-sq-bb ext-sq)
                (reset-sq (svref (bbdb-atk-to-sq-bb-vec my-bbdb) ext-sq) attacker-sq)
                (when
                  (bb-reset?
                    (bit-and
                      attacker-loc-bb
                      (svref (bbdb-atk-to-sq-bb-vec my-bbdb) ext-sq)))
                  (reset-sq atk-by-color-bb ext-sq))
                (if (sq-set? merge-bb ext-sq)
                  (setf ext-sq nil)
                  (setf ext-sq (aref next-sq-vec ext-sq dir)))))))
        (reset-sq attacker-bb attacker-sq))))
  my-bbdb)


;;; Bitboard database add/delete man

(defun add-man-bbdb (my-sq my-man my-bbdb)
  "Add a man on a square to a bitboard database."
  (add-man-locus-bbdb my-sq my-man my-bbdb)
  (add-attacks my-sq my-man my-bbdb)
  (cut-attacks my-sq my-bbdb)
  my-bbdb)

(defun del-man-bbdb (my-sq my-man my-bbdb)
  "Delete a man on a square from a bitboard database."
  (del-man-locus-bbdb my-sq my-man my-bbdb)
  (del-attacks my-sq my-man my-bbdb)
  (pro-attacks my-sq my-bbdb)
  my-bbdb)

[sje]

The new and hopefully improved CIL toolkit has seen some progress. Nearly all of the needed Lisp structures and many of their associated routines have been specified and implemented. I have used the Lisp defstruct over the defclass approach as I'm concerned that the CLOS (Common Lisp Object System) needed for the latter is not evenly implemented on the various extant interpreters and compilers.

Stuff that is working:

1) Formatted output for moves (SAN) and positions (FEN).

2) Boards, censuses, and bitboard databases with fairly fast functions for both creation and incremental updating.

3) Generation, execution, and retraction for some classes of moves.

4) Misc: hashes, pinned man detection, frozen man detection, check and checkmate detection, SAN file/rank disambiguation detection, various sorts, etc.

It's about 4,200 lines long so far, bit this includes test routines and lots of data tables. There has been no attempt (yet) to optimize the speed of the code via the usual Common Lisp inline and hint features.

Possibly by the end of this month I would welcome a beta tester (or two); I hope to have movepath enumeration (i.e., perft) and a simple mate search in place by then.

Sample code snippet:

Code: Select all

(defun is-move-busted? (my-move my-pos)
  "Return t if the move leaves the moving color's king in check."
  (let ((result nil) (env-stack nil))
    (push (clone-posenv (pos-posenv my-pos)) env-stack)
    (execute-move my-move my-pos)
    (when (is-pas-king-in-check? my-pos)
      (setf result t))
    (setf (pos-posenv my-pos) (pop env-stack))
    (retract-move my-move my-pos)
    result))

[sje]

Actually, the movepath enumeration is trivial, but I can't fully test it until I get all the move generation/execution parts working.

Code: Select all

(defun enumerate-movepaths (my-pos my-depth)
  "Return a count of the distinct movepaths from the given position to the given ply depth."
  (let ((result nil))
    (cond
      ((= my-depth 0)
        (setf result 1))
      ((= my-depth 1)
        (setf result (length (generate my-pos))))
      (t
        (setf result 0)
        (dolist (move (generate my-pos))
          (let ((env-stack nil))
            (push (clone-posenv (pos-posenv my-pos)) env-stack)
            (execute-move move my-pos)
            (incf result (enumerate-movepaths my-pos (1- my-depth)))
            (setf (pos-posenv my-pos) (pop env-stack))
            (retract-move move my-pos)))))
    result))

[Michael Sherwin]

Actually, the movepath enumeration is trivial, but I can't fully test it until I get all the move generation/execution parts working.

Code: Select all

(defun enumerate-movepaths (my-pos my-depth)
  "Return a count of the distinct movepaths from the given position to the given ply depth."
  (let ((result nil))
    (cond
      ((= my-depth 0)
        (setf result 1))
      ((= my-depth 1)
        (setf result (length (generate my-pos))))
      (t
        (setf result 0)
        (dolist (move (generate my-pos))
          (let ((env-stack nil))
            (push (clone-posenv (pos-posenv my-pos)) env-stack)
            (execute-move move my-pos)
            (incf result (enumerate-movepaths my-pos (1- my-depth)))
            (setf (pos-posenv my-pos) (pop env-stack))
            (retract-move move my-pos)))))
    result))

If you ever read one of my post about what it took for me to learn C then you would realize that learning a new language would be, for me, impossible. But, of the languages that I have read about, lisp (scheme) or haskell would be my choices.

I mention scheme (a lisp dialect) only because, there is PLT scheme, a multi platform robust implimentation with very nice gui and graphics libraries as well as an integrated editor and tons and tons of sample apps. And a compiler! It is a remarkable package. A chess kit coded for PLT scheme would then be accesible to everyone!

However, the GHC haskell compiler is what I would learn first. It is also multi platform. My understanding of haskell is that the programmer describes in mathematical language the algorithms needed to 'solve the problem' and then it is the compiler that actually writes the program that executes. The compiler does a better more consistant job writting fast code than most programmers (including lisp or even c programmers) and haskell programs 'promise' to be smaller and virtually error free.

It would be great if someone were to port your kit with a working perft to these two enviroments!

[sje]

A concise and breezy introduction to Lisp can be had for free with the online book at http://www.psg.com/~dlamkins/sl/contents.html

Of course, Scheme has been around for more than three decades and has been famously taught in _The Structure and Interpretation of Computer Programs_ from Tech Land. Back in the early 1970s, Scheme had some advantages over Lisp in the sense that there were many different Lisps with little standardization and most lacked certain features like lexical scoping) that Scheme did have. But that was then, this is now, and Common Lisp now rules the day.

Some CIL bitboard functions:

Code: Select all

;;; Bitboard primitives

(defun mk-bb () (make-array sq-limit :element-type `bit :initial-element 0))

(defconstant all-0-bb (make-array sq-limit :element-type `bit :initial-element 0))
(defconstant all-1-bb (make-array sq-limit :element-type `bit :initial-element 1))

(defun clone-bb (my-bb)
  "Return a clone of the given bitboard."
  (copy-seq my-bb))

(defun clone-bb-vec (my-bb-vec)
  "Return a clone of the given bitboard vector."
  (let ((result (make-array (array-total-size my-bb-vec))))
    (dotimes (index (array-total-size my-bb-vec))
      (setf (svref result index) (clone-bb (svref my-bb-vec index))))
    result))

(defun copy-bb (my-target-bb my-source-bb)
  "Copy the source bitboard into the target bitboard; return the target bitboard."
  (bit-xor my-target-bb my-target-bb t)
  (bit-ior my-target-bb my-source-bb t)
  my-target-bb)

(defun copy-bb-vec (my-target-bb-vec my-source-bb-vec)
  "Copy the source bitboard vector into the target bitboard vector; return the target."
  (dotimes (index (array-total-size my-target-bb-vec))
    (copy-bb (svref my-target-bb-vec index) (svref my-source-bb-vec index)))
  my-target-bb-vec)

(defun reset-bb (my-bb)
  "Reset a bitboard."
  (bit-xor my-bb my-bb t)
  my-bb)

(defun reset-bb-vec (my-bb-vec)
  "Reset a bitboard vector."
  (dotimes (index (array-total-size my-bb-vec))
    (reset-bb (svref my-bb-vec index)))
  my-bb-vec)

(defun bb-reset? (my-bb)
  "Return t if the given bitboard is reset (e.g., empty)."
  (not (position 1 my-bb)))

(defun set-sq (my-bb my-sq)
  "Set a square in a bitboard."
  (setf (sbit my-bb my-sq) 1)
  my-bb)

(defun reset-sq (my-bb my-sq)
  "Reset a square in a bitboard."
  (setf (sbit my-bb my-sq) 0)
  my-bb)

(defun sq-set? (my-bb my-sq)
  "Test a square in a bitboard."
  (plusp (sbit my-bb my-sq)))

(defun sq-reset? (my-bb my-sq)
  "Test a square in a bitboard; return inverted sense."
  (zerop (sbit my-bb my-sq)))


;;; Bitboard square scanning

(defun first-sq (my-bb)
  "Return the index of the first bit in a bitboard; return nil if none."
  (position 1 my-bb))

(defun first1-sq (my-bb my-start-sq)
  "Same as first-sq, but with a starting index."
  (position 1 my-bb :start my-start-sq))

(defun next-sq (my-bb)
  "Return the index of the first bit in a bitboard and clear; return nil if none."
  (let ((result (position 1 my-bb)))
    (when result
      (setf (sbit my-bb result) 0))
    result))

(defun next1-sq (my-bb my-start-sq)
  "Same as next-sq, but with a starting index."
  (let ((result (position 1 my-bb :start my-start-sq)))
    (when result
      (setf (sbit my-bb result) 0))
    result))

(defun card (my-bb)
  "Count the number of squares in a bitboard."
  (count 1 bb))

[Michael Sherwin]

Okay, I'll just accept that common lisp is a superior language--you are the expert!

But which common lisp package even comes close to PLT scheme in terms of integrated inviroment and graphics/gui libraries and many other useful toolkits. Not to mention all the sample apps with graphics, including many games? Edit: and I mean for windows (don't shoot) as that is all I know, sort of anyway.

Also PLT scheme has step_up tutorial modes.

Maybe PLT scheme cannot do the bitboard stuff though--I just do not know.

[sje]

I do not deny that Scheme has its place in the academic environment. Also, it's obvious that there is a significant amount of interest in Scheme. But overall, Common Lisp is a more mature, more unified, more supported, and more general platform for symbolic programming.

Scheme can handle bitboards. But can it handle them as well as Common Lisp? CL has both integer bit-wise access (e.g., logior, logand, logbitp) and also bit vector primitive types and operators (e.g., bit-ior, bit-xor, sbit, etc.). And there are some Common Lisp wrappers that support fancy interactive graphics, too. But I can get by with a plain xterm and a text debugger.

Note: there are some commercial CL developer kits that sell for US$2,500 single user with a hefty annual maintenance fee. I assume there must be enough extra goodies in these kits that make the expenditure worthwhile.