1 ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo
\r
2 ! Cavazos, Slava Pestov.
\r
3 ! See http://factorcode.org/license.txt for BSD license.
\r
4 USING: kernel sequences sequences.private namespaces math math.ranges
\r
5 combinators macros quotations fry locals arrays ;
\r
8 MACRO: narray ( n -- quot )
\r
9 [ <reversed> ] [ '[ , f <array> ] ] bi
\r
10 [ '[ @ [ , swap set-nth-unsafe ] keep ] ] reduce ;
\r
12 MACRO: firstn ( n -- )
\r
13 dup zero? [ drop [ drop ] ] [
\r
14 [ [ '[ , _ nth-unsafe ] ] map ]
\r
15 [ 1- '[ , _ bounds-check 2drop ] ]
\r
16 bi prefix '[ , cleave ]
\r
19 MACRO: npick ( n -- )
\r
20 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;
\r
22 MACRO: ndup ( n -- )
\r
23 dup '[ , npick ] n*quot ;
\r
25 MACRO: nrot ( n -- )
\r
26 1- dup saver swap [ r> swap ] n*quot append ;
\r
28 MACRO: -nrot ( n -- )
\r
29 1- dup [ swap >r ] n*quot swap restorer append ;
\r
31 MACRO: ndrop ( n -- )
\r
35 swap >r ndrop r> ; inline
\r
37 MACRO: ntuck ( n -- )
\r
38 2 + [ dupd -nrot ] curry ;
\r
40 MACRO: nrev ( n -- quot )
\r
41 1 [a,b] [ '[ , -nrot ] ] map concat ;
\r
43 MACRO: ndip ( quot n -- )
\r
44 dup saver -rot restorer 3append ;
\r
46 MACRO: nslip ( n -- )
\r
47 dup saver [ call ] rot restorer 3append ;
\r
49 MACRO: nkeep ( n -- )
\r
51 '[ [ , ndup ] dip , -nrot , nslip ] ;
\r
53 MACRO: ncurry ( n -- ) [ curry ] n*quot ;
\r
55 MACRO:: nwith ( quot n -- )
\r
56 [let | n' [ n 1+ ] |
\r
57 [ n' -nrot [ n' nrot quot call ] n ncurry ] ] ;
\r
59 MACRO: napply ( n -- )
\r
61 [ [ 1- ] keep '[ , ntuck , nslip ] ]
\r
62 map concat >quotation [ call ] append ;
\r