Merge stable-2.2 into master

This commit resolves conflicts by removing the deprecated make-struct.

1 files changed, 40 insertions, 60 deletions

diff --git a/libguile/struct.c b/libguile/struct.c
index 67e2e62df..53bf3f302 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007,
- *   2008, 2009, 2010, 2011, 2012, 2013, 2015, 2017 Free Software Foundation, Inc.
+/* Copyright (C) 1996-2001, 2003-2004, 2006-2013, 2015,
+ *               2017 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -30,6 +30,7 @@
 #include "libguile/_scm.h"
 #include "libguile/async.h"
 #include "libguile/chars.h"
+#include "libguile/deprecation.h"
 #include "libguile/eval.h"
 #include "libguile/alist.h"
 #include "libguile/hashtab.h"
@@ -68,16 +69,14 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	    "@var{fields} must be a string made up of pairs of characters\n"
 	    "strung together.  The first character of each pair describes a field\n"
 	    "type, the second a field protection.  Allowed types are 'p' for\n"
-	    "GC-protected Scheme data, 'u' for unprotected binary data, and 's' for\n"
-	    "a field that points to the structure itself.    Allowed protections\n"
+	    "GC-protected Scheme data, 'u' for unprotected binary data.  \n"
+            "Allowed protections\n"
 	    "are 'w' for mutable fields, 'h' for hidden fields, 'r' for read-only\n"
             "fields, and 'o' for opaque fields.\n\n"
             "Hidden fields are writable, but they will not consume an initializer arg\n"
             "passed to @code{make-struct}. They are useful to add slots to a struct\n"
             "in a way that preserves backward-compatibility with existing calls to\n"
-            "@code{make-struct}, especially for derived vtables.\n\n"
-            "The last field protection specification may be capitalized to indicate\n"
-	    "that the field is a tail-array.")
+            "@code{make-struct}, especially for derived vtables.")
 #define FUNC_NAME s_scm_make_struct_layout
 {
   SCM new_sym;
@@ -100,10 +99,6 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	  {
 	  case 'u':
 	  case 'p':
-#if 0
-	  case 'i':
-	  case 'd':
-#endif
 	  case 's':
 	    break;
 	  default:
@@ -134,16 +129,6 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	    SCM_MISC_ERROR ("unrecognized ref specification: ~S",
 			    scm_list_1 (SCM_MAKE_CHAR (c)));
 	  }
-#if 0
-	if (scm_i_string_ref (fields, x, 'd'))
-	  {
-	    if (!scm_i_string_ref (fields, x+2, '-'))
-	      SCM_MISC_ERROR ("missing dash field at position ~A",
-			      scm_list_1 (scm_from_int (x / 2)));
-	    x += 2;
-	    goto recheck_ref;
-	  }
-#endif
       }
     new_sym = scm_string_to_symbol (fields);
   }
@@ -243,6 +228,23 @@ scm_is_valid_vtable_layout (SCM layout)
   return 1;
 }
 
+static void
+issue_deprecation_warning_for_self_slots (SCM vtable)
+{
+  SCM olayout;
+  size_t idx, first_user_slot = 0;
+
+  olayout = scm_symbol_to_string (SCM_VTABLE_LAYOUT (vtable));
+  if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_VTABLE))
+    first_user_slot = scm_vtable_offset_user;
+
+  for (idx = first_user_slot * 2; idx < scm_c_string_length (olayout); idx += 2)
+    if (scm_is_eq (scm_c_string_ref (olayout, idx), SCM_MAKE_CHAR ('s')))
+      scm_c_issue_deprecation_warning
+        ("Vtables with \"self\" slots are deprecated.  Initialize these "
+         "fields manually.");
+}
+
 /* Have OBJ, a newly created vtable, inherit flags from VTABLE.  VTABLE is a
    vtable-vtable and OBJ is an instance of VTABLE.  */
 void
@@ -302,6 +304,8 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
       SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_APPLICABLE);
     }
 
+  issue_deprecation_warning_for_self_slots (obj);
+
   SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_VALIDATED);
 }
 #undef FUNC_NAME
@@ -540,23 +544,19 @@ SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, 
-            (SCM vtable, SCM tail_array_size, SCM init),
+SCM_DEFINE (scm_make_struct_no_tail, "make-struct/no-tail", 1, 0, 1, 
+            (SCM vtable, SCM init),
 	    "Create a new structure.\n\n"
 	    "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n"
-	    "@var{tail_array_size} must be a non-negative integer.  If the layout\n"
-	    "specification indicated by @var{vtable} includes a tail-array,\n"
-	    "this is the number of elements allocated to that array.\n\n"
 	    "The @var{init1}, @dots{} are optional arguments describing how\n"
-	    "successive fields of the structure should be initialized.  Only fields\n"
-	    "with protection 'r' or 'w' can be initialized, except for fields of\n"
-	    "type 's', which are automatically initialized to point to the new\n"
-	    "structure itself. Fields with protection 'o' can not be initialized by\n"
-	    "Scheme programs.\n\n"
+	    "successive fields of the structure should be initialized.\n"
+            "Only fields with protection 'r' or 'w' can be initialized.\n"
+            "Fields with protection 'o' can not be initialized by Scheme\n"
+            "programs.\n\n"
 	    "If fewer optional arguments than initializable fields are supplied,\n"
 	    "fields of type 'p' get default value #f while fields of type 'u' are\n"
 	    "initialized to 0.")
-#define FUNC_NAME s_scm_make_struct
+#define FUNC_NAME s_scm_make_struct_no_tail
 {
   size_t i, n_init;
   long ilen;
@@ -579,7 +579,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
   for (i = 0; i < n_init; i++, init = SCM_CDR (init))
     v[i] = SCM_UNPACK (SCM_CAR (init));
 
-  return scm_c_make_structv (vtable, scm_to_size_t (tail_array_size), n_init, v);
+  return scm_c_make_structv (vtable, 0, n_init, v);
 }
 #undef FUNC_NAME
 
@@ -625,9 +625,9 @@ SCM_DEFINE (scm_make_vtable, "make-vtable", 1, 1, 0,
   if (SCM_UNBNDP (printer))
     printer = SCM_BOOL_F;
 
-  return scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
-                          scm_list_2 (scm_make_struct_layout (fields),
-                                      printer));
+  return scm_c_make_struct (scm_standard_vtable_vtable, 0, 2,
+                            SCM_UNPACK (scm_make_struct_layout (fields)),
+                            SCM_UNPACK (printer));
 }
 #undef FUNC_NAME
 
@@ -748,16 +748,6 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
 	  answer = scm_from_ulong (data[p]);
 	  break;
 
-#if 0
-	case 'i':
-	  answer = scm_from_long (data[p]);
-	  break;
-
-	case 'd':
-	  answer = scm_make_real (*((double *)&(data[p])));
-	  break;
-#endif
-
 	case 's':
 	case 'p':
 	  answer = SCM_PACK (data[p]);
@@ -831,16 +821,6 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
 	  data[p] = SCM_NUM2ULONG (3, val);
 	  break;
 
-#if 0
-	case 'i':
-	  data[p] = SCM_NUM2LONG (3, val);
-	  break;
-
-	case 'd':
-	  *((double *)&(data[p])) = scm_num2dbl (val, (char *)SCM_ARG3);
-	  break;
-#endif
-
 	case 'p':
 	  data[p] = SCM_UNPACK (val);
 	  break;
@@ -979,8 +959,8 @@ scm_init_struct ()
   scm_define (name, scm_standard_vtable_vtable);
 
   scm_applicable_struct_vtable_vtable =
-    scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
-                     scm_list_1 (scm_make_struct_layout (required_vtable_fields)));
+    scm_c_make_struct (scm_standard_vtable_vtable, 0, 1,
+                       SCM_UNPACK (scm_make_struct_layout (required_vtable_fields)));
   name = scm_from_utf8_symbol ("<applicable-struct-vtable>");
   SCM_SET_VTABLE_FLAGS (scm_applicable_struct_vtable_vtable,
                         SCM_VTABLE_FLAG_APPLICABLE_VTABLE);
@@ -988,8 +968,8 @@ scm_init_struct ()
   scm_define (name, scm_applicable_struct_vtable_vtable);
 
   scm_applicable_struct_with_setter_vtable_vtable =
-    scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
-                     scm_list_1 (scm_make_struct_layout (required_vtable_fields)));
+    scm_c_make_struct (scm_standard_vtable_vtable, 0, 1,
+                       SCM_UNPACK (scm_make_struct_layout (required_vtable_fields)));
   name = scm_from_utf8_symbol ("<applicable-struct-with-setter-vtable>");
   scm_set_struct_vtable_name_x (scm_applicable_struct_with_setter_vtable_vtable, name);
   SCM_SET_VTABLE_FLAGS (scm_applicable_struct_with_setter_vtable_vtable,