]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/specialized-arrays/functor/functor.factor
Fix conflicts
[factor.git] / basis / specialized-arrays / functor / functor.factor
old mode 100644 (file)
new mode 100755 (executable)
index aaec309..b4d0524
@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: functors sequences sequences.private prettyprint.custom
 kernel words classes math math.vectors.specialization parser
-alien.c-types byte-arrays accessors summary ;
+alien.c-types byte-arrays accessors summary alien specialized-arrays ;
 IN: specialized-arrays.functor
 
 ERROR: bad-byte-array-length byte-array type ;
@@ -22,9 +22,12 @@ A            DEFINES-CLASS ${T}-array
 S            DEFINES-CLASS ${T}-sequence
 <A>          DEFINES <${A}>
 (A)          DEFINES (${A})
+<direct-A>   DEFINES <direct-${A}>
 >A           DEFINES >${A}
 byte-array>A DEFINES byte-array>${A}
+
 A{           DEFINES ${A}{
+A@           DEFINES ${A}@
 
 NTH          [ T dup c-type-getter-boxer array-accessor ]
 SET-NTH      [ T dup c-setter array-accessor ]
@@ -34,18 +37,20 @@ WHERE
 MIXIN: S
 
 TUPLE: A
-{ length array-capacity read-only }
-{ underlying byte-array read-only } ;
+{ underlying c-ptr read-only }
+{ length array-capacity read-only } ;
+
+: <direct-A> ( alien len -- specialized-array ) A boa ; inline
 
-: <A> ( n -- specialized-array ) dup T <underlying> A boa ; inline
+: <A> ( n -- specialized-array ) [ T <underlying> ] keep <direct-A> ; inline
 
-: (A) ( n -- specialized-array ) dup T (underlying) A boa ; inline
+: (A) ( n -- specialized-array ) [ T (underlying) ] keep <direct-A> ; inline
 
 : byte-array>A ( byte-array -- specialized-array )
     dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
-    swap A boa ; inline
+    <direct-A> ; inline
 
-M: A clone [ length>> ] [ underlying>> clone ] bi A boa ; inline
+M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
 
 M: A length length>> ; inline
 
@@ -62,24 +67,20 @@ M: A new-sequence drop (A) ; inline
 M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
 
 M: A resize
-    [ drop ] [
+    [
         [ T heap-size * ] [ underlying>> ] bi*
         resize-byte-array
-    ] 2bi
-    A boa ; inline
+    ] [ drop ] 2bi
+    <direct-A> ; inline
 
 M: A byte-length underlying>> length ; inline
-
 M: A pprint-delims drop \ A{ \ } ;
-
 M: A >pprint-sequence ;
 
-M: A pprint* pprint-object ;
-
 SYNTAX: A{ \ } [ >A ] parse-literal ;
+SYNTAX: A@ scan-object scan-object <direct-A> parsed ;
 
-INSTANCE: A sequence
-INSTANCE: A S
+INSTANCE: A specialized-array
 
 A T c-type-boxed-class f specialize-vector-words
 
@@ -87,7 +88,7 @@ T c-type
     \ A >>array-class
     \ <A> >>array-constructor
     \ (A) >>(array)-constructor
-    \ S >>sequence-mixin-class
+    \ <direct-A> >>direct-array-constructor
     drop
 
 ;FUNCTOR