steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

basis: fix bit-vectors

modern-harvey2
Doug Coleman 2017-12-25 15:06:14 -08:00
parent 0134a5fc3f
commit f27c35a7dd
2 changed files with 16 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/bit-vectors/bit-vectors.factor
View File

@ -5,7 +5,7 @@ sequences.private growable bit-arrays prettyprint.custom
parser accessors vectors.functor classes.parser ;
IN: bit-vectors
<< "bit-vector" create-class-in \ bit-array \ <bit-array> define-vector >>
SPECIAL-VECTOR: bit-vector bit-array
SYNTAX: \?V{ \ } [ >bit-vector ] parse-literal ;

31
basis/vectors/functor/functor.factor
View File

@ -4,31 +4,28 @@ USING: classes functors growable kernel math sequences
sequences.private functors2 ;
IN: vectors.functor
FUNCTOR: special-vector ( T: existing-word -- ) [[
USING: classes growable kernel math sequences sequences.private
specialized-arrays ;
SAME-FUNCTOR: special-vector ( vector: name underlying: existing-class -- ) [[
USING: classes growable kernel math sequences sequences.private
specialized-arrays ;
SPECIALIZED-ARRAY: ${T}
TUPLE: ${vector} { underlying ${underlying} } { length array-capacity } ;
TUPLE: ${T}-vector { underlying ${T}-array } { length array-capacity } ;
: >${vector} ( seq -- vector ) ${vector} new clone-like ; inline
: >${T}-vector ( seq -- vector ) ${T}-vector new clone-like ; inline
: <${vector}> ( capacity -- vector ) <${underlying}> 0 ${vector} boa ; inline
: <${T}-vector> ( capacity -- vector ) <${T}-array> 0 ${T}-vector boa ; inline
M: ${T}-vector like
drop dup ${T}-vector instance? [
dup ${T}-array instance? [ dup length ${T}-vector boa ] [ >${T}-vector ] if
M: ${vector} like
drop dup ${vector} instance? [
dup ${underlying} instance? [ dup length ${vector} boa ] [ >${vector} ] if
] unless ; inline
M: ${T}-vector new-sequence drop [ <${T}-array> ] [ >fixnum ] bi ${T}-vector boa ; inline
M: ${vector} new-sequence drop [ <${underlying}> ] [ >fixnum ] bi ${vector} boa ; inline
M: ${T}-array new-resizable drop <${T}-vector> ; inline
M: ${underlying} new-resizable drop <${vector}> ; inline
M: ${T}-vector new-resizable drop <${T}-vector> ; inline
M: ${vector} new-resizable drop <${vector}> ; inline
M: ${T}-vector equal? over ${T}-vector instance? [ sequence= ] [ 2drop f ] if ;
INSTANCE: ${T}-vector growable
M: ${vector} equal? over ${vector} instance? [ sequence= ] [ 2drop f ] if ;
INSTANCE: ${vector} growable
]]