Как заставить нормально работать stacktrace в Racket?

в drracket вроде оно умеет целиком показывать.

Так в нем и смотрю.

В рабочей программе с классами вообще в трейсе (send method obj), а затем тела метода нет, а сразу тело функции, вызванной из метода. Беда в том, что она там из десятка мест вызывается.

Можно, конечно через continuation-mark и макросы стек вручную сделать, но может есть правильный метод. Тут был анонимус, который рассказывал, что syntax/loc там именно чтобы нужное место ошибки подсвечивалось и этим Racket намного круче, чем Common Lisp. Как бы его кастануть?

racket/trace, не?

#lang racket

(require racket/trace)

(define (foo x)
  (/ 1 x))

(define (bar x) 
  (define res (foo (- x 1)))
  res)

(trace foo bar)

(bar 1)

>(bar 1)
> (foo 0)
. . /: division by zero
> 

Единственная проблема, что trace использует set!.

Как сделать, чтобы попал вызов (foo (- x 1)) ?

Cделать вызов нехвостовым. TCO все промежуточные фреймы убирает, если они будут где-то храниться, то ТСО не будет работать.

Тут был анонимус, который рассказывал, что syntax/loc там именно чтобы нужное место ошибки подсвечивалось и этим Racket намного круче, чем Common Lisp. Как бы его кастануть?

Здесь проблема не в указании локации, а в том, что с точки зрения control-flow в момент выполнения деления фрейма с foo просто не существует, то есть деление выполняется непосредственно в фрейме bar, вот она и скачет так.

Можно, конечно через continuation-mark и макросы стек вручную сделать,

Если у тебя вызовы хвостовые, то не поможет все равно. А если переделать в нехвостовые, то марки будут не нужны.

Могу предложить вот такой вот костыль:

#lang racket
(require syntax/parse/define)


(define-simple-macro (trace x)
  #:with res (syntax/loc #'x (values x))
  res)


(define (foo x) (/ 1 x))
(define (bar x) 
  (define res (trace (foo (- x 1)))) res)
(bar 1)

там нету флага отключения TCO?

да, рэкет - профессия для суровых мужиков =)

там нету флага отключения TCO?

Там нету циклов. Если отключить ТСО, то (for ([i 1000000000]) 'huy) выжрет всю память

Я думал, хвостовой вызов - когда вызов является последним выражением. Здесь последнее выражение res.

Тогда ближе к вечеру выложу тот кусок из-за которого отрыл тему: там макрос раскрывается в определение класса, но при ошибке в теле класса строка тела не попадает в трейс. Из-за этого не работает syntax/loc.

Я думал, хвостовой вызов - когда вызов является последним выражением.

Ну да. Хвостовой вызов - внешний вызов ф-и foo (в данном случае это /), по-этому фрейм с foo подменяется на фрейм с /.

Вот реальная проблема

#lang racket
(require binary-class)
(define-binary-class test% ((a u1) (b u1) (c u1)))
(define test (make-object test%))
(set-field! a test "") ;; делаем значение неверного типа
(call-with-output-bytes (λ (stream) (write-value test% stream test)))

В трассировке я вижу (send value write out) и сразу тело типа u1. Хотя в macro-stepper'е ясно вижу, что тело метода

(define/public (write out)
         (write-value u1 out a)
         (write-value u1 out b)
         (write-value u1 out c)
         (void))

Из контекста ошибки очевидно, что ошибка в строке (write-value u1 out a). Почему её не видно в трассировке? Она не последняя, тут нет ТСО!

по-этому фрейм с foo подменяется на фрейм с /

Упс. Я думал, при ТСО не создаётся новый фрейм, а не затирается последний.

То есть в случае syntax/loc надо писать свою обёртку, чтобы фрейм не терялся?

Упс. Я думал, при ТСО не создаётся новый фрейм

Ну да, не создается. В качестве нового используется текущий, что, вобщем-то, эквивалентно затиранию :)

То есть в случае syntax/loc надо писать свою обёртку, чтобы фрейм не терялся?

syntax/loc тут не при чем - он просто подменяет информацию о source location у конкретного syntax object'а, а проблема в том, что из-за ТСО эта информация просто нигде не сохраняется и не важно, по-этому, какой она будет. Единственный вариант - руками в точке вызова добавить новый фрейм (как я в макросе trace), вызвав какую-нибудь функцию, например id или ее аналог (values в моем случае).

Как это будет удобно сделать для конкретного кода я, конечно, без самого кода сказать не могу.

Ну да, не создается. В качестве нового используется текущий, что, вобщем-то, эквивалентно затиранию :)

Вообще в данном случае это особенности работы формы with-continuation-marks. При включенной отладке в Dr.Racket (или при использовании errortrace, что эквивалентно) код инструментируется этими with-syntax-mark, при нехвостовых вызовах марки (в которых как раз и хранится syntax object формы текущего фрейма) просто консятся друг к другу, но когда вызов хвостовой - то новая марка перезаписывает старую. В документации по continuation marks это есть.

Cделать вызов нехвостовым

Сделал

#lang racket
(define (foo x) 
  (define r (/ 1 x))
  (+ r 0))
(define (bar x) 
  (define res (foo (- x 1)))
  (define res2 (foo x))
  res)
(bar 1)

Всё равно (foo (- x 1)) в стеке нет. Есть целиком bar, а потом целиком foo и (/ 1 x)

Из контекста ошибки очевидно, что ошибка в строке (write-value u1 out a). Почему её не видно в трассировке? Она не последняя, тут нет ТСО!

Я не понял примера. write-value - функция, макрос? Функция write зачем? write-value как определена? И какие формы конкретно показываются в трейсе?

Всё равно (foo (- x 1)) в стеке нет. Есть целиком bar, а потом целиком foo и (/ 1 x)

Ну смысл в том, что когда вызывается foo добавляется марка с вызовом foo, потом контрол-флоу доходит до foo, вся форма в свою очередь обернута в with-syntax-mark, причем этот вызов хвостовой (выполняется внешняя форма в самом foo), то есть марка с «целиком foo» затирает марку с вызовом. Если бы так не было то, например, при рекурсивном вызове foo внутри foo они бы друг на друга наслаивались и память бы всю выжрало.

То есть чтобы показывало надо обернуть форму вызова foo во что-нибудь, например values:

#lang racket
(define (foo x) 
  (define r (/ 1 x))
  (+ r 0))
(define (bar x) 
  (define res (values (foo (- x 1))))
  (define res2 (foo x))
  res)
(bar 1)

syntax/loc тут не при чем - он просто подменяет информацию о source location у конкретного syntax object'а

Я имею в виду, что хочу его использовать, но обернуть нечего.

как я в макросе trace

Воткнул его в define-binary-class.

Теперь метод раскрывается как

(define/public (write out)
         (trace (write-value u1 out a))
         (trace (write-value u1 out b))
         (trace (write-value u1 out c))
         (void))))

Но в трассировке всё равно сразу после send потроха write-value. Я не хочу показывать пользователю макроса, что вызывается write-value, но для этого надо как-то этот вызов воткнуть в стек.

Но в трассировке всё равно сразу после send потроха write-value.

Отладка в DrRacket включена? Должна показываться форма (write-value u1 out a) (или в какой конкретно ошибка?) и потом уже потроха.

Я не хочу показывать пользователю макроса, что вызывается write-value, но для этого надо как-то этот вызов воткнуть в стек.

Не понял, так надо показывать write-value или нет? И можно реализацию write-value?

(define (write-value type out value . rest-values)
  (cond 
    [(binary? type) 
     (apply (binary-write type) out value rest-values)]
    [(implementation? type binary<%>) 
     (send value write out)
     (for ([v (in-list rest-values)]) (send value write out))]))

для type = u1 вызывается (apply (binary-write type) out value rest-values)

В трейсе я вижу (send value write out), а затем сразу (let loop ...) из тела функции (binary-write u1).

Еще вариант - навесить на нужную функцию (foo или write-value) контракт.

Отладка в DrRacket включена?

да

Должна показываться форма (write-value u1 out a)

именно этого я и хочу

Не понял, так надо показывать write-value или нет

Я хочу его завернуть в syntax/loc, чтобы показывало на строку define-binary-class, но для этого надо, чтобы эта строка была в трассировке

Можешь, кстати, установить пакет binary-class и проверить на своём компьютере

Навесил контракт на write-value. Всё равно в стеке нет.

Сейчас я попробую

(define-for-syntax (make-writer id+val)
  (with-syntax ([(FNAME FTYPE ARG ...) id+val])
    (syntax-case #'FNAME ()
      [(NAME ...)
       (with-syntax ([(NAME* ...) (map (λ (x) (if (not-null? x) x #f)) (syntax->list #'(NAME ...)))])
         (syntax/loc #'FTYPE (values (write-value (values->maybe-list FTYPE) out NAME* ...))))]
      [NAME (not-null? #'NAME) (syntax/loc #'FTYPE (values (write-value FTYPE out NAME)))]
      [NAME                    (syntax/loc #'FTYPE (values (write-value FTYPE out #f)))])))

теперь между (send value write out) и кишками (let loop blabla) фрейм в u1 (#'FTYPE, взял первое что попалось, на какую именно оформу тебе надо location указать сам уже смотри). Все ок?

А проблема из-за непоказывания стектрейса тут какбы в том что ты во время конструкции формы макроса define-binary-class слишком сильно собирал/пересобирал формы и получилось что нужные формы оказались без соуса в принципе - их потому и не отмечало в стеке

А проблема из-за непоказывания стектрейса тут какбы в том что ты во время конструкции формы макроса define-binary-class слишком сильно собирал/пересобирал формы и получилось что нужные формы оказались без соуса в принципе - их потому и не отмечало в стеке

Точнее проблема и в том и в том - с одной стороны стек не показывается изза-того что просто нету инфы там (стерло ТСО, проблема решена через добавление values), а во-вторых из-за отсутствия location, если хотя бы один из пунктов не выполнен - то фрейм не показывается.

Спасибо, заработало!

Всё-таки не всё...

Посоветуй.

(with-syntax ([(LOCAL ...) (generate-temporaries #'(NAME ...))])
         #'(let-values ([(LOCAL ...) 
                         (read-value (values->maybe-list FTYPE) in ARG ...)])
             (set* NAME LOCAL) ...))

Как завернуть (read-value ...) в syntax/loc ? Просто syntax/loc не хватает, values нельзя так как возвращается много значений.

Просто syntax/loc не хватает, values нельзя так как возвращается много значений.

Попробуй (syntax\loc #'source (call-with-values (lambda () (read-value ...))) values)

А вообще это лютые костыли, конечно, надо им в стандартной либе запилить подобные вещи.

Работает. Спасибо!