Hello,
The other day, I shared an implementation of subset which used a
"static stack" and did it's own iteration. A nice thing about the
stock subset is that it uses each to do it's iteration; the guideline
of code reuse is observed. So let's see if we can start with something
like the stock subset and refactor it.
----------------------------------------------------------------------
: push-if ( elt quot accum -- )
>r keep r> rot [ push ] [ 2drop ] if ; inline
: subset ( seq quot -- subseq )
over >r over length pick new-resizable rot
[ -rot [ push-if ] 2keep ] each
nip r> like ; inline
----------------------------------------------------------------------
The idea behind the factoring subset is to name each part that does
something, and to have a couple of focal words that tie everything
together.
Upon analyzing subset, a problem is immediately encountered. A copy of
'seq' is saved so that at the end the accumulator can be converted
back to the 'seq' type. It would be nice to name this step
'subset-save-seq'. The code that does this is:
over >r
However, that isn't factorable into a word because >r isn't balanced
by r>. So there's a lesson here about "factorability", >r and r>.
Anyways, there are two ways to proceed. We can work around this
problem by saving a copy of the seq on the datastack. Or we can allow
this wart into one of our focal words. First, let's try the first option.
----------------------------------------------------------------------
: subset-match? ( seq accum pred elt -- seq accum pred elt ? )
4 ndup >r >r >r >r rot drop rot drop swap call r> r> r> r> 5 nrot ; inline
: subset-yes ( seq accum pred elt -- seq accum pred ) pick push ; inline
: subset-no ( seq accum pred elt -- seq accum pred ) drop ; inline
: subset-inner ( seq accum pred elt -- seq accum pred )
subset-match? [ subset-yes ] [ subset-no ] if ; inline
----------------------------------------------------------------------
: subset-done ( seq accum pred -- subseq ) drop swap like ; inline
: subset-run ( seq accum pred seq -- seq accum pred )
[ subset-inner ] each ; inline
: subset-accum ( seq -- accum ) dup length swap new-resizable ; inline
: subset-setup ( seq pred -- seq accum pred seq )
>r dup subset-accum r> pick ; inline
: alt-subset ( seq pred -- subseq )
subset-setup subset-run subset-done ; inline
----------------------------------------------------------------------
The focal words are:
alt-subset
subset-run
subset-inner
A good focal word contains no shuffle words. To understand what's
happening, it's good to start with those first.
This version of alt-subset has decent performance, but is a bit slower
than the stock subset. One reason is that since we are keeping the saved
copy of seq on the stack, we have to work to save it in each step
of the 'each' iteration. We can save it on the retain stack, but then we
introduce the un-factorable wart back into our program. Let's pay the
price and see what we get.
----------------------------------------------------------------------
: subset-match? ( accum pred elt -- accum pred elt ? )
3dup >r >r >r rot drop swap call r> r> r> 4 nrot ; inline
: subset-yes ( accum pred elt -- accum pred ) pick push ; inline
: subset-no ( accum pred elt -- accum pred ) drop ; inline
: subset-inner ( accum pred elt -- accum pred )
subset-match? [ subset-yes ] [ subset-no ] if ; inline
----------------------------------------------------------------------
: subset-done ( accum pred seq -- subseq ) nip like ; inline
: subset-run ( accum pred seq -- accum pred ) [ subset-inner ] each ; inline
: subset-accum ( seq -- accum ) dup length swap new-resizable ; inline
: subset-setup ( seq pred -- accum pred seq )
swap dup subset-accum -rot ; inline
: alt-subset ( seq pred -- subseq )
over >r subset-setup subset-run r> subset-done ; inline
----------------------------------------------------------------------
The warts (>r and r>) show up in our alt-subset focal word.
We paid the price so what's our prize? This version is just as fast as
the stock subset and according to my timings is on average faster.
Ed
-------------------------------------------------------------------------
This SF.net email is sponsored by DB2 Express
Download DB2 Express C - the FREE version of DB2 express and take
control of your XML. No limits. Just data. Click to get it now.
http://sourceforge.net/powerbar/db2/
_______________________________________________
Factor-talk mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/factor-talk
