alien: need to differentiate between the type of the result before and after boxing...

diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
index 4786c85bd469068b49d0b68be6e68b91d8987919..d793814c28925225b1ae9ff13ff5df2b5790c4c4 100755 (executable)
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -11,6 +11,8 @@ M: array c-type ;
 
 M: array c-type-class drop object ;
 
+M: array c-type-boxed-class drop object ;
+
 M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
 
 M: array c-type-align first c-type-align ;
@@ -45,8 +47,9 @@ PREDICATE: string-type < pair
 
 M: string-type c-type ;
 
-M: string-type c-type-class
-    drop object ;
+M: string-type c-type-class drop object ;
+
+M: string-type c-type-boxed-class drop object ;
 
 M: string-type heap-size
     drop "void*" heap-size ;

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 7807113999a4f27de2f733d1d4a027921b91f74d..2eba6a2b9e76cd9cb47434716a7df391c82248ec 100755 (executable)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -15,6 +15,7 @@ DEFER: *char
 
 TUPLE: abstract-c-type
 { class class initial: object }
+{ boxed-class class initial: object }
 { boxer-quot callable }
 { unboxer-quot callable }
 { getter callable }
@@ -76,6 +77,12 @@ M: abstract-c-type c-type-class class>> ;
 
 M: string c-type-class c-type c-type-class ;
 
+GENERIC: c-type-boxed-class ( name -- class )
+
+M: abstract-c-type c-type-boxed-class boxed-class>> ;
+
+M: string c-type-boxed-class c-type c-type-boxed-class ;
+
 GENERIC: c-type-boxer ( name -- boxer )
 
 M: c-type c-type-boxer boxer>> ;
@@ -300,6 +307,7 @@ CONSTANT: primitive-types
 [
     <c-type>
         c-ptr >>class
+        c-ptr >>boxed-class
         [ alien-cell ] >>getter
         [ [ >c-ptr ] 2dip set-alien-cell ] >>setter
         bootstrap-cell >>size
@@ -311,6 +319,7 @@ CONSTANT: primitive-types
 
     <long-long-type>
         integer >>class
+        integer >>boxed-class
         [ alien-signed-8 ] >>getter
         [ set-alien-signed-8 ] >>setter
         8 >>size
@@ -321,6 +330,7 @@ CONSTANT: primitive-types
 
     <long-long-type>
         integer >>class
+        integer >>boxed-class
         [ alien-unsigned-8 ] >>getter
         [ set-alien-unsigned-8 ] >>setter
         8 >>size
@@ -331,6 +341,7 @@ CONSTANT: primitive-types
 
     <c-type>
         integer >>class
+        integer >>boxed-class
         [ alien-signed-cell ] >>getter
         [ set-alien-signed-cell ] >>setter
         bootstrap-cell >>size
@@ -341,6 +352,7 @@ CONSTANT: primitive-types
 
     <c-type>
         integer >>class
+        integer >>boxed-class
         [ alien-unsigned-cell ] >>getter
         [ set-alien-unsigned-cell ] >>setter
         bootstrap-cell >>size
@@ -351,6 +363,7 @@ CONSTANT: primitive-types
 
     <c-type>
         integer >>class
+        integer >>boxed-class
         [ alien-signed-4 ] >>getter
         [ set-alien-signed-4 ] >>setter
         4 >>size
@@ -361,6 +374,7 @@ CONSTANT: primitive-types
 
     <c-type>
         integer >>class
+        integer >>boxed-class
         [ alien-unsigned-4 ] >>getter
         [ set-alien-unsigned-4 ] >>setter
         4 >>size
@@ -371,6 +385,7 @@ CONSTANT: primitive-types
 
     <c-type>
         fixnum >>class
+        fixnum >>boxed-class
         [ alien-signed-2 ] >>getter
         [ set-alien-signed-2 ] >>setter
         2 >>size
@@ -381,6 +396,7 @@ CONSTANT: primitive-types
 
     <c-type>
         fixnum >>class
+        fixnum >>boxed-class
         [ alien-unsigned-2 ] >>getter
         [ set-alien-unsigned-2 ] >>setter
         2 >>size
@@ -391,6 +407,7 @@ CONSTANT: primitive-types
 
     <c-type>
         fixnum >>class
+        fixnum >>boxed-class
         [ alien-signed-1 ] >>getter
         [ set-alien-signed-1 ] >>setter
         1 >>size
@@ -401,6 +418,7 @@ CONSTANT: primitive-types
 
     <c-type>
         fixnum >>class
+        fixnum >>boxed-class
         [ alien-unsigned-1 ] >>getter
         [ set-alien-unsigned-1 ] >>setter
         1 >>size
@@ -420,6 +438,7 @@ CONSTANT: primitive-types
 
     <c-type>
         float >>class
+        float >>boxed-class
         [ alien-float ] >>getter
         [ [ >float ] 2dip set-alien-float ] >>setter
         4 >>size
@@ -432,6 +451,7 @@ CONSTANT: primitive-types
 
     <c-type>
         float >>class
+        float >>boxed-class
         [ alien-double ] >>getter
         [ [ >float ] 2dip set-alien-double ] >>setter
         8 >>size

diff --git a/basis/alien/complex/complex-tests.factor b/basis/alien/complex/complex-tests.factor
index 0bff73b898dae2ddc88e873c4c0d3d722461275c..e84bb322e29020a99742ca13539aa20f66878a9f 100644 (file)
--- a/basis/alien/complex/complex-tests.factor
+++ b/basis/alien/complex/complex-tests.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test alien.complex kernel alien.c-types alien.syntax
-namespaces ;
+namespaces math ;
 IN: alien.complex.tests
 
 C-STRUCT: complex-holder
@@ -16,3 +16,7 @@ C-STRUCT: complex-holder
 ] unit-test
 
 [ C{ 1.0 2.0 } ] [ "h" get complex-holder-z ] unit-test
+
+[ complex ] [ "complex-float" c-type-boxed-class ] unit-test
+
+[ complex ] [ "complex-double" c-type-boxed-class ] unit-test
\ No newline at end of file

diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor
index 59bf3451b87cd70b23a6a06318114780ba763f21..98d412639f8c239a0b50e76848b1a559fad8a5f6 100644 (file)
--- a/basis/alien/complex/functor/functor.factor
+++ b/basis/alien/complex/functor/functor.factor
@@ -30,7 +30,7 @@ define-struct
 T c-type
 <T> 1quotation >>unboxer-quot
 *T 1quotation >>boxer-quot
-number >>class
+number >>boxed-class
 drop
 
 ;FUNCTOR

diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index 4154ad1dd8f3aef9e1f3d1f7b967d2d1499b6f9e..5c1fb4063b90f78dff63428173bc87be66eb558c 100755 (executable)
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -39,6 +39,7 @@ M: struct-type stack-size
     [ [ align ] keep ] dip
     struct-type new
         byte-array >>class
+        byte-array >>boxed-class
         swap >>fields
         swap >>align
         swap >>size

diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor
index beb4aa89ac4f587f07b22c0deb700852619f33f8..1c855be1a485c84144538cdcc51eea63d683e04e 100644 (file)
--- a/basis/specialized-arrays/functor/functor.factor
+++ b/basis/specialized-arrays/functor/functor.factor
@@ -74,6 +74,6 @@ SYNTAX: A{ \ } [ >A ] parse-literal ;
 
 INSTANCE: A sequence
 
-A T c-type class>> specialize-vector-words
+A T c-type-boxed-class specialize-vector-words
 
 ;FUNCTOR