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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/alien/parser/parser.factor
View File

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

11
basis/generalizations/generalizations.factor
View File

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

16
basis/memoize/memoize.factor
View File

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