CIL Toolkit: code snippets: move generation

[sje]

Lisp will output non empty lists using parentheses, but this is not always a format usable by other programs. Also, some Lisp processors (e,g., gcl) will try to sneak in their own ideas of pretty printing with newlines and indentation.

Here's some more simple code that shows how the toolkit does no-frills variation encoding:

Code: Select all

;;; SAN variation encoding

(defun encode-san-variation (my-stream my-moves)
  "Encode the given variation on a stream."
  (when my-moves
    (let ((needspace nil))
      (dolist (move my-moves)
        (when needspace
          (blank my-stream))
        (encode-san my-stream move)
        (setf needspace t))))
  (values))


;;; UCI variation encoding

(defun encode-uan-variation (my-stream my-moves)
  "Encode the given variation on a stream with UCI algebraic move encoding."
  (when my-moves
    (let ((needspace nil))
      (dolist (move my-moves)
        (when needspace
          (blank my-stream))
        (encode-uan my-stream move)
        (setf needspace t))))
  (values))

[sje]

The toolkit needs a way to translate input ASCII SAN moves into an internal format. Instead of parsing an input SAN string character by character, a move list is created and the input string is tested against its members via string comparison.

In some caller contexts, the failure to find the input string is a sufficiently serious enough inconsistency that the program will be terminated with an error message.

More simple code:

Code: Select all

;;; SAN move string location

(defun find-san (my-san my-moves)
  "Locate a SAN move string in a list of marked moves; return list move on match."
  (let ((result nil))
    (do ((move)) ((or result (null? my-moves)))
      (setf move (pop my-moves))
      (when (string= my-san (san-string move))
        (setf result move)))
    result))

(defun find-san-no-fail (my-san my-moves)
  "Locate a SAN move string in a list of marked moves; return list move on match; else error."
  (let ((result nil))
    (do ((move)) ((or result (null? my-moves)))
      (setf move (pop my-moves))
      (when (string= my-san (san-string move))
        (setf result move)))
    (unless result
      (error "find-san-no-fail: can't locate move"))
    result))

(defun match-san (my-san my-pos)
  "Return the move, if any, in the given position that matches the input SAN string."
  (find-san my-san (generate-marked my-pos)))

(defun match-san-no-fail (my-san my-pos)
  "Return the move in the given position that matches the input SAN string; else error."
  (find-san-no-fail my-san (generate-marked my-pos)))

Sometimes there's a need to handle a whole sequence of input moves. Here's how that's done:

Code: Select all

;;; SAN variation validation and translation

(defun validate-san-variation (my-san-moves my-pos)
  "Return t if the given SAN variation is a valid continuation for the given position."
  (let ((result t))
    (when my-san-moves
      (let ((pos (clone-pos my-pos)) (san-moves my-san-moves))
        (dowhile (and result san-moves)
          (let ((move (match-san (pop san-moves) pos)))
            (if move
              (execute-move move pos)
              (setf result nil))))))
    result))

(defun translate-san-variation (my-san-moves my-pos)
  "Translate the given and known valid SAN variation for the given position."
  (let ((result nil))
    (when my-san-moves
      (let ((pos (clone-pos my-pos)) (san-moves my-san-moves))
        (dowhile san-moves
          (let ((move (match-san-no-fail (pop san-moves) pos)))
            (execute-move move pos)
            (push move result)))))
    (nreverse result)))

[sje]

After six weeks of work, I'd say it's time to get the toolkit to understand user move input. For now I'll have the user be responsible for typing exact SAN; matching irregularly formed move strings is something to be done later.

The SAN move input handler is called from the ICP on each input line that doesn't look like a command.

First, the slightly revised ICP main driver:

Code: Select all

;;; Interactive command processor

(defun icp (&rest my-args)
  "Interactive command processor for console operation of the Chess In Lisp Toolkit."
  (let ((cpc (mk-cpc cpid-icp my-args)))
    (icp-init cpc)
    (icp-emit-greeting cpc)
    (dountil (cpc-is-done cpc)
      (icp-emit-prompt cpc)
      (command-line-cpc (read-line (cpc-stin cpc) nil nil) cpc)
      (unless (or (cpc-is-done cpc) (cpc-is-pass cpc))
        (if (cpc-cmdord cpc)
          (eval (list (svref icp-dispatch-vec (cpc-cmdord cpc)) cpc))
          (icp-move-entry cpc)))
      (finish-output (cpc-stout cpc)))
    (icp-emit-farewell cpc)
    (icp-term cpc))
  (values))

And the move entry processor:

Code: Select all

;;; Move entry

(defun icp-move-entry (my-cpc)
  "Handle raw move entry of zero or more moves; return t if all moves valid."
  (let ((result t) (san-moves (cpc-cmdtkns my-cpc)))
    (if (not (validate-san-variation san-moves (cpc-pos my-cpc)))
      (progn
        (setf result nil)
        (put-string (cpc-stout my-cpc) "Error: invalid move(s)")
        (newline (cpc-stout my-cpc)))
      (let ((moves (translate-san-variation san-moves (cpc-pos my-cpc))))
        (dolist (move moves)
          (advance-cpc move my-cpc))
        (icp-display-pos my-cpc)))
    result))

I tried the above with the eleven thousand plus ply game posted elsewhere. The paste didn't work because the Lisp in use has a 1 KB character limit on text line input handled by the standard read-line function. So only a little over a hundred moves made it; I'll have to write my own line reader to handle longer input.

Oh, and the advance-cpc routine advances the CPC state by one played move. This updates the CPC's Persistent Search Environment and the CPC's PGN object:

Code: Select all

;;; CPC advancement

(defun advance-cpc (my-move my-cpc)
  "Advance the given CPC by playing a move."
  (advance-pgn my-move (cpc-pgn my-cpc))
  (advance-pse my-move (cpc-pse my-cpc)))

[sje]

The toolkit's command processors need a way to enter a position. FEN is used exclusively, and all FEN str
ings must have the full set of six fields.

Because some FEN may be entered by a human (or a buggy program source), a check is needed as well.

The position is loaded into the current CPC object. This is done as the CPC handler calls the position loader routines for its PGN object and its PSE (Persistent Search Environment) object. The PGN handler then calls the position loader for its game object. It turns out that there's a bit of code needed at different levels to make sure that every object is a happy object with internally consistent values. I have the basic things working but I'm sure their will be revisions. For example, a reloaded PSE will not only need its base position changed, but it also should have all of its transposition tables, history data, etc., reset as well.

Within the ICP (Interactive Command Processor), FEN position loading can be done by the "ef"command (enter FEN at the prompt as part of the command) and also by the "lf" command (load FEN from file). The "ef" command handler has been written:

Code: Select all

(defun icp-do-ef (my-cpc)
  "Handle the ICP ef command."
  (if (/= (cpc-cmdtknc my-cpc) 7)
    (icp-user-error my-cpc "Need six field FEN specication")
    (let ((fen-str nil) (tokens (rest (cpc-cmdtkns my-cpc))) (pos nil))
      (setf fen-str
        (format nil "~A ~A ~A ~A ~A ~A"
          (first tokens)
          (second tokens)
          (third tokens)
          (fourth tokens)
          (fifth tokens)
          (sixth tokens)))
      (setf pos (calc-pos-from-str fen-str))
      (if (not pos)
        (icp-user-error my-cpc "Invalid FEN specication")
        (progn
          (load-cpc-pos pos my-cpc)
          (icp-display-pos my-cpc))))))

The CPC position loader:

Code: Select all

;;; CPC position loading

(defun load-cpc-pos (my-pos my-cpc)
  "Load the given position into the given CPC."
  (load-pse-pos my-pos (cpc-pse my-cpc))
  (load-pgn-pos my-pos (cpc-pgn my-cpc)))

The PSE position loader:

Code: Select all

;;; PSE position loading

(defun load-pse-pos (my-pos my-pse)
  "Load the given position into the given PSE."
  (reset-pse my-pse)
  (setf (pse-base-pos my-pse) (clone-pos my-pos))
  my-pse)

The PGN position loader:

Code: Select all

;;; PGN position loading

(defun load-pgn-pos (my-pos my-pgn)
  "Load the given position into the given PGN."
  (load-game-pos my-pos (pgn-game my-pgn))
  (normalize-pgn my-pgn)
  my-pgn)

The game position loader:

Code: Select all

;;; Game position loading

(defun load-game-pos (my-pos my-game)
  "Load the given position into the given game."
  (reset-game my-game)
  (setf (game-base-fenpos my-game) (calc-fenpos-from-pos my-pos))
  (setf (game-pos         my-game) (clone-pos my-pos))
  (setf (game-sgt         my-game) (calc-game-termination my-pos))
  (establish-game-termination my-game)
  my-game)

[sje]

The xboard and UCI command processors are being written at the same time as the interactive command processor, and this helps identify those areas of common code that can be factored into the CPC context object.

For example, the above code for move and FEN entry can be used via factoring fore the UCI "position" command and the xboard "usermove" and "setboard" commands.

In progress: common code for logging and dribble file support.

[sje]

The CPC (Command Processor Context) object has been enhanced to handle logging and dribble file output. The logfile is mandatory but the dribble file is not.

First, the upgraded CPC structure:

Code: Select all

;;; CPC: Command Processor Context

(defstruct
  (cpc
    (:print-function
      (lambda (my-cpc my-stream my-level)
        (declare (ignore my-level))
        (encode-cpc my-stream my-cpc))))
  (cpid     0 :type fixnum) ; Command processor identification enumeration constant
  (cpstr    nil)            ; Command processor identification name string
  (args     nil)            ; Program ommand line arguments
  (lfpstr   nil)            ; Log file pathname string
  (dfpstr   nil)            ; Dribble file pathname string
  (stin     nil)            ; Input stream
  (stout    nil)            ; Output stream
  (stlog    nil)            ; Logging output stream
  (stdrib   nil)            ; Dribble output stream
  (cmdord   nil)            ; Current command ordinal
  (cmdstr   nil)            ; Current command string input
  (cmdtkns  nil)            ; Tokens from command string input
  (cmdtknc  0 :type fixnum) ; Count of tokens
  (cmd-vec  nil)            ; Constant command string vector
  (is-done  nil)            ; Exiting flag
  (is-pass  nil)            ; Empty command input flag
  (pgn      nil)            ; The current PGN; includes game object
  (pse      nil))           ; The current PSE

CPC initialization:

Code: Select all

(defun mk-cpc (my-cpid my-args)
  "Return a new Command Processor Context object for the given command processor kind."
  (declare (type fixnum my-cpid))
  (let ((result (make-cpc)))
    (setf (cpc-cpid    result) my-cpid)
    (setf (cpc-cpstr   result) (svref as-cpid-vec my-cpid))
    (setf (cpc-args    result) my-args)
    (setf (cpc-lfpstr  result) (format nil "~A.log" (svref as-cpid-vec my-cpid)))
    (setf (cpc-dfpstr  result) (format nil "~A.drb" (svref as-cpid-vec my-cpid)))
    (setf (cpc-stlog   result) nil)
    (setf (cpc-stdrib  result) nil)
    (setf (cpc-cmdord  result) nil)
    (setf (cpc-cmdstr  result) "")
    (setf (cpc-cmdtkns result) nil)
    (setf (cpc-cmdtknc result) 0)
    (setf (cpc-is-done result) nil)
    (setf (cpc-is-pass result) nil)
    (setf (cpc-pgn     result) (mk-pgn))
    (setf (cpc-pse     result) (mk-pse))
    (cond
      ((= my-cpid cpid-icp)
        (setf (cpc-stin    result) *terminal-io*)
        (setf (cpc-stout   result) *terminal-io*)
        (setf (cpc-cmd-vec result) as-icp-cmd-vec))
      ((= my-cpid cpid-uci)
        (setf (cpc-stin    result) *standard-input*)
        (setf (cpc-stout   result) *standard-output*)
        (setf (cpc-cmd-vec result) as-uci-cmd-vec))
      ((= my-cpid cpid-xboard)
        (setf (cpc-stin    result) *standard-input*)
        (setf (cpc-stout   result) *standard-output*)
        (setf (cpc-cmd-vec result) as-xboard-cmd-vec))
      (t (error "mk-cpc: cond fault")))
    result))

The command dispatch that now handles logging and dribbling of the input command:

Code: Select all

(defun command-line-cpc (my-cpc)
  "Set up the various command fields in a CPC based on a command line input string."
  (let ((text-str (read-line (cpc-stin my-cpc) nil nil)) (stdrib (cpc-stdrib my-cpc)))
    (setf (cpc-cmdord  my-cpc) nil)
    (setf (cpc-cmdstr  my-cpc) text-str)
    (setf (cpc-cmdtkns my-cpc) nil)
    (setf (cpc-is-pass my-cpc) nil)
    (if (null? text-str)
      (setf (cpc-is-done my-cpc) t)
      (progn
        (cpc-log-line my-cpc (format nil "> ~A" text-str))
        (when stdrib
          (put-string stdrib (format nil "> ~A" text-str))
          (newline stdrib)
          (finish-output stdrib))
        (setf (cpc-cmdtkns my-cpc) (tokenize text-str))
        (setf (cpc-cmdtknc my-cpc) (length (cpc-cmdtkns my-cpc)))
        (if (null? (cpc-cmdtkns my-cpc))
          (setf (cpc-is-pass my-cpc) t)
          (setf (cpc-cmdord my-cpc)
            (locate-string (first (cpc-cmdtkns my-cpc)) (cpc-cmd-vec my-cpc))))))))

The logfile writer (note the use of timestamping):

Code: Select all

(defun cpc-log-line (my-cpc my-string)
  "Output the given string plus a newline to the logging file."
  (let ((stlog (cpc-stlog my-cpc)))
    (when stlog
      (encode-timemark stlog (calc-current-ltz-timemark))
      (blank stlog)
      (put-string stlog my-string)
      (newline stlog)
      (finish-output stlog)))
  (values))

The CPC output text writer:

Code: Select all

(defun cpc-put-line (my-cpc my-string)
  "Output the given string plus a newline."
  (let ((stout (cpc-stout my-cpc)) (stdrib (cpc-stdrib my-cpc)))
    (put-string stout my-string)
    (newline stout)
    (finish-output stout)
    (when stdrib
      (put-string stdrib my-string)
      (newline stdrib)
      (finish-output stdrib)))
  (values))

The initialization and termination routines for the ICP (Interactive Command Processor; the UCI and xboard versions are similar):

Code: Select all

(defun icp-init (my-cpc)
  "Initialize ICP operations."
  (setf (cpc-stlog my-cpc) (open (cpc-lfpstr my-cpc) :direction :output))
  (cpc-log-line my-cpc (format nil "~A: ~A logfile begin" prog-name (cpc-cpstr my-cpc)))
  (cpc-log-line my-cpc (format nil "Program date: ~A" prog-date))
  (values))

(defun icp-term (my-cpc)
  "Terminate ICP operations."
  (cpc-log-line my-cpc (format nil "~A: ~A logfile end" prog-name (cpc-cpstr my-cpc)))
  (when (cpc-stdrib my-cpc)
    (close (cpc-stdrib my-cpc)))
  (when (cpc-stlog my-cpc)
    (close (cpc-stlog my-cpc)))
  (values))

The upgraded ICP main routine; the UCI and xboard versions are similar):

Code: Select all

(defun icp (&rest my-args)
  "Interactive command processor for console operation of the Chess In Lisp Toolkit."
  (let ((cpc (mk-cpc cpid-icp my-args)))
    (icp-init cpc)
    (icp-emit-greeting cpc)
    (dountil (cpc-is-done cpc)
      (icp-emit-prompt cpc)
      (command-line-cpc cpc)
      (unless (or (cpc-is-done cpc) (cpc-is-pass cpc))
        (if (cpc-cmdord cpc)
          (eval (list (svref icp-dispatch-vec (cpc-cmdord cpc)) cpc))
          (icp-move-handler cpc)))
      (finish-output (cpc-stout cpc)))
    (icp-emit-farewell cpc)
    (icp-term cpc))
  (values))

And finally, a sample logfile:

Code: Select all

2008.09.25 14:25:05 Chess In Lisp Toolkit: ICP logfile begin
2008.09.25 14:25:05 Program date: 2008.09.25
2008.09.25 14:25:10 > db
2008.09.25 14:25:12 > dm
2008.09.25 14:25:14 > df
2008.09.25 14:25:15 > 
2008.09.25 14:25:16 > exit
2008.09.25 14:25:16 Chess In Lisp Toolkit: ICP logfile end

[mhull]

This is an interesting thread. Thanks for the informative code examples.

BTW, is the Symbolic 'cognitron' still being developed?

Thanks,

[sje]

This is an interesting thread. Thanks for the informative code examples.

BTW, is the Symbolic 'cognitron' still being developed?

Yes. In fact, one of the motivations for the reincarnation of the CIL Toolkit is to implement Symbolic's cognitive search in Common Lisp. Nearly all of the code in the new toolkit is actually a translation of the C++ code in Symbolic's ChessLisp interpreter.

[sje]

Every chess program operating in a console text environment needs a help command.

The routine:

Code: Select all

(defun icp-do-help (my-cpc)
  "Handle the ICP help command."
  (doicp-cmds (icp-cmd)
    (cpc-put-line my-cpc
      (format nil "~4A  ~A"
        (svref as-icp-cmd-vec icp-cmd)
        (svref help-icp-cmd-vec icp-cmd))))
  (values))

The output, taken straight from the dribble file:

Code: Select all

[] help
ad    Activate dribble
ao    Activate option(s)
db    Display board
dbm   Display board in monochrome
df    Display FEN
dg    Display game
dm    Display moves
do    Display options
dp    Display PGN
ef    Enter FEN
em    Enter move(s)
et    Enter PGN tag pair
exit  Exit the command processor
g     Go search and play move(s)
help  Helpful text display
lf    Load FEN
lp    Load PGN
ng    New game
noop  No operation
pd    Passivate dribble
po    Passivate option(s)
sf    Store FEN
sp    Store PGN
t     Test (development only)
tb    Take back move(s)

[sje]

More simple stuff, commands for saving the current FEN or the current PGN to a file:

Code: Select all

(defun icp-do-sf (my-cpc)
  "Handle the ICP sf command."
  (if (/= (cpc-cmdtknc my-cpc) 2)
    (icp-user-error my-cpc "Need exactly one save file pathname parameter")
    (let ((save-stream (open (second (cpc-cmdtkns my-cpc)) :direction :output)))
      (if (not save-stream)
        (icp-user-error my-cpc "Can't open save file for output")
        (progn
          (format save-stream "~A~%" (pos-string (cpc-pos my-cpc)))
          (close save-stream)))))
  (values))

(defun icp-do-sp (my-cpc)
  "Handle the ICP sp command."
  (if (/= (cpc-cmdtknc my-cpc) 2)
    (icp-user-error my-cpc "Need exactly one save file pathname parameter")
    (let ((save-stream (open (second (cpc-cmdtkns my-cpc)) :direction :output)))
      (if (not save-stream)
        (icp-user-error my-cpc "Can't open save file for output")
        (progn
          (format save-stream "~A~%" (pgn-string (cpc-pgn my-cpc)))
          (close save-stream)))))
  (values))