refactor so that generalizations reuses the stub versions of nsequence, firstn, and n*quot needed by memoize
parent
63842c7dc9
commit
b150deeb11
|
@ -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 ] }
|
||||
|
|
|
@ -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 ] ] [
|
||||
|
|
|
@ -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 <=
|
||||
|
|
Loading…
Reference in New Issue