Steel Bank Common Lisp

Teemu Likonen wrote:

>     (with-open-stream (s (run-program-stream "ls" "-la"))
>       (loop for line = (read-line s nil)
>          while line
>          do (format t "~A~%" line)))
>
>
> Running the script with "./program | head" prints the first lines of the
> output but also gives me the following error:
>
>
> --8<---------------cut here---------------start------------->8---
> unhandled SB-INT:SIMPLE-STREAM-ERROR in thread #<SB-THREAD:THREAD
>                                                  "initial thread" RUNNING
>                                                  {A9F0A19}>:
>   Couldn't write to #<SB-SYS:FD-STREAM for "standard output" {A9F10F9}>:
>     Broken pipe

You need to install a custom SIGPIPE handler.

  Leslie

* 2010-04-25 11:14 (+0200), Leslie P. Polzer wrote:

> Teemu Likonen wrote:
>> unhandled SB-INT:SIMPLE-STREAM-ERROR in thread [...]

> You need to install a custom SIGPIPE handler.

How do I do that? Sorry but I have no idea what is a "custom SIGPIPE
handler". First I tried

    (handler-case [...]
      (sb-int:simple-stream-error () nil)))

but it doesn't catch the error, not even with "t" as the typespec in the
error clause.

Teemu Likonen wrote:
> * 2010-04-25 11:14 (+0200), Leslie P. Polzer wrote:
>
>> Teemu Likonen wrote:
>>> unhandled SB-INT:SIMPLE-STREAM-ERROR in thread [...]
>
>> You need to install a custom SIGPIPE handler.

Actually you don't. I've checked the code and SBCL disregards
SIGPIPE signals sent by the kernel.

Some other solution is needed.

  Leslie

Leslie P. Polzer wrote:

> Some other solution is needed.

The problem is that the error occurs when the stream is being
flushed (by the toplevel code).

Several solutions come to mind, for example:

  * extending the default toplevel (or overwriting the function
    definition for sb-impl::flush-standard-output-streams) to
    let the user define the error behavior.

  * building and installing your own toplevel.

If you need a quick fix, use the first suggestion (copy the code
from src/code/toplevel.lisp). I haven't tried it yet though and
it's late here.

Hope that helps.

 Leslie

Here's a quick working sketch:

---

(without-package-locks
  (defun sb-impl::flush-standard-output-streams ()
    (ignore-errors
      (dolist (name '(*debug-io*
                      *error-output*
                      *query-io*
                      *standard-output*
                      *trace-output*
                      *terminal-io*))
        ;; FINISH-OUTPUT may block more easily than FORCE-OUTPUT
        (force-output (symbol-value name)))
      (values))))


(format t "one~%two~%three~%")

---

  Leslie

On Wed, Apr 28, 2010 at 07:28:24PM +0300, Teemu Likonen wrote:
> * 2010-04-26 09:11 (+0200), Leslie P. Polzer wrote:
> 
> > Here's a quick working sketch:
> 
> > (without-package-locks
> >   (defun sb-impl::flush-standard-output-streams ()
> >     (ignore-errors
> >       (dolist (name '(*debug-io*
> >                       *error-output*
> >                       *query-io*
> >                       *standard-output*
> >                       *trace-output*
> >                       *terminal-io*))
> >         ;; FINISH-OUTPUT may block more easily than FORCE-OUTPUT
> >         (force-output (symbol-value name)))
> >       (values))))
> >
> >
> > (format t "one~%two~%three~%")
> 
> Redefining an internal function seems ugly. I do appreciate your help
> and efforts, though. So really, thank you.

It's just a kludge to fix this until we have a sane solution in upstream.
I happen to need this functionality too for one of my projects so I might
write a proper patch soon. Of course this will take some time, and more
still until the patch is committed.

 
> Unfortunately I don't understand the problem fully myself and most
> likely that's the reason I couldn't get your "quick working sketch"
> working. With the above code (at script's top level) and my original
> test script I still get the same "broken pipe" error when the output is
> piped to "head -n1".

There's a bunch of output preceding the actual program's output,
like the version/license banner.

When the pipe breaks before we have a chance to redefine
sb-impl::flush-standard-output-streams then our code won't change
anything.

Try the --script switch (cuts down banner size to one line)
and -n2 with head. Furthermore add another IGNORE-ERRORS around
the FORMAT form since the output might go straight to stdout
instead of being buffered.

I can post a full transcript next time if you can't get the same
results.

  Leslie

* 2010-04-26 09:11 (+0200), Leslie P. Polzer wrote:

> Here's a quick working sketch:

> (without-package-locks
>   (defun sb-impl::flush-standard-output-streams ()
>     (ignore-errors
>       (dolist (name '(*debug-io*
>                       *error-output*
>                       *query-io*
>                       *standard-output*
>                       *trace-output*
>                       *terminal-io*))
>         ;; FINISH-OUTPUT may block more easily than FORCE-OUTPUT
>         (force-output (symbol-value name)))
>       (values))))
>
>
> (format t "one~%two~%three~%")

Redefining an internal function seems ugly. I do appreciate your help
and efforts, though. So really, thank you.

Unfortunately I don't understand the problem fully myself and most
likely that's the reason I couldn't get your "quick working sketch"
working. With the above code (at script's top level) and my original
test script I still get the same "broken pipe" error when the output is
piped to "head -n1".

* 2010-04-28 18:36 (+0200), Leslie P. Polzer wrote:

> It's just a kludge to fix this until we have a sane solution in
> upstream. I happen to need this functionality too for one of my
> projects so I might write a proper patch soon. Of course this will
> take some time, and more still until the patch is committed.

A nice upstream solution would indeed make SBCL a better language for
writing shell tools.

> Try the --script switch (cuts down banner size to one line) and -n2
> with head. Furthermore add another IGNORE-ERRORS around the FORMAT
> form since the output might go straight to stdout instead of being
> buffered.

Ah, IGNORE-ERRORS did it. I also wrapped the redefining of
SB-IMPL::FLUSH-STANDARD-OUTPUT-STREAMS inside

    (with-output-to-string (*error-output*) ...)

to silence that too in a script.

The actual tool I was writing is called git-rank-commit which simply
runs "git shortlog -ns" (plus possible additional command-line
arguments) and pretty-prints its output. Thanks to you, it now works
quite nicely with pipes so I'll post the code (see below) as a kind of
conclusion of working example.


$ git rank-commit --no-merges | head -n12
| Rank | Commits | Name
+------+---------+------------------------
|    1 |    1215 | Christophe Rhodes
|    2 |    1104 | Nikodemus Siivola
|    3 |     769 | William Harold Newman
|    4 |     403 | Juho Snellman
|    5 |     321 | Alexey Dejneka
|    6 |     212 | Gabor Melis
|    7 |     202 | Nathan Froyd
|    8 |     170 | Thiemo Seufer
|    9 |     149 | Daniel Barlow
|   10 |      77 | Richard M Kreuter


--8<---------------cut here---------------start------------->8---
#!/usr/bin/sbcl --script

;; or #!/usr/bin/clisp

(defun get-args (&optional pos)
  (let ((args
         #+sbcl sb-ext:*posix-argv*
         #+clisp (cons "clisp" ext:*args*)))
    (if pos (nth pos args) (rest args))))


#+sbcl
(with-output-to-string (*error-output*)
  (without-package-locks
    (defun sb-impl::flush-standard-output-streams ()
      (ignore-errors
        (dolist (name '(*debug-io*
                        *error-output*
                        *query-io*
                        *standard-output*
                        *trace-output*
                        *terminal-io*))
          ;; FINISH-OUTPUT may block more easily than FORCE-OUTPUT
          (force-output (symbol-value name)))
        (values)))))


(defun run-program-stream (program &rest arguments)
  #+sbcl (sb-ext:process-output
          (sb-ext:run-program program arguments :output :stream :search t
                              :input t))
  #+clisp (ext:run-program program :arguments arguments :output :stream))


(defun main ()
  (with-open-stream (s (apply #'run-program-stream
                              "git" "shortlog" "-ns" (get-args)))
    (loop
       with rank = 0
       with total = 0
       with commits-previous = 0
       for line = (read-line s nil)
       while line
       initially (format t "| Rank | Commits | Name~%~
                            +------+---------+------------------------~%")
       finally (format t "+------+---------+------------------------~%~
                          Total: ~9D~%" total)
       do (multiple-value-bind (commits n)
              (read-from-string line nil 0)
            (incf total commits)
            (ignore-errors
              (format t "| ~4@... | ~7D | ~A~%"
                      (if (= commits commits-previous)
                          ""
                          (incf rank))
                      commits (subseq line n)))
            (setf commits-previous commits)))))

(handler-case (main)
  (t (c)
    (format *error-output* "~A~%" c)))
--8<---------------cut here---------------end--------------->8---

In article <878w871otr.fsf@...>,
 Teemu Likonen <tlikonen@...> wrote:

> * 2010-04-28 18:36 (+0200), Leslie P. Polzer wrote:
> 
> > It's just a kludge to fix this until we have a sane solution in
> > upstream. I happen to need this functionality too for one of my
> > projects so I might write a proper patch soon. Of course this will
> > take some time, and more still until the patch is committed.
> 
> A nice upstream solution would indeed make SBCL a better language for
> writing shell tools.
> 
> > Try the --script switch (cuts down banner size to one line) and -n2
> > with head. Furthermore add another IGNORE-ERRORS around the FORMAT
> > form since the output might go straight to stdout instead of being
> > buffered.
> 
> Ah, IGNORE-ERRORS did it. I also wrapped the redefining of
> SB-IMPL::FLUSH-STANDARD-OUTPUT-STREAMS inside
> 
>     (with-output-to-string (*error-output*) ...)
> 
> to silence that too in a script.

What happens if you SB-EXT:QUIT when you hit EOF on *standard-input* 
instead?

Paul Khuong