Skip to content

Instantly share code, notes, and snippets.

@greggirwin

greggirwin/inject.red

Last active May 14, 2020 10:59
Show Gist options
  • Save greggirwin/29836d25de0c68eaba0e6dbd268a20f5 to your computer and use it in GitHub Desktop.
Save greggirwin/29836d25de0c68eaba0e6dbd268a20f5 to your computer and use it in GitHub Desktop.
Download ZIP
INJECT func experiment. Alternative to REDUCE or COMPOSE.
Raw
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]
]
@hiiamboris
Copy link

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

@greggirwin
Copy link
Author

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

@greggirwin
Copy link
Author

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

@greggirwin
Copy link
Author

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

@hiiamboris
Copy link

hiiamboris commented May 9, 2020 •
edited
Loading

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.

@greggirwin
Copy link
Author

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.

@hiiamboris
Copy link

hiiamboris commented May 10, 2020 •
edited
Loading

  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.

@greggirwin
Copy link
Author

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.

@rebolek
Copy link

rebolek commented May 11, 2020

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

@greggirwin
Copy link
Author

Thanks Bolek!

@hiiamboris
Copy link

Thanks! build/with is very interesting

@hiiamboris
Copy link

hiiamboris commented May 11, 2020 •
edited
Loading

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

@greggirwin
Copy link
Author

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

@greggirwin
Copy link
Author

I deeply appreciate the time put into it. 👍

@greggirwin
Copy link
Author

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.

@hiiamboris
Copy link

hiiamboris commented May 14, 2020 •
edited
Loading

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 ;)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment