[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 02/02: [gnugo int] Remove abstraction: continue-on
From: |
Thien-Thi Nguyen |
Subject: |
[elpa] 02/02: [gnugo int] Remove abstraction: continue-on |
Date: |
Fri, 04 Apr 2014 10:45:39 +0000 |
ttn pushed a commit to branch master
in repository elpa.
commit c5636ba76ca0a103c0c3d6d3ff524ef826b7b705
Author: Thien-Thi Nguyen <address@hidden>
Date: Fri Apr 4 12:17:29 2014 +0200
[gnugo int] Remove abstraction: continue-on
* packages/gnugo/gnugo.el (gnugo-note): ...here, inlining it.
---
packages/gnugo/gnugo.el | 89 ++++++++++++++++++++++-------------------------
1 files changed, 42 insertions(+), 47 deletions(-)
diff --git a/packages/gnugo/gnugo.el b/packages/gnugo/gnugo.el
index ca8042a..c271f8e 100644
--- a/packages/gnugo/gnugo.el
+++ b/packages/gnugo/gnugo.el
@@ -953,53 +953,48 @@ are dimmed. The buffer is in View minor mode."
;; X---Y---A new
;; \
;; --B old
- (cl-flet
- ((continue-on (bx)
- (rotatef (aref tree bidx)
- (aref tree bx))))
- (loop
- with count = (length tree)
- with (bx previous)
- for i
- ;; Start with latest / highest likelihood for hit.
- ;; todo: prune unfeasible candidates
- from (if (gnugo--no-regrets monkey tree)
- 1
- 0)
- below count
- if (setq bx (mod (+ bidx i) count)
- previous
- ;; todo: early termination based on move number
- (loop for m on (aref tree bx)
- if (eq mem (cdr m))
- return
- (when (equal pair (assoc property (car m)))
- m)
- finally return
- nil))
- ;; yes => follow
- return
- (progn
- ;; (message "déjà-vu! %d follows %d" bidx bx)
- (unless (= bidx bx)
- (continue-on bx))
- (setq mem previous))
- ;; no => construct
- finally do
- (progn
- ;; (message "new %d" bidx)
- (unless (gnugo--no-regrets monkey tree)
- ;; <grumble grumble> SGF sez "move" node in the root
- ;; position of a (sub-)gametree is "bad style". :-/
- (let ((where (memq tree (gnugo-get :sgf-collection))))
- (setq tree (let ((ls (append tree nil)))
- ;; copy old to the right of new
- (push mem (nthcdr bidx ls))
- (apply 'vector ls)))
- (gnugo-put :sgf-gametree tree)
- (setcar where tree)))
- (push fruit mem)
- (aset tree bidx mem))))
+ (loop
+ with count = (length tree)
+ with (bx previous)
+ for i
+ ;; Start with latest / highest likelihood for hit.
+ ;; todo: prune unfeasible candidates
+ from (if (gnugo--no-regrets monkey tree)
+ 1
+ 0)
+ below count
+ if (setq bx (mod (+ bidx i) count)
+ previous
+ ;; todo: early termination based on move number
+ (loop for m on (aref tree bx)
+ if (eq mem (cdr m))
+ return
+ (when (equal pair (assoc property (car m)))
+ m)
+ finally return
+ nil))
+ ;; yes => follow
+ return
+ (progn
+ (unless (= bidx bx)
+ (rotatef (aref tree bidx)
+ (aref tree bx)))
+ (setq mem previous))
+ ;; no => construct
+ finally do
+ (progn
+ (unless (gnugo--no-regrets monkey tree)
+ ;; <grumble grumble> SGF sez "move" node in the root
+ ;; position of a (sub-)gametree is "bad style". :-/
+ (let ((where (memq tree (gnugo-get :sgf-collection))))
+ (setq tree (let ((ls (append tree nil)))
+ ;; copy old to the right of new
+ (push mem (nthcdr bidx ls))
+ (apply 'vector ls)))
+ (gnugo-put :sgf-gametree tree)
+ (setcar where tree)))
+ (push fruit mem)
+ (aset tree bidx mem)))
(setf (aref monkey 0) mem)
(incf (aref monkey 2)))
(setcdr (last (car mem)) fruit))))