From 43bceacd0709c39e1999e5de8d6c72c8e0cf4551 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Sat, 7 Sep 2024 16:33:44 +0200 Subject: [PATCH] Use errortrace-key instead of DrRacket's own key. This is so we can pick it up in the teaching languages for reporting error locations. --- drracket/drracket/private/debug.rkt | 8 ++++---- .../drracket/private/drracket-errortrace-key.rkt | 12 ------------ .../drracket/private/eval-helpers-and-pref-init.rkt | 4 ++-- drracket/drracket/private/eval.rkt | 2 +- drracket/drracket/private/expanding-place.rkt | 2 +- drracket/drracket/private/language-configuration.rkt | 4 ++-- drracket/drracket/private/stack-checkpoint.rkt | 6 +++--- 7 files changed, 13 insertions(+), 25 deletions(-) delete mode 100644 drracket/drracket/private/drracket-errortrace-key.rkt diff --git a/drracket/drracket/private/debug.rkt b/drracket/drracket/private/debug.rkt index 310528a46..7db823886 100644 --- a/drracket/drracket/private/debug.rkt +++ b/drracket/drracket/private/debug.rkt @@ -1,9 +1,9 @@ #lang racket/base -(require "drracket-errortrace-key.rkt" - racket/unit +(require racket/unit racket/contract errortrace/stacktrace + errortrace/errortrace-key racket/class racket/path racket/bool @@ -68,7 +68,7 @@ (define (cms->srclocs cms) (map errortrace-stack-item->srcloc - (continuation-mark-set->list cms drracket-errortrace-key))) + (continuation-mark-set->list cms errortrace-key))) ;; type debug-source = (union symbol (instanceof editor<%>)) @@ -718,7 +718,7 @@ [else #f])) (define with-mark (make-with-mark special-source-handling-for-drr)) - (define key-module-name 'drracket/private/drracket-errortrace-key) + (define key-module-name 'errortrace/errortrace-key) ;; current-backtrace-window : (union #f (instanceof frame:basic<%>)) ;; the currently visible backtrace window, or #f, if none diff --git a/drracket/drracket/private/drracket-errortrace-key.rkt b/drracket/drracket/private/drracket-errortrace-key.rkt deleted file mode 100644 index 3e560a794..000000000 --- a/drracket/drracket/private/drracket-errortrace-key.rkt +++ /dev/null @@ -1,12 +0,0 @@ -(module drracket-errortrace-key '#%kernel - (void '#:errortrace-dont-annotate) - - ;; as with errortrace/errortrace-key: - ;; Defining `errortrace-key' as a function is a performance hack: - ;; the compiler can track function constants, and in particular the - ;; fact that it's not an impersonated/chaperoned mark key, so that a - ;; `with-continuation-mark' using this key can be dropped if the - ;; body expression is simple. - (define-values (drracket-errortrace-key) (lambda () 'anything)) - - (#%provide drracket-errortrace-key)) diff --git a/drracket/drracket/private/eval-helpers-and-pref-init.rkt b/drracket/drracket/private/eval-helpers-and-pref-init.rkt index 4c85f627a..1e747448b 100644 --- a/drracket/drracket/private/eval-helpers-and-pref-init.rkt +++ b/drracket/drracket/private/eval-helpers-and-pref-init.rkt @@ -10,7 +10,7 @@ pkg/lib framework/preferences errortrace/stacktrace - "drracket-errortrace-key.rkt" + errortrace/errortrace-key (prefix-in *** '#%foreign) ;; just to make sure it is here "compiled-dir.rkt") @@ -216,7 +216,7 @@ (define column (or (syntax-column src-stx) 0)) (with-syntax ([expr expr] [mark (vector source line column position span)] - [et-key (syntax-shift-phase-level #'drracket-errortrace-key phase)] + [et-key (syntax-shift-phase-level #'errortrace-key phase)] [wcm (syntax-shift-phase-level #'with-continuation-mark phase)] [qte (syntax-shift-phase-level #'quote phase)]) (syntax diff --git a/drracket/drracket/private/eval.rkt b/drracket/drracket/private/eval.rkt index 0df57a8e4..53b45bdc1 100644 --- a/drracket/drracket/private/eval.rkt +++ b/drracket/drracket/private/eval.rkt @@ -194,7 +194,7 @@ (list ''#%foreign '(lib "mzlib/pconvert-prop.rkt") '(lib "planet/terse-info.rkt") - '(lib "drracket/private/drracket-errortrace-key.rkt") + '(lib "errortrace/errortrace-key.rkt") '(lib "simple-tree-text-markup/data.rkt") ; srclocs-special<%> '(lib "simple-tree-text-markup/port.rkt") diff --git a/drracket/drracket/private/expanding-place.rkt b/drracket/drracket/private/expanding-place.rkt index 9fc19c173..77bd93f1f 100644 --- a/drracket/drracket/private/expanding-place.rkt +++ b/drracket/drracket/private/expanding-place.rkt @@ -565,5 +565,5 @@ (define profiling-enabled (make-parameter #f)) (define (register-profile-start key) (void)) (define (register-profile-done key start) (void)) -(define key-module-name 'drracket/private/drracket-errortrace-key) +(define key-module-name 'errortrace/errortrace-key) (define-values/invoke-unit/infer stacktrace/errortrace-annotate/key-module-name@) diff --git a/drracket/drracket/private/language-configuration.rkt b/drracket/drracket/private/language-configuration.rkt index b609ca69e..e89df57b2 100644 --- a/drracket/drracket/private/language-configuration.rkt +++ b/drracket/drracket/private/language-configuration.rkt @@ -2016,8 +2016,8 @@ (super on-execute setting run-in-user-thread) (run-in-user-thread (λ () - (namespace-require 'drracket/private/drracket-errortrace-key) - (namespace-require '(for-syntax drracket/private/drracket-errortrace-key))))) + (namespace-require 'errortrace/errortrace-key) + (namespace-require '(for-syntax errortrace/errortrace-key))))) (super-new))) (define (r5rs-mixin %) diff --git a/drracket/drracket/private/stack-checkpoint.rkt b/drracket/drracket/private/stack-checkpoint.rkt index a511b7193..17786bc22 100644 --- a/drracket/drracket/private/stack-checkpoint.rkt +++ b/drracket/drracket/private/stack-checkpoint.rkt @@ -1,11 +1,11 @@ #lang racket/base -(require "drracket-errortrace-key.rkt" - racket/class +(require racket/class racket/contract racket/gui/base racket/math racket/match framework + errortrace/errortrace-key "interface.rkt") (module+ test (require (rename-in rackunit [check r:check]) racket/list racket/bool)) @@ -171,7 +171,7 @@ (define (cms->errortrace-viewable-stack cms interesting-editors #:share-cache [a-viewable-stack #f]) - (build-viewable-stack (continuation-mark-set->list cms drracket-errortrace-key) + (build-viewable-stack (continuation-mark-set->list cms errortrace-key) errortrace-stack-item->srcloc interesting-editors a-viewable-stack))