;; Default system method for objects
;; this package implements the default system methods
;
; print
; equal
; eval
; hash
; copy
; make-instance
; put
; get
; 
; for ExOs, useable by call-next-method.
; these methods are autoloaded at the first error KlE_NO_NEXT_METHOD
; (Errors:NoNextMethod selector class call) by the following error corrector:
; 

;;AUTOLOAD: default-exo-system-methods-loader
(if (not (seek *error-correctors* 'default-exo-system-methods-loader))
  (insert *error-correctors* 0 'default-exo-system-methods-loader)
)

(defun default-exo-system-methods-loader (errorcode &rest data)
  (if (and (= errorcode 'Errors:NoNextMethod)
      (typep (getn data 1) ExClass)
      (seek '(= print eval hash copy make-instance put get) (getn data 0))
    )
    (define-default-exo-system-methods errorcode (getn data 0)
      (getn data 1) (getn data 2))
    :nil))

;;AUTOLOAD: define-default-exo-system-methods

(defun define-default-exo-system-methods (errorcode selector class call
    &aux pos
  )
  ;; define the methods
  
  (defmethod print ((self Object) stream)
    (print-format stream "{%0" (class-name (class-of self)))
    (dohash (slot init (class-slots (class-of self)))
      (print-format stream " %0 %1" slot (*:slot self slot))
    )
    (print-format stream "}")
  )
  
  (add-method Object '= eq)
  
  (add-method Object 'eval (type-replace (copy quote) Subr))
  
  (add-method Object 'hash *:address-of)
  
  (add-method Object 'copy *:copy)
  
  (add-method Object 'make-instance *:make-instance)
  
  (defmethod get ((self Object) key default-value &aux val)
    (with (*error-correctors* (put *error-correctors* -1
	  *:ignore-slot-errors
	)
	*:slot-error ()
      )
      (setq val (*:slot self key))
    )
    (if *:slot-error
      (eval default-value)
      val
  ))
  
  (defmethod put ((self Object) key value)
    (with (*error-correctors* (put *error-correctors* -1
	  *:ignore-slot-errors
	)
	*:slot-error ()
      )
      (*:slot self key value)
    )
    (if *:slot-error
      (eval default-value)
      value
  ))
  
  ;; remove error-corrector
  (setq pos (seek *error-correctors* 'default-exo-system-methods-loader))
  (if pos (delete *error-correctors* pos))
  
  ;; then remove unused code
  (makunbound 'define-default-exo-system-methods)
  (makunbound 'default-exo-system-methods-loader)
  
  ;; then execute the method
  (apply (find-method Object selector) (subseq call 1))
)

(defun *:ignore-slot-errors (errorcode &rest args)
  (if (= errorcode 'Errors:NoSlot)
    (progn
      (setq *:slot-error t)
      ()
    )
    :nil
))
