Add support for C99 complex float and complex double types to FFI

They are named complex-float and complex-double in the Factor world

basis/alien/arrays/arrays.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays alien.c-types alien.structs
-sequences math kernel namespaces make libc cpu.architecture ;
+sequences math kernel namespaces fry libc cpu.architecture ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;
@@ -10,7 +10,7 @@ M: array c-type ;
 
 M: array c-type-class drop object ;
 
-M: array heap-size unclip heap-size [ * ] reduce ;
+M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
 
 M: array c-type-align first c-type-align ;
 
@@ -26,16 +26,15 @@ M: array box-return drop "void*" box-return ;
 
 M: array stack-size drop "void*" stack-size ;
 
+M: array c-type-boxer-quot drop f ;
+
+M: array c-type-unboxer-quot drop f ;
+
 M: value-type c-type-reg-class drop int-regs ;
 
-M: value-type c-type-boxer-quot drop f ;
-
-M: value-type c-type-unboxer-quot drop f ;
-
 M: value-type c-type-getter
     drop [ swap <displaced-alien> ] ;
 
 M: value-type c-type-setter ( type -- quot )
-    [
+    [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
-        dup c-type-getter % \ swap , heap-size , \ memcpy ,
+    '[ @ swap @ _ memcpy ] ;
-    ] [ ] make ;

basis/alien/c-types/c-types-docs.factor

@@ -178,6 +178,8 @@ $nl
     { { $snippet "ulonglong" } { } }
     { { $snippet "float" } { } }
     { { $snippet "double" } { "same format as " { $link float } " objects" } }
+    { { $snippet "complex-float" } { "C99 " { $snippet "complex float" } " type, converted to and from " { $link complex } " values" } }
+    { { $snippet "complex-double" } { "C99 " { $snippet "complex double" } " type, converted to and from " { $link complex } " values" } }
 }
 "When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision."
 $nl

basis/alien/structs/structs.factor

@@ -5,7 +5,7 @@ math namespaces parser sequences strings words libc fry
 alien.c-types alien.structs.fields cpu.architecture math.order ;
 IN: alien.structs
 
-TUPLE: struct-type size align fields ;
+TUPLE: struct-type size align fields boxer-quot unboxer-quot getter setter ;
 
 M: struct-type heap-size size>> ;
 
@@ -15,6 +15,10 @@ M: struct-type c-type-align align>> ;
 
 M: struct-type c-type-stack-align? drop f ;
 
+M: struct-type c-type-boxer-quot boxer-quot>> ;
+
+M: struct-type c-type-unboxer-quot unboxer-quot>> ;
+
 : if-value-struct ( ctype true false -- )
     [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
 
@@ -40,7 +44,10 @@ M: struct-type stack-size
 
 : (define-struct) ( name size align fields -- )
     [ [ align ] keep ] dip
-    struct-type boa
+    struct-type new
+    swap >>fields
+    swap >>align
+    swap >>size
     swap typedef ;
 
 : make-fields ( name vocab fields -- fields )

basis/compiler/codegen/codegen.factor

@@ -3,8 +3,8 @@
 USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
-alien.strings alien.arrays sets libc continuations.private
+alien.strings alien.arrays alien.complex sets libc
-fry cpu.architecture
+continuations.private fry cpu.architecture
 compiler.errors
 compiler.alien
 compiler.cfg

basis/compiler/tests/alien.factor

@@ -558,3 +558,10 @@ FUNCTION: test_struct_14 ffi_test_44 ( ) ; inline
 : stack-frame-bustage ( -- a b ) ffi_test_44 gc 3 ;
 
 [ ] [ stack-frame-bustage 2drop ] unit-test
+
+FUNCTION: complex-float ffi_test_45 ( complex-float x, complex-double y ) ;
+
+[ C{ 4.0 4.0 } ] [
+    C{ 1.0 2.0 }
+    C{ 1.5 1.0 } ffi_test_45
+] unit-test

vm/ffi_test.c

@@ -1,6 +1,5 @@
 /* This file is linked into the runtime for the sole purpose
  * of testing FFI code. */
-#include <stdio.h>
 #include "master.h"
 #include "ffi_test.h"
 
@@ -303,3 +302,8 @@ struct test_struct_14 ffi_test_44(void)
 	retval.x2 = 2.0;
 	return retval;
 }
+
+complex float ffi_test_45(complex float x, complex double y)
+{
+	return x + 2 * y;
+}

vm/ffi_test.h

@@ -88,3 +88,5 @@ struct test_struct_16 { float x; int a; };
 DLLEXPORT struct test_struct_16 ffi_test_43(float x, int a);
 
 DLLEXPORT struct test_struct_14 ffi_test_44();
+
+complex float ffi_test_45(complex float x, complex double y);

vm/master.h

@@ -8,6 +8,7 @@
 #include <fcntl.h>
 #include <limits.h>
 #include <math.h>
+#include <complex.h>
 #include <stdbool.h>
 #include <setjmp.h>