How to force slot's type to be checked during make-instance?

后端 未结 2 690
别那么骄傲
别那么骄傲 2021-02-09 04:38

Let\'s say I have the following class declaration:

(defclass foo-class ()
  ((bar :initarg :bar
        :type list)))

When I create an instance

相关标签:
2条回答
  • 2021-02-09 05:14

    Whether slot types are being checked or not is undefined for both structures and CLOS instances.

    Many implementations will do it for structures - but not all.

    Few implementations will do it for CLOS instances - Clozure CL actually does it for example.

    SBCL also can check CLOS slot types - when safety is high:

    * (declaim (optimize safety))
    
    NIL
    * (progn
    (defclass foo-class ()
      ((bar :initarg :bar
            :type list)))
    (make-instance 'foo-class :bar 'some-symb))
    
    debugger invoked on a TYPE-ERROR: The value SOME-SYMB is not of type LIST.
    
    Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
    
    restarts (invokable by number or by possibly-abbreviated name):
      0: [ABORT] Exit debugger, returning to top level.
    
    ((SB-PCL::SLOT-TYPECHECK LIST) SOME-SYMB)
    0] 
    

    How to do it otherwise?

    This is kind of an advanced subject which probably needs some CLOS meta-object-protocol hackery. Two variants:

    • define a method for SHARED-INITALIZE which checks the init arguments.

    • define a metaclass for your class and a method on SET-SLOT-VALUE-USING-CLASS . But then you need to be sure that your implementation actually provides AND uses SET-SLOT-VALUE-USING-CLASS. This is a generic function, which is part of the MOP. Some implementations provide it, but some are only using it when requested (otherwise setting a slot may get a speed penalty).

    For the latter here is self-built SBCL version to check types for writing slots:

    First the metaclass:

    ; first a metaclass for classes which checks slot writes
    (defclass checked-class (standard-class)
      ())
    
    ; this is a MOP method, probably use CLOSER-MOP for a portable version
    (defmethod sb-mop:validate-superclass
               ((class checked-class)
                (superclass standard-class))
       t)
    

    Now we check all slot writes for that metaclass:

    ; this is a MOP method, probably use CLOSER-MOP for a portable version    
    (defmethod (setf sb-mop:slot-value-using-class) :before
                  (new-value (class checked-class) object slot)
      (assert (typep new-value (sb-mop:slot-definition-type slot))
          ()
        "new value ~a is not of type ~a in object ~a slot ~a"
        new-value (sb-mop:slot-definition-type slot) object slot))
    

    Our example class uses that metaclass:

    (defclass foo-class ()
      ((bar :initarg :bar :type list))
      (:metaclass checked-class))
    

    Using it:

    * (make-instance 'foo-class :bar 42)
    
    debugger invoked on a SIMPLE-ERROR in thread
    #<THREAD "main thread" RUNNING {10005605B3}>:
      new value 42 is not of type LIST
      in object #<FOO-CLASS {1004883143}>
      slot #<STANDARD-EFFECTIVE-SLOT-DEFINITION COMMON-LISP-USER::BAR>
    
    Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
    
    restarts (invokable by number or by possibly-abbreviated name):
      0: [CONTINUE] Retry assertion.
      1: [ABORT   ] Exit debugger, returning to top level.
    
    0 讨论(0)
  • 2021-02-09 05:21

    The sanity-clause library just merged a feature for this yesterday.

    Sanity clause is a data validation/contract library. You might use it for configuration data, validating an api response, or documents from a datastore. In a dynamically typed langauge, it helps you define clearly defined areas of doubt and uncertainty. We should love our users, but we should never blindly trust their inputs.

    To make use of it, you define schemas, which can be property lists with symbols for keys and instances of :class:sanity-clause.field:field

    So:

    (defclass person ()
         ((favorite-dog :type symbol
                        :field-type :member
                        :members (:wedge :walter)
                        :initarg :favorite-dog
                        :required t)
          (age :type (integer 0)
               :initarg :age
               :required t)
          (potato :type string
                  :initarg :potato
                  :required t))
         (:metaclass sanity-clause.metaclass:validated-metaclass))
    
    ;; bad dog:
    (make-instance 'person :favorite-dog :nope)
    ; Evaluation aborted on Error converting value for field #<MEMBER-FIELD {1004BFA973}>: 
    Value "NOPE" couldn't be found in set (WEDGE WALTER)
    
    ;; bad age:
    (make-instance 'person :age -1 :favorite-dog :walter)
    ; Evaluation aborted on Error validating value -1 in field #<INTEGER-FIELD {1004BFF103}>:
    * Value -1 didn't satisfy condition "must be larger than 0"
    
    ;; missing potato:
    (make-instance 'person :age 7 :favorite-dog :walter)
    ; Evaluation aborted on A value for field POTATO is required but none was provided..
    
    ;; all OK:
    (make-instance 'person :age 1 :favorite-dog :walter :potato "patate")
    #<PERSON {10060371E3}>
    
    0 讨论(0)
提交回复
热议问题