Sequence cleanups

TODO.FACTOR.txt

@@ -1,5 +1,6 @@
 + 0.87:
 
+- better error handling in early startup
 - some module operations don't work on module-links
 - list operations: what if nothing is selected?
 - slider needs to be modelized

doc/handbook/sequences.facts

@@ -207,7 +207,7 @@ ARTICLE: "sequence-protocol" "Sequence protocol"
 "An optional generic word for creating sequences of the same class as a given sequence:"
 { $subsection like }
 "Another optional generic word for optimization purposes:"
-{ $subsection thaw } ;
+{ $subsection new } ;
 
 ARTICLE: "arrays" "Arrays"
 "An array is a fixed-size mutable sequence whose elements are stored in a contiguous range of memory. The literal syntax is covered in " { $link "syntax-arrays" } ". Sometimes you need a resizable array -- this is called a vector, and vectors are documented in " { $link "vectors" } "."

library/collections/namespaces.factor

@@ -48,9 +48,9 @@ words ;
 SYMBOL: building
 
 : make ( quot exemplar -- seq )
-    [
+    >r
-        dup thaw building set >r call building get r> like
+    [ V{ } clone building set call building get ] with-scope
-    ] with-scope ; inline
+    r> like ; inline
 
 : , ( elt -- ) building get push ;
 

library/collections/sbuf.factor

@@ -12,7 +12,7 @@ M: sbuf nth bounds-check nth-unsafe ;
 M: sbuf set-nth-unsafe underlying set-nth-unsafe ;
 M: sbuf set-nth growable-check 2dup ensure set-nth-unsafe ;
 M: sbuf clone clone-resizable ;
-M: sbuf thaw drop SBUF" " clone ;
+M: sbuf new drop <sbuf> ;
 : >sbuf ( seq -- sbuf ) [ sbuf? ] [ <sbuf> ] >sequence ; inline
 
 M: sbuf like

library/collections/sequence-combinators.factor

@@ -30,6 +30,9 @@ vectors ;
         t <array> f 0 pick set-nth-unsafe
     ] if ;
 
+: map>array ( seq quot -- array )
+    over length [ (map) ] collect 2nip ; inline
+
 IN: sequences
 
 : each ( seq quot -- )
@@ -43,9 +46,7 @@ IN: sequences
 : reduce ( seq identity quot -- result )
     swapd each ; inline
 
-: map ( seq quot -- newseq )
+: map ( seq quot -- newseq ) over >r map>array r> like ; inline
-    over >r over length [ (map) ] collect r> like 2nip ;
-    inline
 
 : map-with ( obj list quot -- newseq )
     swap [ with rot ] map 2nip ; inline
@@ -132,12 +133,14 @@ IN: sequences
 : all-with? ( obj seq quot -- ? )
     swap [ with rot ] all? 2nip ; inline
 
+: subset* ( flags seq -- subseq )
+    [
+        dup length <vector>
+        [ swap [ over push ] [ drop ] if ] 2reduce
+    ] keep like ; inline
+
 : subset ( seq quot -- subseq )
-    over >r over length <vector> rot [
+    over >r map>array r> subset* ; inline
-        -rot [
-            >r over >r call [ r> r> push ] [ r> r> 2drop ] if
-        ] 2keep
-    ] each r> like nip ; inline
 
 : subset-with ( obj seq quot -- subseq )
     swap [ with rot ] subset 2nip ; inline

library/collections/sequence-sort.factor

@@ -86,7 +86,7 @@ IN: sequences
     [ 2drop ] [ 0 over length 1- (nsort) ] if ; inline
 
 : sort ( seq quot -- sortedseq )
-    swap [ swap nsort ] immutable ; inline
+    swap [ >array [ swap nsort ] keep ] keep like ; inline
 
 : natural-sort ( seq -- sortedseq ) [ <=> ] sort ;
 

library/collections/sequences-epilogue.factor

@@ -13,8 +13,6 @@ sequences-internals strings vectors words ;
 : first4 ( seq -- first second third fourth )
     3 swap bounds-check nip first4-unsafe ;
 
-M: object like drop ;
-
 : index ( obj seq -- n )
     [ = ] find-with drop ;
 
@@ -64,28 +62,35 @@ M: object like drop ;
 : nappend ( dest src -- )
     >r [ length ] keep r> copy-into ; inline
 
-: >resizable ( seq -- newseq ) [ thaw dup ] keep nappend ;
+: ((append)) ( seq1 seq2 accum -- accum )
+    [ >r over length r> rot copy-into ] keep
+    [ 0 swap rot copy-into ] keep ; inline
 
-: immutable ( seq quot -- newseq )
+: (append3) ( seq1 seq2 seq3 exemplar -- newseq )
-    swap [ >resizable [ swap call ] keep ] keep like ; inline
+    [
+        >r pick length pick length pick length + + r> new
+        [ >r pick length pick length + r> rot copy-into ] keep
+        ((append))
+    ] keep like ;
+
+: append3 ( seq1 seq2 seq3 -- newseq )
+    pick (append3) ; inline
+
+: (append) ( seq1 seq2 exemplar -- newseq )
+    [
+        >r over length over length + r> new ((append))
+    ] keep like ;
 
 : append ( seq1 seq2 -- newseq )
-    swap [ swap nappend ] immutable ;
+    over (append) ; inline
 
-: add ( seq elt -- newseq )
+: add ( seq elt -- newseq ) 1array append ; inline
-    swap [ push ] immutable ;
 
-: add* ( seq elt -- newseq )
+: add* ( seq elt -- newseq ) 1array swap dup (append) ; inline
-    over >r
-    over thaw [ push ] keep [ swap nappend ] keep
-    r> like ;
 
 : diff ( seq1 seq2 -- newseq )
     [ swap member? not ] subset-with ;
 
-: append3 ( seq1 seq2 seq3 -- newseq )
-    rot [ [ rot nappend ] keep swap nappend ] immutable ;
-
 : peek ( seq -- elt ) dup length 1- swap nth ;
 
 : pop* ( seq -- ) dup length 1- swap set-length ;

library/collections/sequences-epilogue.facts

@@ -94,19 +94,6 @@ HELP: nappend
 { $side-effects "dest" }
 { $errors "Throws an error if " { $snippet "src" } " contains elements not permitted in " { $snippet "dest" } "." } ;
 
-HELP: >resizable
-{ $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
-{ $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
 { $values { "seq" "a sequence" } { "elt" "an object" } { "newseq" "a sequence" } }
 { $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the end of " { $snippet "seq" } "." }

library/collections/sequences.factor

@@ -13,9 +13,13 @@ GENERIC: length ( seq -- n )
 GENERIC: set-length ( n seq -- )
 GENERIC: nth ( n seq -- elt )
 GENERIC: set-nth ( elt n seq -- )
-GENERIC: thaw ( seq -- resizable-seq )
+GENERIC: new ( len seq -- newseq )
 GENERIC: like ( seq prototype -- newseq )
 
+M: object new drop f <array> ;
+
+M: object like drop ;
+
 : empty? ( seq -- ? ) length zero? ; inline
 
 : delete-all ( seq -- ) 0 swap set-length ;

library/collections/sequences.facts

@@ -29,10 +29,9 @@ $terpri
 "Throws an error if the sequence cannot hold elements of the given type." }
 { $side-effects "seq" } ;
 
-HELP: thaw
+HELP: new
-{ $values { "seq" "a sequence" } { "resizable-seq" "a resizable mutable sequence" } }
+{ $values { "n" "a non-negative integer" } { "seq" "a sequence" } { "newseq" "a mutable sequence" } }
-{ $contract "Outputs an empty, resizable mutable sequence that can hold the elements of " { $snippet "seq" } "." }
+{ $contract "Outputs a mutable sequence of length " { $snippet "n" } " which can hold the elements of " { $snippet "seq" } "." } ;
-{ $examples "The default implementation returns a new vector, but given a string, it returns a string buffer, since string buffers are more efficient in terms of memory usage." } ;
 
 HELP: like
 { $values { "seq" "a sequence" } { "prototype" "a sequence" } { "newseq" "a sequence" } }

library/collections/strings.factor

@@ -53,8 +53,6 @@ UNION: alpha Letter digit ;
 : >string ( seq -- str )
     [ string? ] [ 0 <string> ] >sequence ; inline
 
-M: string thaw drop SBUF" " clone ;
-
 M: string like
     drop dup string? [
         dup sbuf? [
@@ -64,3 +62,5 @@ M: string like
             >string
         ] if
     ] unless ;
+
+M: string new drop 0 <string> ;

library/collections/vectors.factor

@@ -19,8 +19,6 @@ M: vector set-nth
 : >vector ( seq -- vector )
     [ vector? ] [ <vector> ] >sequence ; inline
 
-M: object thaw drop V{ } clone ;
-
 M: vector clone clone-resizable ;
 
 M: vector like
@@ -28,6 +26,8 @@ M: vector like
         dup array? [ array>vector ] [ >vector ] if
     ] unless ;
 
+M: vector new drop <vector> ;
+
 IN: kernel
 
 : with-datastack ( stack word -- newstack )

library/collections/virtual-sequences.factor

@@ -22,7 +22,7 @@ M: reversed set-nth-unsafe
 
 M: reversed like reversed-seq like ;
 
-M: reversed thaw reversed-seq thaw ;
+M: reversed new reversed-seq new ;
 
 : reverse ( seq -- newseq ) [ <reversed> ] keep like ;
 
@@ -64,7 +64,7 @@ M: slice set-nth-unsafe slice@ set-nth-unsafe ;
 
 M: slice like slice-seq like ;
 
-M: slice thaw slice-seq thaw ;
+M: slice new slice-seq new ;
 
 TUPLE: column seq col ;
 
@@ -79,4 +79,4 @@ M: column set-nth column@ set-nth ;
 
 M: column like column-seq like ;
 
-M: column thaw column-seq thaw ;
+M: column new column-seq new ;

library/quotations.factor

@@ -15,6 +15,7 @@ M: quotation nth bounds-check nth-unsafe ;
 M: quotation set-nth bounds-check set-nth-unsafe ;
 M: quotation nth-unsafe >r >fixnum r> array-nth ;
 M: quotation set-nth-unsafe >r >fixnum r> set-array-nth ;
+M: quotation new drop <quotation> ;
 
 : >quotation ( seq -- quot )
     [ quotation? ] [ <quotation> ] >sequence ; inline