Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
dfc3c2cc78
basis/io/launcher
core/sequences
|
|
@ -58,8 +58,6 @@ SYMBOL: +realtime-priority+
|
|||
! Non-blocking process exit notification facility
|
||||
SYMBOL: processes
|
||||
|
||||
[ H{ } clone processes set-global ] "io.launcher" add-init-hook
|
||||
|
||||
HOOK: wait-for-processes io-backend ( -- ? )
|
||||
|
||||
SYMBOL: wait-flag
|
||||
|
|
@ -73,7 +71,10 @@ SYMBOL: wait-flag
|
|||
<flag> wait-flag set-global
|
||||
[ wait-loop t ] "Process wait" spawn-server drop ;
|
||||
|
||||
[ start-wait-thread ] "io.launcher" add-init-hook
|
||||
[
|
||||
H{ } clone processes set-global
|
||||
start-wait-thread
|
||||
] "io.launcher" add-init-hook
|
||||
|
||||
: process-started ( process handle -- )
|
||||
>>handle
|
||||
|
|
|
|||
|
|
@ -397,6 +397,11 @@ HELP: filter
|
|||
{ $values { "seq" sequence } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "subseq" "a new sequence" } }
|
||||
{ $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ;
|
||||
|
||||
HELP: filter-here
|
||||
{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "subseq" "a new sequence" } }
|
||||
{ $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
|
||||
{ $side-effects "seq" } ;
|
||||
|
||||
HELP: monotonic?
|
||||
{ $values { "seq" sequence } { "quot" "a quotation with stack effect " { $snippet "( elt elt -- ? )" } } { "?" "a boolean" } }
|
||||
{ $description "Applies the relation to successive pairs of elements in the sequence, testing for a truth value. The relation should be a transitive relation, such as a total order or an equality relation." }
|
||||
|
|
@ -436,20 +441,24 @@ HELP: last-index-from
|
|||
{ $description "Outputs the index of the last element in the sequence equal to " { $snippet "obj" } ", traversing the sequence backwards starting from the " { $snippet "i" } "th element and finishing at the first. If no element is found, outputs " { $link f } "." } ;
|
||||
|
||||
HELP: member?
|
||||
{ $values { "obj" object } { "seq" sequence } { "?" "a boolean" } }
|
||||
{ $description "Tests if the sequence contains an element equal to the object." } ;
|
||||
{ $values { "elt" object } { "seq" sequence } { "?" "a boolean" } }
|
||||
{ $description "Tests if the sequence contains an element equal to the object." }
|
||||
{ $notes "This word uses equality comparison (" { $link = } ")." } ;
|
||||
|
||||
HELP: memq?
|
||||
{ $values { "obj" object } { "seq" sequence } { "?" "a boolean" } }
|
||||
{ $values { "elt" object } { "seq" sequence } { "?" "a boolean" } }
|
||||
{ $description "Tests if the sequence contains the object." }
|
||||
{ $examples
|
||||
"This word uses identity comparison, so the following will most likely print " { $link f } ":"
|
||||
{ $example "USING: prettyprint sequences ;" "\"hello\" { \"hello\" } memq? ." "f" }
|
||||
} ;
|
||||
{ $notes "This word uses identity comparison (" { $link eq? } ")." } ;
|
||||
|
||||
HELP: remove
|
||||
{ $values { "obj" object } { "seq" sequence } { "newseq" "a new sequence" } }
|
||||
{ $description "Outputs a new sequence containing all elements of the input sequence except those equal to the given element." } ;
|
||||
{ $values { "elt" object } { "seq" sequence } { "newseq" "a new sequence" } }
|
||||
{ $description "Outputs a new sequence containing all elements of the input sequence except for given element." }
|
||||
{ $notes "This word uses equality comparison (" { $link = } ")." } ;
|
||||
|
||||
HELP: remq
|
||||
{ $values { "elt" object } { "seq" sequence } { "newseq" "a new sequence" } }
|
||||
{ $description "Outputs a new sequence containing all elements of the input sequence except those equal to the given element." }
|
||||
{ $notes "This word uses identity comparison (" { $link eq? } ")." } ;
|
||||
|
||||
HELP: remove-nth
|
||||
{ $values
|
||||
|
|
@ -469,6 +478,13 @@ HELP: move
|
|||
HELP: delete
|
||||
{ $values { "elt" object } { "seq" "a resizable mutable sequence" } }
|
||||
{ $description "Removes all elements equal to " { $snippet "elt" } " from " { $snippet "seq" } "." }
|
||||
{ $notes "This word uses equality comparison (" { $link = } ")." }
|
||||
{ $side-effects "seq" } ;
|
||||
|
||||
HELP: delq
|
||||
{ $values { "elt" object } { "seq" "a resizable mutable sequence" } }
|
||||
{ $description "Outputs a new sequence containing all elements of the input sequence except the given element." }
|
||||
{ $notes "This word uses identity comparison (" { $link eq? } ")." }
|
||||
{ $side-effects "seq" } ;
|
||||
|
||||
HELP: delete-nth
|
||||
|
|
@ -592,7 +608,7 @@ HELP: reverse
|
|||
{ $values { "seq" sequence } { "newseq" "a new sequence" } }
|
||||
{ $description "Outputs a new sequence having the same elements as " { $snippet "seq" } " but in reverse order." } ;
|
||||
|
||||
{ reverse <reversed> } related-words
|
||||
{ reverse <reversed> reverse-here } related-words
|
||||
|
||||
HELP: <reversed> ( seq -- reversed )
|
||||
{ $values { "seq" sequence } { "reversed" "a new sequence" } }
|
||||
|
|
@ -784,7 +800,7 @@ HELP: tail?
|
|||
{ $values { "seq" sequence } { "end" sequence } { "?" "a boolean" } }
|
||||
{ $description "Tests if " { $snippet "seq" } " ends with " { $snippet "end" } ". If " { $snippet "end" } " is longer than " { $snippet "seq" } ", this word outputs " { $link f } "." } ;
|
||||
|
||||
{ delete-nth remove delete } related-words
|
||||
{ remove remove-nth remq delq delete delete-nth } related-words
|
||||
|
||||
HELP: cut-slice
|
||||
{ $values { "seq" sequence } { "n" "a non-negative integer" } { "before-slice" sequence } { "after-slice" "a slice" } }
|
||||
|
|
@ -982,7 +998,7 @@ HELP: harvest
|
|||
}
|
||||
} ;
|
||||
|
||||
{ filter sift harvest } related-words
|
||||
{ filter filter-here sift harvest } related-words
|
||||
|
||||
HELP: set-first
|
||||
{ $values
|
||||
|
|
@ -1315,6 +1331,7 @@ ARTICLE: "sequences-add-remove" "Adding and removing sequence elements"
|
|||
{ $subsection suffix }
|
||||
"Removing elements:"
|
||||
{ $subsection remove }
|
||||
{ $subsection remq }
|
||||
{ $subsection remove-nth } ;
|
||||
|
||||
ARTICLE: "sequences-reshape" "Reshaping sequences"
|
||||
|
|
@ -1446,29 +1463,49 @@ ARTICLE: "sequences-trimming" "Trimming sequences"
|
|||
{ $subsection trim-left-slice }
|
||||
{ $subsection trim-right-slice } ;
|
||||
|
||||
ARTICLE: "sequences-destructive-discussion" "When to use destructive operations"
|
||||
"Constructive (non-destructive) operations should be preferred where possible because code without side-effects is usually more re-usable and easier to reason about. There are two main reasons to use destructive operations:"
|
||||
{ $list
|
||||
"For the side-effect. Some code is simpler to express with destructive operations; constructive operations return new objects, and sometimes ``threading'' the objects through the program manually complicates stack shuffling."
|
||||
{ "As an optimization. Some code can be written to use constructive operations, however would suffer from worse performance. An example is a loop which adds an element to a sequence on each iteration; one could use either " { $link suffix } " or " { $link push } ", however the former copies the entire sequence first, which would cause the loop to run in quadratic time." }
|
||||
}
|
||||
"The second reason is much weaker than the first one. In particular, many combinators (see " { $link map } ", " { $link produce } " and " { $link "namespaces-make" } ") as well as more advanced data structures (such as " { $vocab-link "persistent.vectors" } ") alleviate the need for explicit use of side effects." ;
|
||||
|
||||
ARTICLE: "sequences-destructive" "Destructive operations"
|
||||
"These words modify their input, instead of creating a new sequence."
|
||||
$nl
|
||||
"In-place variant of " { $link reverse } ":"
|
||||
{ $subsection reverse-here }
|
||||
"In-place variant of " { $link append } ":"
|
||||
{ $subsection push-all }
|
||||
"In-place variant of " { $link remove } ":"
|
||||
{ $subsection delete }
|
||||
"In-place variant of " { $link map } ":"
|
||||
{ $subsection change-each }
|
||||
{ $subsection "sequences-destructive-discussion" }
|
||||
"Changing elements:"
|
||||
{ $subsection change-each }
|
||||
{ $subsection change-nth }
|
||||
{ $subsection cache-nth }
|
||||
"Deleting elements:"
|
||||
{ $subsection delete }
|
||||
{ $subsection delq }
|
||||
{ $subsection delete-nth }
|
||||
{ $subsection delete-slice }
|
||||
{ $subsection delete-all }
|
||||
{ $subsection filter-here }
|
||||
"Other destructive words:"
|
||||
{ $subsection reverse-here }
|
||||
{ $subsection push-all }
|
||||
{ $subsection move }
|
||||
{ $subsection exchange }
|
||||
{ $subsection copy }
|
||||
{ $subsection replace-slice }
|
||||
"Many operations have constructive and destructive variants:"
|
||||
{ $table
|
||||
{ "Constructive" "Destructive" }
|
||||
{ { $link suffix } { $link push } }
|
||||
{ { $link but-last } { $link pop* } }
|
||||
{ { $link unclip-last } { $link pop } }
|
||||
{ { $link remove } { $link delete } }
|
||||
{ { $link remq } { $link delq } }
|
||||
{ { $link remove-nth } { $link delete-nth } }
|
||||
{ { $link reverse } { $link reverse-here } }
|
||||
{ { $link append } { $link push-all } }
|
||||
{ { $link map } { $link change-each } }
|
||||
{ { $link filter } { $link filter-here } }
|
||||
}
|
||||
{ $see-also set-nth push pop "sequences-stacks" } ;
|
||||
|
||||
ARTICLE: "sequences-stacks" "Treating sequences as stacks"
|
||||
|
|
|
|||
|
|
@ -498,15 +498,18 @@ PRIVATE>
|
|||
: contains? ( seq quot -- ? )
|
||||
find drop >boolean ; inline
|
||||
|
||||
: member? ( obj seq -- ? )
|
||||
: member? ( elt seq -- ? )
|
||||
[ = ] with contains? ;
|
||||
|
||||
: memq? ( obj seq -- ? )
|
||||
: memq? ( elt seq -- ? )
|
||||
[ eq? ] with contains? ;
|
||||
|
||||
: remove ( obj seq -- newseq )
|
||||
: remove ( elt seq -- newseq )
|
||||
[ = not ] with filter ;
|
||||
|
||||
: remq ( elt seq -- newseq )
|
||||
[ eq? not ] with filter ;
|
||||
|
||||
: sift ( seq -- newseq )
|
||||
[ ] filter ;
|
||||
|
||||
|
|
@ -552,16 +555,24 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: (delete) ( elt store scan seq -- elt store scan seq )
|
||||
: (filter-here) ( quot: ( elt -- ? ) store scan seq -- )
|
||||
2dup length < [
|
||||
3dup move
|
||||
[ nth pick = ] 2keep rot
|
||||
[ >r >r 1+ r> r> ] unless >r 1+ r> (delete)
|
||||
] when ;
|
||||
[ move ] 3keep
|
||||
[ nth-unsafe pick call [ 1+ ] when ] 2keep
|
||||
[ 1+ ] dip
|
||||
(filter-here)
|
||||
] [ nip set-length drop ] if ; inline recursive
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: delete ( elt seq -- ) 0 0 rot (delete) nip set-length drop ;
|
||||
: filter-here ( seq quot -- )
|
||||
0 0 roll (filter-here) ; inline
|
||||
|
||||
: delete ( elt seq -- )
|
||||
[ = not ] with filter-here ;
|
||||
|
||||
: delq ( elt seq -- )
|
||||
[ eq? not ] with filter-here ;
|
||||
|
||||
: prefix ( seq elt -- newseq )
|
||||
over >r over length 1+ r> [
|
||||
|
|
|
|||
Loading…
Reference in New Issue