src/output-proto.lisp, etc. (hook-output): Use standard combination.

This will let subclasses selectively override portions of the basic
output machinery.

The existing implicit traversal is now done via `:after' methods.
Existing hook methods which engaged custom traversal have been split out
into separate `:after' methods so that they don't get overridden by
accident.

The main output-class-to-header method (i.e., `hook-output' specialized
on `sod-class' and `(eql :h)') is huge and could usefully be split into
smaller pieces which can be overridden separately.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index fc98f01..0396997 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -1263,47 +1263,50 @@ format-temporary-name
 guess-metaclass
   sod-class
 hook-output
-  t t t [progn]
-  base-offset (eql :c) t [progn]
-  base-offset (eql :h) t [progn]
-  basic-effective-method (eql :c) t [progn]
-  chain-offset (eql :c) t [progn]
-  chain-offset (eql :h) t [progn]
-  class-pointer (eql :c) t [progn]
-  class-pointer (eql :h) t [progn]
-  code-fragment-item t t [progn]
-  delegating-direct-method (eql :c) t [progn]
-  effective-slot (eql cl:class) t [progn]
-  ichain (eql :h) t [progn]
-  ichain (eql cl:class) t [progn]
-  ichain (eql ilayout) t [progn]
-  ichain t t [progn]
-  ilayout (eql :h) t [progn]
-  ilayout t t [progn]
-  islots (eql :h) t [progn]
-  islots (eql cl:class) t [progn]
-  islots t t [progn]
-  method-entry (eql :c) t [progn]
-  method-entry (eql vtmsgs) t [progn]
-  module (eql :c) t [progn]
-  module (eql :h) t [progn]
-  module t t [progn]
-  sod-class (eql :c) t [progn]
-  sod-class (eql :h) t [progn]
-  sod-class t t [progn]
-  sod-class-effective-slot (eql cl:class) t [progn]
-  sod-method (eql :c) t [progn]
-  sod-method (eql :h) t [progn]
-  sod-slot (eql islots) t [progn]
-  vtable (eql :c) t [progn]
-  vtable (eql :h) t [progn]
-  vtable t t [progn]
-  vtable-pointer (eql :h) t [progn]
-  vtable-pointer (eql cl:class) t [progn]
-  vtmsgs (eql :c) t [progn]
-  vtmsgs (eql :h) t [progn]
-  vtmsgs (eql vtmsgs) t [progn]
-  vtmsgs t t [progn]
+  t t t
+  base-offset (eql :c) t
+  base-offset (eql :h) t
+  basic-effective-method (eql :c) t
+  chain-offset (eql :c) t
+  chain-offset (eql :h) t
+  class-pointer (eql :c) t
+  class-pointer (eql :h) t
+  code-fragment-item t t
+  delegating-direct-method (eql :c) t
+  effective-slot (eql cl:class) t
+  ichain (eql :h) t
+  ichain (eql cl:class) t
+  ichain (eql ilayout) t
+  ichain t t [:after]
+  ilayout (eql :h) t [:after]
+  ilayout (eql :h) t
+  ilayout t t [:after]
+  islots (eql :h) t
+  islots (eql cl:class) t
+  islots t t [:after]
+  method-entry (eql :c) t
+  method-entry (eql vtmsgs) t
+  module (eql :c) t
+  module (eql :h) t
+  module t t [:after]
+  sod-class (eql :c) t [:after]
+  sod-class (eql :c) t
+  sod-class (eql :h) t [:after]
+  sod-class (eql :h) t
+  sod-class t t [:after]
+  sod-class-effective-slot (eql cl:class) t
+  sod-method (eql :c) t
+  sod-method (eql :h) t
+  sod-slot (eql islots) t
+  vtable (eql :c) t
+  vtable (eql :h) t
+  vtable t t [:after]
+  vtable-pointer (eql :h) t
+  vtable-pointer (eql cl:class) t
+  vtmsgs (eql :c) t
+  vtmsgs (eql :h) t
+  vtmsgs (eql vtmsgs) t
+  vtmsgs t t [:after]
 ichain-body
   ichain
 ichain-class

diff --git a/doc/output.tex b/doc/output.tex
index 5b464ba..fc59bb4 100644 (file)
--- a/doc/output.tex
+++ b/doc/output.tex
@@ -159,9 +159,9 @@ until the third.  So the final processing order is
     {invoke-sequencer-items @<sequencer> \&rest @<arguments>}
 \end{describe}
 
-\begin{describe}{gf}{hook-output progn @<object> @<reason> @<sequencer>}
+\begin{describe}{gf}{hook-output @<object> @<reason> @<sequencer>}
   \begin{describe}{meth}{t,t}
-    {hook-output progn (@<object> t) (@<reason> t) @<sequencer>}
+    {hook-output (@<object> t) (@<reason> t) @<sequencer>}
   \end{describe}
 \end{describe}
 

diff --git a/src/class-output.lisp b/src/class-output.lisp
index dec1e4e..2fbdda1 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -28,35 +28,35 @@
 ;;;--------------------------------------------------------------------------
 ;;; Walking the layout tree.
 
-(defmethod hook-output progn ((class sod-class) reason sequencer)
+(defmethod hook-output :after ((class sod-class) reason sequencer)
   (with-slots ((ilayout %ilayout) vtables methods effective-methods) class
     (hook-output ilayout reason sequencer)
     (dolist (method methods) (hook-output method reason sequencer))
     (dolist (method effective-methods) (hook-output method reason sequencer))
     (dolist (vtable vtables) (hook-output vtable reason sequencer))))
 
-(defmethod hook-output progn ((ilayout ilayout) reason sequencer)
+(defmethod hook-output :after ((ilayout ilayout) reason sequencer)
   (with-slots (ichains) ilayout
     (dolist (ichain ichains) (hook-output ichain reason sequencer))))
 
-(defmethod hook-output progn ((ichain ichain) reason sequencer)
+(defmethod hook-output :after ((ichain ichain) reason sequencer)
   (dolist (item (ichain-body ichain)) (hook-output item reason sequencer)))
 
-(defmethod hook-output progn ((islots islots) reason sequencer)
+(defmethod hook-output :after ((islots islots) reason sequencer)
   (dolist (slot (islots-slots islots)) (hook-output slot reason sequencer)))
 
-(defmethod hook-output progn ((vtable vtable) reason sequencer)
+(defmethod hook-output :after ((vtable vtable) reason sequencer)
   (with-slots (body) vtable
     (dolist (item body) (hook-output item reason sequencer))))
 
-(defmethod hook-output progn ((vtmsgs vtmsgs) reason sequencer)
+(defmethod hook-output :after ((vtmsgs vtmsgs) reason sequencer)
   (with-slots (entries) vtmsgs
     (dolist (entry entries) (hook-output entry reason sequencer))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Classes.
 
-(defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
+(defmethod hook-output ((class sod-class) (reason (eql :h)) sequencer)
 
   ;; Main output sequencing.
   (sequence-output (stream sequencer)
@@ -108,8 +108,6 @@
 
   ;; Maybe generate an islots structure.
   (when (sod-class-slots class)
-    (dolist (slot (sod-class-slots class))
-      (hook-output slot 'islots sequencer))
     (sequence-output (stream sequencer)
       ((class :islots :start)
        (format stream "/* Instance slots. */~@
@@ -201,35 +199,42 @@
                     (nreverse out-names))
             (when varargsp
               (format stream "#endif~%"))))
-        (terpri stream)))))
+        (terpri stream))))))
+
+(defmethod hook-output :after ((class sod-class) (reason (eql :h)) sequencer)
 
-  ;; Generate vtmsgs structure for all superclasses.
+  ;; Output a structure member definition for each instance slot.
+  (dolist (slot (sod-class-slots class))
+    (hook-output slot 'islots sequencer))
+
+  ;; Generate a vtmsgs structure for all superclasses.
   (hook-output (car (sod-class-vtables class)) 'vtmsgs sequencer))
 
 ;;;--------------------------------------------------------------------------
 ;;; Instance structure.
 
-(defmethod hook-output progn
-    ((slot sod-slot) (reason (eql 'islots)) sequencer)
+(defmethod hook-output ((slot sod-slot) (reason (eql 'islots)) sequencer)
   (sequence-output (stream sequencer)
     (((sod-slot-class slot) :islots :slots)
      (pprint-logical-block (stream nil :prefix "  " :suffix ";")
        (pprint-c-type (sod-slot-type slot) stream (sod-slot-name slot)))
      (terpri stream))))
 
-(defmethod hook-output progn ((ilayout ilayout) (reason (eql :h)) sequencer)
-  (with-slots ((class %class) ichains) ilayout
+(defmethod hook-output ((ilayout ilayout) (reason (eql :h)) sequencer)
+  (with-slots ((class %class)) ilayout
     (sequence-output (stream sequencer)
       ((class :ilayout :start)
        (format stream "/* Instance layout. */~@
                       struct ~A {~%"
               (ilayout-struct-tag class)))
       ((class :ilayout :end)
-       (format stream "};~2%")))
-    (dolist (ichain ichains)
-      (hook-output ichain 'ilayout sequencer))))
+       (format stream "};~2%")))))
+
+(defmethod hook-output :after ((ilayout ilayout) (reason (eql :h)) sequencer)
+  (dolist (ichain (ilayout-ichains ilayout))
+    (hook-output ichain 'ilayout sequencer)))
 
-(defmethod hook-output progn ((ichain ichain) (reason (eql :h)) sequencer)
+(defmethod hook-output ((ichain ichain) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head chain-tail) ichain
     (when (eq class chain-tail)
       (sequence-output (stream sequencer)
@@ -258,8 +263,7 @@
                                 (sod-class-nickname super)))
                         (sod-class-chain chain-tail))))))))
 
-(defmethod hook-output progn
-    ((ichain ichain) (reason (eql 'ilayout)) sequencer)
+(defmethod hook-output ((ichain ichain) (reason (eql 'ilayout)) sequencer)
   (with-slots ((class %class) chain-head chain-tail) ichain
     (sequence-output (stream sequencer)
       ((class :ilayout :slots)
@@ -267,9 +271,7 @@
               (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 ((vtptr vtable-pointer) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head chain-tail) vtptr
     (when (eq class chain-tail)
       (sequence-output (stream sequencer)
@@ -277,7 +279,7 @@
         (format stream "  const struct ~A *_vt;~%"
                 (vtable-struct-tag chain-tail chain-head)))))))
 
-(defmethod hook-output progn ((islots islots) (reason (eql :h)) sequencer)
+(defmethod hook-output ((islots islots) (reason (eql :h)) sequencer)
   (with-slots ((class %class) subclass slots) islots
     (let ((head (sod-class-chain-head class)))
       (when (eq head (sod-class-chain-head subclass))
@@ -290,8 +292,7 @@
 ;;;--------------------------------------------------------------------------
 ;;; Vtable structure.
 
-(defmethod hook-output progn
-    ((method sod-method) (reason (eql :h)) sequencer)
+(defmethod hook-output ((method sod-method) (reason (eql :h)) sequencer)
   (with-slots ((class %class)) method
     (sequence-output (stream sequencer)
       ((class :methods)
@@ -311,7 +312,7 @@
                   (direct-method-suppliedp-struct-tag method)
                   (mapcar #'argument-name keys))))))))
 
-(defmethod hook-output progn ((vtable vtable) (reason (eql :h)) sequencer)
+(defmethod hook-output ((vtable vtable) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head chain-tail) vtable
     (when (eq class chain-tail)
       (sequence-output (stream sequencer)
@@ -344,7 +345,7 @@
               (vtable-union-tag chain-tail chain-head)
               (vtable-name class chain-head))))))
 
-(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :h)) sequencer)
+(defmethod hook-output ((vtmsgs vtmsgs) (reason (eql :h)) sequencer)
   (with-slots ((class %class) subclass chain-head chain-tail) vtmsgs
     (when (eq subclass chain-tail)
       (sequence-output (stream sequencer)
@@ -353,8 +354,7 @@
                 (vtmsgs-struct-tag subclass class)
                 (sod-class-nickname class)))))))
 
-(defmethod hook-output progn
-    ((vtmsgs vtmsgs) (reason (eql 'vtmsgs)) sequencer)
+(defmethod hook-output ((vtmsgs vtmsgs) (reason (eql 'vtmsgs)) sequencer)
   (when (vtmsgs-entries vtmsgs)
     (with-slots ((class %class) subclass) vtmsgs
       (sequence-output (stream sequencer)
@@ -371,8 +371,8 @@
        ((subclass :vtmsgs class :end)
         (format stream "};~2%"))))))
 
-(defmethod hook-output progn
-    ((entry method-entry) (reason (eql 'vtmsgs)) sequencer)
+(defmethod hook-output ((entry method-entry)
+                       (reason (eql 'vtmsgs)) sequencer)
   (let* ((method (method-entry-effective-method entry))
         (message (effective-method-message method))
         (class (effective-method-class method))
@@ -385,8 +385,7 @@
         (pprint-c-type pointer-type stream (method-entry-slot-name entry)))
        (terpri stream)))))
 
-(defmethod hook-output progn
-    ((cptr class-pointer) (reason (eql :h)) sequencer)
+(defmethod hook-output ((cptr class-pointer) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr
     (when (eq chain-head (sod-class-chain-head class))
       (sequence-output (stream sequencer)
@@ -396,15 +395,14 @@
                 (and (sod-class-direct-superclasses meta-chain-head)
                      (sod-class-nickname meta-chain-head))))))))
 
-(defmethod hook-output progn ((boff base-offset) (reason (eql :h)) sequencer)
+(defmethod hook-output ((boff base-offset) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head) boff
     (when (eq chain-head (sod-class-chain-head class))
       (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 ((choff chain-offset) (reason (eql :h)) sequencer)
   (with-slots ((class %class) chain-head target-head) choff
     (when (eq chain-head (sod-class-chain-head class))
       (sequence-output (stream sequencer)
@@ -426,7 +424,7 @@
 
    It may be bound at other times.")
 
-(defmethod hook-output progn ((class sod-class) (reason (eql :c)) sequencer)
+(defmethod hook-output ((class sod-class) (reason (eql :c)) sequencer)
   (sequence-output (stream sequencer)
 
     :constraint
@@ -448,8 +446,9 @@ const struct ~A ~A__classobj = {~%"
             (ilayout-struct-tag (sod-class-metaclass class))
             class))
     ((class :object :end)
-     (format stream "};~2%")))
+     (format stream "};~2%"))))
 
+(defmethod hook-output :after ((class sod-class) (reason (eql :c)) sequencer)
   (let ((*instance-class* class))
     (hook-output (sod-class-ilayout (sod-class-metaclass class))
                 'class sequencer)))
@@ -457,8 +456,8 @@ const struct ~A ~A__classobj = {~%"
 ;;;--------------------------------------------------------------------------
 ;;; Direct and effective methods.
 
-(defmethod hook-output progn
-    ((method delegating-direct-method) (reason (eql :c)) sequencer)
+(defmethod hook-output ((method delegating-direct-method)
+                       (reason (eql :c)) sequencer)
   (with-slots ((class %class) body) method
     (unless body
       (return-from hook-output))
@@ -469,10 +468,10 @@ const struct ~A ~A__classobj = {~%"
                       (c-function-arguments (sod-method-next-method-type
                                              method)))))
       ((class :direct-method method :end)
-       (format stream "#undef CALL_NEXT_METHOD~%")))))
+       (format stream "#undef CALL_NEXT_METHOD~%"))))
+  (call-next-method))
 
-(defmethod hook-output progn
-    ((method sod-method) (reason (eql :c)) sequencer)
+(defmethod hook-output ((method sod-method) (reason (eql :c)) sequencer)
   (with-slots ((class %class) role body message) method
     (unless body
       (return-from hook-output))
@@ -502,8 +501,8 @@ const struct ~A ~A__classobj = {~%"
       ((class :direct-method method :end)
        (terpri stream)))))
 
-(defmethod hook-output progn
-    ((method basic-effective-method) (reason (eql :c)) sequencer)
+(defmethod hook-output ((method basic-effective-method)
+                       (reason (eql :c)) sequencer)
   (with-slots ((class %class) functions) method
     (sequence-output (stream sequencer)
       ((class :effective-methods)
@@ -531,7 +530,7 @@ const struct ~A ~A__classobj = {~%"
 ;;;--------------------------------------------------------------------------
 ;;; Vtables.
 
-(defmethod hook-output progn ((vtable vtable) (reason (eql :c)) sequencer)
+(defmethod hook-output ((vtable vtable) (reason (eql :c)) sequencer)
   (with-slots ((class %class) chain-head chain-tail) vtable
     (sequence-output (stream sequencer)
       :constraint ((class :vtables :start)
@@ -547,8 +546,7 @@ const struct ~A ~A__classobj = {~%"
       ((class :vtable chain-head :end)
        (format stream "} };~2%")))))
 
-(defmethod hook-output progn
-    ((cptr class-pointer) (reason (eql :c)) sequencer)
+(defmethod hook-output ((cptr class-pointer) (reason (eql :c)) sequencer)
   (with-slots ((class %class) chain-head metaclass meta-chain-head) cptr
     (sequence-output (stream sequencer)
       :constraint ((class :vtable chain-head :start)
@@ -564,7 +562,7 @@ const struct ~A ~A__classobj = {~%"
               (sod-class-nickname meta-chain-head)
               (sod-class-nickname metaclass))))))
 
-(defmethod hook-output progn ((boff base-offset) (reason (eql :c)) sequencer)
+(defmethod hook-output ((boff base-offset) (reason (eql :c)) sequencer)
   (with-slots ((class %class) chain-head) boff
     (sequence-output (stream sequencer)
       :constraint ((class :vtable chain-head :start)
@@ -576,8 +574,7 @@ const struct ~A ~A__classobj = {~%"
               (ilayout-struct-tag class)
               (sod-class-nickname chain-head))))))
 
-(defmethod hook-output progn
-    ((choff chain-offset) (reason (eql :c)) sequencer)
+(defmethod hook-output ((choff chain-offset) (reason (eql :c)) sequencer)
   (with-slots ((class %class) chain-head target-head) choff
     (sequence-output (stream sequencer)
       :constraint ((class :vtable chain-head :start)
@@ -590,7 +587,7 @@ const struct ~A ~A__classobj = {~%"
               (sod-class-nickname chain-head)
               (sod-class-nickname target-head))))))
 
-(defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c)) sequencer)
+(defmethod hook-output ((vtmsgs vtmsgs) (reason (eql :c)) sequencer)
   (with-slots ((class %class) subclass chain-head) vtmsgs
     (sequence-output (stream sequencer)
       :constraint ((subclass :vtable chain-head :start)
@@ -604,8 +601,7 @@ const struct ~A ~A__classobj = {~%"
       ((subclass :vtable chain-head :vtmsgs class :end)
        (format stream "  },~%")))))
 
-(defmethod hook-output progn
-    ((entry method-entry) (reason (eql :c)) sequencer)
+(defmethod hook-output ((entry method-entry) (reason (eql :c)) sequencer)
   (with-slots ((method %method) chain-head chain-tail role) entry
     (let* ((message (effective-method-message method))
           (class (effective-method-class method))
@@ -619,8 +615,7 @@ const struct ~A ~A__classobj = {~%"
 ;;;--------------------------------------------------------------------------
 ;;; Filling in the class object.
 
-(defmethod hook-output progn
-    ((ichain ichain) (reason (eql 'class)) sequencer)
+(defmethod hook-output ((ichain ichain) (reason (eql 'class)) sequencer)
   (with-slots ((class %class) chain-head) ichain
     (sequence-output (stream sequencer)
       :constraint ((*instance-class* :object :start)
@@ -633,8 +628,7 @@ const struct ~A ~A__classobj = {~%"
       ((*instance-class* :object chain-head :ichain :end)
        (format stream "  } },~%")))))
 
-(defmethod hook-output progn
-    ((islots islots) (reason (eql 'class)) sequencer)
+(defmethod hook-output ((islots islots) (reason (eql 'class)) sequencer)
   (with-slots ((class %class)) islots
     (let ((chain-head (sod-class-chain-head class)))
       (sequence-output (stream sequencer)
@@ -648,8 +642,8 @@ const struct ~A ~A__classobj = {~%"
        ((*instance-class* :object class :slots :end)
         (format stream "      },~%"))))))
 
-(defmethod hook-output progn
-    ((vtptr vtable-pointer) (reason (eql 'class)) sequencer)
+(defmethod hook-output ((vtptr vtable-pointer)
+                       (reason (eql 'class)) sequencer)
   (with-slots ((class %class) chain-head chain-tail) vtptr
     (sequence-output (stream sequencer)
       :constraint ((*instance-class* :object chain-head :ichain :start)
@@ -677,17 +671,18 @@ const struct ~A ~A__classobj = {~%"
              (sod-slot-name direct-slot)
              (sod-initializer-value init)))))
 
-(defmethod hook-output progn
-    ((slot sod-class-effective-slot) (reason (eql 'class)) sequencer)
+(defmethod hook-output ((slot sod-class-effective-slot)
+                       (reason (eql 'class)) sequencer)
   (let ((instance *instance-class*)
        (func (effective-slot-prepare-function slot)))
     (when func
       (sequence-output (stream sequencer)
        ((instance :object :prepare)
-        (funcall func instance stream))))))
+        (funcall func instance stream)))))
+  (call-next-method))
 
-(defmethod hook-output progn
-    ((slot effective-slot) (reason (eql 'class)) sequencer)
+(defmethod hook-output ((slot effective-slot)
+                       (reason (eql 'class)) sequencer)
   (with-slots ((class %class) (dslot slot)) slot
     (let ((instance *instance-class*)
          (super (sod-slot-class dslot)))

diff --git a/src/module-output.lisp b/src/module-output.lisp
index 7895176..90ecb75 100644 (file)
--- a/src/module-output.lisp
+++ b/src/module-output.lisp
@@ -102,13 +102,13 @@
 ;;;--------------------------------------------------------------------------
 ;;; Output implementation.
 
-(defmethod hook-output progn ((module module) reason sequencer)
+(defmethod hook-output :after ((module module) reason sequencer)
 
   ;; Ask the module's items to sequence themselves.
   (dolist (item (module-items module))
     (hook-output item reason sequencer)))
 
-(defmethod hook-output progn ((frag code-fragment-item) reason sequencer)
+(defmethod hook-output ((frag code-fragment-item) reason sequencer)
 
   ;; Output fragments when their reasons are called up.
   (when (eq reason (code-fragment-reason frag))
@@ -122,7 +122,7 @@
                                            :pretty nil
                                            :escape nil))))))
 
-(defmethod hook-output progn ((module module) (reason (eql :h)) sequencer)
+(defmethod hook-output ((module module) (reason (eql :h)) sequencer)
   (sequence-output (stream sequencer)
 
     :constraint
@@ -174,7 +174,7 @@
     ((:includes :end)
      (terpri stream))))
 
-(defmethod hook-output progn ((module module) (reason (eql :c)) sequencer)
+(defmethod hook-output ((module module) (reason (eql :c)) sequencer)
   (sequence-output (stream sequencer)
 
     :constraint

diff --git a/src/output-proto.lisp b/src/output-proto.lisp
index 6a26a7b..e31b201 100644 (file)
--- a/src/output-proto.lisp
+++ b/src/output-proto.lisp
@@ -111,8 +111,7 @@
    a reason to its sub-objects that is different from the REASON with which
    it was itself invoked.")
 
-  (:method-combination progn)
-  (:method progn (object reason sequencer)
+  (:method (object reason sequencer)
     (declare (ignore object reason sequencer))))
 
 ;;;--------------------------------------------------------------------------