Add support for guile 2.0: update swg and interface files

Note: only the scm interface is considered.

4 files changed, 186 insertions, 17 deletions

diff --git a/Lib/guile/ghinterface.i b/Lib/guile/ghinterface.i
index c5fda62cf..022c0f568 100644
--- a/Lib/guile/ghinterface.i
+++ b/Lib/guile/ghinterface.i
@@ -1,3 +1,5 @@
+#ifdef GUILE_VERSION_1_6
+
 #define gh_append2(a, b) scm_append(scm_listify(a, b, SCM_UNDEFINED)) 
 #define gh_apply(a, b) scm_apply(a, b, SCM_EOL) 
 #define gh_bool2scm SCM_BOOL 
@@ -37,3 +39,47 @@
 #define gh_vector_ref scm_vector_ref 
 #define gh_vector_set_x scm_vector_set_x 
 #define gh_char2scm SCM_MAKE_CHAR
+
+#else
+
+#define gh_append2(a, b) scm_append(scm_listify(a, b, SCM_UNDEFINED)) 
+#define gh_apply(a, b) scm_apply(a, b, SCM_EOL) 
+#define gh_bool2scm scm_from_bool 
+#define gh_boolean_p scm_is_bool 
+#define gh_car SCM_CAR 
+#define gh_cdr SCM_CDR 
+#define gh_cons scm_cons 
+#define gh_double2scm scm_from_double 
+#define gh_int2scm scm_from_long 
+#define gh_length(lst) scm_to_ulong(scm_length(lst))
+#define gh_list scm_listify 
+#define gh_list_to_vector scm_vector 
+#define gh_make_vector scm_make_vector 
+#define gh_null_p scm_is_null 
+#define gh_number_p scm_is_number 
+#define gh_pair_p scm_is_pair 
+#define gh_scm2bool scm_is_true
+#define gh_scm2char SCM_CHAR 
+#define gh_scm2double scm_to_double
+#define gh_scm2int scm_to_int
+#define gh_scm2long scm_to_long
+#define gh_scm2short scm_to_short
+#define gh_scm2newstr SWIG_Guile_scm2newstr
+#define gh_scm2ulong scm_to_ulong
+#define gh_scm2ushort scm_to_ushort
+#define gh_scm2uint scm_to_uint
+#define gh_ulong2scm scm_from_ulong
+#define gh_long2scm scm_from_long
+#define gh_str02scm(str) str ? scm_from_locale_string(str) : SCM_BOOL_F 
+#define gh_long_long2scm scm_from_long_long
+#define gh_scm2long_long scm_to_long_long
+#define gh_ulong_long2scm scm_from_ulong_long
+#define gh_scm2ulong_long scm_to_ulong_long
+#define gh_string_p scm_is_string 
+#define gh_vector_length scm_c_vector_length 
+#define gh_vector_p scm_is_vector 
+#define gh_vector_ref scm_vector_ref 
+#define gh_vector_set_x scm_vector_set_x 
+#define gh_char2scm SCM_MAKE_CHAR
+
+#endif
\ No newline at end of file
diff --git a/Lib/guile/guile_gh_run.swg b/Lib/guile/guile_gh_run.swg
index d8cc56b91..8616875da 100644
--- a/Lib/guile/guile_gh_run.swg
+++ b/Lib/guile/guile_gh_run.swg
@@ -15,6 +15,36 @@
 extern "C" {
 #endif
 
+
+/* In the code below, use guile 2.0 compatible functions where possible.
+   Functions that don't exist in older versions will be mapped to
+   a deprecated equivalent for those versions only */
+/* ... setup guile 2-like interface for guile 1.6 */
+#if (SCM_MAJOR_VERSION == 1) && (SCM_MINOR_VERSION <= 6)
+
+# define scm_from_locale_keyword scm_c_make_keyword
+# define scm_from_locale_symbol scm_str2symbol
+# define scm_is_null SCM_NULLP
+# define scm_is_true SCM_NFALSEP
+# define scm_is_string SCM_STRINGP
+
+/* Used later on to setup different code paths where it's
+   not possible to use a guile 2-like interface */
+# define GUILE_VERSION_1_6
+
+#endif
+
+/* ... setup guile 2-like interface for guile 1.6 and 1.8 */
+#if defined (SCM_MAJOR_VERSION) && (SCM_MAJOR_VERSION < 2)
+
+static SCM
+scm_module_variable (SCM module, SCM sym)
+{
+  return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
+}
+
+#endif
+
 typedef SCM (*swig_guile_proc)();
 
 #define SWIG_malloc(size) \
@@ -150,7 +180,7 @@ SWIG_Guile_ConvertPtr(swig_module_info *module, SCM s, void **result,
 {
   swig_cast_info *cast;
   swig_type_info *from;
-  if (SCM_NULLP(s)) {
+  if (scm_is_null(s)) {
     *result = NULL;
     return SWIG_OK;
   } else if (SCM_NIMP(s)) {
@@ -246,7 +276,7 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
   }
   for (; i<optargs; i++)
     *dest++ = SCM_UNDEFINED;
-  if (!SCM_NULLP(rest))
+  if (!scm_is_null(rest))
     scm_wrong_num_args(gh_str02scm((char *) procname));
   return num_args_passed;
 }
diff --git a/Lib/guile/guile_scm_run.swg b/Lib/guile/guile_scm_run.swg
index 925aaadb4..71de33535 100644
--- a/Lib/guile/guile_scm_run.swg
+++ b/Lib/guile/guile_scm_run.swg
@@ -12,7 +12,44 @@
 extern "C" {
 #endif
 
+
+/* In the code below, use guile 2.0 compatible functions where possible.
+   Functions that don't exist in older versions will be mapped to
+   a deprecated equivalent for those versions only */
+/* ... setup guile 2-like interface for guile 1.6 */
+#if (SCM_MAJOR_VERSION == 1) && (SCM_MINOR_VERSION <= 6)
+
+# define scm_from_locale_keyword scm_c_make_keyword
+# define scm_from_locale_symbol scm_str2symbol
+# define scm_is_null SCM_NULLP
+# define scm_is_true SCM_NFALSEP
+# define scm_is_string SCM_STRINGP
+
+/* Used later on to setup different code paths where it's
+   not possible to use a guile 2-like interface */
+# define GUILE_VERSION_1_6
+
+#endif
+
+/* ... setup guile 2-like interface for guile 1.6 and 1.8 */
+#if defined (SCM_MAJOR_VERSION) && (SCM_MAJOR_VERSION < 2)
+
+static SCM
+scm_module_variable (SCM module, SCM sym)
+{
+  return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
+}
+
+#endif
+
+#if SCM_MAJOR_VERSION >= 2
+// scm_c_define_gsubr takes a different parameter type
+// depending on the guile version
+
+typedef scm_t_subr swig_guile_proc;
+#else
 typedef SCM (*swig_guile_proc)();
+#endif
 typedef SCM (*guile_destructor)(SCM);
 
 typedef struct swig_guile_clientdata {
@@ -22,10 +59,17 @@ typedef struct swig_guile_clientdata {
 
 #define SWIG_scm2str(s) \
   SWIG_Guile_scm2newstr(s, NULL)
-#define SWIG_malloc(size) \
-  SCM_MUST_MALLOC(size)
-#define SWIG_free(mem) \
-  scm_must_free(mem)
+#ifdef GUILE_VERSION_1_6
+# define SWIG_malloc(size) \
+   SCM_MUST_MALLOC(size)
+# define SWIG_free(mem) \
+   scm_must_free(mem)
+#else
+# define SWIG_malloc(size) \
+   scm_malloc(size)
+# define SWIG_free(mem) \
+   free(mem)
+#endif
 #define SWIG_ConvertPtr(s, result, type, flags) \
   SWIG_Guile_ConvertPtr(s, result, type, flags)
 #define SWIG_MustGetPtr(s, type, argnum, flags) \
@@ -42,7 +86,7 @@ typedef struct swig_guile_clientdata {
   SWIG_Guile_IsPointer(object)
 #define SWIG_contract_assert(expr, msg)				\
   if (!(expr))							\
-    scm_error(scm_str2symbol("swig-contract-assertion-failed"),	\
+    scm_error(scm_from_locale_symbol("swig-contract-assertion-failed"),	\
 	      (char *) FUNC_NAME, (char *) msg,			\
 	      SCM_EOL, SCM_BOOL_F); else
 
@@ -61,15 +105,25 @@ SWIGINTERN char *
 SWIG_Guile_scm2newstr(SCM str, size_t *len) {
 #define FUNC_NAME "SWIG_Guile_scm2newstr"
   char *ret;
+# ifndef GUILE_VERSION_1_6
+  char *tmp;
+# endif
   size_t l;
 
-  SCM_ASSERT (SCM_STRINGP(str), str, 1, FUNC_NAME);
-  
-  l = SCM_STRING_LENGTH(str);
+  SCM_ASSERT (scm_is_string(str), str, 1, FUNC_NAME);
+  l = scm_c_string_length(str);
+
   ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
   if (!ret) return NULL;
 
+# ifdef GUILE_VERSION_1_6
   memcpy(ret, SCM_STRING_CHARS(str), l);
+# else
+  tmp = scm_to_locale_string(str);
+  memcpy(ret, tmp, l);
+  free(tmp);
+# endif
+
   ret[l] = '\0';
   if (len) *len = l;
   return ret;
@@ -86,7 +140,7 @@ static SCM swig_keyword = SCM_EOL;
 static SCM swig_symbol = SCM_EOL;
 
 #define SWIG_Guile_GetSmob(x) \
-  ( SCM_NNULLP(x) && SCM_INSTANCEP(x) && SCM_NFALSEP(scm_slot_exists_p(x, swig_symbol)) \
+  ( !scm_is_null(x) && SCM_INSTANCEP(x) && scm_is_true(scm_slot_exists_p(x, swig_symbol)) \
       ? scm_slot_ref(x, swig_symbol) : (x) )
 
 SWIGINTERN SCM
@@ -361,6 +415,7 @@ ensure_smob_tag(SCM swig_module,
 		const char *smob_name,
 		const char *scheme_variable_name)
 {
+#ifdef GUILE_VERSION_1_6
   SCM variable = scm_sym2var(scm_str2symbol(scheme_variable_name),
 			     scm_module_lookup_closure(swig_module),
 			     SCM_BOOL_T);
@@ -375,6 +430,20 @@ ensure_smob_tag(SCM swig_module,
 				  "SWIG_Guile_Init");
     return 0;
   }
+#else
+  SCM variable = scm_module_variable(swig_module,
+                             scm_from_locale_symbol(scheme_variable_name));
+  if (scm_is_false(variable)) {
+    *tag_variable = scm_make_smob_type((char*)scheme_variable_name, 0);
+    scm_c_module_define(swig_module, scheme_variable_name, 
+                        scm_from_ulong(*tag_variable));
+    return 1;
+  }
+  else {
+    *tag_variable = scm_to_ulong(SCM_VARIABLE_REF(variable));
+    return 0;
+  }
+#endif
 }
 
 SWIGINTERN SCM
@@ -409,8 +478,8 @@ SWIG_Guile_Init ()
   }
   swig_make_func = scm_permanent_object(
   scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make")));
-  swig_keyword = scm_permanent_object(scm_c_make_keyword((char*) "init-smob"));
-  swig_symbol = scm_permanent_object(scm_str2symbol("swig-smob"));
+  swig_keyword = scm_permanent_object(scm_from_locale_keyword((char*) "init-smob"));
+  swig_symbol = scm_permanent_object(scm_from_locale_symbol("swig-smob"));
 #ifdef SWIG_INIT_RUNTIME_MODULE
   SWIG_INIT_RUNTIME_MODULE
 #endif
@@ -426,6 +495,7 @@ SWIG_Guile_GetModule(void *SWIGUNUSEDPARM(clientdata))
 
   module = SWIG_Guile_Init();
 
+#ifdef GUILE_VERSION_1_6
   variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
 			       scm_module_lookup_closure(module),
 			       SCM_BOOL_T);
@@ -434,6 +504,15 @@ SWIG_Guile_GetModule(void *SWIGUNUSEDPARM(clientdata))
   } else {
     return (swig_module_info *) scm_num2ulong(SCM_VARIABLE_REF(variable), 0, "SWIG_Guile_Init");
   }
+#else
+  variable = scm_module_variable(module,
+                 scm_from_locale_symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME));
+  if (scm_is_false(variable)) {
+    return NULL;
+  } else {
+    return (swig_module_info *) scm_to_ulong(SCM_VARIABLE_REF(variable));
+  }
+#endif
 }
 
 SWIGINTERN void
@@ -444,11 +523,17 @@ SWIG_Guile_SetModule(swig_module_info *swig_module)
 
   module = SWIG_Guile_Init();
     
+#ifdef GUILE_VERSION_1_6
   variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
 			       scm_module_lookup_closure(module),
 			       SCM_BOOL_T);
 
   SCM_VARIABLE_SET(variable, scm_ulong2num((unsigned long) swig_module));
+#else
+  scm_module_define(module,
+                    scm_from_locale_symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
+                    scm_from_ulong((unsigned long) swig_module));
+#endif
 }
 
 SWIGINTERN int
@@ -460,7 +545,11 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
   int num_args_passed = 0;
   for (i = 0; i<reqargs; i++) {
     if (!SCM_CONSP(rest))
+#ifdef GUILE_VERSION_1_6
       scm_wrong_num_args(scm_makfrom0str((char *) procname));
+#else
+      scm_wrong_num_args(scm_from_locale_string(procname ? (char *) procname : "unknown procedure"));
+#endif
     *dest++ = SCM_CAR(rest);
     rest = SCM_CDR(rest);
     num_args_passed++;
@@ -473,7 +562,11 @@ SWIG_Guile_GetArgs (SCM *dest, SCM rest,
   for (; i<optargs; i++)
     *dest++ = SCM_UNDEFINED;
   if (!SCM_NULLP(rest))
-    scm_wrong_num_args(scm_makfrom0str((char *) procname));
+#ifdef GUILE_VERSION_1_6
+      scm_wrong_num_args(scm_makfrom0str((char *) procname));
+#else
+      scm_wrong_num_args(scm_from_locale_string(procname ? (char *) procname : "unknown procedure"));
+#endif
   return num_args_passed;
 }
 
diff --git a/Lib/guile/typemaps.i b/Lib/guile/typemaps.i
index edf227d46..5036162fd 100644
--- a/Lib/guile/typemaps.i
+++ b/Lib/guile/typemaps.i
@@ -406,7 +406,7 @@ typedef unsigned long SCM;
          const std::size_t &, const std::ptrdiff_t &,
 	 enum SWIGTYPE
 {
-  $1 = SCM_NFALSEP(scm_integer_p($input)) && SCM_NFALSEP(scm_exact_p($input))? 1 : 0;
+  $1 = scm_is_true(scm_integer_p($input)) && scm_is_true(scm_exact_p($input))? 1 : 0;
 }
 
 %typecheck(SWIG_TYPECHECK_BOOL)
@@ -419,7 +419,7 @@ typedef unsigned long SCM;
 	float, double,
 	const float &, const double &
 {
-  $1 = SCM_NFALSEP(scm_real_p($input)) ? 1 : 0;
+  $1 = scm_is_true(scm_real_p($input)) ? 1 : 0;
 }
 
 %typecheck(SWIG_TYPECHECK_CHAR) char {
@@ -427,7 +427,7 @@ typedef unsigned long SCM;
 }
 
 %typecheck(SWIG_TYPECHECK_STRING) char * {
-  $1 = SCM_STRINGP($input) ? 1 : 0;
+  $1 = scm_is_string($input) ? 1 : 0;
 }
 
 %typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {