(scheme foreign): API is less configuration-dependent

* libguile/foreign.h:
* libguile/foreign.c: Always define complex-float and complex-double.
Fall back to alignof float / 2*sizeof float if no complex numbers.  (But
with C99 surely it exists everywhere.)
* module/system/foreign.scm (*writers*, *readers*): Always include
complex-float and complex-double readers and writers.
* test-suite/tests/foreign.test: Always run the complex tests.

libguile/foreign.c

@@ -1,4 +1,4 @@
-/* Copyright 2010-2016,2018
+/* Copyright 2010-2016,2018,2024
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -29,7 +29,7 @@
 
 #include <ffi.h>
 
-#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
+#ifdef HAVE_COMPLEX_H
 #include <complex.h>
 #endif
 
@@ -67,10 +67,8 @@
 SCM_SYMBOL (sym_void, "void");
 SCM_SYMBOL (sym_float, "float");
 SCM_SYMBOL (sym_double, "double");
-#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
 SCM_SYMBOL (sym_complex_float, "complex-float");
 SCM_SYMBOL (sym_complex_double, "complex-double");
-#endif
 SCM_SYMBOL (sym_uint8, "uint8");
 SCM_SYMBOL (sym_int8, "int8");
 SCM_SYMBOL (sym_uint16, "uint16");
@@ -478,11 +476,17 @@ SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type),
           return scm_from_size_t (alignof_type (float));
         case SCM_FOREIGN_TYPE_DOUBLE:
           return scm_from_size_t (alignof_type (double));
-#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
         case SCM_FOREIGN_TYPE_COMPLEX_FLOAT:
+#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
           return scm_from_size_t (alignof_type (float _Complex));
+#else
+          return scm_from_size_t (alignof_type (float));
+#endif
         case SCM_FOREIGN_TYPE_COMPLEX_DOUBLE:
+#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
           return scm_from_size_t (alignof_type (double _Complex));
+#else
+          return scm_from_size_t (alignof_type (double));
 #endif
         case SCM_FOREIGN_TYPE_UINT8:
           return scm_from_size_t (alignof_type (uint8_t));
@@ -548,11 +552,17 @@ SCM_DEFINE (scm_sizeof, "sizeof", 1, 0, 0, (SCM type),
           return scm_from_size_t (sizeof (float));
         case SCM_FOREIGN_TYPE_DOUBLE:
           return scm_from_size_t (sizeof (double));
-#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
         case SCM_FOREIGN_TYPE_COMPLEX_FLOAT:
+#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
           return scm_from_size_t (sizeof (float _Complex));
+#else
+          return scm_from_size_t (2 * sizeof (float));
+#endif
         case SCM_FOREIGN_TYPE_COMPLEX_DOUBLE:
+#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
           return scm_from_size_t (sizeof (double _Complex));
+#else
+          return scm_from_size_t (2 * sizeof (double));
 #endif
         case SCM_FOREIGN_TYPE_UINT8:
           return scm_from_size_t (sizeof (uint8_t));
@@ -607,6 +617,14 @@ parse_ffi_type (SCM type, int return_p, long *n_structs, long *n_struct_elts)
         return 0;
       else if (SCM_I_INUM (type) == SCM_FOREIGN_TYPE_VOID && !return_p)
         return 0;
+#ifndef FFI_TARGET_HAS_COMPLEX_TYPE
+      /* The complex types are always defined so they can be used when
+         accessing data, but some targets don't support them as
+         arguments or return values.  */
+      else if (SCM_I_INUM (type) == SCM_FOREIGN_TYPE_COMPLEX_FLOAT
+               || SCM_I_INUM (type) == SCM_FOREIGN_TYPE_COMPLEX_DOUBLE)
+        return 0;
+#endif
       else
         return 1;
     }
@@ -1239,10 +1257,8 @@ scm_init_foreign (void)
   scm_define (sym_void, scm_from_uint8 (SCM_FOREIGN_TYPE_VOID));
   scm_define (sym_float, scm_from_uint8 (SCM_FOREIGN_TYPE_FLOAT));
   scm_define (sym_double, scm_from_uint8 (SCM_FOREIGN_TYPE_DOUBLE));
-#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
   scm_define (sym_complex_float, scm_from_uint8 (SCM_FOREIGN_TYPE_COMPLEX_FLOAT));
   scm_define (sym_complex_double, scm_from_uint8 (SCM_FOREIGN_TYPE_COMPLEX_DOUBLE));
-#endif
   scm_define (sym_uint8, scm_from_uint8 (SCM_FOREIGN_TYPE_UINT8));
   scm_define (sym_int8, scm_from_uint8 (SCM_FOREIGN_TYPE_INT8));
   scm_define (sym_uint16, scm_from_uint8 (SCM_FOREIGN_TYPE_UINT16));

libguile/foreign.h

@@ -1,7 +1,7 @@
 #ifndef SCM_FOREIGN_H
 #define SCM_FOREIGN_H
 
-/* Copyright 2010-2013,2016,2018
+/* Copyright 2010-2013,2016,2018,2024
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -43,13 +43,9 @@ enum scm_t_foreign_type
     SCM_FOREIGN_TYPE_INT32,
     SCM_FOREIGN_TYPE_UINT64,
     SCM_FOREIGN_TYPE_INT64,
-#ifdef FFI_TARGET_HAS_COMPLEX_TYPE
     SCM_FOREIGN_TYPE_COMPLEX_FLOAT,
     SCM_FOREIGN_TYPE_COMPLEX_DOUBLE,
     SCM_FOREIGN_TYPE_LAST = SCM_FOREIGN_TYPE_COMPLEX_DOUBLE
-#else
-    SCM_FOREIGN_TYPE_LAST = SCM_FOREIGN_TYPE_INT64
-#endif
   };
 
 typedef enum scm_t_foreign_type scm_t_foreign_type;

module/system/foreign.scm

@@ -1,19 +1,18 @@
-;;;; 	Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2010-2011,2013-2014,2024 Free Software Foundation, Inc.
-;;;;
+;;;
-;;;; This library is free software; you can redistribute it and/or
+;;; This library is free software: you can redistribute it and/or modify
-;;;; modify it under the terms of the GNU Lesser General Public
+;;; it under the terms of the GNU Lesser General Public License as
-;;;; License as published by the Free Software Foundation; either
+;;; published by the Free Software Foundation, either version 3 of the
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;; License, or (at your option) any later version.
-;;;;
+;;;
-;;;; This library is distributed in the hope that it will be useful,
+;;; This library is distributed in the hope that it will be useful, but
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
+;;; Lesser General Public License for more details.
-;;;;
+;;;
-;;;; You should have received a copy of the GNU Lesser General Public
+;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
+;;; License along with this program.  If not, see
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;; <http://www.gnu.org/licenses/>.
-;;;;
 
 
 (define-module (system foreign)
@@ -108,12 +107,10 @@
 (define *writers*
   `((,float . ,bytevector-ieee-single-native-set!)
     (,double . ,bytevector-ieee-double-native-set!)
-    ,@(if (defined? 'complex-float)
+    (,complex-float
-          `((,complex-float
      . ,(writer-complex bytevector-ieee-single-native-set! (sizeof float)))
     (,complex-double
-             . ,(writer-complex bytevector-ieee-double-native-set! (sizeof double))))
+     . ,(writer-complex bytevector-ieee-double-native-set! (sizeof double)))
-          '())
     (,int8 . ,bytevector-s8-set!)
     (,uint8 . ,bytevector-u8-set!)
     (,int16 . ,bytevector-s16-native-set!)
@@ -127,12 +124,10 @@
 (define *readers*
   `((,float . ,bytevector-ieee-single-native-ref)
     (,double . ,bytevector-ieee-double-native-ref)
-    ,@(if (defined? 'complex-float)
+    (,complex-float
-          `((,complex-float
      . ,(reader-complex bytevector-ieee-single-native-ref (sizeof float)))
     (,complex-double
-             . ,(reader-complex bytevector-ieee-double-native-ref (sizeof double))))
+     . ,(reader-complex bytevector-ieee-double-native-ref (sizeof double)))
-          '())
     (,int8 . ,bytevector-s8-ref)
     (,uint8 . ,bytevector-u8-ref)
     (,int16 . ,bytevector-s16-native-ref)
@@ -143,7 +138,6 @@
     (,uint64 . ,bytevector-u64-native-ref)
     (* . ,bytevector-pointer-ref)))
 
-
 (define (align off alignment)
   (1+ (logior (1- off) (1- alignment))))
 

test-suite/tests/foreign.test

@@ -1,20 +1,20 @@
-;;;; foreign.test --- FFI.           -*- mode: scheme; coding: utf-8; -*-
+;;; foreign.test --- FFI.           -*- mode: scheme; coding: utf-8; -*-
-;;;;
+;;;
-;;;; 	Copyright (C) 2010, 2011, 2012, 2013, 2017, 2021 Free Software Foundation, Inc.
+;;; Copyright (C) 2010-2013,2017,2021,2024 Free Software Foundation, Inc.
-;;;;
+;;;
-;;;; This library is free software; you can redistribute it and/or
+;;; This library is free software: you can redistribute it and/or modify
-;;;; modify it under the terms of the GNU Lesser General Public
+;;; it under the terms of the GNU Lesser General Public License as
-;;;; License as published by the Free Software Foundation; either
+;;; published by the Free Software Foundation, either version 3 of the
-;;;; version 3 of the License, or (at your option) any later version.
+;;; License, or (at your option) any later version.
-;;;;
+;;;
-;;;; This library is distributed in the hope that it will be useful,
+;;; This library is distributed in the hope that it will be useful, but
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
+;;; Lesser General Public License for more details.
-;;;;
+;;;
-;;;; You should have received a copy of the GNU Lesser General Public
+;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
+;;; License along with this program.  If not, see
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;; <http://www.gnu.org/licenses/>.
 
 ;;;
 ;;; See also ../standalone/test-ffi for FFI tests.
@@ -418,12 +418,11 @@
                               layout)
               data)))
 
-  (when (defined? 'complex-float)
   (pass-if "complex types"
     (let ((layout (list complex-float int complex-double))
           (data '(1+3i 99 3-1i)))
       (equal? data (parse-c-struct (make-c-struct layout data)
-                                     layout))))))
+                                   layout)))))
 
 
 (with-test-prefix "lib->cyg"