Slices over specialized arrays can now be passed to C functions, written to binary...

[factor.git] / basis / specialized-vectors / specialized-vectors.factor

diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor
index 19f32a7fdbf0df27fd303dc610f3ee0be76e6804..0c0569ea9d964a4a4f748723b26d494afa5fd262 100644 (file)
--- a/basis/specialized-vectors/specialized-vectors.factor
+++ b/basis/specialized-vectors/specialized-vectors.factor
@@ -1,9 +1,10 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types assocs compiler.units functors
-growable io kernel lexer namespaces parser prettyprint.custom
-sequences specialized-arrays specialized-arrays.private strings
-vocabs vocabs.parser ;
+USING: accessors alien alien.c-types alien.parser assocs
+compiler.units functors growable kernel lexer math namespaces
+parser prettyprint.custom sequences specialized-arrays
+specialized-arrays.private strings vocabs vocabs.parser
+vocabs.generated fry make ;
 QUALIFIED: vectors.functor
 IN: specialized-vectors
 
@@ -14,7 +15,6 @@ FUNCTOR: define-vector ( T -- )
 V   DEFINES-CLASS ${T}-vector
 
 A   IS      ${T}-array
-S   IS      ${T}-sequence
 <A> IS      <${A}>
 
 >V  DEFERS >${V}
@@ -24,9 +24,9 @@ WHERE
 
 V A <A> vectors.functor:define-vector
 
-M: V contract 2drop ;
+M: V contract 2drop ; inline
 
-M: V byte-length underlying>> byte-length ;
+M: V element-size drop \ T heap-size ; inline
 
 M: V pprint-delims drop \ V{ \ } ;
 
@@ -37,36 +37,32 @@ M: V pprint* pprint-object ;
 SYNTAX: V{ \ } [ >V ] parse-literal ;
 
 INSTANCE: V growable
-INSTANCE: V S
 
 ;FUNCTOR
 
-: specialized-vector-vocab ( type -- vocab )
-    "specialized-vectors.instances." prepend ;
-
-: defining-vector-message ( type -- )
-    "quiet" get [ drop ] [
-        "Generating specialized " " vectors..." surround print
-    ] if ;
+: specialized-vector-vocab ( c-type -- vocab )
+    [
+        "specialized-vectors.instances." %
+        [ vocabulary>> % "." % ]
+        [ name>> % ]
+        bi
+    ] "" make ;
 
 PRIVATE>
 
-: define-vector-vocab ( type  -- vocab )
+: define-vector-vocab ( type -- vocab )
     underlying-type
-    dup specialized-vector-vocab vocab
-    [ ] [
-        [ defining-vector-message ]
-        [
-            [
-                dup specialized-vector-vocab
-                [ define-vector ] with-current-vocab
-            ] with-compilation-unit
-        ]
-        [ specialized-vector-vocab ]
-        tri
-    ] ?if ;
+    [ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi
+    generate-vocab ;
+
+SYNTAX: SPECIALIZED-VECTORS:
+    ";" parse-tokens [
+        parse-c-type
+        [ define-array-vocab use-vocab ]
+        [ define-vector-vocab use-vocab ] bi
+    ] each ;
 
 SYNTAX: SPECIALIZED-VECTOR:
-    scan
+    scan-c-type
     [ define-array-vocab use-vocab ]
     [ define-vector-vocab use-vocab ] bi ;