Fix (for :within-radius ... :origin ... :skip-origin t) and add tests
author |
Steve Losh <steve@stevelosh.com> |
date |
Wed, 01 Dec 2021 23:43:54 -0500 |
parents |
a1be2be82e9d
|
children |
0d62d291dfb1
95393d6a5226
|
branches/tags |
(none) |
files |
src/iterate.lisp test/iterate.lisp |
Changes
--- a/src/iterate.lisp Wed Dec 01 20:52:30 2021 -0500
+++ b/src/iterate.lisp Wed Dec 01 23:43:54 2021 -0500
@@ -518,6 +518,9 @@
; the point it is works in arbitrary dimensions.
"
+ ;; TODO rewrite this as bare `for`s without all the generator cruft to avoid
+ ;; the bullshit SBCL `deleting unreachable code` garbage we get every time
+ ;; skip-origin is true.
(let* ((delta-vars (ensure-list delta-vars))
(origin-vars (mapcar (lambda (dv) (gensym (mkstr 'origin- dv)))
delta-vars))
@@ -539,7 +542,8 @@
`((with ,skip = ,should-skip-origin)
(when (and ,skip
,@(iterate (for var :in (ensure-list delta-vars))
- (collect `(zerop ,var))))
+ (for ovar :in origin-vars)
+ (collect `(= ,ovar ,var))))
(next ,control))))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/iterate.lisp Wed Dec 01 23:43:54 2021 -0500
@@ -0,0 +1,39 @@
+(in-package :losh.test)
+
+
+(define-test within-radius
+ (is (equal '(-1 0 1) (iterate (for (x) :within-radius 1) (collect x))))
+ (is (equal '(-1 1) (iterate (for (x) :within-radius 1 :skip-origin t) (collect x))))
+ (is (equal '(9 10 11) (iterate (for (x) :within-radius 1 :origin (10)) (collect x))))
+ (is (equal '(9 11) (iterate (for (x) :within-radius 1 :skip-origin t :origin (10)) (collect x))))
+
+ (is (equal '((-1 -1) (-1 0) (-1 1) (0 -1) (0 0) (0 1) (1 -1) (1 0) (1 1))
+ (iterate (for (x y) :within-radius 1) (collect (list x y)))))
+
+ (is (equal '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1))
+ (iterate (for (x y) :within-radius 1 :skip-origin t)
+ (collect (list x y)))))
+
+ (is (equal '((9 99) (9 100) (9 101) (10 99) (10 101) (11 99) (11 100) (11 101))
+ (iterate (for (x y) :within-radius 1 :skip-origin t :origin (10 100))
+ (collect (list x y)))))
+
+ (is (equal '((8 98) (8 99) (8 100) (8 101) (8 102)
+ (9 98) (9 99) (9 100) (9 101) (9 102)
+ (10 98) (10 99) (10 101) (10 102)
+ (11 98) (11 99) (11 100) (11 101) (11 102)
+ (12 98) (12 99) (12 100) (12 101) (12 102))
+ (iterate (for (x y) :within-radius 2 :skip-origin t :origin (10 100))
+ (collect (list x y)))))
+
+ (is (equal '((9 99 999) (9 99 1000) (9 99 1001)
+ (9 100 999) (9 100 1000) (9 100 1001)
+ (9 101 999) (9 101 1000) (9 101 1001)
+ (10 99 999) (10 99 1000) (10 99 1001)
+ (10 100 999) (10 100 1001)
+ (10 101 999) (10 101 1000) (10 101 1001)
+ (11 99 999) (11 99 1000) (11 99 1001)
+ (11 100 999) (11 100 1000) (11 100 1001)
+ (11 101 999) (11 101 1000) (11 101 1001))
+ (iterate (for (x y z) :within-radius 1 :skip-origin t :origin (10 100 1000))
+ (collect (list x y z))))))