changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/obj/meta/pkg.lisp

changeset 234: d7aa08025537
child: cb6effbda1dd
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 20 Mar 2024 22:51:48 -0400
permissions: -rw-r--r--
description: cry, obj/meta, ffi/magick 
     1 ;;; obj/meta/pkg.lisp --- Meta-objects
     2 
     3 ;;
     4 
     5 ;;; Code:
     6 (in-package :obj/meta)
     7 
     8 (defun class-equalp (c1 c2)
     9   (when (symbolp c1) (setf c1 (find-class c1)))
    10   (when (symbolp c2) (setf c2 (find-class c2)))
    11   (eq c1 c2))
    12 
    13 (defun type-specifier-and (&rest type-specifiers)
    14   (let ((relevant (remove t type-specifiers)))
    15     (cond ((null relevant) t)
    16           ((null (cdr relevant)) (first relevant))
    17           (t `(and ,@relevant)))))
    18 
    19 (defun type-specifier-or (&rest type-specifiers)
    20   (let ((relevant (remove nil type-specifiers)))
    21     (cond ((null relevant) nil)
    22           ((null (cdr relevant)) (first relevant))
    23           (t `(or ,@relevant)))))
    24 
    25 (defun type-specifier-not (type-specifier)
    26   (cond ((eql type-specifier t) nil)
    27         ((eql type-specifier nil) t)
    28         (t `(not ,type-specifier))))
    29 
    30 (defparameter *standard-metaobjects*
    31   (list (find-class 'standard-object)
    32         (find-class 'standard-class)
    33         (find-class 'standard-generic-function)
    34         (find-class 'standard-method)
    35         (find-class 'built-in-class)))
    36 
    37 (defpackage :obj/meta/stealth
    38   (:use :cl :std))
    39 
    40 (defpackage :obj/meta/typed
    41   (:use :cl :std))
    42 
    43 (defpackage :obj/meta/filtered
    44   (:use :cl :std))
    45 
    46 (defpackage :obj/meta/sealed
    47   (:use :cl :std :obj/meta)
    48   (:import-from :sb-pcl :eql-specializer :intern-eql-specializer
    49    :eql-specializer-object :funcallable-standard-class)
    50   (:import-from :sb-mop :class-finalized-p :finalize-inheritance
    51    :class-precedence-list :class-direct-superclasses :specializer :method-specializers
    52    :generic-function-argument-precedence-order :generic-function-name :generic-function-methods :class-direct-subclasses
    53    :class-prototype)
    54   (:export
    55    :ensure-specializer
    56    :specializer-type
    57    :specializer-prototype
    58    :specializer-direct-superspecializers
    59    :specializer-intersectionp
    60    :specializer-subsetp
    61 
    62    :domain
    63    :ensure-domain
    64    :method-domain
    65    :domain-specializers
    66    :domain-arity
    67    :domain-equal
    68    :domain-intersectionp
    69    :domain-subsetp
    70 
    71    :metaobject-sealable-p
    72    :class-sealable-p
    73    :generic-function-sealable-p
    74    :method-sealable-p
    75    :specializer-sealable-p
    76 
    77    :metaobject-sealed-p
    78    :class-sealed-p
    79    :generic-function-sealed-p
    80    :method-sealed-p
    81    :specializer-sealed-p
    82 
    83    :seal-class
    84    :seal-generic-function
    85    :seal-method
    86    :seal-domain
    87    :seal-specializer
    88 
    89    :method-properties
    90    :validate-method-property
    91 
    92    :static-call-signature
    93    :static-call-signature-types
    94    :static-call-signature-prototypes
    95 
    96    :sealed-domains
    97    :compute-static-call-signatures
    98    :externalizable-object-p
    99    :sealable-class
   100    :sealable-generic-function
   101    :sealable-standard-generic-function
   102    :potentially-sealable-method
   103    :potentially-sealable-standard-method))
   104 
   105 (defpackage :obj/meta/fast
   106   (:use :cl :std :obj/meta/sealed))
   107 
   108 (defpackage :obj/meta/lazy
   109   (:use :cl :std))