LINUX.ORG.RU

Про рестарты и интерактивность в CL

 


1

4

Я тут посмотрел на свои старые проги и ужаснулся, какой я быдлокодер!

Вот у меня такая неприятная ситуация с flac-декодером, как обработка ошибок. Вначале flac файла есть несколько секций с метаданными (из которых обязательна, ЕМНИП, только одна - streaminfo). Я хочу сделать так, чтобы при возникновении ошибки в чтении метаданных пользователь мог бы пропустить битые данные и читать следующие. Пока сделано так:

Определены contitions:

(define-condition flac-error ()
  ((message :initarg :message
	    :initform ""
	    :type string
	    :reader flac-error-message)))

(define-condition flac-bad-metadata (flac-error)
  ((metadata     :reader flac-metadata
		 :initarg :metadata))
  (:report (lambda (c s)
	     (format s "Bad metadata: ~A"
		     (flac-error-message c)))))

В любом месте, где возникает ошибка, сигнализируем flac-bad-metadata (как, например тут):

(defmethod metadata-body-reader (stream (data padding))
  ;; Read zero padding bytes
  (let ((chunk (make-array (list (metadata-length data))
			   :element-type 'ub8)))
    (read-octet-vector chunk stream)
    ;; Do sanity checks
    (if (find-if-not #'zerop  chunk)
        (error 'flac-bad-metadata
               :message "Padding bytes is not zero"
               :metadata data))))

Где собираем полученные метаданные в список, делаем так:

       (setq last-block
             (restart-case
              (let ((metadata (metadata-reader bitreader)))
                (push metadata metadata-list)
                (metadata-last-block-p metadata))
              (skip-malformed-metadata (c)
                                       (let ((metadata (flac-metadata c)))
                                         (fix-stream-position bitreader metadata)
                                         (metadata-last-block-p metadata))))

Суть в том, что чтобы из места выше по стеку, где стоит restart-case пропустить плохие метаданные, нужно с места ошибки передать эти самые метаданные (там внутри инфа о том, как восстановиться). Я передаю их в слоте condition.

Но тут возникает такая проблема. Где-то, где программист должен принимать решение, что делать с возникшими ошибками, он может написать:

(handler-bind ((flac:flac-bad-metadata
                #'(lambda (c) 
                    (invoke-restart 'flac:skip-malformed-metadata c))))
              (multiple-value-setq (*a* *b*) (flac:open-flac *stream*)))

и получить список нормальных метаданных. А как ему это сделать интерактивно (через REPL/отладчик)? Суть такая, что в рестарт надо передать объект непосредственно с места ошибки, а restart-case задвинуть ниже по стеку не выйдет, иначе перемешается код читающий метаданные и код, предоставляющий стратегию восстановления.


В SBCL есть *debug-condition*, можно его передавать, явно или через параметр :interactive у restart-case. Если позарез нужно универсальное решение, можно состряпать свой вариант через *debugger-hook*, см. документацию на invoke-debugger.

anonymous
()
Ответ на: комментарий от anonymous

Пишу (restart-case (error «lol») (omg (c) :interactive (lambda () (list sb-debug::*debug-condition*)) c))

и в голом sbcl работает, а в slime - фигушки. Пишет, что переменная не связана. Может там уже какой-нибудь хук до связывания *debug-condition*

shamaz
() автор топика
Ответ на: комментарий от shamaz

А зачем текущее положение внутри ошибки передавать? Почему не в глобальной переменной? (Например, *current-metadata*)

monk ★★★★★
()
Ответ на: комментарий от monk

Я же пишу, что это текущее положение будет определено ниже по стеку, чем сидит рестарт, иначе это смешение кода.

В общем, сделал как-то так (черезжопно). Чтение метаданных: https://github.com/shamazmazum/easy-audio/blob/master/flac/metadata.lisp Обработка: https://github.com/shamazmazum/easy-audio/blob/master/flac/flac.lisp

Использую такое вот макро:

(defmacro with-interactive-debug (&body body)
  (let ((debugger-hook (gensym)))
    `(let ((,debugger-hook *debugger-hook*))
       (flet ((,debugger-hook (condition me)
                (declare (ignore me))
                (let ((*debugger-hook* ,debugger-hook)
                      (*current-condition* condition))
                  (invoke-debugger condition))))

         (let ((*debugger-hook* #',debugger-hook))
           ,@body)))))

Ничего лучше пока не придумал, хотя опыта в этих рестартах у меня немного

shamaz
() автор топика
Ответ на: комментарий от shamaz

текущее положение будет определено ниже по стеку, чем сидит рестарт

Так ведь рестарт не раскручивает стек. То есть

(define-condition flac-bad-metadata (flac-error)
  ()
  (:report (lambda (c s)
	     (format s "Bad metadata: ~A"
		     (flac-error-message *current-data*)))))

(defmethod metadata-body-reader (stream (data padding))
  ;; Read zero padding bytes
  (let ((chunk (make-array (list (metadata-length data))
			   :element-type 'ub8)))
    (read-octet-vector chunk stream)
    ;; Do sanity checks
    (if (find-if-not #'zerop  chunk)
        (let ((*current-data* data))
          (error 'flac-bad-metadata
                 :message "Padding bytes is not zero")))))

....

(setq last-block
             (restart-case
              (let ((metadata (metadata-reader bitreader)))
                (push metadata metadata-list)
                (metadata-last-block-p metadata))
              (skip-malformed-metadata ()
                                       (let ((metadata (flac-metadata *current-data*)))
                                         (fix-stream-position bitreader metadata)
                                         (metadata-last-block-p metadata))))

должно нормально работать.

monk ★★★★★
()
Ответ на: комментарий от monk

должно нормально работать.

Неа.

Так ведь рестарт не раскручивает стек.

restart-case evaluates restartable-form in a dynamic environment where the clauses have special meanings as points to which control may be transferred. If restartable-form finishes executing and returns any values, all values returned are returned by restart-case and processing has completed. While restartable-form is executing, any code may transfer control to one of the clauses (see invoke-restart). If a transfer occurs, the forms in the body of that clause is evaluated and any values returned by the last such form are returned by restart-case. In this case, the dynamic state is unwound appropriately (so that the restarts established around the restartable-form are no longer active) prior to execution of the clause.

А handler-bind может стоять ещё выше по стеку и до него раскрутка не произойдет. В отличие от try/catch в том же цепепе. К тому же handler-bind связывает с condition некую функцию, которая вызывается, не раскручивая стек, а она в конце-концов вызывает invoke-restart, который производит non-local transfer of control

Смотри сам:

(defvar *a*)
(defun foo (a) (let ((*a* a)) (if (zerop *a*) (error "Error") (1+ *a*))))
(defun bar () (foo 0))
(restart-case (bar) (error () *a*))

The variable *A* is unbound. [Condition of type UNBOUND-VARIABLE]

shamaz
() автор топика
Ответ на: комментарий от monk

Т.е. в CL я могу написать так:

(defun играй-музон (музон)
  (handler-bind
      ((flac:flac-frame-error #'(lambda (c)
                                  (format t "Cannot read frame~%")
                                  (invoke-restart 'flac:skip-malformed-frame))))
    (with-all-frames (frame музон)
      (играй-фрейм frame))))

и, что характерно, будет играть. А с try/catch мы можем или так:

void play_music (music)
{
  try
 {
    frame = read_frame (music);
    play (frame);
 }
 except (FlacFrameError e) {print ("Не судьба");}
}

Или вставлять try/catch ниже по стеку, не давая программисту выбрать стратегию решения проблемы. Вот это и значит, что стек не разворачивается

shamaz
() автор топика
Ответ на: комментарий от shamaz

А если так:

(handler-bind ((flac:flac-bad-metadata
                #'(lambda (c)
                    (cerror "Continue parsing" "Bad metadata")
                    (invoke-restart 'flac:skip-malformed-metadata c))))
              (multiple-value-setq (*a* *b*) (flac:open-flac *stream*)))

?

monk ★★★★★
()
Ответ на: комментарий от monk

Если нужны разные рестарты, а не просто «продолжить», то будет что-то вроде

(handler-bind ((flac:flac-bad-metadata
                #'(lambda (c)
                    (restart-case 
                       (signal c)
                       (interactive-skip-malformed-metadata ()
                           (invoke-restart 'flac:skip-malformed-metadata c))))))
              (multiple-value-setq (*a* *b*) (flac:open-flac *stream*)))
monk ★★★★★
()
Ответ на: комментарий от monk

А ещё лучше сам restart-case поменять

(setq last-block
         (handler-bind ((flac:flac-bad-metadata
           #'(lambda (c)  
             (restart-case
              (let ((metadata (metadata-reader bitreader)))
                (push metadata metadata-list)
                (metadata-last-block-p metadata))
              (skip-malformed-metadata (c) :interactive (lambda () c)
                                       (let ((metadata (flac-metadata c)))
                                         (fix-stream-position bitreader metadata)
                                         (metadata-last-block-p metadata))))))

monk ★★★★★
()
Ответ на: комментарий от monk

Не-не. Ты что-то путаешь. Какой смысл вообще писать handler-bind и restart-case в одном месте? Это типичный c++ way - предоставлять стратегию исполнения и тут же запускать её. Тогда уж handler-case - это полнейший аналог try/catch в цепепе.

Я handler-bind написал для примера того как раз, что выбор стратегии решения проблемы может быть в другом месте в коде, нежели чем само решение. И как раз не обязательно разворачивать стек до того места, где ты это решение принимаешь (в отличие от цепепе).

Я как раз по этому месту писал уже на ЛОР и вроде мне сказали, что сама идея правильная. Единственное, меня смущает вот этот boilerplate: (metadata-last-block-p metadata)

Ну а то, что для передачи condition в рестарт при входе в отладчик приходиться малость поплясать, приходится терпеть. Собственно, я же показывал, вроде, как это выглядит:

https://github.com/shamazmazum/easy-audio/blob/master/flac/flac.lisp

shamaz
() автор топика
Ответ на: комментарий от shamaz

Какой смысл вообще писать handler-bind и restart-case в одном месте? Это типичный c++ way - предоставлять стратегию исполнения и тут же запускать её.

Я имел в виду делать второй рестарт для интерактивного запуска с с переданным через параметр handler-bind сигналом... Хотя извращаться приходится гораздо сильнее, чем с *debugger-hook*.

Получается что-то вроде

(defmacro with-condition-restart-case (c main &body clauses)
  `(handler-case ,main 
     (t (,c)
       (restart-case
           (error ,c)
         ,@clauses))))

....

(setq last-block
                 (with-condition-restart-case c
                     (let ((metadata (metadata-reader bitreader)))
                       (push metadata metadata-list)
                       (metadata-last-block-p metadata))
                   
                   (skip-malformed-metadata (c)
                     :interactive (lambda () (list c))
                     :report "Skip malformed metadata"
                     (let ((metadata (flac-metadata c)))
                       (fix-stream-position bitreader metadata)
                       (metadata-last-block-p metadata)))
                   
                   (read-raw-block (c)
                     :interactive (lambda () (list c))
                     :report "Interprete as unknown metadata block"
                     (let ((metadata (flac-metadata c)))
                       (read-block-and-fix bitreader metadata)
                       (push metadata metadata-list)
                       (metadata-last-block-p metadata)))))))

monk ★★★★★
()
Ответ на: комментарий от shamaz

меня смущает вот этот boilerplate: (metadata-last-block-p metadata)

Против boilerplate есть макросы.

(defmacro with-metadata (init &body body)
  (let ((metadata ,init))
    ,@body
    (metadata-last-block-p metadata)))

(setq last-block
                 (with-condition-restart-case c
                     (with-metadata (metadata-reader bitreader)
                       (push metadata metadata-list))
                   
                   (skip-malformed-metadata (c)
                     :interactive (lambda () (list c))
                     :report "Skip malformed metadata"
                     (with-metadata (flac-metadata c)
                       (fix-stream-position bitreader metadata)))
                   
                   (read-raw-block (c)
                     :interactive (lambda () (list c))
                     :report "Interprete as unknown metadata block"
                     (with-metadata (flac-metadata c)
                       (read-block-and-fix bitreader metadata)
                       (push metadata metadata-list)))))))
monk ★★★★★
()
Ответ на: комментарий от monk

Получается что-то вроде

Нет, это не пройдет. Выглядит настолько отвратно, что, пожалуй, я воздержусь от такого. Или знаешь пример использования этого в реальных программах? :)

shamaz
() автор топика
Ответ на: комментарий от shamaz

не место ли тут где для unwind-protect

Тебе же результат (metadata-last-block-p metadata) надо. Или ты про структуру

(unwind-protect
  (restart-case ...)
  (setq last-block (metadata-last-block-p metadata)))
Так metadata у тебя везде локальная.

monk ★★★★★
()
Ответ на: комментарий от shamaz

Или знаешь пример использования этого в реальных программах? :)

В реальных программах я и твой вариант с *debugger-hook* + interactive не видел.

monk ★★★★★
()
Ответ на: комментарий от shamaz

чувствую, что ITT собрались спецы по рестартам просто космического масштаба

Так ты же на ЛОР. За спецами тебе на lisper.ru или lispforum.com

monk ★★★★★
()

А, это же ты, по-моему, FLAC-декодер на CL писал?

Твой топик? flac декодер для common-lisp

Я помню, что я тогда замерял и получил, что код на CL в 6 раз медленее, чем flac был. Потом подумалось, что проблема в файловых оперциях. С тех пор что-нибудь изменилось?

Zubok ★★★★★
()
Ответ на: комментарий от Zubok

Да-да, это я.

Я помню, что я тогда замерял и получил, что код на CL в 6 раз медленее, чем flac был

Да не, в принципе. Щас померял, оно медленнее где-то раза в 4.5

Потом подумалось, что проблема в файловых оперциях

Ну да, sb-prof говорит, что в них.

А отчего я к этому вернулся? А оттого, что собрал свой плеерок новым sbcl'ем и оно всё отвалилось нафиг из-за небезопасного кода. Поэтому теперь я вынес сборку небезопасного кода в отдельную фичу, исправил ошибки (в том числе касающиеся чтения flac-файлов в некоторых случаях), впилил проверку чтения потока по CRC-сумме (которая в flac записывается), сделал так, чтобы при работе оно меньше консило итд. А ещё я планирую (в далеком будущем ;) добавить больше кодеков и форматов

shamaz
() автор топика
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.