Add 1sequence word. Add unit tests for existing 1vector and 1byte-array words, and make them use 1sequence
parent
4ee7fb1c30
commit
f8d80faed3
|
|
@ -9,3 +9,5 @@ USING: tools.test byte-arrays sequences kernel ;
|
||||||
[ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test
|
[ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test
|
||||||
|
|
||||||
[ -10 B{ } resize-byte-array ] must-fail
|
[ -10 B{ } resize-byte-array ] must-fail
|
||||||
|
|
||||||
|
[ B{ 123 } ] [ 123 1byte-array ] unit-test
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2007, 2008 Slava Pestov.
|
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel kernel.private alien.accessors sequences
|
USING: accessors kernel kernel.private alien.accessors sequences
|
||||||
sequences.private math ;
|
sequences.private math ;
|
||||||
|
|
@ -19,7 +19,7 @@ M: byte-array resize
|
||||||
|
|
||||||
INSTANCE: byte-array sequence
|
INSTANCE: byte-array sequence
|
||||||
|
|
||||||
: 1byte-array ( x -- byte-array ) 1 <byte-array> [ set-first ] keep ; inline
|
: 1byte-array ( x -- byte-array ) B{ } 1sequence ; inline
|
||||||
|
|
||||||
: 2byte-array ( x y -- byte-array ) B{ } 2sequence ; inline
|
: 2byte-array ( x y -- byte-array ) B{ } 2sequence ; inline
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -207,6 +207,10 @@ HELP: first4-unsafe
|
||||||
{ $values { "seq" sequence } { "first" "the first element" } { "second" "the second element" } { "third" "the third element" } { "fourth" "the fourth element" } }
|
{ $values { "seq" sequence } { "first" "the first element" } { "second" "the second element" } { "third" "the third element" } { "fourth" "the fourth element" } }
|
||||||
{ $contract "Unsafe variant of " { $link first4 } " that does not perform bounds checks." } ;
|
{ $contract "Unsafe variant of " { $link first4 } " that does not perform bounds checks." } ;
|
||||||
|
|
||||||
|
HELP: 1sequence
|
||||||
|
{ $values { "obj" object } { "exemplar" sequence } { "seq" sequence } }
|
||||||
|
{ $description "Creates a one-element sequence of the same type as " { $snippet "exemplar" } "." } ;
|
||||||
|
|
||||||
HELP: 2sequence
|
HELP: 2sequence
|
||||||
{ $values { "obj1" object } { "obj2" object } { "exemplar" sequence } { "seq" sequence } }
|
{ $values { "obj1" object } { "obj2" object } { "exemplar" sequence } { "seq" sequence } }
|
||||||
{ $description "Creates a two-element sequence of the same type as " { $snippet "exemplar" } "." } ;
|
{ $description "Creates a two-element sequence of the same type as " { $snippet "exemplar" } "." } ;
|
||||||
|
|
|
||||||
|
|
@ -137,9 +137,12 @@ INSTANCE: iota immutable-sequence
|
||||||
|
|
||||||
: from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
|
: from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
|
||||||
|
|
||||||
|
: (1sequence) ( obj seq -- seq )
|
||||||
|
[ 0 swap set-nth-unsafe ] keep ; inline
|
||||||
|
|
||||||
: (2sequence) ( obj1 obj2 seq -- seq )
|
: (2sequence) ( obj1 obj2 seq -- seq )
|
||||||
[ 1 swap set-nth-unsafe ] keep
|
[ 1 swap set-nth-unsafe ] keep
|
||||||
[ 0 swap set-nth-unsafe ] keep ; inline
|
(1sequence) ; inline
|
||||||
|
|
||||||
: (3sequence) ( obj1 obj2 obj3 seq -- seq )
|
: (3sequence) ( obj1 obj2 obj3 seq -- seq )
|
||||||
[ 2 swap set-nth-unsafe ] keep
|
[ 2 swap set-nth-unsafe ] keep
|
||||||
|
|
@ -151,6 +154,9 @@ INSTANCE: iota immutable-sequence
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
: 1sequence ( obj exemplar -- seq )
|
||||||
|
1 swap [ (1sequence) ] new-like ; inline
|
||||||
|
|
||||||
: 2sequence ( obj1 obj2 exemplar -- seq )
|
: 2sequence ( obj1 obj2 exemplar -- seq )
|
||||||
2 swap [ (2sequence) ] new-like ; inline
|
2 swap [ (2sequence) ] new-like ; inline
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -97,3 +97,5 @@ IN: vectors.tests
|
||||||
[ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test
|
[ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test
|
||||||
|
|
||||||
[ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test
|
[ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test
|
||||||
|
|
||||||
|
[ V{ "lulz" } ] [ "lulz" 1vector ] unit-test
|
||||||
|
|
@ -40,7 +40,7 @@ M: sequence new-resizable drop <vector> ;
|
||||||
|
|
||||||
INSTANCE: vector growable
|
INSTANCE: vector growable
|
||||||
|
|
||||||
: 1vector ( x -- vector ) 1array >vector ;
|
: 1vector ( x -- vector ) V{ } 1sequence ;
|
||||||
|
|
||||||
: ?push ( elt seq/f -- seq )
|
: ?push ( elt seq/f -- seq )
|
||||||
[ 1 <vector> ] unless* [ push ] keep ;
|
[ 1 <vector> ] unless* [ push ] keep ;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue