Pass indexes to ARRAY/initial function

When calling ARRAY/initial with a function used to generate the values,
pass the current index at the position the function is being called for,
with each index in a block of sizes provided to create a multidimensional
array being provided as a separate parameter to the function in the order
specified in the sizes block. Uses APPLY so the function can optionally
not take the parameters. Uses an internal function option for efficiency.

See http://issue.cc/r3/2193 for details.

Author: BrianHawley

src/mezz/mezz-series.r

@@ -85,24 +85,39 @@ array: func [
 	size [integer! block!] "Size or block of sizes for each dimension"
 	/initial "Specify an initial value for all elements"
 	value "Initial value (will be called each time if a function)"
-	/local block rest
+	/local block rest word
+	/with tag indexes  ; Token to ensure internal use, and block of index expressions
 ][
+	unless same? :tag 'tag [with: tag: indexes: none]  ; Enforced internal option
 	if block? size [
+		if all [not with any-function? :value] [  ; Make indexes to pass to function
+			indexes: append/dup make block! 2 * length? size [index? block] length? size
+		]
 		if tail? rest: next size [rest: none]
 		unless integer? set/any 'size first size [
 			cause-error 'script 'expect-arg reduce ['array 'size type? :size]
 		]
 	]
 	block: make block! size
 	case [
-		block? rest [
-			loop size [block: insert/only block array/initial rest :value]
+		block? :rest [
+			either any-function? :value [  ; Must construct params to pass to function
+				word: in make object! copy [x: block] 'x  ; Make a persistent word for this level
+				indexes: change next indexes word  ; Put that word in the params block
+				loop size [  ; Pass indexes block to recursive call, at that level's position
+					set word insert/only get word array/initial/with rest :value 'tag indexes
+				]
+				block: get word
+			] [  ; Regular value, no parameter handling needed
+				loop size [block: insert/only block array/initial rest :value]
+			]
 		]
 		series? :value [
 			loop size [block: insert/only block copy/deep value]
 		]
-		any-function? :value [ ; So value can be a thunk :)
-			loop size [block: insert/only block value] ; Called every time
+		any-function? :value [
+			unless indexes [indexes: [index? block]]  ; Single dimension, single index
+			loop size [block: insert/only block apply :value head indexes]
 		]
 		insert/dup block value size
 	]
@@ -421,7 +436,7 @@ printf: func [
 split: func [
 	"Split a series into pieces; fixed or variable size, fixed number, or at delimiters"
 	series	[series!] "The series to split"
-	dlm		[block! integer! char! bitset! any-string!] "Split size, delimiter(s), or rule(s)." 
+	dlm		[block! integer! char! bitset! any-string!] "Split size, delimiter(s), or rule(s)."
 	/into	"If dlm is an integer, split into n pieces, rather than pieces of length n."
 	/local size piece-size count mk1 mk2 res fill-val add-fill-val
 ][
@@ -480,7 +495,7 @@ split: func [
 				; implied empty field after it, which we add here.
 				case [
 					bitset? dlm [
-						; ATTEMPT is here because LAST will return NONE for an 
+						; ATTEMPT is here because LAST will return NONE for an
 						; empty series, and finding none in a bitest is not allowed.
 						if attempt [find dlm last series] [add-fill-val]
 					]
@@ -496,7 +511,7 @@ split: func [
 				]
 			]
 		]
-				
+
 		res
 	]
 ]