moved raise-syntax-error* to unstable/error
This commit is contained in:
parent
ed5b0afbac
commit
30d6863e44
|
@ -65,6 +65,27 @@ unless @racket['maybe] or @racket['multi] is also provided}
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@defproc[(raise-syntax-error*
|
||||||
|
[message string?]
|
||||||
|
[expr (or/c syntax? #f)]
|
||||||
|
[sub-expr (or/c syntax? #f)]
|
||||||
|
[field (let ([option/c (or/c 'value 'multi 'maybe)])
|
||||||
|
(or/c string? (cons/c string? (listof option/c))))]
|
||||||
|
[value any/c] ... ...
|
||||||
|
[#:continued continued-message (or/c string? (listof string?)) null])
|
||||||
|
any]{
|
||||||
|
|
||||||
|
Like @racket[raise-syntax-error] but with the formatting of
|
||||||
|
@racket[error*]. The raised exception is an instance of
|
||||||
|
@racket[exn:fail:syntax]. Like @racket[raise-syntax-error], the
|
||||||
|
inclusion of @racket[expr] and @racket[sub-expr] in the details of the
|
||||||
|
error message is controlled by the
|
||||||
|
@racket[error-print-source-location] paramter; if they included, they
|
||||||
|
are included before the other details specified by @racket[field] and
|
||||||
|
@racket[value]. Unlike @racket[raise-syntax-error], both @racket[expr]
|
||||||
|
and @racket[sub-expr] are mandatory arguments.
|
||||||
|
}
|
||||||
|
|
||||||
@defproc[(compose-error-message
|
@defproc[(compose-error-message
|
||||||
[name (or/c symbol? #f)]
|
[name (or/c symbol? #f)]
|
||||||
[message string?]
|
[message string?]
|
||||||
|
|
|
@ -157,32 +157,6 @@ complicated.
|
||||||
'("parsing context" multi maybe) context
|
'("parsing context" multi maybe) context
|
||||||
'("note" maybe) (and more? "additional errors omitted"))))
|
'("note" maybe) (and more? "additional errors omitted"))))
|
||||||
|
|
||||||
(define (raise-syntax-error* message0 stx sub-stx
|
|
||||||
#:who [who #f]
|
|
||||||
#:continued [continued-message null]
|
|
||||||
#:extra-sources [extra-stxs null]
|
|
||||||
. field+detail-list)
|
|
||||||
(let* ([source-stx (or stx sub-stx)]
|
|
||||||
[who (or who
|
|
||||||
(let* ([maybe-id (if (stx-pair? stx) (stx-car stx) stx)])
|
|
||||||
(if (identifier? maybe-id) (syntax-e maybe-id) '?)))]
|
|
||||||
[message
|
|
||||||
(apply compose-error-message who message0
|
|
||||||
#:continued continued-message
|
|
||||||
'("at" maybe) (and sub-stx
|
|
||||||
(error-print-source-location)
|
|
||||||
(format "~.s" (syntax->datum sub-stx)))
|
|
||||||
'("in" maybe) (and stx
|
|
||||||
(error-print-source-location)
|
|
||||||
(format "~.s" (syntax->datum stx)))
|
|
||||||
field+detail-list)]
|
|
||||||
[message
|
|
||||||
(if (error-print-source-location)
|
|
||||||
(string-append (source-location->prefix source-stx) message)
|
|
||||||
message)])
|
|
||||||
(raise (exn:fail:syntax message (current-continuation-marks)
|
|
||||||
(filter values (list* stx sub-stx extra-stxs))))))
|
|
||||||
|
|
||||||
;; ====
|
;; ====
|
||||||
|
|
||||||
(define (comma-list items)
|
(define (comma-list items)
|
||||||
|
|
|
@ -1,5 +1,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require racket/contract/base)
|
(require racket/contract/base
|
||||||
|
syntax/srcloc
|
||||||
|
syntax/stx)
|
||||||
|
|
||||||
#|
|
#|
|
||||||
TODO
|
TODO
|
||||||
|
@ -32,6 +34,11 @@ TODO
|
||||||
#:constructor (-> string? continuation-mark-set? exn?))
|
#:constructor (-> string? continuation-mark-set? exn?))
|
||||||
#:rest details-list/c
|
#:rest details-list/c
|
||||||
any)]
|
any)]
|
||||||
|
[raise-syntax-error*
|
||||||
|
(->* [string? (or/c syntax? #f) (or/c syntax? #f)]
|
||||||
|
[#:continued (or/c string? (listof string))]
|
||||||
|
#:rest details-list/c
|
||||||
|
any)]
|
||||||
[compose-error-message
|
[compose-error-message
|
||||||
(->* ((or/c symbol? #f) string?)
|
(->* ((or/c symbol? #f) string?)
|
||||||
(#:continued (or/c string? (listof string)))
|
(#:continued (or/c string? (listof string)))
|
||||||
|
@ -52,6 +59,34 @@ TODO
|
||||||
(field+detail-list->table 'raise-misc-error field+detail-list detail-table))
|
(field+detail-list->table 'raise-misc-error field+detail-list detail-table))
|
||||||
(current-continuation-marks))))
|
(current-continuation-marks))))
|
||||||
|
|
||||||
|
(define (raise-syntax-error* message0 stx sub-stx
|
||||||
|
#:who [who #f]
|
||||||
|
#:continued [continued-message null]
|
||||||
|
#:extra-sources [extra-stxs null]
|
||||||
|
. field+detail-list)
|
||||||
|
(let* ([source-stx (or stx sub-stx)]
|
||||||
|
[who (or who
|
||||||
|
(let* ([maybe-id (if (stx-pair? stx) (stx-car stx) stx)])
|
||||||
|
(if (identifier? maybe-id) (syntax-e maybe-id) '?)))]
|
||||||
|
[message
|
||||||
|
(apply compose-error-message who message0
|
||||||
|
#:continued continued-message
|
||||||
|
'("at" maybe) (and sub-stx
|
||||||
|
(error-print-source-location)
|
||||||
|
(format "~.s" (syntax->datum sub-stx)))
|
||||||
|
'("in" maybe) (and stx
|
||||||
|
(error-print-source-location)
|
||||||
|
(format "~.s" (syntax->datum stx)))
|
||||||
|
field+detail-list)]
|
||||||
|
[message
|
||||||
|
(if (error-print-source-location)
|
||||||
|
(string-append (source-location->prefix source-stx) message)
|
||||||
|
message)])
|
||||||
|
(raise (exn:fail:syntax message (current-continuation-marks)
|
||||||
|
(filter values (list* stx sub-stx extra-stxs))))))
|
||||||
|
|
||||||
|
;; ----
|
||||||
|
|
||||||
(define (compose-error-message who message
|
(define (compose-error-message who message
|
||||||
#:details [detail-table null]
|
#:details [detail-table null]
|
||||||
#:continued [continued-message null]
|
#:continued [continued-message null]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user