1 ! Copyright (C) 2007, 2009 Chris Double, Doug Coleman, Eduardo
2 ! Cavazos, Slava Pestov.
3 ! See http://factorcode.org/license.txt for BSD license.
4 USING: kernel sequences sequences.private math combinators
5 macros quotations fry effects ;
10 : n*quot ( n quot -- quot' ) <repetition> concat >quotation ;
12 : repeat ( n obj quot -- ) swapd times ; inline
16 MACRO: nsequence ( n seq -- )
18 [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
19 [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
23 MACRO: narray ( n -- )
24 '[ _ { } nsequence ] ;
29 MACRO: firstn-unsafe ( n -- )
30 [ '[ [ _ ] dip nth-unsafe ] ] map '[ _ cleave ] ;
32 MACRO: firstn ( n -- )
33 dup zero? [ drop [ drop ] ] [
34 [ 1- swap bounds-check 2drop ]
40 1- [ dup ] [ '[ _ dip swap ] ] repeat ;
43 dup '[ _ npick ] n*quot ;
46 1- [ ] [ '[ _ dip swap ] ] repeat ;
49 1- [ ] [ '[ swap _ dip ] ] repeat ;
55 '[ [ _ ndrop ] dip ] ;
58 2 + '[ dup _ -nrot ] ;
60 MACRO: ndip ( quot n -- )
61 [ '[ _ dip ] ] times ;
63 MACRO: nkeep ( quot n -- )
64 tuck '[ _ ndup _ _ ndip ] ;
66 MACRO: ncurry ( n -- )
72 MACRO: ncleave ( quots n -- )
73 [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
76 MACRO: nspread ( quots n -- )
77 over empty? [ 2drop [ ] ] [
81 '[ [ _ _ nspread ] _ ndip @ ]
84 MACRO: napply ( quot n -- )
85 swap <repetition> spread>quot ;
87 MACRO: mnswap ( m n -- )
88 1+ '[ _ -nrot ] swap '[ _ _ napply ] ;
90 MACRO: nweave ( n -- )
91 [ dup <reversed> [ '[ _ _ mnswap ] ] with map ] keep
94 : nappend-as ( n exemplar -- seq )
95 [ narray concat ] dip like ; inline
97 : nappend ( n -- seq ) narray concat ; inline