Some tweaks for ABCL

code/defstruct-parse.lisp

@@ -131,10 +131,10 @@
                (get-singular-option options :named))
            ;; Structure is named, allow predicate options.
            predicates)
-          (t
+          ((and suppliedp predicates)
            ;; Structure is not named, predicates not permitted.
-           (when (and suppliedp predicates)
-             (error 'predicate-requires-named-structure))
+           (error 'predicate-requires-named-structure))
+          (t
            '()))))
 
 (defun parse-named-option (options)

code/interface.lisp

@@ -1,9 +1,6 @@
 (cl:in-package #:anatomicl)
 
-(defmacro define-interface (client-var client-class
-                            &key (class-superclasses '(standard-class))
-                                 (object-superclasses '(standard-object))
-                                 intrinsic)
+(defmacro define-interface (client-var client-class &optional intrinsic)
   (let* ((pkg (if intrinsic (find-package "COMMON-LISP") *package*))
          (defstruct-name (intern "DEFSTRUCT" pkg))
          (copy-structure-name (intern "COPY-STRUCTURE" pkg))
@@ -24,10 +21,11 @@
        (defmethod structure-class-name ((client ,client-class))
          ',structure-class-name)
 
-       (defclass ,structure-class-name ,class-superclasses
+       (defclass ,structure-class-name (#+sicl sicl-clos:regular-class
+                                        #-sicl standard-class)
          ((%standard-constructor :initarg :standard-constructor
                                  :initform nil
-                                 :reader anatomicl:standard-constructor-p)))
+                                 :reader standard-constructor-p)))
 
        (defmethod closer-mop:validate-superclass ((class ,structure-class-name) (superclass (eql (find-class 't))))
          ;; T is not a valid direct superclass, all structures inherit from STRUCTURE-OBJECT.
@@ -36,10 +34,10 @@
        (defmethod closer-mop:validate-superclass ((class ,structure-class-name) (superclass (eql (find-class 'standard-object))))
          ;; Only STRUCTURE-OBJECT may have STANDARD-OBJECT as a direct superclass, all
          ;; other structure classes must inherit from STRUCTURE-OBJECT.
-         #-clasp (eql (class-name class) ',structure-object-name)
-         #+clasp t)
+         #-(or abcl clasp) (eql (class-name class) ',structure-object-name)
+         #+(or abcl clasp) t)
 
-       (defclass ,structure-object-name ,object-superclasses
+       (defclass ,structure-object-name (standard-object)
          ()
          (:metaclass ,structure-class-name))
 

code/intrinsic/interface.lisp

@@ -39,6 +39,4 @@
     (funcall setf-structure-description-function
              new-value name (funcall global-environment-function environment))))
 
-(anatomicl:define-interface *client* intrinsic-client
-  :intrinsic t
-  #+sicl :structure-class-superclasses #+sicl '(sicl-clos:regular-class))
+(anatomicl:define-interface *client* intrinsic-client t)

code/structure-slot-definition.lisp

@@ -4,7 +4,12 @@
 ;;; be constant.
 (defclass structure-slot-definition (closer-mop:standard-slot-definition
                                      #+sbcl sb-pcl::structure-slot-definition)
-  ((%read-only :initarg :read-only :reader structure-slot-definition-read-only)))
+  ((%read-only :initarg :read-only :accessor structure-slot-definition-read-only)))
+
+#+abcl
+(defmethod initialize-instance :after ((instance structure-slot-definition) &rest initargs &key read-only)
+  (declare (ignore initargs))
+  (setf (structure-slot-definition-read-only instance) read-only))
 
 (defclass structure-direct-slot-definition (structure-slot-definition
                                             closer-mop:standard-direct-slot-definition)