limn goops flags, remove foreign objs, rename entity to applicable-struct

* libguile/goops.c (scm_class_applicable_struct)
  (scm_class_applicable_struct_with_setter)
  (scm_class_applicable_struct_class): Rename from
  scm_class_entity, scm_class_entity_with_setter, and
  scm_class_entity_class.
  (scm_class_simple_method): Removed; this abstraction is not used.
  (scm_class_foreign_class, scm_class_foreign_object): Remove these,
  they are undocumented and unused. They might come back later.
  (scm_sys_inherit_magic_x): Simply inherit the vtable flags from the
  class's class. Flags are about layout, and it is the class that
  determines the layout of the instance.
  (scm_basic_basic_make_class): Don't bother setting GOOPS_OR_VALID,
  inherit-magic will do that.
  (scm_basic_make_class): Inherit magic after setting the layout. Allows
  the struct magic checker to do its job.
  (scm_accessor_method_slot_definition): Move implementation to Scheme.
  Removes the need for the accessor flag.
  (scm_sys_allocate_instance): Adapt to scm_i_alloc_struct name change,
  and that alloc-struct will handle finalization.
  (scm_compute_applicable_methods): Remove accessor check, as it's
  unnecessary.
  (scm_make): Adapt to new generic slot order, and no more
  simple-method.
  (create_standard_classes): What was the GF slot "dispatch-procedure"
  is now the applicable-struct slot "procedure". No more foreign class,
  foreign object, or simple method. Rename <entity> and friends to
  <applicable-struct> and friends. No more entity-with-setter -- though
  perhaps it will come back too. Instead generic-with-setter is its own
  thing.

* libguile/goops.h (SCM_CLASSF_METACLASS): "A goops class that is a
  vtable" -- no need for a separate flag.
  (SCM_CLASSF_FOREIGN, SCM_CLASSF_SIMPLE_METHOD)
  (SCM_CLASSF_ACCESSOR_METHOD): Removed these unused flags.
  (SCM_ACCESSORP): Removed.
  Renumber generic slots, rename entity classes, and remove the foreign
  class, foreign object, and simple method classes.

* libguile/struct.c (scm_i_struct_inherit_vtable_magic): New function,
  called when making new vtables.applicable structs
  (scm_i_alloc_struct): Remove 8-bit alignment check, as libGC
  guarantees this for us. Handle finalizer registration here.
  (scm_make_struct): Factor some things to scm_i_alloc_struct and
  scm_i_struct_inherit_vtable_magic.
  (scm_make_vtable_vtable): Adapt to scm_i_alloc_struct name change.

* libguile/struct.h (scm_i_alloc_struct): Change name from
  scm_alloc_struct, and make internal.

* module/oop/goops.scm (oop): Don't declare #:replace <class> et al,
  because <class> isn't defined in the core any more.
  (accessor-method-slot-definition): Defined in Scheme now.
  Remove <foreign-object> methods.
  (initialize on <class>): Prep layout before inheriting magic, as in
  scm_basic_make_class.

* module/oop/goops/dispatch.scm (delayed-compile)
  (memoize-effective-method!): Adapt to 'procedure slot name change.

module/oop/goops.scm

@@ -73,7 +73,6 @@
 	   primitive-generic-generic enable-primitive-generic!
 	   method-procedure accessor-method-slot-definition
 	   slot-exists? make find-method get-keyword)
-  :replace (<class> <entity-class> <entity>)
   :no-backtrace)
 
 (define *goops-module* (current-module))
@@ -705,6 +704,10 @@
 (define (slot-init-function class slot-name)
   (cadr (assq slot-name (slot-ref class 'getters-n-setters))))
 
+(define (accessor-method-slot-definition obj)
+  "Return the slot definition of the accessor @var{obj}."
+  (slot-ref obj 'slot-definition))
+
 
 ;;;
 ;;; {Standard methods used by the C runtime}
@@ -745,17 +748,6 @@
 	  (display #\> file))
 	(next-method))))
 
-(define-method (write (o <foreign-object>) file)
-  (let ((class (class-of o)))
-    (if (slot-bound? class 'name)
-	(begin
-	  (display "#<foreign-object " file)
-	  (display (class-name class) file)
-	  (display #\space file)
-	  (display-address o file)
-	  (display #\> file))
-	(next-method))))
-
 (define-method (write (class <class>) file)
   (let ((meta (class-of class)))
     (if (and (slot-bound? class 'name)
@@ -1168,6 +1160,7 @@
 
 ;;; compute-getters-n-setters
 ;;;
+;; FIXME!!!
 (define (make-thunk thunk)
   (lambda () (thunk)))
 
@@ -1467,11 +1460,10 @@
 
     ;; Support for the underlying structs:
     
-    ;; Inherit class flags (invisible on scheme level) from supers
-    (%inherit-magic! class supers)
-
     ;; Set the layout slot
-    (%prep-layout! class)))
+    (%prep-layout! class)
+    ;; Inherit class flags (invisible on scheme level) from supers
+    (%inherit-magic! class supers)))
 
 (define (initialize-object-procedure object initargs)
   (let ((proc (get-keyword #:procedure initargs #f)))
@@ -1484,13 +1476,9 @@
 	   (set-object-procedure! object
 				  (lambda args (apply proc args)))))))
 
-(define-method (initialize (entity <entity>) initargs)
+(define-method (initialize (applicable-struct <applicable-struct>) initargs)
   (next-method)
-  (initialize-object-procedure entity initargs))
-
-(define-method (initialize (ews <entity-with-setter>) initargs)
-  (next-method)
-  (%set-object-setter! ews (get-keyword #:setter initargs #f)))
+  (initialize-object-procedure applicable-struct initargs))
 
 (define-method (initialize (generic <generic>) initargs)
   (let ((previous-definition (get-keyword #:default initargs #f))
@@ -1504,6 +1492,10 @@
 	(set-procedure-property! generic 'name name))
     ))
 
+(define-method (initialize (gws <generic-with-setter>) initargs)
+  (next-method)
+  (%set-object-setter! gws (get-keyword #:setter initargs #f)))
+
 (define-method (initialize (eg <extended-generic>) initargs)
   (next-method)
   (slot-set! eg 'extends (get-keyword #:extends initargs '())))
@@ -1521,8 +1513,6 @@
   (slot-set! method 'make-procedure (get-keyword #:make-procedure initargs #f)))
              
 
-(define-method (initialize (obj <foreign-object>) initargs))
-
 ;;;
 ;;; {Change-class}
 ;;;

module/oop/goops/dispatch.scm

@@ -206,7 +206,7 @@
               (with-fluids ((*in-progress* (cons gf in-progress)))
                 (let ((dispatch (compute-dispatch-procedure
                                  gf (slot-ref gf 'effective-methods))))
-                  (slot-set! gf 'dispatch-procedure dispatch)
+                  (slot-set! gf 'procedure dispatch)
                   (apply dispatch args))))))))))
 
 (define (cache-dispatch gf args)
@@ -242,7 +242,7 @@
            (cache (cons (vector len types rest? cmethod)
                         (slot-ref gf 'effective-methods))))
       (slot-set! gf 'effective-methods cache)
-      (slot-set! gf 'dispatch-procedure (delayed-compile gf))
+      (slot-set! gf 'procedure (delayed-compile gf))
       cmethod))
   (parse 0 args))