Skip to content

Instantly share code, notes, and snippets.

@greggirwin
Last active April 28, 2016 16:19
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save greggirwin/fd6e17f706431e06772a303e6d234568 to your computer and use it in GitHub Desktop.
Save greggirwin/fd6e17f706431e06772a303e6d234568 to your computer and use it in GitHub Desktop.
divisible?: func [a b] [0 = remainder a b]
; This doesn't work like R3 in how negative widths work.
forskip: func [
"Evaluates a block at regular intervals in a series."
'word [word!] "Word referring to the series to traverse (modified)"
width [integer!] "Interval size (width of each skip)"
body [block!] "Body to evaluate at each position"
/local orig result op
][
either zero? width [none] [
; TBD: assert word refs series
; Store original position in series, so we can restore it.
orig: get word
; What is our "reached the end" test?
op: either positive? width [:tail?] [:head?]
if all [negative? width tail? get word] [
; We got a negative width, so we're going backwards,
; and we're at the tail. That means we want to step
; back one interval to find the start of the first
; "record".
set word skip get word width
]
; When we hit the end, restore the word to the original position.
while [any [not op get word (set word orig false)]] [
set/any 'result do body
set word skip get word width
get/any 'result
]
if all [
negative? width
divisible? subtract index? orig 1 width
;?? check orig = get word for BREAK support?
] [
; We got a negative width, so we're going backwards,
; and the above WHILE loop ended before processing
; the element at the head of the series. Plus we reset
; the word to its original position, *and* we would
; have landed right on the head. Because of all that,
; we want to process the head element.
set word head get word
set/any 'result do body
set word orig
]
get/any 'result
]
]
;tbb: back tb: tail blk: [1 2 3 4 5 6]
;forskip blk 2 [print mold blk]
;forskip tb -2 [print mold tb]
;forskip tbb -2 [print mold tbb]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment