~mdw
/
sod
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
doc/sod.tex: Print a proper title page.
[sod]
/
src
/
class-utilities.lisp
diff --git
a/src/class-utilities.lisp
b/src/class-utilities.lisp
index
62f27d8
..
0aec35a
100644
(file)
--- a/
src/class-utilities.lisp
+++ b/
src/class-utilities.lisp
@@
-100,7
+100,7
@@
The root superclass is the superclass which itself has no direct
superclasses. In universes not based on the provided builtin module, the
The root superclass is the superclass which itself has no direct
superclasses. In universes not based on the provided builtin module, the
- root class may not be our beloved
SodObject
; however, there must be one
+ root class may not be our beloved
`SodObject'
; however, there must be one
(otherwise the class graph is cyclic, which should be forbidden), and we
insist that it be unique."
(otherwise the class graph is cyclic, which should be forbidden), and we
insist that it be unique."
@@
-160,7
+160,8
@@
(and (= (length message-args) (length method-args))
(every (lambda (message-arg method-arg)
(if (eq message-arg :ellipsis)
(and (= (length message-args) (length method-args))
(every (lambda (message-arg method-arg)
(if (eq message-arg :ellipsis)
- (eq method-arg (c-type va-list))
+ (c-type-equal-p (argument-type method-arg)
+ (c-type va-list))
(c-type-equal-p (argument-type message-arg)
(argument-type method-arg))))
message-args method-args)))
(c-type-equal-p (argument-type message-arg)
(argument-type method-arg))))
message-args method-args)))
@@
-188,6
+189,10
@@
(defun vtmsgs-struct-tag (class super)
(format nil "~A__vtmsgs_~A" class (sod-class-nickname super)))
(defun vtmsgs-struct-tag (class super)
(format nil "~A__vtmsgs_~A" class (sod-class-nickname super)))
+(export 'vtable-union-tag)
+(defun vtable-union-tag (class chain-head)
+ (format nil "~A__vtu_~A" class (sod-class-nickname chain-head)))
+
(export 'vtable-struct-tag)
(defun vtable-struct-tag (class chain-head)
(format nil "~A__vt_~A" class (sod-class-nickname chain-head)))
(export 'vtable-struct-tag)
(defun vtable-struct-tag (class chain-head)
(format nil "~A__vt_~A" class (sod-class-nickname chain-head)))
@@
-196,4
+201,8
@@
(defun vtable-name (class chain-head)
(format nil "~A__vtable_~A" class (sod-class-nickname chain-head)))
(defun vtable-name (class chain-head)
(format nil "~A__vtable_~A" class (sod-class-nickname chain-head)))
+(export 'message-macro-name)
+(defun message-macro-name (class entry)
+ (format nil "~A_~A" class (method-entry-slot-name entry)))
+
;;;----- That's all, folks --------------------------------------------------
;;;----- That's all, folks --------------------------------------------------