chiark
/
gitweb
/
~mdw
/
sod
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
7d467fa
)
Fix formatting badness.
author
Mark Wooding
<mdw@distorted.org.uk>
Fri, 12 Jul 2013 01:39:37 +0000
(
02:39
+0100)
committer
Mark Wooding
<mdw@distorted.org.uk>
Fri, 12 Jul 2013 01:39:37 +0000
(
02:39
+0100)
src/class-output.lisp
patch
|
blob
|
blame
|
history
diff --git
a/src/class-output.lisp
b/src/class-output.lisp
index 58d483048d79ca4a8b5abc77c645ceb19194ba92..b168d8928987308d498bbf17de90de822a5e1e54 100644
(file)
--- a/
src/class-output.lisp
+++ b/
src/class-output.lisp
@@
-28,8
+28,7
@@
(cl:in-package #:sod)
;;;--------------------------------------------------------------------------
;;; Classes.
;;;--------------------------------------------------------------------------
;;; Classes.
-(defmethod hook-output progn ((class sod-class) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
;; Main output sequencing.
(sequence-output (stream sequencer)
;; Main output sequencing.
(sequence-output (stream sequencer)
@@
-121,8
+120,9
@@
(defmethod hook-output progn ((class sod-class) reason sequencer)
;;;--------------------------------------------------------------------------
;;; Instance structure.
;;;--------------------------------------------------------------------------
;;; Instance structure.
-(defmethod hook-output progn ((slot sod-slot) (reason (eql 'islots))
- sequencer)
+(defmethod hook-output progn ((slot sod-slot)
+ (reason (eql 'islots))
+ sequencer)
(sequence-output (stream sequencer)
(((sod-slot-class slot) :islots :slots)
(pprint-logical-block (stream nil :prefix " " :suffix ";")
(sequence-output (stream sequencer)
(((sod-slot-class slot) :islots :slots)
(pprint-logical-block (stream nil :prefix " " :suffix ";")
@@
-137,8
+137,7
@@
(defmethod hook-output progn ((ichain ichain) reason sequencer)
(dolist (item (ichain-body ichain))
(hook-output item reason sequencer)))
(dolist (item (ichain-body ichain))
(hook-output item reason sequencer)))
-(defmethod hook-output progn ((ilayout ilayout) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((ilayout ilayout) (reason (eql :h)) sequencer)
(with-slots (class ichains) ilayout
(sequence-output (stream sequencer)
((class :ilayout :start)
(with-slots (class ichains) ilayout
(sequence-output (stream sequencer)
((class :ilayout :start)
@@
-150,8
+149,7
@@
(defmethod hook-output progn ((ilayout ilayout) (reason (eql :h))
(dolist (ichain ichains)
(hook-output ichain 'ilayout sequencer))))
(dolist (ichain ichains)
(hook-output ichain 'ilayout sequencer))))
-(defmethod hook-output progn ((ichain ichain) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((ichain ichain) (reason (eql :h)) sequencer)
(with-slots (class chain-head chain-tail) ichain
(when (eq class chain-tail)
(sequence-output (stream sequencer)
(with-slots (class chain-head chain-tail) ichain
(when (eq class chain-tail)
(sequence-output (stream sequencer)
@@
-180,8
+178,9
@@
(defmethod hook-output progn ((ichain ichain) (reason (eql :h))
(sod-class-nickname super)))
(sod-class-chain chain-tail))))))))
(sod-class-nickname super)))
(sod-class-chain chain-tail))))))))
-(defmethod hook-output progn ((ichain ichain) (reason (eql 'ilayout))
- sequencer)
+(defmethod hook-output progn ((ichain ichain)
+ (reason (eql 'ilayout))
+ sequencer)
(with-slots (class chain-head chain-tail) ichain
(sequence-output (stream sequencer)
((class :ilayout :slots)
(with-slots (class chain-head chain-tail) ichain
(sequence-output (stream sequencer)
((class :ilayout :slots)
@@
-189,8
+188,9
@@
(defmethod hook-output progn ((ichain ichain) (reason (eql 'ilayout))
(ichain-union-tag chain-tail chain-head)
(sod-class-nickname chain-head))))))
(ichain-union-tag chain-tail chain-head)
(sod-class-nickname chain-head))))))
-(defmethod hook-output progn ((vtptr vtable-pointer) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((vtptr vtable-pointer)
+ (reason (eql :h))
+ sequencer)
(with-slots (class chain-head chain-tail) vtptr
(sequence-output (stream sequencer)
((class :ichain chain-head :slots)
(with-slots (class chain-head chain-tail) vtptr
(sequence-output (stream sequencer)
((class :ichain chain-head :slots)
@@
-201,8
+201,7
@@
(defmethod hook-output progn ((islots islots) reason sequencer)
(dolist (slot (islots-slots islots))
(hook-output slot reason sequencer)))
(dolist (slot (islots-slots islots))
(hook-output slot reason sequencer)))
-(defmethod hook-output progn ((islots islots) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
(with-slots (class subclass slots) islots
(sequence-output (stream sequencer)
((subclass :ichain (sod-class-chain-head class) :slots)
(with-slots (class subclass slots) islots
(sequence-output (stream sequencer)
((subclass :ichain (sod-class-chain-head class) :slots)
@@
-217,8
+216,9
@@
(defmethod hook-output progn ((vtable vtable) reason sequencer)
(with-slots (body) vtable
(dolist (item body) (hook-output item reason sequencer))))
(with-slots (body) vtable
(dolist (item body) (hook-output item reason sequencer))))
-(defmethod hook-output progn ((method sod-method) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((method sod-method)
+ (reason (eql :h))
+ sequencer)
(with-slots (class) method
(sequence-output (stream sequencer)
((class :methods)
(with-slots (class) method
(sequence-output (stream sequencer)
((class :methods)
@@
-228,8
+228,7
@@
(defmethod hook-output progn ((method sod-method) (reason (eql :h))
(sod-method-function-name method))
(format stream ";~%"))))))
(sod-method-function-name method))
(format stream ";~%"))))))
-(defmethod hook-output progn ((vtable vtable) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((vtable vtable) (reason (eql :h)) sequencer)
(with-slots (class chain-head chain-tail) vtable
(when (eq class chain-tail)
(sequence-output (stream sequencer)
(with-slots (class chain-head chain-tail) vtable
(when (eq class chain-tail)
(sequence-output (stream sequencer)
@@
-250,8
+249,7
@@
(defmethod hook-output progn ((vtable vtable) (reason (eql :h))
(vtable-struct-tag chain-tail chain-head)
class (sod-class-nickname chain-head))))))
(vtable-struct-tag chain-tail chain-head)
class (sod-class-nickname chain-head))))))
-(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h)) sequencer)
(with-slots (class subclass chain-head chain-tail) vtmsgs
(sequence-output (stream sequencer)
((subclass :vtable chain-head :slots)
(with-slots (class subclass chain-head chain-tail) vtmsgs
(sequence-output (stream sequencer)
((subclass :vtable chain-head :slots)
@@
-259,8
+257,9
@@
(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h))
(vtmsgs-struct-tag subclass class)
(sod-class-nickname class))))))
(vtmsgs-struct-tag subclass class)
(sod-class-nickname class))))))
-(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql 'vtmsgs))
- sequencer)
+(defmethod hook-output progn ((vtmsgs vtmsgs)
+ (reason (eql 'vtmsgs))
+ sequencer)
(when (vtmsgs-entries vtmsgs)
(with-slots (class subclass) vtmsgs
(sequence-output (stream sequencer)
(when (vtmsgs-entries vtmsgs)
(with-slots (class subclass) vtmsgs
(sequence-output (stream sequencer)
@@
-285,8
+284,9
@@
(defmethod hook-output progn ((entry method-entry) reason sequencer)
(with-slots (method) entry
(hook-output method reason sequencer)))
(with-slots (method) entry
(hook-output method reason sequencer)))
-(defmethod hook-output progn ((entry method-entry) (reason (eql 'vtmsgs))
- sequencer)
+(defmethod hook-output progn ((entry method-entry)
+ (reason (eql 'vtmsgs))
+ sequencer)
(let* ((method (method-entry-effective-method entry))
(message (effective-method-message method))
(class (effective-method-class method))
(let* ((method (method-entry-effective-method entry))
(message (effective-method-message method))
(class (effective-method-class method))
@@
-298,8
+298,9
@@
(defmethod hook-output progn ((entry method-entry) (reason (eql 'vtmsgs))
(pprint-c-type commented-type stream (sod-message-name message)))
(terpri stream)))))
(pprint-c-type commented-type stream (sod-message-name message)))
(terpri stream)))))
-(defmethod hook-output progn ((cptr class-pointer) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((cptr class-pointer)
+ (reason (eql :h))
+ sequencer)
(with-slots (class chain-head metaclass meta-chain-head) cptr
(sequence-output (stream sequencer)
((class :vtable chain-head :slots)
(with-slots (class chain-head metaclass meta-chain-head) cptr
(sequence-output (stream sequencer)
((class :vtable chain-head :slots)
@@
-309,15
+310,15
@@
(defmethod hook-output progn ((cptr class-pointer) (reason (eql :h))
(sod-class-nickname meta-chain-head)
nil))))))
(sod-class-nickname meta-chain-head)
nil))))))
-(defmethod hook-output progn ((boff base-offset) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((boff base-offset) (reason (eql :h)) sequencer)
(with-slots (class chain-head) boff
(sequence-output (stream sequencer)
((class :vtable chain-head :slots)
(write-line " size_t _base;" stream)))))
(with-slots (class chain-head) boff
(sequence-output (stream sequencer)
((class :vtable chain-head :slots)
(write-line " size_t _base;" stream)))))
-(defmethod hook-output progn ((choff chain-offset) (reason (eql :h))
- sequencer)
+(defmethod hook-output progn ((choff chain-offset)
+ (reason (eql :h))
+ sequencer)
(with-slots (class chain-head target-head) choff
(sequence-output (stream sequencer)
((class :vtable chain-head :slots)
(with-slots (class chain-head target-head) choff
(sequence-output (stream sequencer)
((class :vtable chain-head :slots)
@@
-329,8
+330,7
@@
(defmethod hook-output progn ((choff chain-offset) (reason (eql :h))
(defvar *instance-class*)
(defvar *instance-class*)
-(defmethod hook-output progn ((class sod-class) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)
(sequence-output (stream sequencer)
:constraint
(sequence-output (stream sequencer)
:constraint
@@
-362,8
+362,9
@@
(defmethod hook-output progn ((class sod-class) (reason (eql :c))
;;;--------------------------------------------------------------------------
;;; Direct methods.
;;;--------------------------------------------------------------------------
;;; Direct methods.
-(defmethod hook-output progn ((method delegating-direct-method) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((method delegating-direct-method)
+ (reason (eql :c))
+ sequencer)
(with-slots (class body) method
(unless body
(return-from hook-output))
(with-slots (class body) method
(unless body
(return-from hook-output))
@@
-376,8
+377,9
@@
(defmethod hook-output progn ((method delegating-direct-method) (reason (eql :c)
((class :direct-method method :end)
(format stream "#undef CALL_NEXT_METHOD~%")))))
((class :direct-method method :end)
(format stream "#undef CALL_NEXT_METHOD~%")))))
-(defmethod hook-output progn ((method sod-method) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((method sod-method)
+ (reason (eql :c))
+ sequencer)
(with-slots (class body) method
(unless body
(return-from hook-output))
(with-slots (class body) method
(unless body
(return-from hook-output))
@@
-397,7
+399,8
@@
(defmethod hook-output progn ((method sod-method) (reason (eql :c))
((class :direct-method method :end)
(terpri stream)))))
((class :direct-method method :end)
(terpri stream)))))
-(defmethod hook-output progn ((method basic-effective-method) (reason (eql :c))
+(defmethod hook-output progn ((method basic-effective-method)
+ (reason (eql :c))
sequencer)
(with-slots (class functions) method
(sequence-output (stream sequencer)
sequencer)
(with-slots (class functions) method
(sequence-output (stream sequencer)
@@
-408,8
+411,7
@@
(defmethod hook-output progn ((method basic-effective-method) (reason (eql :c))
;;;--------------------------------------------------------------------------
;;; Vtables.
;;;--------------------------------------------------------------------------
;;; Vtables.
-(defmethod hook-output progn ((vtable vtable) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((vtable vtable) (reason (eql :c)) sequencer)
(with-slots (class chain-head chain-tail) vtable
(sequence-output (stream sequencer)
:constraint ((class :vtables :start)
(with-slots (class chain-head chain-tail) vtable
(sequence-output (stream sequencer)
:constraint ((class :vtables :start)
@@
-425,8
+427,9
@@
(defmethod hook-output progn ((vtable vtable) (reason (eql :c))
((class :vtable chain-head :end)
(format stream "};~2%")))))
((class :vtable chain-head :end)
(format stream "};~2%")))))
-(defmethod hook-output progn ((cptr class-pointer) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((cptr class-pointer)
+ (reason (eql :c))
+ sequencer)
(with-slots (class chain-head metaclass meta-chain-head) cptr
(sequence-output (stream sequencer)
:constraint ((class :vtable chain-head :start)
(with-slots (class chain-head metaclass meta-chain-head) cptr
(sequence-output (stream sequencer)
:constraint ((class :vtable chain-head :start)
@@
-438,8
+441,7
@@
(defmethod hook-output progn ((cptr class-pointer) (reason (eql :c))
(sod-class-nickname meta-chain-head)
(sod-class-nickname metaclass))))))
(sod-class-nickname meta-chain-head)
(sod-class-nickname metaclass))))))
-(defmethod hook-output progn ((boff base-offset) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((boff base-offset) (reason (eql :c)) sequencer)
(with-slots (class chain-head) boff
(sequence-output (stream sequencer)
:constraint ((class :vtable chain-head :start)
(with-slots (class chain-head) boff
(sequence-output (stream sequencer)
:constraint ((class :vtable chain-head :start)
@@
-450,8
+452,9
@@
(defmethod hook-output progn ((boff base-offset) (reason (eql :c))
(ilayout-struct-tag class)
(sod-class-nickname chain-head))))))
(ilayout-struct-tag class)
(sod-class-nickname chain-head))))))
-(defmethod hook-output progn ((choff chain-offset) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((choff chain-offset)
+ (reason (eql :c))
+ sequencer)
(with-slots (class chain-head target-head) choff
(sequence-output (stream sequencer)
:constraint ((class :vtable chain-head :start)
(with-slots (class chain-head target-head) choff
(sequence-output (stream sequencer)
:constraint ((class :vtable chain-head :start)
@@
-463,8
+466,7
@@
(defmethod hook-output progn ((choff chain-offset) (reason (eql :c))
(sod-class-nickname chain-head)
(sod-class-nickname target-head))))))
(sod-class-nickname chain-head)
(sod-class-nickname target-head))))))
-(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c)) sequencer)
(with-slots (class subclass chain-head) vtmsgs
(sequence-output (stream sequencer)
:constraint ((subclass :vtable chain-head :start)
(with-slots (class subclass chain-head) vtmsgs
(sequence-output (stream sequencer)
:constraint ((subclass :vtable chain-head :start)
@@
-478,8
+480,9
@@
(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c))
((subclass :vtable chain-head :vtmsgs class :end)
(format stream " },~%")))))
((subclass :vtable chain-head :vtmsgs class :end)
(format stream " },~%")))))
-(defmethod hook-output progn ((entry method-entry) (reason (eql :c))
- sequencer)
+(defmethod hook-output progn ((entry method-entry)
+ (reason (eql :c))
+ sequencer)
(with-slots (method chain-head chain-tail) entry
(let* ((message (effective-method-message method))
(class (effective-method-class method))
(with-slots (method chain-head chain-tail) entry
(let* ((message (effective-method-message method))
(class (effective-method-class method))
@@
-492,8
+495,9
@@
(defmethod hook-output progn ((entry method-entry) (reason (eql :c))
;;;--------------------------------------------------------------------------
;;; Filling in the class object.
;;;--------------------------------------------------------------------------
;;; Filling in the class object.
-(defmethod hook-output progn ((ichain ichain) (reason (eql 'class))
- sequencer)
+(defmethod hook-output progn ((ichain ichain)
+ (reason (eql 'class))
+ sequencer)
(with-slots (class chain-head) ichain
(sequence-output (stream sequencer)
:constraint ((*instance-class* :object :start)
(with-slots (class chain-head) ichain
(sequence-output (stream sequencer)
:constraint ((*instance-class* :object :start)
@@
-506,8
+510,9
@@
(defmethod hook-output progn ((ichain ichain) (reason (eql 'class))
((*instance-class* :object chain-head :ichain :end)
(format stream " } },~%")))))
((*instance-class* :object chain-head :ichain :end)
(format stream " } },~%")))))
-(defmethod hook-output progn ((islots islots) (reason (eql 'class))
- sequencer)
+(defmethod hook-output progn ((islots islots)
+ (reason (eql 'class))
+ sequencer)
(with-slots (class) islots
(let ((chain-head (sod-class-chain-head class)))
(sequence-output (stream sequencer)
(with-slots (class) islots
(let ((chain-head (sod-class-chain-head class)))
(sequence-output (stream sequencer)
@@
-521,8
+526,9
@@
(defmethod hook-output progn ((islots islots) (reason (eql 'class))
((*instance-class* :object class :slots :end)
(format stream " },~%"))))))
((*instance-class* :object class :slots :end)
(format stream " },~%"))))))
-(defmethod hook-output progn ((vtptr vtable-pointer) (reason (eql 'class))
- sequencer)
+(defmethod hook-output progn ((vtptr vtable-pointer)
+ (reason (eql 'class))
+ sequencer)
(with-slots (class chain-head chain-tail) vtptr
(sequence-output (stream sequencer)
:constraint ((*instance-class* :object chain-head :ichain :start)
(with-slots (class chain-head chain-tail) vtptr
(sequence-output (stream sequencer)
:constraint ((*instance-class* :object chain-head :ichain :start)
@@
-555,8
+561,9
@@
(defgeneric output-class-initializer (slot instance stream)
(:compound (format stream " ~@<{ ~;~A~; },~:>~%"
(sod-initializer-value-form init)))))))
(:compound (format stream " ~@<{ ~;~A~; },~:>~%"
(sod-initializer-value-form init)))))))
-(defmethod hook-output progn ((slot sod-class-effective-slot) (reason (eql 'class))
- sequencer)
+(defmethod hook-output progn ((slot sod-class-effective-slot)
+ (reason (eql 'class))
+ sequencer)
(let ((instance *instance-class*)
(func (effective-slot-prepare-function slot)))
(when func
(let ((instance *instance-class*)
(func (effective-slot-prepare-function slot)))
(when func
@@
-564,8
+571,9
@@
(defmethod hook-output progn ((slot sod-class-effective-slot) (reason (eql 'clas
((instance :object :prepare)
(funcall func instance stream))))))
((instance :object :prepare)
(funcall func instance stream))))))
-(defmethod hook-output progn ((slot effective-slot) (reason (eql 'class))
- sequencer)
+(defmethod hook-output progn ((slot effective-slot)
+ (reason (eql 'class))
+ sequencer)
(with-slots (class (dslot slot)) slot
(let ((instance *instance-class*)
(super (sod-slot-class dslot)))
(with-slots (class (dslot slot)) slot
(let ((instance *instance-class*)
(super (sod-slot-class dslot)))