A `delimit` function for Red.

delimit.red

; 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 ;<<< !! This may be a remnant of older implementations !!
		]
		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
	]
]

; Do we want to use a lit-word! arg here. I know they make things look
; clean for the user, but they also make it a pain to use expressions.
incr: function [
	"Increments a value or series index."
	'word [word!] "Must refer to a number or series value"
	/by "Change by this amount"
		value
][
	op: either series? get word [:skip] [:add]
	set word op get word any [value 1]
]

rejoin: function [data][
    collect/into [
        foreach value reduce data [keep value]
    ] copy ""
]

; This could also be done by adding a /SKIP refinement to INSERT.
delimit: func [
	;[throw catch]
	"Insert a delimiter between series values."
	series [series!] "(modified)"
	delim "The delimiter to insert between items"
	/skip "Treat the series as fixed size records" ; Overrides system/words/skip
		size [integer!] ;"The number of items between delimiters (default is 1)"
][
	; By default, delimiters go between each item.
	; MAX catches zero and negative sizes.
	size: max 1 any [size 1]
	; If we aren't going to insert any delimiters, return the series.
	if size + 1 > length? series [return series]
	; We don't want a delimiter at the beginning.
	incr/by series size
	; Use size+n because we're inserting a delimiter on each pass,
	; and need to skip over that as well. If we're inserting a
	; series into a string, we have to skip the length of that
	; series. i.e. the delimiter value is more than a single item
	; we need to skip.
	incr/by size any [
		all [any-string? series  series? delim  length? delim]
		all [any-string? series  length? form delim]
		1
	]
	forskip series size [
		insert/only series either series? delim [copy delim] [delim]
	]
	;?? Do we want to do this, restore to the original series pos,
	;   or something else? e.g. what if we added a /part refinment?
	head series
]

make-csv: func [block] [rejoin delimit copy block #","]
make-csv ['name 'rank 'serial-number]

make-parse-OR: func [block] [delimit copy block '|]
make-parse-OR [yes no maybe]

comment {
	; empty series and delimiter
	print mold delimit "" ""
	; empty series
	print mold delimit "" ","
	; empty delimiter
	print mold delimit "123" ""
	; delimiter same length as series
	print mold delimit "123" "..."
	; delimiter longer than series
	print mold delimit "123" "......"
	; delimiter same as series
	x: "x" print mold delimit x x
	; skip size longer than series
	print mold delimit/skip "12345" #"," 10
	; skip size same as series length
	print mold delimit/skip "12345" #"," 5
	; skip size same as series length - 1
	print mold delimit/skip "12345" #"," 4
	; skip size of zero
	print mold delimit/skip "12345" #"," 0

	print mold delimit "12345" #","
	print mold delimit/skip "12345" #"," 1
	print mold delimit/skip "12345" #"," 2
	print mold delimit/skip "12345" #"," 3
	print mold delimit/skip "123456" #"," 3
	print mold delimit/skip "1234567" "..." 3
	print mold delimit "1234567" [a b]
	print mold delimit/skip "1234567" [a b] 3
	print mold delimit [a b c d e f] '|
	print mold delimit/skip [a b c d e f] '| 2
	print mold delimit [a b c d e f] none
	;print mold delimit [a b c d e f] print 'x  ; can't use unset as a delimiter
	print mold delimit [a b c d e f] [1 2]
	print mold delimit [a b c d e f] "12"

	print mold delimit make list! [a b c d e f] '|

	print mold delimit [a b c d e f] does [1]

	; trim decimals for this to be generalized
	fmt-int: func [str [string!]] [
		if 3 >= length? str [return str]
		reverse delimit/skip reverse str #"," 3
	]
	print mold fmt-int "123456789"
	print mold fmt-int "12345678"
	print mold fmt-int "1234567"
	print mold fmt-int "123456"
	print mold fmt-int "12345"
	print mold fmt-int "1234"
	print mold fmt-int "123"
	print mold fmt-int "12"
	print mold fmt-int "1"
	print mold fmt-int ""
}