[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/gnugo 7647c9c 062/357: [gnugo int] Avoid redundant cal
From: |
Stefan Monnier |
Subject: |
[elpa] externals/gnugo 7647c9c 062/357: [gnugo int] Avoid redundant calls to ‘gnugo-get’. |
Date: |
Sun, 29 Nov 2020 14:50:48 -0500 (EST) |
branch: externals/gnugo
commit 7647c9cf9cb520fccf5ffd8971788657c1e4b00f
Author: Thien-Thi Nguyen <ttn@gnu.org>
Commit: Thien-Thi Nguyen <ttn@gnu.org>
[gnugo int] Avoid redundant calls to ‘gnugo-get’.
* packages/gnugo/gnugo.el (gnugo-move-history):
(gnugo-read-sgf-file, gnugo-magic-undo, gnugo-display-final-score)
(gnugo-board-mode): Add local vars to save ‘gnugo-get’ values.
---
gnugo.el | 170 +++++++++++++++++++++++++++++++++------------------------------
1 file changed, 90 insertions(+), 80 deletions(-)
diff --git a/gnugo.el b/gnugo.el
index f9bac18..a6c8594 100644
--- a/gnugo.el
+++ b/gnugo.el
@@ -630,8 +630,10 @@ For all other values of RSEL, do nothing and return nil."
(interactive "P")
(let ((size (gnugo-treeroot :SZ))
col
- (mem (aref (gnugo-get :monkey) 1))
+ monkey mem
acc node mprop move)
+ (setq monkey (gnugo-get :monkey)
+ mem (aref monkey 1))
(cl-labels
((as-pos (cc) (if (string= "tt" cc)
"PASS"
@@ -657,7 +659,7 @@ For all other values of RSEL, do nothing and return nil."
(`nil (finish nil))
(`car (car (next nil)))
(`cadr (next nil) (car (next nil)))
- (`count (aref (gnugo-get :monkey) 2))
+ (`count (aref monkey 2))
(_ nil)))))
(defun gnugo-boss-is-near ()
@@ -1269,7 +1271,7 @@ If FILENAME already exists, Emacs confirms that you wish
to overwrite it."
(interactive "fSGF file to load: ")
(when (file-directory-p filename)
(user-error "Cannot load a directory (try a filename with extension
.sgf)"))
- (let (ans play wait samep coll)
+ (let (ans play wait samep coll tree)
;; problem: requiring GTP `loadsgf' complicates network subproc support;
;; todo: skip it altogether when confident about `gnugo/sgf-read-file'
(unless (= ?= (aref (setq ans (gnugo--q "loadsgf %s"
@@ -1283,26 +1285,26 @@ If FILENAME already exists, Emacs confirms that you
wish to overwrite it."
(unless samep
(gnugo-put :gnugo-color wait)
(gnugo-put :user-color play))
- (gnugo-put :sgf-collection (setq coll (gnugo/sgf-read-file filename)))
- (gnugo-put :sgf-gametree
- (nth (let ((n (length coll)))
- ;; This is better:
- ;; (if (= 1 n)
- ;; 0
- ;; (let* ((q (format "Which game? (1-%d)" n))
- ;; (choice (1- (read-number q 1))))
- ;; (if (and (< -1 choice) (< choice n))
- ;; choice
- ;; (message "(Selecting the first game)")
- ;; 0)))
- ;; but this is what we use (for now) to accomodate
- ;; (aka faithfully mimic) GTP `loadsgf' limitations:
- (unless (= 1 n)
- (message "(Selecting the first game)"))
- 0)
- coll))
- (let* ((tree (gnugo-get :sgf-gametree))
- (loc tree)
+ (setq coll (gnugo/sgf-read-file filename)
+ tree (nth (let ((n (length coll)))
+ ;; This is better:
+ ;; (if (= 1 n)
+ ;; 0
+ ;; (let* ((q (format "Which game? (1-%d)" n))
+ ;; (choice (1- (read-number q 1))))
+ ;; (if (and (< -1 choice) (< choice n))
+ ;; choice
+ ;; (message "(Selecting the first game)")
+ ;; 0)))
+ ;; but this is what we use (for now) to accomodate
+ ;; (aka faithfully mimic) GTP `loadsgf' limitations:
+ (unless (= 1 n)
+ (message "(Selecting the first game)"))
+ 0)
+ coll))
+ (gnugo-put :sgf-collection coll)
+ (gnugo-put :sgf-gametree tree)
+ (let* ((loc tree)
(count 0)
mem node play game-over)
(while (setq node (car loc))
@@ -1329,7 +1331,7 @@ If FILENAME already exists, Emacs confirms that you wish
to overwrite it."
'(car cadr))))
'two-passes))))
(gnugo-put :monkey
- (vector (or (car mem) (gnugo-get :sgf-gametree))
+ (vector (or (car mem) tree)
mem
count))
(when (and game-over
@@ -1361,6 +1363,7 @@ After undoing the move(s), schedule a move by GNU Go if
it is GNU Go's
turn to play. Optional second arg NOALT non-nil inhibits this."
(gnugo-gate)
(let* ((n 0)
+ (user-color (gnugo-get :user-color))
(monkey (gnugo-get :monkey))
(mem (aref monkey 1))
(count (aref monkey 2))
@@ -1374,14 +1377,13 @@ turn to play. Optional second arg NOALT non-nil
inhibits this."
(memq (char-after) '(?. ?+))))
(when (funcall done)
(user-error "%s already clear" pos))
- (let ((u (gnugo-get :user-color)))
- (when (= (save-excursion
- (gnugo-goto-pos pos)
- (char-after))
- (if (string= "black" u)
- ?O
- ?X))
- (user-error "%s not occupied by %s" pos u)))))
+ (when (= (save-excursion
+ (gnugo-goto-pos pos)
+ (char-after))
+ (if (string= "black" user-color)
+ ?O
+ ?X))
+ (user-error "%s not occupied by %s" pos user-color))))
(t (user-error "Bad spec: %S" spec)))
(when (gnugo-get :game-over)
(gnugo--unclose-game))
@@ -1396,18 +1398,18 @@ turn to play. Optional second arg NOALT non-nil
inhibits this."
(gnugo-merge-showboard-results) ; all
(gnugo-refresh) ; this
(decf n) ; is
- (redisplay))) ; eye candy
- (let* ((ulastp (string= (gnugo-get :last-mover) (gnugo-get :user-color)))
-
- (ubpos (gnugo-move-history (if ulastp 'car 'cadr))))
- (gnugo-put :last-user-bpos (if (and ubpos (not (string= "PASS" ubpos)))
- ubpos
- (gnugo-get :center-position)))
- (gnugo-refresh t)
- ;; preserve restricted-functionality semantics (todo: remove restriction)
- (setcdr (aref (gnugo-get :monkey) 0) nil)
- (when (and ulastp (not noalt))
- (gnugo-get-move (gnugo-get :gnugo-color)))))
+ (redisplay)) ; eye candy
+ (let* ((ulastp (string= (gnugo-get :last-mover) user-color))
+
+ (ubpos (gnugo-move-history (if ulastp 'car 'cadr))))
+ (gnugo-put :last-user-bpos (if (and ubpos (not (string= "PASS" ubpos)))
+ ubpos
+ (gnugo-get :center-position)))
+ (gnugo-refresh t)
+ ;; preserve restricted-functionality semantics (todo: remove restriction)
+ (setcdr (aref monkey 0) nil)
+ (when (and ulastp (not noalt))
+ (gnugo-get-move (gnugo-get :gnugo-color))))))
(defun gnugo-undo-one-move ()
"Undo exactly one move (perhaps GNU Go's, perhaps yours).
@@ -1434,21 +1436,22 @@ If the game is still ongoing, Emacs asks if you wish to
stop play (by
making sure two \"pass\" moves are played consecutively, if necessary).
Also, add the `:RE' SGF property to the root node of the game tree."
(interactive)
- (unless (or (gnugo-get :game-over)
- (and (not (gnugo-get :waitingp))
- (y-or-n-p "Game still in play. Stop play now? ")))
- (user-error "Sorry, game still in play"))
- (unless (gnugo-get :game-over)
- (cl-labels
- ((pass (userp)
- (message "Playing PASS for %s ..."
- (gnugo-get (if userp :user-color :gnugo-color)))
- (sit-for 1)
- (gnugo-push-move userp "PASS")))
- (unless (pass t)
- (pass nil)))
- (gnugo-refresh)
- (sit-for 3))
+ (let ((game-over (gnugo-get :game-over)))
+ (unless (or game-over
+ (and (not (gnugo-get :waitingp))
+ (y-or-n-p "Game still in play. Stop play now? ")))
+ (user-error "Sorry, game still in play"))
+ (unless game-over
+ (cl-labels
+ ((pass (userp)
+ (message "Playing PASS for %s ..."
+ (gnugo-get (if userp :user-color :gnugo-color)))
+ (sit-for 1)
+ (gnugo-push-move userp "PASS")))
+ (unless (pass t)
+ (pass nil)))
+ (gnugo-refresh)
+ (sit-for 3)))
(let ((b= " Black = ")
(w= " White = ")
(res (let* ((node (car (aref (gnugo-get :monkey) 0)))
@@ -1466,8 +1469,9 @@ Also, add the `:RE' SGF property to the root node of the
game tree."
result (concat (upcase (substring (gnugo-other res) 0 1))
"+Resign"))
(message "Computing final score ...")
- (let* ((live (cdr (assq 'live (gnugo-get :game-over))))
- (dead (cdr (assq 'dead (gnugo-get :game-over))))
+ (let* ((g-over (gnugo-get :game-over))
+ (live (cdr (assq 'live g-over)))
+ (dead (cdr (assq 'dead g-over)))
(seed (gnugo-get :scoring-seed))
(terr-q (format "final_status_list %%s_territory %d" seed))
(terr "territory")
@@ -1521,14 +1525,18 @@ Also, add the `:RE' SGF property to the root node of
the game tree."
blurb)
(message "Computing final score ... done")))
;; extra info
- (when (gnugo-get :game-end-time)
- (push "\n" blurb)
- (dolist (spec '(("Game start" . :game-start-time)
- (" end" . :game-end-time)))
- (push (format-time-string
- (concat (car spec) ": %Y-%m-%d %H:%M:%S %z\n")
- (gnugo-get (cdr spec)))
- blurb)))
+ (let ((beg (gnugo-get :game-start-time))
+ (end (gnugo-get :game-end-time)))
+ (when end
+ (push "\n" blurb)
+ (cl-labels
+ ((yep (pretty moment)
+ (push (format-time-string
+ (concat pretty ": %Y-%m-%d %H:%M:%S %z\n")
+ moment)
+ blurb)))
+ (yep "Game start" beg)
+ (yep " end" end))))
(setq blurb (apply 'concat (nreverse blurb)))
(let* ((root (car (gnugo-get :sgf-gametree)))
(cur (assq :RE root)))
@@ -1701,6 +1709,7 @@ In this mode, keys do not self insert.
(car gnugo-option-history)
'gnugo-option-history))
(rules "Japanese")
+ proc
board-size user-color handicap komi minus-l infile)
(dolist (x '((board-size 19 "--boardsize")
(user-color "black" "--color" "\\(black\\|white\\)")
@@ -1721,30 +1730,33 @@ In this mode, keys do not self insert.
(setq rules "Chinese"))
(let ((proc-args (split-string args)))
(gnugo-put :proc-args proc-args)
- (gnugo-put :proc (apply 'start-process "gnugo" nil name
- "--mode" "gtp" "--quiet"
- proc-args)))
+ (gnugo-put :proc (setq proc (apply 'start-process "gnugo"
+ nil name
+ "--mode" "gtp" "--quiet"
+ proc-args))))
+ (set-process-sentinel proc 'gnugo-sentinel)
+ (set-process-buffer proc (current-buffer))
;; Emacs is too protective sometimes, blech.
- (set-process-query-on-exit-flag (gnugo-get :proc) nil)
+ (set-process-query-on-exit-flag proc nil)
(when (or minus-l infile)
(dolist (x '((board-size "query_boardsize")
(komi "get_komi")
(handicap "get_handicap")))
(destructuring-bind (prop q) x
(set prop (string-to-number (gnugo-query q))))))
- (gnugo-put :diamond (substring (process-name (gnugo-get :proc)) 5))
- (gnugo-put :gnugo-color (gnugo-other (gnugo-get :user-color)))
+ (gnugo-put :diamond (substring (process-name proc) 5))
+ (gnugo-put :gnugo-color (gnugo-other user-color))
(gnugo-put :highlight-last-move-spec
(gnugo-put :default-highlight-last-move-spec '("(" -1 nil)))
(gnugo-put :lparen-ov (make-overlay 1 1))
(gnugo-put :rparen-ov (let ((ov (make-overlay 1 1)))
(overlay-put ov 'display ")")
ov))
- (gnugo-put :sgf-gametree (list (list '(:FF . 4) '(:GM . 1))))
- (let ((tree (gnugo-get :sgf-gametree)))
+ (let ((tree (list (list '(:FF . 4) '(:GM . 1)))))
+ (gnugo-put :sgf-gametree tree)
(gnugo-put :sgf-collection (list tree))
(gnugo-put :monkey (vector tree nil 0)))
- (let ((g-blackp (string= "black" (gnugo-get :gnugo-color))))
+ (let ((g-blackp (string= "white" user-color)))
(mapc (lambda (x) (apply 'gnugo-note x))
`((:SZ ,board-size)
(:DT ,(format-time-string "%Y-%m-%d"))
@@ -1758,8 +1770,6 @@ In this mode, keys do not self insert.
`((:HA ,handicap)
(:AB ,(gnugo-lsquery "fixed_handicap %d" handicap)
nil t)))))))
- (set-process-sentinel (gnugo-get :proc) 'gnugo-sentinel)
- (set-process-buffer (gnugo-get :proc) (current-buffer))
(gnugo-put :waiting-start (current-time))
(gnugo-put :hmul 1)
(gnugo-put :wmul 1)
- [elpa] externals/gnugo 7f961b7 016/357: [gnugo maint] Update "next" in HACKING; nfc., (continued)
- [elpa] externals/gnugo 7f961b7 016/357: [gnugo maint] Update "next" in HACKING; nfc., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo f84b823 018/357: [gnugo maint] Update a musing item in HACKING; nfc., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 0838a13 021/357: [gnugo gtp int] Use :post-thunk instead of :post-hook., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo e16a8d5 031/357: [gnugo int] Add abstraction: gnugo--unclose-game, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 28da1b4 035/357: [gnugo int] Use ‘dolist’ and ‘destructuring-bind’., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 08b2a66 017/357: [gnugo] Indicate buffer not modified after save., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 9893ff1 027/357: [gnugo int] Hang the sync-return-stash on the process object., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo b8b8763 037/357: [gnugo maint] Update "next" in HACKING; nfc., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo a4b96a1 024/357: [gnugo int] Use ‘number-sequence’ more., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 402bf68 039/357: [gnugo] Don't show underscore in group-animation message., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 7647c9c 062/357: [gnugo int] Avoid redundant calls to ‘gnugo-get’.,
Stefan Monnier <=
- [elpa] externals/gnugo fef1847 040/357: [gnugo] Use special constructs for keybindings in docstrings., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 5c8f31d 043/357: [gnugo maint] Update HACKING; nfc., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 2d4c9ad 046/357: [gnugo] New command: ‘_’ and ‘M-_’ (gnugo-boss-is-near), Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 02c55b7 054/357: [gnugo] Release: 2.3.1, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo c479509 044/357: [gnugo] Bind ‘DEL’ to ‘gnugo-undo-two-moves’., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 9748703 060/357: [gnugo int] Elide single-use local var., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 6573d16 065/357: [gnugo int] Add abstraction: gnugo--compare-strings, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo a949e26 071/357: [gnugo int] Rename arg from SWITCH to ME-NEXT., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 558d778 072/357: [gnugo] Fix bug: Handle property value type ‘none’ normally., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 9469952 075/357: fixup! [gnugo sgf] Move gratuitous newline from after to before (sub)trees., Stefan Monnier, 2020/11/29