From: Coby Beck
Subject: code generating problem
Date: 
Message-ID: <vNG37.233007$WB1.34678927@typhoon.tampabay.rr.com>
Hello,

I am writng functions to generate some method definitions and am having
strange (to me) troubles with the following first attempt:  (variable and
method names have been changed to protect the innocent)

ACL returns:

(DEFMETHOD DOIT-THINGY ((BLUEPRINT GRAMMAR) (STREAM STREAM))
  (HANDLER-CASE (LET (#:SUB-THING-0291 #:SUB-THING-1292 #:SUB-THING-2293
                      #:SUB-THING-3294)
                  (SETF #:SUB-THING-0291 (DOIT-TYPE2 BLUEPRINT STREAM))
                  (READ-CHAR STREAM)
                  (SETF #:SUB-THING-1292 (DOIT-TYPE4 BLUEPRINT STREAM))
                  (READ-CHAR STREAM)
                  (SETF #:SUB-THING-2293 (DOIT-TYPE3 BLUEPRINT STREAM))
                  (READ-CHAR STREAM)
                  (SETF #:SUB-THING-3294 (DOIT-TYPE1 BLUEPRINT STREAM))
                  (LIST #:SUB-THING-0291 #:SUB-THING-1292 #:SUB-THING-2293
                        #:SUB-THING-3294))
                (END-OF-FILE NIL NIL)))

which I believe to be what I want.  But LW returns:

(DEFMETHOD CONSUME-RECORD
           ((BLUEPRINT GRAMMAR) (STREAM STREAM))
           (HANDLER-CASE (LET #7=(#1=#1# #2=#2# #4=#4# #6=#6#)
                           (SETF #1# (CONSUME-FLOAT BLUEPRINT STREAM))
                           #3=(READ-CHAR STREAM)
                           (SETF #2# (CONSUME-DATE . #5=(BLUEPRINT STREAM)))
                           #3#
                           (SETF #4# (CONSUME-STRING . #5#))
                           #3#
                           (SETF #6# (CONSUME-INTEGER . #5#))
                           (LIST . #7#))
                         (END-OF-FILE NIL NIL)))

which I don't understand.

The code is:

(defmethod generate-thingy-doitr-code ((descriptor grammar))
  (let ((special-code (thingy-delimiter descriptor))
        (sub-thing-doitr-funcs (mapcar #'doitr (sub-thing-descriptors
descriptor)))
        (sub-thing-vars nil))

    (setf sub-thing-vars
          (loop for i below (length sub-thing-doitr-funcs)
                collect (gensym (concatenate 'string "SUB-THING-"
(write-to-string i)))))

    (let ((let-body '())
          (delim-doiting-form (if (characterp special-code)
                                    '(read-char stream)
                                  `(dotimes (i ,(length special-code))
                                     (read-char stream)))))

      ;; assemble the code for inside the let binding
      (push `(setf ,(car sub-thing-vars) (,(car sub-thing-doitr-funcs)
blueprint stream))
            let-body)
      (loop for var in (cdr sub-thing-vars)
            for func in (cdr sub-thing-doitr-funcs) do
            (push delim-doiting-form let-body)
            (push `(setf ,var (,func blueprint stream)) let-body))
      (push `(list ,@sub-thing-vars) let-body)

      ;; now return the method definition
      `(defmethod doit-thingy ((blueprint ,(type-of descriptor)) (stream
stream))
         (handler-case
             (let (,@sub-thing-vars)
               ,@(reverse let-body))
           (end-of-file ()
                        nil))))))


Thanks for any insights.

Coby


--
(remove #\space "coby . beck @ opentechgroup . com")

PS. and if any are so inclined the definition above and what is below is
enough to run a test:


(defclass grammar ()
  ((thingy-delimiter ;; type (or char string)
                     :initarg :thingy-delimiter
                     :initform #\newline
                     :accessor thingy-delimiter)
   (sub-thing-descriptors :type list
                      :initarg :sub-thing-descriptors
                      :initform nil
                      :accessor sub-thing-descriptors)))

(defclass sub-thing-descriptor ()
  ((logical-type :type symbol
                 :initarg :logical-type
                 :initform nil
                 :accessor logical-type)))

(defmethod doitr ((descriptor sub-thing-descriptor))
  (case (logical-type descriptor)
    ('type1 'doit-type1)
    ('type2 'doit-type2)
    ('type3 'doit-type3)
    ('type4 'doit-date)))


(setf descriptor (make-instance 'grammar
                             :sub-thing-descriptors
                             (list (make-instance 'sub-thing-descriptor
:logical-type 'type2)
                                   (make-instance 'sub-thing-descriptor
:logical-type 'type4)
                                   (make-instance 'sub-thing-descriptor
:logical-type 'type3)
                                   (make-instance 'sub-thing-descriptor
:logical-type 'type1))))

(generate-thingy-doitr-code descriptor)

From: Barry Margolin
Subject: Re: code generating problem
Date: 
Message-ID: <tKH37.116$Zv6.1673@burlma1-snr2>
In article <·························@typhoon.tampabay.rr.com>,
Coby Beck <·····@mercury.bc.ca> wrote:
>But LW returns:
>
>(DEFMETHOD CONSUME-RECORD
>           ((BLUEPRINT GRAMMAR) (STREAM STREAM))
>           (HANDLER-CASE (LET #7=(#1=#1# #2=#2# #4=#4# #6=#6#)
>                           (SETF #1# (CONSUME-FLOAT BLUEPRINT STREAM))
>                           #3=(READ-CHAR STREAM)
>                           (SETF #2# (CONSUME-DATE . #5=(BLUEPRINT STREAM)))
>                           #3#
>                           (SETF #4# (CONSUME-STRING . #5#))
>                           #3#
>                           (SETF #6# (CONSUME-INTEGER . #5#))
>                           (LIST . #7#))
>                         (END-OF-FILE NIL NIL)))
>
>which I don't understand.

Set *PRINT-CIRCLE* to NIL and look again.

-- 
Barry Margolin, ······@genuity.net
Genuity, Burlington, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.
From: Kent M Pitman
Subject: Re: code generating problem
Date: 
Message-ID: <sfwr8vkobuo.fsf@world.std.com>
Barry Margolin <······@genuity.net> writes:

> In article <·························@typhoon.tampabay.rr.com>,
> Coby Beck <·····@mercury.bc.ca> wrote:
> >But LW returns: [...]
> >
> >which I don't understand.
> 
> Set *PRINT-CIRCLE* to NIL and look again.

I several print-circle bugs in LW 4.1.20 in the past few months, so
that may be vexing Coby, too.  If it turns out to be that, and if you
have a commercial copy, you might check with Xanalys web site to see
if they've posted a fix, or talk to their support people...  
From: Coby Beck
Subject: Re: code generating problem
Date: 
Message-ID: <0gI37.233030$WB1.34735086@typhoon.tampabay.rr.com>
"Barry Margolin" <······@genuity.net> wrote in message
·······················@burlma1-snr2...
> In article <·························@typhoon.tampabay.rr.com>,
> Coby Beck <·····@mercury.bc.ca> wrote:
> >But LW returns:
> >
> >(DEFMETHOD CONSUME-RECORD
> >           ((BLUEPRINT GRAMMAR) (STREAM STREAM))
> >           (HANDLER-CASE (LET #7=(#1=#1# #2=#2# #4=#4# #6=#6#)
> >                           (SETF #1# (CONSUME-FLOAT BLUEPRINT STREAM))
> >                           #3=(READ-CHAR STREAM)
> >                           (SETF #2# (CONSUME-DATE . #5=(BLUEPRINT
STREAM)))
> >                           #3#
> >                           (SETF #4# (CONSUME-STRING . #5#))
> >                           #3#
> >                           (SETF #6# (CONSUME-INTEGER . #5#))
> >                           (LIST . #7#))
> >                         (END-OF-FILE NIL NIL)))
> >
> >which I don't understand.
>
> Set *PRINT-CIRCLE* to NIL and look again.
>

Thank you, I can now see it is the same thing.  The HyperSpec says the
"initial" value should be nil anyway.  Is this non-conformance that it was
not?  I never knowingly set it, are there certain printer or reader
operations that have the side effect of changing this?

There are a number of these printer variables that I have never
investigated, maybe there are some one needs to take control of..?  (Of
course in this case the only significant difference was some minor pain in
the eyeballs.)

Coby
From: Simon Katz
Subject: Re: code generating problem
Date: 
Message-ID: <Zue47.2$io5.245@news.dircon.co.uk>
"Coby Beck" <·····@mercury.bc.ca> wrote in message
······························@typhoon.tampabay.rr.com...
> "Barry Margolin" <······@genuity.net> wrote in message
> ·······················@burlma1-snr2...

[snip]

> > Set *PRINT-CIRCLE* to NIL and look again.
> >
>
> Thank you, I can now see it is the same thing.  The HyperSpec says
> the
> "initial" value should be nil anyway.  Is this non-conformance that
> it was
> not?  I never knowingly set it, are there certain printer or reader
> operations that have the side effect of changing this?

I'm running LW for Windows 4.1.20, and *PRINT-CIRCLE* has the correct
initial value, NIL.
From: Thomas A. Russ
Subject: Re: code generating problem
Date: 
Message-ID: <ymilmlovl8p.fsf@sevak.isi.edu>
The difference that you are seeing depends on whether you have
*PRINT-CIRCLE* set or not.  Apparently ACL defaults the value to NIL and
LispWorks to T.  In the Lispworks output you are seeing syntax used by
Lisp to allow the proper reading of circular and shared structure.  For
details, you need to look up the documentation associated with
*print-circle* and the way printing of circular structures are handled.

Note that just because the circular structure printing is used, doesn't
mean that you necessarily have circular structures.



-- 
Thomas A. Russ,  USC/Information Sciences Institute          ···@isi.edu    
From: Coby Beck
Subject: Re: code generating problem
Date: 
Message-ID: <%YY47.8812$uo3.975446@typhoon.tampabay.rr.com>
"Thomas A. Russ" <···@sevak.isi.edu> wrote in message
····················@sevak.isi.edu...
>
> The difference that you are seeing depends on whether you have
> *PRINT-CIRCLE* set or not.  Apparently ACL defaults the value to NIL and
> LispWorks to T.  In the Lispworks output you are seeing syntax used by
> Lisp to allow the proper reading of circular and shared structure.  For
> details, you need to look up the documentation associated with
> *print-circle* and the way printing of circular structures are handled.
>
> Note that just because the circular structure printing is used, doesn't
> mean that you necessarily have circular structures.
>

Yes, I did realize at some point that it was in fact the same structure
though it looked very different.

FWIW, Lispworks does default *print-circle* to nil, I guess something
happened in my session that left things altered.

cb