Fix conflicts

[factor.git] / basis / alien / c-types / c-types.factor

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 8a1b60a0dbebf77051ce327a4a9ce3e297e859a6..aa2ac2f93d6c6a4eb1a2693e76f30a7145a372eb 100755 (executable)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -24,9 +24,8 @@ size
 align
 array-class
 array-constructor
-direct-array-class
-direct-array-constructor
-sequence-mixin-class ;
+(array)-constructor
+direct-array-constructor ;
 
 TUPLE: c-type < abstract-c-type
 boxer
@@ -79,47 +78,72 @@ M: string c-type ( name -- type )
 : ?require-word ( word/pair -- )
     dup word? [ drop ] [ first require ] ?if ;
 
-GENERIC: require-c-type-arrays ( c-type -- )
+! These words being foldable means that words need to be
+! recompiled if a C type is redefined. Even so, folding the
+! size facilitates some optimizations.
+GENERIC: heap-size ( type -- size ) foldable
+
+M: string heap-size c-type heap-size ;
+
+M: abstract-c-type heap-size size>> ;
 
-M: object require-c-type-arrays
+GENERIC: require-c-array ( c-type -- )
+
+M: object require-c-array
     drop ;
 
-M: c-type require-c-type-arrays
-    [ array-class>> ?require-word ]
-    [ sequence-mixin-class>> ?require-word ]
-    [ direct-array-class>> ?require-word ] tri ;
+M: c-type require-c-array
+    array-class>> ?require-word ;
 
-M: string require-c-type-arrays
-    c-type require-c-type-arrays ;
+M: string require-c-array
+    c-type require-c-array ;
 
-M: array require-c-type-arrays
-    first c-type require-c-type-arrays ;
+M: array require-c-array
+    first c-type require-c-array ;
 
 ERROR: specialized-array-vocab-not-loaded vocab word ;
 
-: c-type-array-constructor ( c-type -- word )
+: c-array-constructor ( c-type -- word )
     array-constructor>> dup array?
     [ first2 specialized-array-vocab-not-loaded ] when ; foldable
 
-: c-type-direct-array-constructor ( c-type -- word )
+: c-(array)-constructor ( c-type -- word )
+    (array)-constructor>> dup array?
+    [ first2 specialized-array-vocab-not-loaded ] when ; foldable
+
+: c-direct-array-constructor ( c-type -- word )
     direct-array-constructor>> dup array?
     [ first2 specialized-array-vocab-not-loaded ] when ; foldable
 
-GENERIC: <c-type-array> ( len c-type -- array )
-M: object <c-type-array>
-    c-type-array-constructor execute( len -- array ) ; inline
-M: string <c-type-array>
-    c-type <c-type-array> ; inline
-M: array <c-type-array>
-    first c-type <c-type-array> ; inline
-
-GENERIC: <c-type-direct-array> ( alien len c-type -- array )
-M: object <c-type-direct-array>
-    c-type-direct-array-constructor execute( alien len -- array ) ; inline
-M: string <c-type-direct-array>
-    c-type <c-type-direct-array> ; inline
-M: array <c-type-direct-array>
-    first c-type <c-type-direct-array> ; inline
+GENERIC: <c-array> ( len c-type -- array )
+M: object <c-array>
+    c-array-constructor execute( len -- array ) ; inline
+M: string <c-array>
+    c-type <c-array> ; inline
+M: array <c-array>
+    first c-type <c-array> ; inline
+
+GENERIC: (c-array) ( len c-type -- array )
+M: object (c-array)
+    c-(array)-constructor execute( len -- array ) ; inline
+M: string (c-array)
+    c-type (c-array) ; inline
+M: array (c-array)
+    first c-type (c-array) ; inline
+
+GENERIC: <c-direct-array> ( alien len c-type -- array )
+M: object <c-direct-array>
+    c-direct-array-constructor execute( alien len -- array ) ; inline
+M: string <c-direct-array>
+    c-type <c-direct-array> ; inline
+M: array <c-direct-array>
+    first c-type <c-direct-array> ; inline
+
+: malloc-array ( n type -- alien )
+    [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
+
+: (malloc-array) ( n type -- alien )
+    [ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
 
 GENERIC: c-type-class ( name -- class )
 
@@ -219,15 +243,6 @@ M: c-type unbox-return f swap c-type-unbox ;
 
 M: string unbox-return c-type unbox-return ;
 
-! These words being foldable means that words need to be
-! recompiled if a C type is redefined. Even so, folding the
-! size facilitates some optimizations.
-GENERIC: heap-size ( type -- size ) foldable
-
-M: string heap-size c-type heap-size ;
-
-M: abstract-c-type heap-size size>> ;
-
 GENERIC: stack-size ( type -- size ) foldable
 
 M: string stack-size c-type stack-size ;
@@ -253,20 +268,17 @@ M: f byte-length drop 0 ; inline
         [ "Cannot write struct fields with this type" throw ]
     ] unless* ;
 
-: <c-array> ( n type -- array )
-    heap-size * <byte-array> ; inline deprecated
-
 : <c-object> ( type -- array )
     heap-size <byte-array> ; inline
 
 : (c-object) ( type -- array )
     heap-size (byte-array) ; inline
 
-: malloc-array ( n type -- alien )
-    [ heap-size calloc ] [ <c-type-direct-array> ] 2bi ; inline
-
 : malloc-object ( type -- alien )
-   heap-size malloc ; inline
+    1 swap heap-size calloc ; inline
+
+: (malloc-object) ( type -- alien )
+    heap-size malloc ; inline
 
 : malloc-byte-array ( byte-array -- alien )
     dup byte-length [ nip malloc dup ] 2keep memcpy ;
@@ -350,14 +362,10 @@ M: long-long-type box-return ( type -- )
         ]
         [
             [ "specialized-arrays." prepend ]
-            [ "-sequence" append ] bi* ?lookup >>sequence-mixin-class
+            [ "(" "-array)" surround ] bi* ?lookup >>(array)-constructor
         ]
         [
-            [ "specialized-arrays.direct." prepend ]
-            [ "direct-" "-array" surround ] bi* ?lookup >>direct-array-class
-        ]
-        [
-            [ "specialized-arrays.direct." prepend ]
+            [ "specialized-arrays." prepend ]
             [ "<direct-" "-array>" surround ] bi* ?lookup >>direct-array-constructor
         ]
     } 2cleave ;
@@ -529,7 +537,7 @@ CONSTANT: primitive-types
         4 >>align
         "box_float" >>boxer
         "to_float" >>unboxer
-        single-float-rep >>rep
+        float-rep >>rep
         [ >float ] >>unboxer-quot
         "float" set-array-class
     "float" define-primitive-type
@@ -543,7 +551,7 @@ CONSTANT: primitive-types
         8 >>align
         "box_double" >>boxer
         "to_double" >>unboxer
-        double-float-rep >>rep
+        double-rep >>rep
         [ >float ] >>unboxer-quot
         "double" set-array-class
     "double" define-primitive-type