![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to flavorm.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / ucb / lisp / lisplib|
Return to flavorm.l CVS log | Up to [CSRG BSD Unix] / 43BSD / ucb / lisp / lisplib |
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.