functors: Fix up look sharp

basis/specialized-arrays/specialized-arrays.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.data alien.parser
-byte-arrays classes combinators fry functors kernel lexer locals
+arrays byte-arrays classes combinators fry functors2
-make math math.vectors parser prettyprint.custom sequences
+kernel lexer locals make math math.parser math.vectors parser
-sequences.private vocabs.generated vocabs.loader vocabs.parser
+prettyprint.custom sequences sequences.private vocabs.generated
-words math.parser arrays functors2 ;
+vocabs.loader vocabs.parser words ;
 IN: specialized-arrays
 
 MIXIN: specialized-array-mixin
@@ -176,4 +176,4 @@ SYNTAX: \SPECIALIZED-ARRAYS:
 
 ! { "specialized-arrays" "mirrors" } "specialized-arrays.mirrors" require-when
 
-! uchar define-specialized-array
+uchar define-specialized-array

basis/specialized-vectors/specialized-vectors-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax byte-vectors alien byte-arrays classes.struct ;
+USING: alien byte-arrays classes.struct help.markup help.syntax ;
 IN: specialized-vectors
 
 HELP: \SPECIALIZED-VECTOR:

basis/specialized-vectors/specialized-vectors-tests.factor

@@ -1,8 +1,10 @@
 IN: specialized-vectors.tests
 USING: specialized-arrays specialized-vectors
-tools.test kernel sequences alien.c-types ;
+tools.test kernel sequences alien.c-types vectors.functor ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-VECTORS: float double ;
+SPECIAL-VECTOR: double
+SPECIAL-VECTOR: float
 
 { 3 } [ double-vector{ 1 2 } 3 suffix! length ] unit-test
 

basis/specialized-vectors/specialized-vectors.factor

@@ -1,69 +1,64 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.data alien.parser
+USING: alien.parser arrays functors2 growable kernel lexer make
-classes fry functors growable kernel lexer make math parser
+math.parser sequences vocabs.loader ;
-prettyprint.custom sequences specialized-arrays vocabs.generated
-vocabs.loader vocabs.parser ;
 FROM: sequences.private => nth-unsafe ;
-FROM: specialized-arrays.private => nth-c-ptr direct-like ;
 QUALIFIED: vectors.functor
 IN: specialized-vectors
 
 MIXIN: specialized-vector
 
-<PRIVATE
+FUNCTOR: specialized-vector ( T: existing-word -- ) [[
 
-<FUNCTOR: define-vector ( T -- )
+USING: accessors alien alien.c-types alien.data classes growable
+kernel math parser prettyprint.custom sequences
+sequences.private specialized-arrays specialized-arrays.private
+specialized-vectors vectors.functor ;
+FROM: specialized-arrays.private => nth-c-ptr direct-like ;
 
-V DEFINES-CLASS ${T}-vector
+SPECIALIZED-ARRAY: ${T}
 
-A          IS ${T}-array
+SPECIAL-VECTOR: ${T}
-<A>        IS <${A}>
-<direct-A> IS <direct-${A}>
 
->V DEFERS >${V}
+SYNTAX: ${T}-vector{ \ } [ >${T}-vector ] parse-literal ;
-V{ DEFINES ${V}{
 
-WHERE
+INSTANCE: ${T}-vector specialized-vector
+INSTANCE: ${T}-vector growable
 
-V A <A> vectors.functor:define-vector
+M: ${T}-vector contract 2drop ; inline
 
-M: V contract 2drop ; inline
+M: ${T}-vector element-size drop \ ${T} heap-size ; inline
 
-M: V element-size drop \ T heap-size ; inline
+M: ${T}-vector pprint-delims drop \ ${T}-vector{ \ } ;
 
-M: V pprint-delims drop \ V{ \ } ;
+M: ${T}-vector >pprint-sequence ;
 
-M: V >pprint-sequence ;
+M: ${T}-vector pprint* pprint-object ;
 
-M: V pprint* pprint-object ;
+M: ${T}-vector >c-ptr underlying>> underlying>> ; inline
+M: ${T}-vector byte-length [ length ] [ element-size ] bi * ; inline
 
-M: V >c-ptr underlying>> underlying>> ; inline
+M: ${T}-vector direct-like drop <direct-${T}-array> ; inline
-M: V byte-length [ length ] [ element-size ] bi * ; inline
+M: ${T}-vector nth-c-ptr underlying>> nth-c-ptr ; inline
 
-M: V direct-like drop <direct-A> ; inline
+M: ${T}-array like
-M: V nth-c-ptr underlying>> nth-c-ptr ; inline
+    drop dup ${T}-array instance? [
-
+        dup ${T}-vector instance? [
-M: A like
+            [ >c-ptr ] [ length>> ] bi <direct-${T}-array>
-    drop dup A instance? [
+        ] [ \ ${T} >c-array ] if
-        dup V instance? [
-            [ >c-ptr ] [ length>> ] bi <direct-A>
-        ] [ \ T >c-array ] if
     ] unless ; inline
 
-SYNTAX: V{ \ } [ >V ] parse-literal ;
+]]
 
-INSTANCE: V specialized-vector
+<PRIVATE
-INSTANCE: V growable
-
-;FUNCTOR>
 
 : specialized-vector-vocab ( c-type -- vocab )
     [
-        "specialized-vectors.instances." %
+        "specialized-vectors:functors:specialized-vector:" %
-        [ vocabulary>> % "." % ]
+        ! [ vocabulary>> % "." % ]
-        [ name>> % ]
+        ! [ name>> % ":" % ]
-        bi
+        [ drop ]
+        [ 1array hashcode number>string % ] bi
     ] "" make ;
 
 PRIVATE>
@@ -71,21 +66,7 @@ PRIVATE>
 : push-new ( vector -- new )
     [ length ] keep ensure nth-unsafe ; inline
 
-: define-vector-vocab ( type -- vocab )
-    underlying-type
-    [ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi
-    generate-vocab ;
-
 SYNTAX: \SPECIALIZED-VECTORS:
-    ";" [
+    ";" [ parse-c-type define-specialized-vector ] each-token ;
-        parse-c-type
-        [ define-specialized-array use-vocab ]
-        [ define-vector-vocab use-vocab ] bi
-    ] each-token ;
-
-SYNTAX: \SPECIALIZED-VECTOR:
-    scan-c-type
-    [ define-specialized-array use-vocab ]
-    [ define-vector-vocab use-vocab ] bi ;
 
 { "specialized-vectors" "mirrors" } "specialized-vectors.mirrors" require-when

basis/vectors/functor/functor.factor

@@ -1,35 +1,34 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes functors growable kernel math sequences
-sequences.private ;
+sequences.private functors2 ;
 IN: vectors.functor
 
-<FUNCTOR: define-vector ( V A <A> -- )
+FUNCTOR: special-vector ( T: existing-word -- ) [[
+USING: classes growable kernel math sequences sequences.private
+specialized-arrays ;
 
-<V> DEFINES <${V}>
+SPECIALIZED-ARRAY: ${T}
->V  DEFINES >${V}
 
-WHERE
+TUPLE: ${T}-vector { underlying ${T}-array } { length array-capacity } ;
 
-TUPLE: V { underlying A } { length array-capacity } ;
+: >${T}-vector ( seq -- vector ) ${T}-vector new clone-like ; inline
 
-: <V> ( capacity -- vector ) <A> 0 V boa ; inline
+: <${T}-vector> ( capacity -- vector ) <${T}-array> 0 ${T}-vector boa ; inline
 
-M: V like
+M: ${T}-vector like
-    drop dup V instance? [
+    drop dup ${T}-vector instance? [
-        dup A instance? [ dup length V boa ] [ >V ] if
+        dup ${T}-array instance? [ dup length ${T}-vector boa ] [ >${T}-vector ] if
     ] unless ; inline
 
-M: V new-sequence drop [ <A> ] [ >fixnum ] bi V boa ; inline
+M: ${T}-vector new-sequence drop [ <${T}-array> ] [ >fixnum ] bi ${T}-vector boa ; inline
 
-M: A new-resizable drop <V> ; inline
+M: ${T}-array new-resizable drop <${T}-vector> ; inline
 
-M: V new-resizable drop <V> ; inline
+M: ${T}-vector new-resizable drop <${T}-vector> ; inline
 
-M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ;
+M: ${T}-vector equal? over ${T}-vector instance? [ sequence= ] [ 2drop f ] if ;
 
-: >V ( seq -- vector ) V new clone-like ; inline
+INSTANCE: ${T}-vector growable
 
-INSTANCE: V growable
+]]
-
-;FUNCTOR>