src/module-parse.lisp: Reinstate `peek' around the main item parser.

[sod] / src / class-output.lisp

diff --git a/src/class-output.lisp b/src/class-output.lisp
index d6ead498d1f4610e7f71a12b5ec06abaf5dc1617..2ab636392fd50fe66384c80d4c48e21c147534fc 100644 (file)
--- a/src/class-output.lisp
+++ b/src/class-output.lisp
@@ -125,16 +125,14 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
         (dolist (entry (vtmsgs-entries vtmsgs))
           (let* ((type (method-entry-function-type entry))
                  (args (c-function-arguments type))
         (dolist (entry (vtmsgs-entries vtmsgs))
           (let* ((type (method-entry-function-type entry))
                  (args (c-function-arguments type))

-                 (method (method-entry-effective-method entry))
-                 (message (effective-method-message method))

                  (in-names nil) (out-names nil) (varargsp nil) (me "me"))
             (do ((args args (cdr args)))
                 ((endp args))
                  (in-names nil) (out-names nil) (varargsp nil) (me "me"))
             (do ((args args (cdr args)))
                 ((endp args))

-              (let* ((raw-name (argument-name (car args)))
+              (let* ((raw-name (princ-to-string (argument-name (car args))))

                      (name (if (find raw-name
                                      (list "_vt"
                                            (sod-class-nickname class)
                      (name (if (find raw-name
                                      (list "_vt"
                                            (sod-class-nickname class)

-                                           (sod-message-name message))
+                                           (method-entry-slot-name entry))

                                      :test #'string=)
                                (format nil "sod__a_~A" raw-name)
                                raw-name)))
                                      :test #'string=)
                                (format nil "sod__a_~A" raw-name)
                                raw-name)))


@@ -151,11 +149,11 @@ (defmethod hook-output progn ((class sod-class) (reason (eql :h)) sequencer)
               (format stream "#if __STDC_VERSION__ >= 199901~%"))
             (format stream "#define ~A(~{~A~^, ~}) ~
                                   ~A->_vt->~A.~A(~{~A~^, ~})~%"
               (format stream "#if __STDC_VERSION__ >= 199901~%"))
             (format stream "#define ~A(~{~A~^, ~}) ~
                                   ~A->_vt->~A.~A(~{~A~^, ~})~%"

-                    (message-macro-name class message)
+                    (message-macro-name class entry)

                     (nreverse in-names)
                     me
                     (sod-class-nickname class)
                     (nreverse in-names)
                     me
                     (sod-class-nickname class)

-                    (sod-message-name message)
+                    (method-entry-slot-name entry)

                     (nreverse out-names))
             (when varargsp
               (format stream "#endif~%"))))
                     (nreverse out-names))
             (when varargsp
               (format stream "#endif~%"))))


@@ -348,7 +346,7 @@ (defmethod hook-output progn ((entry method-entry)
     (sequence-output (stream sequencer)
       ((class :vtmsgs (sod-message-class message) :slots)
        (pprint-logical-block (stream nil :prefix "  " :suffix ";")
     (sequence-output (stream sequencer)
       ((class :vtmsgs (sod-message-class message) :slots)
        (pprint-logical-block (stream nil :prefix "  " :suffix ";")

-        (pprint-c-type pointer-type stream (sod-message-name message)))
+        (pprint-c-type pointer-type stream (method-entry-slot-name entry)))

        (terpri stream)))))
 
 (defmethod hook-output progn ((cptr class-pointer)
        (terpri stream)))))
 
 (defmethod hook-output progn ((cptr class-pointer)


@@ -541,15 +539,15 @@ (defmethod hook-output progn ((vtmsgs vtmsgs) (reason (eql :c)) sequencer)
 (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
+  (with-slots (method chain-head chain-tail role) entry

     (let* ((message (effective-method-message method))
           (class (effective-method-class method))
           (super (sod-message-class message)))
       (sequence-output (stream sequencer)
        ((class :vtable chain-head :vtmsgs super :slots)
         (format stream "    /* ~19@A = */ ~A,~%"
     (let* ((message (effective-method-message method))
           (class (effective-method-class method))
           (super (sod-message-class message)))
       (sequence-output (stream sequencer)
        ((class :vtable chain-head :vtmsgs super :slots)
         (format stream "    /* ~19@A = */ ~A,~%"

-                (sod-message-name message)
-                (method-entry-function-name method chain-head)))))))
+                (method-entry-slot-name entry)
+                (method-entry-function-name method chain-head role)))))))

 
 ;;;--------------------------------------------------------------------------
 ;;; Filling in the class object.
 
 ;;;--------------------------------------------------------------------------
 ;;; Filling in the class object.