steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

shatter the four-argument barrier in memoize

db4
Joe Groff 2009-10-08 12:24:07 -05:00
parent 1bb8a99368
commit 27c5ab9cc3
3 changed files with 36 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/memoize/memoize-docs.factor
View File

@ -19,12 +19,10 @@ ABOUT: "memoize"
HELP: define-memoized
{ $values { "word" word } { "quot" quotation } { "effect" effect } }
{ $description "defines the given word at runtime as one which memoizes its output given a particular input" }
{ $notes "A maximum of four input and four output arguments can be used" }
{ $see-also POSTPONE: MEMO: } ;
{ $description "Defines the given word at run time as one which memoizes its outputs given a particular input." } ;
HELP: MEMO:
{ $syntax "MEMO: word ( stack -- effect ) definition ;" }
{ $description "defines the given word at parsetime as one which memoizes its output given a particular input. The stack effect is mandatory." }
{ $notes "A maximum of four input and four output arguments can be used" }
{ $see-also define-memoized } ;
{ $description "Defines the given word at parse time as one which memoizes its output given a particular input. The stack effect is mandatory." } ;
{ define-memoized POSTPONE: MEMO: } related-words

11
basis/memoize/memoize-tests.factor
View File

@ -7,9 +7,18 @@ IN: memoize.tests
MEMO: fib ( m -- n )
dup 1 <= [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ;
MEMO: x ( a b c d e -- f g h i j )
[ 1 + ] 4 ndip ;
[ 89 ] [ 10 fib ] unit-test
[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1 + ] 4 ndip ;" eval( -- ) ] must-fail
[
1 0 0 0 0
1 0 0 0 0
] [
0 0 0 0 0 x
0 0 0 0 0 x
] unit-test
MEMO: see-test ( a -- b ) reverse ;

34
basis/memoize/memoize.factor
View File

@ -5,18 +5,32 @@ parser math assocs effects definitions quotations summary
accessors fry ;
IN: memoize
ERROR: too-many-arguments ;
M: too-many-arguments summary
drop "There must be no more than 4 input and 4 output arguments" ;
<PRIVATE
! We can't use n*quot, narray and firstn from generalizations because
! they're macros, and macros use memoize!
: (n*quot) ( n quot -- quotquot )
<repetition> concat >quotation ;
: [narray] ( length -- quot )
[ [ 1 - ] keep '[ _ _ f <array> ] ]
[ [ [ set-nth ] 2keep [ 1 - ] dip ] (n*quot) ] bi
[ nip ] 3append ;
: [firstn] ( length -- quot )
[ 0 swap ] swap
[ [ nth ] 2keep [ 1 + ] dip ] (n*quot)
[ 2drop ] 3append ;
: packer ( seq -- quot )
length { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
length dup 4 <=
[ { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ]
[ [narray] ] if ;
: unpacker ( seq -- quot )
length { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
length dup 4 <=
[ { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ]
[ [firstn] ] if ;
: pack/unpack ( quot effect -- newquot )
[ in>> packer ] [ out>> unpacker ] bi surround ;
@ -24,11 +38,7 @@ M: too-many-arguments summary
: unpack/pack ( quot effect -- newquot )
[ in>> unpacker ] [ out>> packer ] bi surround ;
: check-memoized ( effect -- )
[ in>> ] [ out>> ] bi [ length 4 > ] either? [ too-many-arguments ] when ;
: make-memoizer ( table quot effect -- quot )
[ check-memoized ] keep
[ unpack/pack '[ _ _ cache ] ] keep
pack/unpack ;
@ -62,4 +72,4 @@ M: memoized reset-word
: invalidate-memoized ( inputs... word -- )
[ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;
\ invalidate-memoized t "no-compile" set-word-prop
\ invalidate-memoized t "no-compile" set-word-prop