Merge branch 'master' into new_ui
commit
d305cb897b
|
@ -15,6 +15,8 @@ USING: tools.test math arrays kernel sequences ;
|
|||
[ { { 1 } } ]
|
||||
[ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
|
||||
|
||||
[ { 1 } [ = ] slice monotonic-slice ] must-infer
|
||||
|
||||
[ t ]
|
||||
[ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test
|
||||
|
||||
|
|
|
@ -24,13 +24,15 @@ PRIVATE>
|
|||
<PRIVATE
|
||||
|
||||
: (monotonic-slice) ( seq quot class -- slices )
|
||||
-rot
|
||||
[
|
||||
dupd '[
|
||||
[ length ] [ ] [ <circular> 1 over change-circular-start ] tri
|
||||
[ @ not [ , ] [ drop ] if ] 3each
|
||||
] { } make
|
||||
dup empty? [ over length 1- prefix ] when -1 prefix 2 clump
|
||||
[ first2 [ 1+ ] bi@ rot roll boa ] with with map ; inline
|
||||
swap
|
||||
] dip
|
||||
'[ first2 [ 1+ ] bi@ _ _ boa ] map ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -39,7 +41,7 @@ PRIVATE>
|
|||
{ 0 [ 2drop ] }
|
||||
{ 1 [ nip [ 0 1 rot ] dip boa 1array ] }
|
||||
[ drop (monotonic-slice) ]
|
||||
} case ;
|
||||
} case ; inline
|
||||
|
||||
TUPLE: downward-slice < slice ;
|
||||
TUPLE: stable-slice < slice ;
|
||||
|
|
|
@ -34,6 +34,7 @@ ARTICLE: "defining-words" "Defining words"
|
|||
{ $see POSTPONE: SYMBOL: }
|
||||
"The key factor in the definition of " { $link POSTPONE: SYMBOL: } " is " { $link CREATE } ", which reads a token from the input and creates a word with that name. This word is then passed to " { $link define-symbol } "."
|
||||
{ $subsection CREATE }
|
||||
{ $subsection CREATE-WORD }
|
||||
"Colon definitions are defined in a more elaborate way:"
|
||||
{ $subsection POSTPONE: : }
|
||||
"The " { $link POSTPONE: : } " word first calls " { $link CREATE } ", and then reads input until reaching " { $link POSTPONE: ; } " using a utility word:"
|
||||
|
|
|
@ -338,6 +338,10 @@ HELP: 2each
|
|||
{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- )" } } }
|
||||
{ $description "Applies the quotation to pairs of elements from " { $snippet "seq1" } " and " { $snippet "seq2" } "." } ;
|
||||
|
||||
HELP: 3each
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- )" } } }
|
||||
{ $description "Applies the quotation to triples of elements from " { $snippet "seq1" } ", " { $snippet "seq2" } " and " { $snippet "seq3" } "." } ;
|
||||
|
||||
HELP: 2reduce
|
||||
{ $values { "seq1" sequence }
|
||||
{ "seq2" sequence }
|
||||
|
@ -350,10 +354,18 @@ HELP: 2map
|
|||
{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- new )" } } { "newseq" "a new sequence" } }
|
||||
{ $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." } ;
|
||||
|
||||
HELP: 3map
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- new )" } } { "newseq" "a new sequence" } }
|
||||
{ $description "Applies the quotation to each triple of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." } ;
|
||||
|
||||
HELP: 2map-as
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } }
|
||||
{ $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "exemplar" } "." } ;
|
||||
|
||||
HELP: 3map-as
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } }
|
||||
{ $description "Applies the quotation to each triple of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "exemplar" } "." } ;
|
||||
|
||||
HELP: 2all?
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- ? )" } } { "?" "a boolean" } }
|
||||
{ $description "Tests the predicate pairwise against elements of " { $snippet "seq1" } " and " { $snippet "seq2" } "." } ;
|
||||
|
@ -1262,6 +1274,17 @@ HELP: shorten
|
|||
"V{ 1 2 3 }"
|
||||
} } ;
|
||||
|
||||
HELP: iota
|
||||
{ $values { "n" integer } { "iota" iota } }
|
||||
{ $description "Creates an immutable virtual sequence containing the integers from 0 to " { $snippet "n-1" } "." }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: math sequences prettyprint ;"
|
||||
"3 iota [ sq ] map ."
|
||||
"{ 0 1 4 }"
|
||||
}
|
||||
} ;
|
||||
|
||||
ARTICLE: "sequences-unsafe" "Unsafe sequence operations"
|
||||
"The " { $link nth-unsafe } " and " { $link set-nth-unsafe } " sequence protocol bypasses bounds checks for increased performance."
|
||||
$nl
|
||||
|
@ -1422,16 +1445,23 @@ ARTICLE: "sequences-combinators" "Sequence combinators"
|
|||
{ $subsection all? }
|
||||
"Testing how elements are related:"
|
||||
{ $subsection monotonic? }
|
||||
{ $subsection "sequence-2combinators" } ;
|
||||
{ $subsection "sequence-2combinators" }
|
||||
{ $subsection "sequence-3combinators" } ;
|
||||
|
||||
ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators"
|
||||
"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined."
|
||||
"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, then only the prefix having the length of the minimum of the two is examined."
|
||||
{ $subsection 2each }
|
||||
{ $subsection 2reduce }
|
||||
{ $subsection 2map }
|
||||
{ $subsection 2map-as }
|
||||
{ $subsection 2all? } ;
|
||||
|
||||
ARTICLE: "sequence-3combinators" "Triple-wise sequence combinators"
|
||||
"There is a set of combinators which traverse three sequences triple-wise. If one sequence is shorter than the others, then only the prefix having the length of the minimum of the three is examined."
|
||||
{ $subsection 3each }
|
||||
{ $subsection 3map }
|
||||
{ $subsection 3map-as } ;
|
||||
|
||||
ARTICLE: "sequences-tests" "Testing sequences"
|
||||
"Testing for an empty sequence:"
|
||||
{ $subsection empty? }
|
||||
|
|
|
@ -277,3 +277,7 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ;
|
|||
{ 3 0 } [ [ 3drop ] 3each ] must-infer-as
|
||||
|
||||
[ V{ 0 3 } ] [ "A" { "A" "B" "C" "A" "D" } indices ] unit-test
|
||||
|
||||
[ "asdf" iota ] must-fail
|
||||
[ T{ iota { n 10 } } ] [ 10 iota ] unit-test
|
||||
[ 0 ] [ 10 iota first ] unit-test
|
||||
|
|
|
@ -101,6 +101,20 @@ M: integer nth-unsafe drop ;
|
|||
|
||||
INSTANCE: integer immutable-sequence
|
||||
|
||||
PRIVATE>
|
||||
|
||||
! In the future, this will replace integer sequences
|
||||
TUPLE: iota { n integer read-only } ;
|
||||
|
||||
: iota ( n -- iota ) \ iota boa ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
M: iota length n>> ;
|
||||
M: iota nth-unsafe drop ;
|
||||
|
||||
INSTANCE: iota immutable-sequence
|
||||
|
||||
: first-unsafe ( seq -- first )
|
||||
0 swap nth-unsafe ; inline
|
||||
|
||||
|
|
|
@ -20,7 +20,8 @@ ABOUT: "sequences-sorting"
|
|||
|
||||
HELP: sort
|
||||
{ $values { "seq" "a sequence" } { "quot" { $quotation "( obj1 obj2 -- <=> )" } } { "sortedseq" "a new sorted sequence" } }
|
||||
{ $description "Sorts the elements into a new array." } ;
|
||||
{ $description "Sorts the elements into a new array using a stable sort." }
|
||||
{ $notes "The algorithm used is the merge sort." } ;
|
||||
|
||||
HELP: sort-keys
|
||||
{ $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } }
|
||||
|
|
Loading…
Reference in New Issue