diff --git a/basis/bit-vectors/bit-vectors.factor b/basis/bit-vectors/bit-vectors.factor index 70476156d6..959ed067f0 100644 --- a/basis/bit-vectors/bit-vectors.factor +++ b/basis/bit-vectors/bit-vectors.factor @@ -1,11 +1,10 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel kernel.private math sequences -sequences.private growable bit-arrays prettyprint.custom -parser accessors vectors.functor classes.parser ; +USING: bit-arrays classes growable kernel math parser +prettyprint.custom sequences sequences.private vectors.functor ; IN: bit-vectors -SPECIAL-VECTOR: bit-vector bit-array +VECTORIZED: bit bit-array SYNTAX: \?V{ \ } [ >bit-vector ] parse-literal ; diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 6a66ab717e..e195f96dc1 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -41,8 +41,8 @@ M: byte-array direct-like drop uchar ; inline PRIVATE> -VARIABLES-FUNCTOR: specialized-array ( T: existing-word -- ) { - { "A" "${T}-array" } +VARIABLES-FUNCTOR: specialized-array ( type: existing-word -- ) { + { "A" "${type}-array" } { "" "<${A}>" } { "(A)" "(${A})" } { "" "" } @@ -62,13 +62,13 @@ INSTANCE: ${A} specialized-array-mixin : ${} ( alien len -- specialized-array ) ${A} boa ; inline : ${} ( n -- specialized-array ) - [ \ ${T} ] keep ${} ; inline + [ \ ${type} ] keep ${} ; inline : ${(A)} ( n -- specialized-array ) - [ \ ${T} (underlying) ] keep ${} ; inline + [ \ ${type} (underlying) ] keep ${} ; inline >> -SYNTAX: ${A}{ \ } [ \ ${T} >c-array ] parse-literal ; +SYNTAX: ${A}{ \ } [ \ ${type} >c-array ] parse-literal ; M: ${A} direct-like drop ${} ; inline @@ -76,13 +76,13 @@ M: ${A} clone [ underlying>> clone ] [ length>> ] bi ${} ; inline M: ${A} length length>> ; inline -M: ${A} nth-unsafe underlying>> \ ${T} alien-element ; inline +M: ${A} nth-unsafe underlying>> \ ${type} alien-element ; inline -M: ${A} nth-c-ptr underlying>> \ ${T} array-accessor drop swap ; inline +M: ${A} nth-c-ptr underlying>> \ ${type} array-accessor drop swap ; inline -M: ${A} set-nth-unsafe underlying>> \ ${T} set-alien-element ; inline +M: ${A} set-nth-unsafe underlying>> \ ${type} set-alien-element ; inline -M: ${A} like drop dup ${A} instance? [ \ ${T} >c-array ] unless ; inline +M: ${A} like drop dup ${A} instance? [ \ ${type} >c-array ] unless ; inline M: ${A} new-sequence drop ${(A)} ; inline @@ -90,24 +90,24 @@ M: ${A} equal? over ${A} instance? [ sequence= ] [ 2drop f ] if ; M: ${A} resize [ - [ \ ${T} heap-size * ] [ underlying>> ] bi* + [ \ ${type} heap-size * ] [ underlying>> ] bi* resize-byte-array ] [ drop ] 2bi ${} ; inline -M: ${A} element-size drop \ ${T} heap-size ; inline +M: ${A} element-size drop \ ${type} heap-size ; inline -M: ${A} underlying-type drop \ ${T} ; +M: ${A} underlying-type drop \ ${type} ; M: ${A} pprint-delims drop \ ${A}{ \ } ; M: ${A} >pprint-sequence ; -M: ${A} vs+ [ + \ ${T} c-type-clamp ] 2map ; inline -M: ${A} vs- [ - \ ${T} c-type-clamp ] 2map ; inline -M: ${A} vs* [ * \ ${T} c-type-clamp ] 2map ; inline +M: ${A} vs+ [ + \ ${type} c-type-clamp ] 2map ; inline +M: ${A} vs- [ - \ ${type} c-type-clamp ] 2map ; inline +M: ${A} vs* [ * \ ${type} c-type-clamp ] 2map ; inline -M: ${A} v*high [ * \ ${T} heap-size neg shift ] 2map ; inline +M: ${A} v*high [ * \ ${type} heap-size neg shift ] 2map ; inline ]] +VECTORIZED: float float-array { 3 } [ double-vector{ 1 2 } 3 suffix! length ] unit-test diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index b9d7537d4a..6e3cf6038a 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -8,7 +8,7 @@ IN: specialized-vectors MIXIN: specialized-vector -FUNCTOR: specialized-vector ( T: existing-word -- ) [[ +FUNCTOR: specialized-vector ( type: existing-word -- ) [[ USING: accessors alien alien.c-types alien.data classes growable kernel math parser prettyprint.custom sequences @@ -16,39 +16,40 @@ sequences.private specialized-arrays specialized-arrays.private specialized-vectors vectors.functor ; FROM: specialized-arrays.private => nth-c-ptr direct-like ; -SPECIALIZED-ARRAY: ${T} +<< +SPECIALIZED-ARRAY: ${type} +>> << ! For >foo-vector to be defined in time -SPECIAL-VECTOR: ${T} +VECTORIZED: ${type} ${type}-array <${type}-array> >> -SYNTAX: ${T}-vector{ \ } [ >${T}-vector ] parse-literal ; +SYNTAX: ${type}-vector{ \ } [ >${type}-vector ] parse-literal ; -INSTANCE: ${T}-vector specialized-vector -INSTANCE: ${T}-vector growable +INSTANCE: ${type}-vector specialized-vector -M: ${T}-vector contract 2drop ; inline +M: ${type}-vector contract 2drop ; inline -M: ${T}-vector element-size drop \ ${T} heap-size ; inline +M: ${type}-vector element-size drop \ ${type} heap-size ; inline -M: ${T}-vector pprint-delims drop \ ${T}-vector{ \ } ; +M: ${type}-vector pprint-delims drop \ ${type}-vector{ \ } ; -M: ${T}-vector >pprint-sequence ; +M: ${type}-vector >pprint-sequence ; -M: ${T}-vector pprint* pprint-object ; +M: ${type}-vector pprint* pprint-object ; -M: ${T}-vector >c-ptr underlying>> underlying>> ; inline -M: ${T}-vector byte-length [ length ] [ element-size ] bi * ; inline +M: ${type}-vector >c-ptr underlying>> underlying>> ; inline +M: ${type}-vector byte-length [ length ] [ element-size ] bi * ; inline -M: ${T}-vector direct-like drop ; inline -M: ${T}-vector nth-c-ptr underlying>> nth-c-ptr ; inline +M: ${type}-vector direct-like drop ; inline +M: ${type}-vector nth-c-ptr underlying>> nth-c-ptr ; inline -M: ${T}-array like - drop dup ${T}-array instance? [ - dup ${T}-vector instance? [ - [ >c-ptr ] [ length>> ] bi - ] [ \ ${T} >c-array ] if +M: ${type}-array like + drop dup ${type}-array instance? [ + dup ${type}-vector instance? [ + [ >c-ptr ] [ length>> ] bi + ] [ \ ${type} >c-array ] if ] unless ; inline ]] diff --git a/basis/vectors/functor/functor.factor b/basis/vectors/functor/functor.factor index a6f82a1e2c..53978168ae 100644 --- a/basis/vectors/functor/functor.factor +++ b/basis/vectors/functor/functor.factor @@ -4,28 +4,32 @@ USING: classes functors growable kernel math sequences sequences.private functors2 ; IN: vectors.functor -SAME-FUNCTOR: special-vector ( vector: name underlying: existing-class -- ) [[ - USING: classes growable kernel math sequences sequences.private - specialized-arrays ; +! VECTORIZED: bit bit-array ! bit is not necessarily a word +! VECTORIZED: int int-array ! int is a word already - TUPLE: ${vector} { underlying ${underlying} } { length array-capacity } ; +SAME-FUNCTOR: vectorized ( type: name underlying: existing-word constructor: existing-word -- ) [[ + USING: classes growable kernel math sequences sequences.private ; - : >${vector} ( seq -- vector ) ${vector} new clone-like ; inline + << + TUPLE: ${type}-vector { underlying ${underlying} } { length array-capacity } ; + >> - : <${vector}> ( capacity -- vector ) <${underlying}> 0 ${vector} boa ; inline + : >${type}-vector ( seq -- vector ) ${type}-vector new clone-like ; inline - M: ${vector} like - drop dup ${vector} instance? [ - dup ${underlying} instance? [ dup length ${vector} boa ] [ >${vector} ] if + : <${type}-vector> ( capacity -- vector ) ${constructor} 0 ${type}-vector boa ; inline + + M: ${type}-vector like + drop dup ${type}-vector instance? [ + dup ${underlying} instance? [ dup length ${type}-vector boa ] [ >${type}-vector ] if ] unless ; inline - M: ${vector} new-sequence drop [ <${underlying}> ] [ >fixnum ] bi ${vector} boa ; inline + M: ${type}-vector new-sequence drop [ ${constructor} ] [ >fixnum ] bi ${type}-vector boa ; inline - M: ${underlying} new-resizable drop <${vector}> ; inline + M: ${underlying} new-resizable drop <${type}-vector> ; inline - M: ${vector} new-resizable drop <${vector}> ; inline + M: ${type}-vector new-resizable drop <${type}-vector> ; inline - M: ${vector} equal? over ${vector} instance? [ sequence= ] [ 2drop f ] if ; + M: ${type}-vector equal? over ${type}-vector instance? [ sequence= ] [ 2drop f ] if ; - INSTANCE: ${vector} growable + INSTANCE: ${type}-vector growable ]] diff --git a/core/functors2/functors2.factor b/core/functors2/functors2.factor index ddf319dd3b..734b42002c 100644 --- a/core/functors2/functors2.factor +++ b/core/functors2/functors2.factor @@ -63,8 +63,12 @@ ERROR: not-all-unique seq ; ] [ [ [ - [ dup word? [ vocabulary>> ] [ drop current-vocab name>> ] if ] [ dup word? [ name>> ] when ] bi - " => " glue "FROM: " " ;\n" surround + dup { [ word? ] } 1|| [ + [ dup word? [ vocabulary>> ] [ drop current-vocab name>> ] if ] [ dup word? [ name>> ] when ] bi + " => " glue "FROM: " " ;\n" surround + ] [ + drop "" + ] if ] ] replicate ] [ ] tri dup @@ -75,7 +79,7 @@ ERROR: not-all-unique seq ; ! append the IN: and the FROM: quot generator and the functor code [ append - '[ @ over '[ _ _ parse-stream drop ] generate-vocab use-vocab ] + '[ @ over '[ _ _ parse-stream call( -- ) ] generate-vocab use-vocab ] ] dip ] 3tri ;