suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

moved raise-syntax-error* to unstable/error

Browse Source
This commit is contained in:
Ryan Culpepper 2013-08-01 11:15:24 -04:00
parent ed5b0afbac
commit 30d6863e44
3 changed files with 57 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/unstable-pkgs/unstable-doc/scribblings/error.scrbl
View File

@ -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
[name (or/c symbol? #f)]
[message string?]

26
racket/collects/syntax/parse/private/runtime-report.rkt
View File

@ -157,32 +157,6 @@ complicated.
'("parsing context" multi maybe) context
'("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)

37
racket/collects/unstable/error.rkt
View File

@ -1,5 +1,7 @@
#lang racket/base
(require racket/contract/base)
(require racket/contract/base
syntax/srcloc
syntax/stx)
#|
TODO
@ -32,6 +34,11 @@ TODO
#:constructor (-> string? continuation-mark-set? exn?))
#:rest details-list/c
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
(->* ((or/c symbol? #f) string?)
(#:continued (or/c string? (listof string)))
@ -52,6 +59,34 @@ TODO
(field+detail-list->table 'raise-misc-error field+detail-list detail-table))
(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
#:details [detail-table null]
#:continued [continued-message null]