[Openmcl-devel] ASDF Error

[Ron Garret]

It’s not as bad as you think.  Assuming Gail’s diagnosis is correct (and I have no reason to doubt it), this should fix the problem.  Cleaning up this bit of horribleness:

                 (progn
                      (unless *format-arguments*
                      ...  
                      (when *format-arguments*
                      …)

is left as an exercise.

—

(defun format-logical-block (stream colon atsign end-atsign start end &rest parms)
  (declare (ignore parms))
  (flet ((format-check-simple (str)
           (when (and str (or (%str-member #\~ str) (%str-member #\newline str)))
             (format-error "Suffix and prefix must be simple")))
         (first-block-p (start)
           (let* ((*format-index* 0))
             (loop
               (parse-format-operation)
               (when (eq (format-peek) #\<)
                 (cond ((eq *format-index* start)
                        (return t))
                       (t (return nil))))))))
    (format-no-semi #\<)
    (let ((format-string *format-control-string*)
          (prefix (if colon "(" ""))
          (suffix (if colon ")" ""))
          body-string start1 tilde ignore colon1 atsign1 per-line-p)
      (declare (ignore-if-unused ignore colon1))
      (setq *format-index* start)
      (multiple-value-setq (start1 tilde ignore colon1 atsign1)
        (format-find-command  '(#\; #\>)))
      (setq body-string (%substr format-string (1+ start) tilde))
      (when (not (eql *format-index* end)) ; > 1 segment
        (setq prefix body-string)
        (if atsign1 (setq per-line-p t))
        (multiple-value-setq (start1 tilde)
          (format-find-command '(#\; #\>)))
        (setq body-string (%substr format-string (1+ start1) tilde))
        (when (neq *format-index* end)
          (multiple-value-setq (start1 tilde)(format-find-command  '(#\; #\>)))
          (setq suffix (%substr format-string (1+ start1) tilde))
          (when (neq *format-index* end)
            (format-error "Too many chunks"))))
      (when end-atsign (setq body-string (format-fill-transform body-string)))
      (format-check-simple prefix)
      (format-check-simple suffix)
      
      (let ((args (if (not atsign)
                    ; This piece of garbage is needed to avoid double length counting from (formatter ...) things
                    ; but also to allow (flet . t) not to barf.
                    ; Was formerly simply  (if *format-arguments* (pop-format-arg))
                    ; Actually wanna not count the arg iff the ~< is at the top level
                    ; in a format string i.e. "is this the first ~< in THIS string?"
                    (progn
                      (unless *format-arguments*
                        (setq *format-index* start)
                        (format-error "Missing argument"))      
                      (when *format-arguments*
                        (if  (and (listp *format-arguments*)
                                  (first-block-p start))
                          (pop *format-arguments*)  ; dont count
                          (pop-format-arg)))) ; unless not listp or not first
                    (prog1 *format-arguments*
                      (setq *format-arguments* nil))))
            (*format-control-string* body-string)
            (*format-top-level* (and atsign *format-top-level*)))
        (let ((*logical-block-p* t)
              (xp-struct (cond ((xp-structure-p stream) stream)
                               ((typep stream 'xp-stream)
                                (slot-value stream 'xp-structure)))))
          ; lets avoid unnecessary closures
          (cond (xp-struct (logical-block-sub xp-struct args  prefix suffix per-line-p atsign))
                (t (maybe-initiate-xp-printing
                    #'(lambda (s o)
                        (logical-block-sub s o  prefix suffix per-line-p atsign))
                    stream args))))))))

On Mar 3, 2018, at 9:56 AM, R. Matthew Emerson <rme at acm.org> wrote:

> You want to take this bug, Shannon?  Or is format.lisp too horrible to contemplate?
> 
> 
>> On Mar 3, 2018, at 6:28 PM, Gail Zacharias <gz at clozure.com> wrote:
>> 
>> CCL is wrong.  In format-logical-block, the check for non-empty *format-arguments* should only happen in the (not asign) case.
>> 
>> On Sat, Mar 3, 2018 at 12:02 PM, Shannon Spires <svs at bearlanding.com> wrote:
>> The following form appears in ccl/tools/asdf.lisp:
>> 
>> (format s (compatfmt "~@<Retry ASDF operation.~@:>”))
>> 
>> In CCL, compatfmt is a no-op so for purposes of testing this reduces to
>> 
>> (format t "~@<Retry ASDF operation.~@:>")
>> 
>> which throws a “Missing Argument” error in CCL. This line of code is especially egregious because if ASDF encounters an error when it’s loading files and the user tries to restart in the CCL IDE, the “Missing Argument” error throws to the AltConsole and recovery is basically impossible, because the error happens in the drawing of the restarts GUI window.
>> 
>> Since I have no idea how the Common Lisp pretty-printer is supposed to work (and I’ve tried to read the documentation several times), I can’t tell if this is an error in ASDF or an error in CCL’s #'format implementation. I have been working around this by modifying compatfmt to get rid of the pretty-printer gobbledygook on CCL (that’s what compatfmt is for, after all), but if this is really a bug in CCL’s implementation we should probably fix it there.
> 
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> https://lists.clozure.com/mailman/listinfo/openmcl-devel