Skip to content

Instantly share code, notes, and snippets.

@hiiamboris

hiiamboris/benchcollect.red

Created May 19, 2018 16:46
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save hiiamboris/a624c3d767dfe4e4ed20f23bc96433ff to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save hiiamboris/a624c3d767dfe4e4ed20f23bc96433ff to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. hiiamboris created this gist May 19, 2018.
    71 changes: 71 additions & 0 deletions benchcollect.red
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,71 @@
    Red []

    ; outright improvement of collect mezzanine's performance and RAM footprint

    ; the compiled default "collect"
    collect1: :collect

    ; the interpreted default "collect"
    collect2: func spec-of :collect body-of :collect

    ; the improved, compilable "collect"
    ; 1) doesn't allocate new functions
    ; 2) uses `bind` instead of parse
    collect3: func [
    {Collect in a new block all the values passed to KEEP function from the body block}
    body [block!] "Block to evaluate"
    /into {Insert into a buffer instead (returns position after insert)}
    coll [series!] "The buffer series (modified)"
    ] bind [
    unless coll [coll: make block! 16]
    ; `also` here works like a stack
    body': also body' (
    body': body
    coll': also coll' (
    coll': coll
    shoot :keep coll
    ) )
    either into [coll] [head coll]
    ] context [ ; why not move this stuff out into an anonymous context?
    keep: func [v /only] [either only [append/only coll' v] [append coll' v] v]
    ; these two are here to satisfy the compiler, otherwise can be done by binding keep/shoot bodies to :collect3
    body': coll': none
    ; can't bind to a context [keep: collected: none] directly, since it will also bind `self` to it
    ; so here comes a func: `shoot` holds the 2 words used by body: `keep` and `collected`
    shoot: func [keep collected] [do bind body' 'keep]
    ]


    ;------------------ tests -------------------

    ; recursive invocation test
    foreach e [
    [collect1 [loop 4 [ keep collect1 [repeat i 4 [keep i probe collected]] probe collected ]]]
    [collect2 [loop 4 [ keep collect2 [repeat i 4 [keep i probe collected]] probe collected ]]]
    [collect3 [loop 4 [ keep collect3 [repeat i 4 [keep i probe collected]] probe collected ]]]
    ] [ print [mold e "=>" mold do e lf]]


    ; benchmark

    clock: func [b /local t1 t2 s1 s2 b' r] [
    b': copy/deep b
    s1: stats
    t1: now/precise/time
    r: loop 10000 [do b]
    t2: now/precise/time
    s2: stats
    print [pad (t2 - t1) 12 pad s2 - s1 8 mold/flat b' "=>" mold/flat r]
    ]


    n: 10
    print lf
    clock [collect1 [repeat i n [keep i]]]
    clock [collect2 [repeat i n [keep i]]]
    clock [collect3 [repeat i n [keep i]]]
    clock [collect1/into [repeat i n [keep i]] clear []]
    clock [collect2/into [repeat i n [keep i]] clear []]
    clock [collect3/into [repeat i n [keep i]] clear []]