Updating sequences documentation

TODO.FACTOR.txt

@@ -21,7 +21,7 @@
 - get factor running on mac intel
 - constant branch folding
 - cocoa: starting the UI with +foo switches opens them as files
-
+- tests in a loop runs out of memory eventually
 + refactor style stack code so that nested styles are handled at a lower-level
   - in HTML, we can nest div tags, etc
   - fix prettyprinter's highlighting of non-leaves looks bad

library/collections/sequences-epilogue.factor

@@ -154,15 +154,10 @@ M: object <=>
 : no-cond "cond fall-through" throw ;
 
 : cond ( conditions -- )
-    #! Conditions is a sequence of quotation pairs.
-    #! { { [ X ] [ Y ] } { [ Z ] [ T ] } }
-    #! => X [ Y ] [ Z [ T ] [ ] if ] if
-    #! The last condition should be a catch-all 't'.
-    [ first call ] find nip dup
-    [ second call ] [ no-cond ] if ;
+    [ first call ] find nip dup [ second call ] [ no-cond ] if ;
 
 : with-datastack ( stack word -- stack )
-    datastack >r >r set-datastack r> execute
+    datastack >r >r >vector set-datastack r> execute
     datastack r> [ push ] keep set-datastack 2nip ;
 
 : unix? os { "freebsd" "linux" "macosx" "solaris" } member? ;

library/collections/sequences-epilogue.facts

@@ -84,14 +84,30 @@ HELP: >resizable "( seq -- newseq )"
 { $values { "seq" "a sequence" } { "newseq" "a mutable resizable sequence" } }
 { $description "Outputs a new, mutable resizable sequence having the same elements as " { $snippet "seq" } "." } ;
 
-HELP: immutable "( seq -- newseq )"
-{ $values { "seq" "a sequence" } { "newseq" "a mutable resizable sequence" } }
-{ $description "Outputs a new, mutable resizable sequence having the same elements as " { $snippet "seq" } "." } ;
+HELP: immutable "( seq quot -- newseq )"
+{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( seq -- )" } { "newseq" "a sequence" } }
+{ $description "A utility combinator transforming a word which modifies its input sequence into a word which returns a new output sequence. "
+$terpri
+"A mutable, resizable copy of " { $snippet "seq" } " is made, then the quotation is called to modify this copy and consume it. Finally, the copy is converted into a sequence of the same type as the original." }
+{ $examples
+    "Take a look at " { $link append } ", which is built off the mutating word " { $link nappend } ", or " { $link add } " which is built from " { $link push } "."
+} ;
 
 HELP: add "( seq elt -- newseq )"
 { $values { "seq" "a sequence" } { "elt" "an object" } { "newseq" "a sequence" } }
-{ $description "Outputs a new sequence consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "elt" } "." }
-{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } ;
+{ $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the end of " { $snippet "seq" } "." }
+{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." }
+{ $examples
+    { $example "{ 1 2 3 } 4 add ." "{ 1 2 3 4 }" }
+} ;
+
+HELP: add* "( seq elt -- newseq )"
+{ $values { "seq" "a sequence" } { "elt" "an object" } { "newseq" "a sequence" } }
+{ $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the beginning of " { $snippet "seq" } "." }
+{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } 
+{ $examples
+    { $example "{ 1 2 3 } 0 add* ." "{ 0 1 2 3 }" }
+} ;
 
 HELP: diff "( seq1 seq2 -- newseq )"
 { $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "newseq" "a sequence" } }
@@ -139,6 +155,55 @@ HELP: flip "( matrix -- newmatrix )"
 { $description "Transposes the matrix; that is, rows become columns and columns become rows." }
 { $examples { $example "{ { 1 2 3 } { 4 5 6 } } flip ." "{ { 1 4 } { 2 5 } { 3 6 } }" } } ;
 
+HELP: unpair "( assoc -- keys values )"
+{ $values { "assoc" "a sequence of pairs" } { "keys" "a new sequence" } { "values" "a new sequence" } }
+{ $description "Given a sequence of two-element sequences, outputs a new sequence with the first element of each pair, and a new sequence with the second element of each pair." } ;
+
+HELP: exchange "( m n seq -- )"
+{ $values { "m" "a non-negative integer" } { "n" "a non-negative integer" } { "seq" "a mutable sequence" } }
+{ $description "Exchanges the " { $snippet "m" } "th and " { $snippet "n" } "th elements of " { $snippet "seq" } "." } ;
+
+HELP: assoc "( key assoc -- value )"
+{ $values { "key" "an object" } { "assoc" "a sequence of pairs" } { "value" "the associated value, or " { $link f } }
+{ $description "Searches for a pair whose first element is equal to the key and outputs the second element of the pair. Keys are compared for equality using " { $link = } ". Outputs " { $link f } " if no matching key is found." }
+{ $see-also rassoc } ;
+
+HELP: rassoc "( value assoc -- key )"
+{ $values { "value" "an object" } { "assoc" "a sequence of pairs" } { "key" "the associated key, or " { $link f } }
+{ $description "Searches for a pair whose second element is equal to the value and outputs the first element of the pair. Values are compared for equality using " { $link = } ". Outputs " { $link f } " if no matching value is found." } 
+{ $see-also rassoc } ;
+
+HELP: last/first "( seq -- pair )"
+{ $values { "seq" "a sequence" } { "pair" "a two-element array" } }
+{ $description "Creates an array holding the first and last element of the sequence." } ;
+
 HELP: sequence= "( seq1 seq2 -- ? )"
 { $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "?" "a boolean" } }
 { $description "Tests if the two sequences have the same length and elements. This is weaker than " { $link = } ", since it does not ensure that the sequences are instances of the same class." } ;
+
+HELP: depth "( -- n )"
+{ $values { "n" "a non-negative integer" } }
+{ $description "Outputs the number of elements on the data stack." } ;
+
+HELP: cond "( assoc -- )"
+{ $values { "assoc" "a sequence of quotation pairs" } }
+{ $description
+    "Calls the first quotation in each pair in turn, until a quotation outputs a true value, in which case the second quotation in the corresponding pair is called."
+    $terpri
+    "The following two phrases are equivalent:"
+    { $code "{ { [ X ] [ Y ] } { [ Z ] [ T ] } } cond" }
+    { $code "X [ Y ] [ Z [ T ] [ no-cond ] if ] if" }
+    "Note that the base case is " { $link no-cond } " which throws an error."
+}
+{ $errors "Throws an error if the first quotation in every pair yields " { $link f } "." } ;
+
+HELP: with-datastack "( stack word -- newstack )"
+{ $values { "stack" "a sequence" } { "word" "a word" } { "newstack" "a sequence" } }
+{ $description "Executes " { $snippet "word" } " with the given data stack contents, and outputs the new data stack after the word returns. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." }
+{ $examples
+    { $example "{ 3 7 } \ + with-datastack ." "V{ 10 }" }
+} ;
+
+HELP: unix? "( -- ? )"
+{ $values { "?" "a boolean" } }
+{ $description "Tests if Factor is running on a Unix-like system. While this is a rather vague notion, one can use it to make certain assumptions about system calls and file structure which are not valid on Windows." } ;

library/collections/sequences.facts

@@ -1,9 +1,5 @@
 USING: help sequences sequences-internals ;
 
-HELP: empty? "( seq -- ? )"
-{ $values { "seq" "a sequence" } { "?" "a boolean" } }
-{ $description "Tests if the sequence has zero length." } ;
-
 HELP: length "( seq -- n )"
 { $values { "seq" "a sequence" } { "n" "a non-negative integer" } }
 { $contract "Outputs the length of the sequence. All sequences support this operation."
@@ -44,6 +40,10 @@ HELP: like "( seq prototype -- newseq )"
 $terpri
 "This generic word is flushable, so user-defined methods must satisfy the flushable contract (see " { $link "declarations" } ")." } ;
 
+HELP: empty? "( seq -- ? )"
+{ $values { "seq" "a sequence" } { "?" "a boolean" } }
+{ $description "Tests if the sequence has zero length." } ;
+
 HELP: peek "( seq -- elt )"
 { $values { "seq" "a sequence" } { "elt" "an object" } }
 { $description "Outputs the last element of the sequence." }
@@ -69,11 +69,6 @@ HELP: first "( seq -- first )"
 { $description "Outputs the first element of the sequence." }
 { $errors "Throws an error if the sequence is empty." } ;
 
-HELP: first "( seq -- first )"
-{ $values { "seq" "a sequence" } { "first" "the first element of the sequence" } }
-{ $description "Outputs the first element of the sequence." }
-{ $errors "Throws an error if the sequence is empty." } ;
-
 HELP: second "( seq -- second )"
 { $values { "seq" "a sequence" } { "second" "the second element of the sequence" } }
 { $description "Outputs the second element of the sequence." }
@@ -117,3 +112,7 @@ HELP: nth-unsafe "( n seq -- elt )"
 HELP: set-nth-unsafe "( elt n seq -- )"
 { $values { "elt" "an object" } { "n" "an integer" } { "seq" "a sequence" } }
 { $contract "Unsafe variant of " { $link set-nth } " that does not perform bounds checks." } ;
+
+HELP: exchange "( m n seq -- )"
+{ $values { "m" "a non-negative integer" } { "n" "a non-negative integer" } { "seq" "a mutable sequence" } }
+{ $description "Unsafe variant of " { $link exchange } " that does not perform bounds checks." } ;

library/collections/slicing.factor

@@ -48,14 +48,14 @@ strings vectors ;
     tuck >r >r head-slice r> r> tail-slice swapd append3 ;
     flushable
 
-: remove-index ( n seq -- seq )
+: remove-nth ( n seq -- seq )
     [ head-slice ] 2keep >r 1+ r> tail-slice append ;
 
 : (cut) ( n seq -- before after )
     [ head ] 2keep tail-slice ; flushable
 
 : cut ( n seq -- before after )
-    [ (cut) ] keep like ; flushable
+    [ head ] 2keep tail ; flushable
 
 : cut* ( seq1 seq2 -- seq seq )
     [ head* ] 2keep tail* ; flushable

library/collections/slicing.facts

@@ -52,10 +52,31 @@ HELP: ?tail "( seq end -- newseq ? )"
 { $description "Tests if " { $snippet "seq" } " ends with " { $snippet "end" } ". If there is a match, outputs the subrange of " { $snippet "seq" } " excluding " { $snippet "begin" } ", and " { $link t } ". If there is no match, outputs " { $snippet "seq" } " and " { $link f } "." } ;
 
 HELP: replace-slice "( new m n seq -- replaced )"
-{ $values { "new" "a sequence" } { "seq" "a sequence" } { "m" "a non-negative integer" } { "n" "a non-negative integer" } { "reokaced" "a new sequence" } }
+{ $values { "new" "a sequence" } { "seq" "a sequence" } { "m" "a non-negative integer" } { "n" "a non-negative integer" } { "replaced" "a new sequence" } }
 { $description "Outputs a new sequence consisting of the elements of " { $snippet "seq" } ", with the range from " { $snippet "m" } " to " { $snippet "n" } " replaced by " { $snippet "new" } "." }
 { $errors "Throws an error if " { $snippet "new" } " contains elements whose types are not permissible in sequences of the same class as " { $snippet "seq" } "." } ;
 
+HELP: remove-nth "( n seq -- newseq )"
+{ $values { "n" "a non-negative integer" } { "seq" "a sequence" } { "newseq" "a new sequence" } }
+{ $description "Outputs a new sequence with the same elements as " { $snippet "seq" } " except omitting the " { $snippet "n" } "th element." }
+{ $examples
+    { $example "2 { + - = * / } remove-nth ." "{ + - * / }" }
+} ;
+
+HELP: (cut) "( n seq -- before after )"
+{ $values { "n" "a non-negative integer" } { "seq" "a sequence" } { "before" "a sequence" } { "after" "a slice" } }
+{ $description "Outputs a pair of sequences, where " { $snippet "before" } " consists of the first " { $snippet "n" } " elements of " { $snippet "seq" } " and has the same type, while " { $snippet "after" } " is a slice of the remaining elements." }
+{ $notes "Unlike " { $link cut } ", the run time of this word is proportional to the length of " { $snippet "before" } ", not " { $snippet "after" } ", so it is suitable for use in an iterative algorithm which cuts successive pieces off a sequence." } ;
+
+HELP: cut "( n seq -- before after )"
+{ $values { "n" "a non-negative integer" } { "seq" "a sequence" } { "before" "a sequence" } { "after" "a sequence" } }
+{ $description "Outputs a pair of sequences, where " { $snippet "before" } " consists of the first " { $snippet "n" } " elements of " { $snippet "seq" } ", while " { $snippet "after" } " holds the remaining elements. Both output sequences have the same type as " { $snippet "seq" } "." }
+{ $notes "Since this word copies the entire tail of the sequence, it should not be used in a loop. If this is important, consider using " { $link (cut) } " instead, since it returns a slice for the tail instead of copying." } ;
+
+HELP: cut* "( n seq -- before after )"
+{ $values { "n" "a non-negative integer" } { "seq" "a sequence" } { "before" "a sequence" } { "after" "a sequence" } }
+{ $description "Outputs a pair of sequences, where " { $snippet "after" } " consists of the last " { $snippet "n" } " elements of " { $snippet "seq" } ", while " { $snippet "before" } " holds the remaining elements. Both output sequences have the same type as " { $snippet "seq" } "." } ;
+
 HELP: group "( n seq -- groups )"
 { $values { "n" "a non-negative integer" } { "seq" "a sequence" } { "groups" "a sequence of sequences" } }
 { $description "Splits the sequence into groups of " { $snippet "n" } " elements and collects the groups into a new array." }
@@ -90,6 +111,9 @@ HELP: drop-prefix "( seq1 seq2 -- slice1 slice2 )"
 { $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "slice1" "a slice" } { "slice2" "a slice" } }
 { $description "Outputs a pair of virtual sequences with the common prefix of " { $snippet "seq1" } " and " { $snippet "seq2" } " removed." } ;
 
-HELP: unpair "( assoc -- keys values )"
-{ $values { "assoc" "a sequence of pairs" } { "keys" "a new sequence" } { "values" "a new sequence" } }
-{ $description "Given a sequence of two-element sequences, outputs a new sequence with the first element of each pair, and a new sequence with the second element of each pair." } ;
+HELP: unclip "( seq -- rest first )"
+{ $values { "seq" "a sequence" } { "rest" "a sequence" } { "first" "an object" } }
+{ $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first." }
+{ $examples
+    { $example "{ 1 2 3 } unclip add ." "{ 2 3 1 }" }
+} ;

library/collections/virtual-sequences.factor

@@ -4,13 +4,9 @@ IN: sequences
 USING: errors generic kernel math sequences-internals vectors ;
 
 ! A reversal of an underlying sequence.
-TUPLE: reversed ;
+TUPLE: reversed seq ;
 
-C: reversed
-    #! A delegate f means no delegate...
-    [ >r [ { } ] unless* r> set-delegate ] keep ;
-
-: reversed@ delegate [ length swap - 1- ] keep ; inline
+: reversed@ reversed-seq [ length swap - 1- ] keep ; inline
 
 M: reversed nth ( n seq -- elt ) reversed@ nth ;
 
@@ -21,9 +17,9 @@ M: reversed set-nth ( elt n seq -- ) reversed@ set-nth ;
 M: reversed set-nth-unsafe ( elt n seq -- )
     reversed@ set-nth-unsafe ;
 
-M: reversed like ( seq reversed -- seq ) delegate like ;
+M: reversed like ( seq reversed -- seq ) reversed-seq like ;
 
-M: reversed thaw ( seq -- seq ) delegate thaw ;
+M: reversed thaw ( seq -- seq ) reversed-seq thaw ;
 
 : reverse ( seq -- seq ) [ <reversed> ] keep like ;
 

library/collections/virtual-sequences.facts

@@ -7,7 +7,7 @@ HELP: <slice> "( m n seq -- slice )"
 
 HELP: reverse "( seq -- reversed )"
 { $values { "seq" "a sequence" } { "reversed" "a sequence" } }
-{ $description "Outputs a new sequence with the reverse element order." } ;
+{ $description "Outputs a new sequence having the same elements as " { $snippet "seq" } " but in reverse order." } ;
 
 HELP: <reversed> "( seq -- reversed )"
 { $values { "seq" "a sequence" } { "reversed" "a sequence" } }

library/test/collections/sequences.factor

@@ -209,7 +209,7 @@ unit-test
 
 [ 10 "hi" "bye" copy-into ] unit-test-fails
 
-[ { 1 2 3 5 6 } ] [ 3 { 1 2 3 4 5 6 } remove-index ] unit-test
+[ { 1 2 3 5 6 } ] [ 3 { 1 2 3 4 5 6 } remove-nth ] unit-test
 
 [ V{ 1 2 3 } ]
 [ 3 V{ 1 2 } clone [ push-new ] keep ] unit-test

library/ui/gadgets/tracks.factor

@@ -124,7 +124,7 @@ C: divider ( -- divider )
         2dup gadget-children length = [ >r 1- r> ] when
         2dup nth-gadget unparent
     ] unless
-    [ >r 2 /i r> track-sizes remove-index normalize-sizes ] keep
+    [ >r 2 /i r> track-sizes remove-nth normalize-sizes ] keep
     [ set-track-sizes ] keep relayout-1 ;
 
 : track-remove ( gadget track -- )