Experiment metaclass funcallable-standard-class.

experiment-funcall.lisp

(defpackage #:experiment
  (:use :cl :sb-mop))

(in-package #:experiment)

;; ------------------------------------------------------------------------------------------------

(defclass area ()
  ((width :initarg :w)
   (height :initarg :h))
  (:default-initargs :w 0 :h 0)
  (:metaclass funcallable-standard-class))

(defmethod initialize-instance :after ((instance area) &key)
  (with-slots (width height) instance
    (set-funcallable-instance-function
     instance #'(lambda () (* width height)))))

;; ------------------------------------------------------------------------------------------------

(defmethod calculate ((instance area))
  (with-slots (width height) instance
    (* width height)))

;; ------------------------------------------------------------------------------------------------

(defun test ()
  (let ((area (make-instance 'area :w 4 :h 3)))
    (format t "(eql 12 (funcall area)) => ~a~%"
            (eql 12 (funcall area)))
    (format t "(eql 12 (calculate area)) => ~a~%"
            (eql 12 (calculate area)))))

;; (eql 12 (funcall area)) => T
;; (eql 12 (calculate area)) => T

(defun test2 ()
  (let ((instances (list (make-instance 'area :w 4 :h 3)
                         (make-instance 'area :w 3 :h 2)
                         (make-instance 'area :w 2 :h 1))))
    (format t "(equal (mapcar #'funcall instances) (mapcar #'calculate instances)) => ~a~%"
            (equal (mapcar #'funcall instances)
                   (mapcar #'calculate instances)))))

;; (equal (mapcar #'funcall instances) (mapcar #'calculate instances)) => T