Return to flavorm.l CVS log

Up to [CSRG BSD Unix] / 43BSD / ucb / lisp / lisplib

Annotation of 43BSD/ucb/lisp/lisplib/flavorm.l, revision 1.1

1.1     ! root        1: ;; (c) Copywrite 1983, Massachusetts Institute of Technology
        !             2: (setq rcs-flavorm-
        !             3:    "$Header: flavorm.l,v 1.2 85/03/24 11:25:34 sklower Exp $")
        !             4: 
        !             5: ;; This file contains some of the support macros that are need by the
        !             6: ;; flavor system.
        !             7: 
        !             8: (environment-maclisp)
        !             9: (declare (macros t))
        !            10: 
        !            11: ; The data-structure on the FLAVOR property of a flavor-name
        !            12: (DEFSTRUCT (FLAVOR :NAMED)
        !            13:   FLAVOR-BINDINGS              ;List of locatives to instance variable
        !            14:                                ; internal value cells.  MUST BE CDR-CODED!!
        !            15:                                ;Fixnums can also appear.  They say to skip
        !            16:                                ;whatever number of instance variable slots.
        !            17:   FLAVOR-METHOD-HASH-TABLE     ;The hash table for methods of this flavor.
        !            18:                                ; NIL means method-combination not composed yet.
        !            19:   FLAVOR-NAME                  ;Symbol which is the name of the flavor.
        !            20:                                ; This is returned by TYPEP.
        !            21:   FLAVOR-LOCAL-INSTANCE-VARIABLES      ;Names and initializations,
        !            22:                                        ; does not include inherited ones.
        !            23:   FLAVOR-ALL-INSTANCE-VARIABLES        ;Just names, only valid when "flavor 
        !            24:                                ; combination" composed.  Corresponds directly
        !            25:                                ; to FLAVOR-BINDINGS and the instances.
        !            26:   FLAVOR-METHOD-TABLE          ;Defined below.
        !            27:   ;; End of locations depended on in many other files.
        !            28:   FLAVOR-DEPENDS-ON            ;List of names of flavors incorporated into this flavor.
        !            29:   FLAVOR-DEPENDED-ON-BY                ;List of names of flavors which incorporate this one.
        !            30:                                ;The above are only immediate dependencies.
        !            31:   FLAVOR-INCLUDES              ;List of names of flavors to include at the end
        !            32:                                ; rather than as immediate depends-on's.
        !            33:   FLAVOR-DEPENDS-ON-ALL                ;Names of all flavors depended on, to all levels, including
        !            34:                                ; this flavor itself.  NIL means flavor-combination not
        !            35:                                ; composed yet.  This is used by TYPEP of 2 arguments.
        !            36:   (FLAVOR-WHICH-OPERATIONS NIL)        ;List of operations handled, created when needed.
        !            37:                                ; This is NIL if it has not been computed yet.
        !            38:   ;; Redundant copy of :DEFAULT-HANDLER property, for speed in calling it.
        !            39:   (FLAVOR-DEFAULT-HANDLER NIL)
        !            40:   (FLAVOR-GETTABLE-INSTANCE-VARIABLES NIL)
        !            41:   (FLAVOR-SETTABLE-INSTANCE-VARIABLES NIL)
        !            42:   (FLAVOR-INITABLE-INSTANCE-VARIABLES NIL)
        !            43:                                ;Alist from init keyword to name of variable
        !            44:   (FLAVOR-INIT-KEYWORDS NIL)                   ;option
        !            45:   (FLAVOR-PLIST NIL)           ;Esoteric things stored here as properties
        !            46:                                ;Known: :ORDERED-INSTANCE-VARIABLES, :DEFAULT-HANDLER
        !            47:                                ; :OUTSIDE-ACCESSIBLE-INSTANCE-VARIABLES, :ACCESSOR-PREFIX,
        !            48:                                ; :REQUIRED-INSTANCE-VARIABLES, :REQUIRED-METHODS,
        !            49:                                ; :REQUIRED-FLAVORS, :SELECT-METHOD-ORDER,
        !            50:                                ; :DEFAULT-INIT-PLIST, :DOCUMENTATION, :NO-VANILLA-FLAVOR
        !            51:                                ; :GETTABLE-INSTANCE-VARIABLES :SETTABLE-INSTANCE-VARIABLES
        !            52:                                ; ADDITIONAL-INSTANCE-VARIABLES
        !            53:                                ; COMPILE-FLAVOR-METHODS
        !            54:                                ; MAPPED-COMPONENT-FLAVORS
        !            55:                                ; INSTANCE-VARIABLE-INITIALIZATIONS
        !            56:                                ; ALL-INITABLE-INSTANCE-VARIABLES
        !            57:                                ; REMAINING-DEFAULT-PLIST
        !            58:                                ; REMAINING-INIT-KEYWORDS
        !            59:                                ;The convention on these is supposed to be that
        !            60:                                ;ones in the keyword packages are allowed to be
        !            61:                                ;used by users.
        !            62:                                ;Some of these are not used by the flavor system, they are
        !            63:                                ;just remembered on the plist in case anyone cares.  The
        !            64:                                ;flavor system does all its handling of them during the
        !            65:                                ;expansion of the DEFFLAVOR macro.
        !            66:   )
        !            67: 
        !            68: (defsubst instancep (x)
        !            69:   (and (fclosurep x) (eq (fclosure-function x) #'flavor-dispatch)))
        !            70: 
        !            71: (defvar self ()
        !            72:   "Self referential pointer for flavors")
        !            73: 
        !            74: (defmacro send (object message &rest args) 
        !            75:   (if (eq object 'self)
        !            76:       `(send-self ,message ,@args)
        !            77:       `(send-internal ,object ,message ,@args)))
        !            78: 
        !            79: (defmacro lexpr-send (object &rest args)
        !            80:   (if (eq object 'self)
        !            81:       `(lexpr-send-self ,@args)
        !            82:       `(lexpr-funcall #'send-internal ,object ,@args)))
        !            83: 
        !            84: ;; These two functions are used when sending a message to yourself, for 
        !            85: ;; extra efficiency.  They avoid the variable unbinding and binding 
        !            86: ;; required when entering a closure.
        !            87: (defmacro send-self (message &rest args)
        !            88:   `(funcall (or (gethash ,message (flavor-method-hash-table .own-flavor.))
        !            89:                (flavor-default-handler .own-flavor.))
        !            90:            ,message . ,args))
        !            91: (defmacro funcall-self (&rest args) `(send-self . ,args))
        !            92: 
        !            93: (defmacro lexpr-send-self (message &rest args)
        !            94:   `(lexpr-funcall (or (gethash ,message
        !            95:                               (flavor-method-hash-table .own-flavor.))
        !            96:                      (flavor-default-handler .own-flavor.))
        !            97:                  ,message . ,args))
        !            98: (defmacro lexpr-funcall-self (&rest args) `(lexpr-send-self . ,args))
        !            99: 
        !           100: (defsetf send (e v)
        !           101:   (if (or (atom (caddr e))
        !           102:          (neq (car (caddr e)) 'quote))
        !           103:       (ferror () "Don't know how to setf this ~S" e))
        !           104:   (cond ((eq (cadr (caddr e)) ':get)
        !           105:         `(send ,(cadr e) ':putprop ,v ,(cadddr e)))
        !           106:        (t
        !           107:         `(send ,(cadr e) ',(intern (format () ":set-~A"
        !           108:                                            (remove-colon (cadr (caddr e)))))
        !           109:                          ,v))))
        !           110: 
        !           111: (putprop 'flavorm t 'version)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.