INJECT func experiment. Alternative to REDUCE or COMPOSE.

inject.red

Red [
	name: 'inject
	file: %inject.red
	author: "Gregg Irwin"
	notes: {
		Red version of Ladislav Mecir's R2 `build` func. I can't find his on
		the net, to link to, but can post his original if desired. His point
		was that `compose` isn't always easy to use, when parens are part of
		block you're composing, or how your blocks are structured, whether you
		can use `/only` with `compose`. e.g.
	
		Given:		
			a: [block a]

		Wanting:
			[[[block a] (f: fail) | (f: none)] f]

		Compose:	
			compose/deep [[(reduce [a]) ([(f: fail) | (f: none)])] f]

		Build:
			build [[only a (f: fail) | (f: none)] f]


		The idea is great, but too often I forget about it. Part of the reason
		was that I had my own `build` func, which did something very different.
		So I'm reviving it for Red, and thinking about names. It may not be as
		important in Red, as we have the `quote` function, which let's you not
		compose a given paren. For example:
		
		>> compose/deep [[(reduce [a]) (quote (f: fail)) | (quote (f: none))] f]
		== [[[block a] (f: fail) | (f: none)] f]
		
		Still not great.

		Possible names, in order of my personal preference:
		
			inject place inset embed inlay sub-in fabricate implant prefab 
			cut-in introduce incorporate combine blend meld alloy

			compound admix fuse intermix integrate synthesize amalgamate
			
		I like `inject` with the caveat that it may appear to deal with 
		Dependency Injection, or a Smalltalk-like fold func to the uninitiated.
		`Inset` is a good word, but very close to `insert`, which is a concern.
		Both allow blocks as their first argument, which may make mistakes less
		obvious. The other problem with `inject` as a name is that it implies
		more that it's changing the series in place, not producing a new one.

		Once we have the function name, we also need the keywords. `Build` used
		`insert` and `only` which were very clear choices for their behavior.
		The escape mechanism was to use `only`.
		
			build [only 'only only 'insert] ; == [only insert]
		
		Those keywords may be common, which is what makes them clear. But it may
		also make them hide in plain sight. Also, the expressions are evaluated.
		Should we use words that have a clue about that? What about a base 
		keyword with an `/only` "refinement". Longer though. That rules out using
		issue! values...or does it?
		
			>> parse [#insert/only] [#insert /only]
			== true

		Currently, email! will keep the path part, but a new ref! type may change
		things.
		
			>> parse [@/only] [@/only]
			== true

		Should we have a default, but let them pass in a keyword of their own?
		No. At least not in v1.
			
		[@ @/only #-- do get /only do_ get_  /do /get  __  __/only]
	}
]

admix: function [
	"Builds a block, like COMPOSE, but using 'only and 'insert rather than parens."
	input [block! paren!]
	/local value
][
	; TBD: consider copying/deep the input and using parse `change`.
	collect/into [
		parse :input [								; use get-word! as input may be a paren!
			any [
				set op ['insert | 'only] position: (
					set/any 'value do/next :position 'position
					if value? 'value [
						either op = 'only [keep/only :value][keep :value]
					]
				) :position
				| set value [block! | paren!] (keep/only admix :value)
				| set value skip (if value? 'value [keep/only :value])
			]
		]
	] make :input length? :input					; so we return a paren if given one
]

inject: function [
	"Modifies a block, using 'only and 'insert keywords"
	input [block! paren!] "(modified)"
	;/local value
][
	parse :input rule: [							; use get-word! as input may be a paren!
		any [
			;!! Unset results appear in the output using this approach
			change ['insert pos: any-type!] (do/next :pos 'pos) :pos
			| change only ['only pos: any-type!] (do/next :pos 'pos) :pos
			| ahead [block! | paren!] into rule
			| skip
		]
	]
	:input
]

inject-x: function [
	"Modifies a block, using 'only and 'insert keywords"
	input [block! paren!] "(modified)"
	/local value
][
	parse :input rule: [							; use get-word! as input may be a paren!
		any [
			;!! Unset results DO NOT appear in the output using this approach
			set op s: ['insert | 'only] pos: (
				set/any 'value do/next :pos 'pos
				pos: either value? 'value [
					either op = 'only [change/only/part s :value 2][change/part s :value 2]
				][remove/part s 2]
			) :pos
			| ahead [block! | paren!] into rule
			| skip
		]
	]
	:input
]


e.g.: :comment

e.g. [
	a: [block a]
	inject [[only a (f: fail) | (f: none)] f]		;== [[[block a] (f: fail) | (f: none)] f]
	inject [[insert a (f: fail) | (f: none)] f]		;== [[block a (f: fail) | (f: none)] f]
	inject first [([insert a (f: fail) | (f: none)] f)]
	inject [only 'only only 'insert]
	; paths needn't be escaped
	inject [insert/only] ; == [insert/only]
	; to escape a whole subblock, i.e. to prevent BUILD to modify it do
	inject [only [insert only]] ; == [[insert only]]
	; to escape a whole paren! i.e. to forbid BUILD to modify it do
	inject [insert [(insert only)]] ; == [(insert only)]

	;inject [[#only a (f: fail) | (f: none)] f]
	;inject [[#insert a (f: fail) | (f: none)] f]
	;
	;inject [[#set a (f: fail) | (f: none)] f]
	;inject [[#set-only a (f: fail) | (f: none)] f]
	;
	;inject [[ONLY a (f: fail) | (f: none)] f]
	;inject [[/only a (f: fail) | (f: none)] f]
	;inject [[INSERT a (f: fail) | (f: none)] f]
	;inject [[/insert a (f: fail) | (f: none)] f]

	; only> only-> only_>
	;inject [[only> a (f: fail) | (f: none)] f]
	;inject [[insert> a (f: fail) | (f: none)] f]
]

; Can we make sensical short keywords/markers? The thought here is that we
; already have `inject` as the func name, then we use `insert`, which is
; kind of redundant.

; (insert)	#_ 	  #___         #here 
; (only) 	#__   #|_|   #._.  #only

; Not a real macro approach of course, just uses #keywords to look like one.
inject-mac: function [
	"Modifies a block, using #only and #insert keywords"
	input [block! paren!] "(modified)"
	/any "Insert unset values, rather than omitting them"
	/local value
][
	;!! Watch all the `any` uses here. There's parse usage and also a refinement
	;!!	that means we have to use `system/words/any` in action logic.
	parse :input rule: [							; use get-word! as input may be a paren!
		any [
			;!! Unset results DO NOT appear in the output by default.
			;!!	You have to use /any to force them in.
			set op s: [#insert | #only] pos: (
				set/any 'value do/next :pos 'pos
				; Check for `/any` refinement here, which forces an `change`.
				; If that's not used, unset values cause a `remove`.
				pos: either system/words/any [any  value? 'value] [
					either op = #only [change/only/part s :value 2][change/part s :value 2]
				][remove/part s 2]
			) :pos
			| ahead [block! | paren!] into rule
			| skip
		]
	]
	:input
]

e.g.: :comment

e.g. [
	a: [block a]
	inject-mac [[#only a (f: fail) | (f: none)] f]			;== [[[block a] (f: fail) | (f: none)] f]
	inject-mac [[#insert a (f: fail) | (f: none)] f]		;== [[block a (f: fail) | (f: none)] f]
	inject-mac [[#insert () (f: fail) | (f: none)] f]		;== [[(f: fail) | (f: none)] f]
	inject-mac [[#only () (f: fail) | (f: none)] f]			;== [[(f: fail) | (f: none)] f]
	inject-mac/any [[#insert () (f: fail) | (f: none)] f]	;== [[unset block a (f: fail) | (f: none)] f]
	inject-mac/any [[#only () (f: fail) | (f: none)] f]		;== [[unset block a (f: fail) | (f: none)] f]
	inject-mac first [([#insert a (f: fail) | (f: none)] f)]
	inject-mac [#only 'only #only 'insert]
	; paths needn't be escaped
	inject-mac [insert/only] ; == [insert/only]
	; to escape a whole subblock, i.e. to prevent BUILD to modify it do
	inject-mac [#only [insert only]] ; == [[insert only]]
	; to escape a whole paren! i.e. to forbid BUILD to modify it do
	inject-mac [#insert [(insert only)]] ; == [(insert only)]

	;inject [[#only a (f: fail) | (f: none)] f]
	;inject [[#insert a (f: fail) | (f: none)] f]
	;
	;inject [[#set a (f: fail) | (f: none)] f]
	;inject [[#set-only a (f: fail) | (f: none)] f]
	;
	;inject [[ONLY a (f: fail) | (f: none)] f]
	;inject [[/only a (f: fail) | (f: none)] f]
	;inject [[INSERT a (f: fail) | (f: none)] f]
	;inject [[/insert a (f: fail) | (f: none)] f]

	; only> only-> only_>
	;inject [[only> a (f: fail) | (f: none)] f]
	;inject [[insert> a (f: fail) | (f: none)] f]
]

Line 93 - shouldn't admix call admix instead of inject? Doesn't make sense to copy the outer block while modifying the inner ones

Almost certainly a mistake while playing with names. Good catch.

Changed. No admix examples, so won't know if there's a regression. :^\

If we revisit these in earnest, we can address that.

I have troubles with do/next approach as well.
Consider compose [(a) + 1 - (b)]. inject [(insert a) + 1 - (insert b)] leaves parens [(..) + 1 - (..)] which is an extra overhead at best, totally different expression at worst (because who knows how many tokens a and b might have.

Certainly not enough examples here, showing that I haven't thought about real world use. So let's ask 1) is this a fun thought experiment, and an example for others to learn from, about new approaches, or 2) could it be useful enough to be standard in Red, providing enough value beyond compose? If that's the case, we need to come up with more examples, worst case abuses, and tricky reasoning traps. I'm not concerned about extra parens yet though. ;^)

I remember Carl saying that he thought compose was a bad idea initially when Sterling or Jeff proposed it.

1. absolutely
2. not covering my needs in for-each and map-each, so I'm working on a better one

The beauty of compose is that:

• it requires only parens to designate the expression - it is minimalistic and readable (until we are starting to work around it)
• parens being double-sided, allow to visibly distinguish the expression parts from the rest

I don't think it can be beaten, but we can learn from it's best qualities, while lifting off restrictions.

Indeed. Something I think I've mentioned in the past, to the team if not @dockimbel directly, is that quote, while an historical match for Lisp devs, might be better named lit or literal. I have, as many do I'm sure, old enquote/dequote funcs (wrapping their more general cousins that take the end-cap values as args), but quote/unquote are equally valid names.

Coincidentally, I have original on Github: https://gist.github.com/rebolek/edb7ba63bbaddde099cb3b1fd95c2d2c

Thanks Bolek!

Thanks! build/with is very interesting

Here's some deep code construction cases from for-each and map-each. All four variants do the same things. Compose variant is working, everything else is just how I see it - not tested. Tell me what variant is less atrocious ☻

Tip: variant 4 is supposed to be line-oriented (delimited with newline markers)

Compose	Ladislav	Boris 1	Boris 2
end-cond: compose either range? [ length: either integer? series [s][s/x * s/y] [index + (ahead - 1) > (length)] ][ [index + (ahead - 1) > length? s] ] upd-idx: [] if index-word [ upd-idx: case [ set-word? index-word ['where] not image? series ['index] 'image [ compose [int2pair index (series/size/x)] ] ] upd-idx: reduce [to set-word! index-word upd-idx] ] refill: compose pick [ [fill-int-range where index (length)] [fill-pair-range where index (series)] ] integer? series prefix: pick [ old: [] ] filtered? spec-fill: compose/deep pick [ [set [(spec)] (prefix) where] [ (refill when range?) foreach [(spec)] (prefix) where [break] ] ] yes = find set-able! type? series test: [] if filtered? [ type-check: [types-match? old types] values-check: [values-match? old values values-mask :val-cmp-op] test: compose [ (type-check when use-types?) (values-check when use-values?) ] if all [use-types? use-values?] [ test: compose/deep [all [(test)]] ] test: compose [unless (test) [continue]] ] move-idxs: compose [ ([where: at series] when not range?) index: (step) + index ] advance: does compose/deep [ while [not (end-cond)] [ old: where (move-idxs) (test when filtered?) return old ] none ] do compose/deep [ set/any 'r forever [ if (end-cond) [break/return :r] (upd-idx) (spec-fill) (move-idxs) (test) set/any 'r do code ] ] get-pos: compose pick [ [(index-word)] [at series (index-word)] ] set-word? spec/1 call: as path! compose [for-each ('case when case) ('same when same)] do-code: compose pick [ [ either block? set/any 'r (as paren! code) [r: reduce r][:r] ] [ (as paren! code) ] ] eval do compose/deep pick [ [ old-advance: none new-advance: does [new: any [r: old-advance tail series]] do-once: func [b [block!]] [do b clear b] (call) [(spec)] old: series [ do-once [old-advance: :advance advance: :new-advance] new: (get-pos) unless old =? new [append tgt copy/part old new] old: new (keep) (do-code) old: skip new (size) ] unless empty? old [append tgt copy old] ] [ (call) [(spec)] old: series [(keep) (do-code)] ] ] not drop	end-cond: build/with [ index + !ahead-1 > !length ;-- can't use `ins` here! ][ !ahead-1: ahead - 1 !length: either range? [ either integer? s [s][s/x * s/y] ][ [length? s] ] ] upd-idx: build/with [ :!set-index :!index ][ !set-index: !index: [] if index-word [ !set-index: to set-word! index-word !index: case [ set-word? index-word ['where] not image? series ['index] 'image [build [int2pair index ins series/size/x]] ] ] refill: build/with [ !fill-range where index !limit ][ !fill-range: pick [fill-int-range fill-pair-range] integer? series !limit: either integer? series [length][series] ] spec-fill: build/with [ :?refill !set !spec :?prefix where :!break ][ !spec: spec ?refill: either range? [refill][[]] ?prefix: pick [old: []] filtered? !set: 'set !break: [] if find set-able! type? series [ !set: 'foreach !break: [[break]] ] ] test: either filtered? [ build/with [ unless :!test [continue] ][ !test: build/with [ :!type-check :!values-check ][ !type-check: pick [ [types-match? old types] [] ] use-types? !values-check: pick [ [values-match? old values values-mask :val-cmp-op] [] ] use-values? ] if all [use-types? use-values?] [ !test: build [all only !test] ] ] ][ [] ] move-idxs: build/with [ :?where index: !step + index ][ ?where: pick [[where: at series] []] not range? !step: step ] advance: does build/with [ while [not ins end-cond] [ old: where ins move-idxs ?test return old ] none ][ ?test: either filtered? [test][[]] ] do build [ set/any 'r forever [ if ins end-cond [break/return :r] ins upd-idx ins spec-fill ins move-idxs ins test set/any 'r do code ] ] get-pos: build/with [ :?at-series ins index-word ][ ?at-series: pick [[] [at series]] set-word? spec/1 ] call: as path! build/with [ for-each :?case :?same ][ ?case: pick [case []] case ?same: pick [same []] same ] do-code: build [ ins [either block? set/any 'r] when eval only as paren! code ins [[r: reduce r][:r]] when eval ] do build/with pick [ [ old-advance: none new-advance: does [new: any [r: old-advance tail series]] do-once: func [b [block!]] [do b clear b] !call !spec old: series [ do-once [old-advance: :advance advance: :new-advance] new: ins get-pos unless old =? new [append tgt copy/part old new] old: new :!keep :!do-code old: skip new ins size ] unless empty? old [append tgt copy old] ] [ !call !spec old: series [:!keep :!do-code] ] ] not drop [ !call: call !spec: spec !keep: keep !do-code: do-code ]	end-cond: build [ index + !(ahead - 1) > range? => !(length: either integer? s [s][s/x * s/y]) || length? s ] upd-idx: build [ index-word => !(to set-word! index-word) (set-word? index-word) => where || (not image? series) => index || int2pair index !(series/size/x) ] refill: build [ (int?: integer? series) => fill-int-range where index !(length) => fill-pair-range where index !(series) ] prefix: [ filtered? => old: ] spec-fill: [ range? => @(refill) . (find set-able! type? series) => set !(spec) @(prefix) where || foreach !(spec) @(prefix) where [break] ] test: build [ filtered? => /do (test: [ use-values? => types-match? old types . use-types? => values-match? old values values-mask :val-cmp-op ]) unless (all [use-types? use-values?]) => all !(test) || @(test) . [continue] ] move-idxs: build [ (not range?) => where: at series . index: !(step) + index ] advance: does build [ while [not @(end-cond)] [ old: where @(move-idxs) filtered? => @(test) . return old ] none ] do build [ set/any 'r forever [ if @(end-cond) [break/return :r] @(upd-idx) @(spec-fill) @(move-idxs) @(test) set/any 'r do code ] ] get-pos: build [ (not set-word? spec/1) => at series . !(index-word) ] call: as path! build [for-each case => case . same => same] do-code: build [ eval => either block? set/any 'r . !(as paren! code) eval => [r: reduce r][:r] . ] do build pick [ [ old-advance: none new-advance: does [new: any [r: old-advance tail series]] do-once: func [b [block!]] [do b clear b] !(call) !(spec) old: series [ do-once [old-advance: :advance advance: :new-advance] new: @(get-pos) unless old =? new [append tgt copy/part old new] old: new @(keep) @(do-code) old: skip new !(size) ] unless empty? old [append tgt copy old] ] [ !(call) !(spec) old: series [@(keep) @(do-code)] ] ] not drop	end-cond: build [ index + !(ahead - 1) > !(length) /if range? /do length: either integer? s [s][s/x * s/y] length? s /if not range? ] upd-idx: build [ /if index-word !(set-index) /do set-index: to set-word! index-word where /if sw?: set-word? index-word index /else /if not img?: image? series int2pair index !(series/size/x) /else ] refill: build [ fill-int-range where index !(length) /if int?: integer? series fill-pair-range where index !(series) /else ] prefix: [ old: /if filtered? ] spec-fill: [ @(refill) /if range? set !(spec) @(prefix) where /if setable?: find set-able! type? series foreach !(spec) @(prefix) where [break] /else ] test: build [ /if filtered? /do test: [ types-match? old types /if use-values? values-match? old values values-mask :val-cmp-op /if use-types? ] unless all !(test) /if all [use-types? use-values?] @(test) /else [continue] ] move-idxs: build [ where: at series /if not range? index: !(step) + index ] advance: does build [ while [not @(end-cond)] [ old: where @(move-idxs) @(test) /if filtered? return old ] none ] do build [ set/any 'r forever [ if @(end-cond) [break/return :r] @(upd-idx) @(spec-fill) @(move-idxs) @(test) set/any 'r do code ] ] get-pos: build [ at series /if not set-word? spec/1 !(index-word) ] call: as path! build [ for-each case /if case same /if same ] do-code: build [ either block? set/any 'r /if eval !(as paren! code) [r: reduce r][:r] /if eval ] do build pick [ [ old-advance: none new-advance: does [new: any [r: old-advance tail series]] do-once: func [b [block!]] [do b clear b] !(call) !(spec) old: series [ do-once [old-advance: :advance advance: :new-advance] new: @(get-pos) unless old =? new [append tgt copy/part old new] old: new @(keep) @(do-code) old: skip new !(size) ] unless empty? old [append tgt copy old] ] [ !(call) !(spec) old: series [@(keep) @(do-code)] ] ] not drop

Have to figure out how to view all of them at once. Horz scrolling in the browser makes comparison painful.

I deeply appreciate the time put into it. 👍

Reading through, without context, the various indirections, and the original use case for the function itself, make it hard to visualize. That is, where are parens being passed through to the result? Having not looked at build/with beyond a glance when Bolek posted, I have to get my head in that space as well. Also have to look up your when func it seems.

when: make op! func [value test] [either :test [:value][[]]]
A common thing when including code conditionally. Ideally it shouldn't be used in comparison as makes compose look better than it usually is ;) But I just copy/pasted it from real code.

That is, where are parens being passed through to the result?

This case study is mostly about deeply built code, not a show of how ugly parens become within compose. I'll write a wiki soon, to go with the implementation (I chose 4th).

Horz scrolling in the browser makes comparison painful.

Tip: click on the wheel ;)