refactor so that generalizations reuses the stub versions of nsequence, firstn, and n*quot needed by memoize

db4
Joe Groff 2009-10-08 12:55:52 -05:00
parent 63842c7dc9
commit b150deeb11
3 changed files with 13 additions and 16 deletions

View File

@ -10,7 +10,7 @@ IN: alien.parser
: parse-c-type-name ( name -- word )
dup search [ nip ] [ no-word ] if* ;
: parse-c-type ( string -- array )
: parse-c-type ( string -- type )
{
{ [ dup "void" = ] [ drop void ] }
{ [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] }

View File

@ -2,22 +2,19 @@
! Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences sequences.private math combinators
macros quotations fry effects ;
macros quotations fry effects memoize.private ;
IN: generalizations
<<
: n*quot ( n quot -- quot' ) <repetition> concat >quotation ;
ALIAS: n*quot (n*quot)
: repeat ( n obj quot -- ) swapd times ; inline
>>
MACRO: nsequence ( n seq -- )
[
[ drop iota <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
[ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
] keep
[ [nsequence] ] keep
'[ @ _ like ] ;
MACRO: narray ( n -- )
@ -27,7 +24,7 @@ MACRO: nsum ( n -- )
1 - [ + ] n*quot ;
MACRO: firstn-unsafe ( n -- )
iota [ '[ [ _ ] dip nth-unsafe ] ] map '[ _ cleave ] ;
[firstn] ;
MACRO: firstn ( n -- )
dup zero? [ drop [ drop ] ] [

View File

@ -1,8 +1,8 @@
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel hashtables sequences arrays words namespaces make
parser math assocs effects definitions quotations summary
accessors fry ;
USING: kernel hashtables sequences sequences.private arrays
words namespaces make parser math assocs effects definitions
quotations summary accessors fry ;
IN: memoize
<PRIVATE
@ -12,20 +12,20 @@ IN: memoize
: (n*quot) ( n quot -- quotquot )
<repetition> concat >quotation ;
: [narray] ( length -- quot )
[ [ 1 - ] keep '[ _ _ f <array> ] ]
[ [ [ set-nth ] 2keep [ 1 - ] dip ] (n*quot) ] bi
: [nsequence] ( length exemplar -- quot )
[ [ [ 1 - ] keep ] dip '[ _ _ _ new-sequence ] ]
[ drop [ [ set-nth-unsafe ] 2keep [ 1 - ] dip ] (n*quot) ] 2bi
[ nip ] 3append ;
: [firstn] ( length -- quot )
[ 0 swap ] swap
[ [ nth ] 2keep [ 1 + ] dip ] (n*quot)
[ [ nth-unsafe ] 2keep [ 1 + ] dip ] (n*quot)
[ 2drop ] 3append ;
: packer ( seq -- quot )
length dup 4 <=
[ { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ]
[ [narray] ] if ;
[ { } [nsequence] ] if ;
: unpacker ( seq -- quot )
length dup 4 <=