From 30d6863e4415a2c72fd49f64210dbfcce2c3f599 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Thu, 1 Aug 2013 11:15:24 -0400
Subject: [PATCH] moved raise-syntax-error* to unstable/error

---
 .../unstable-doc/scribblings/error.scrbl      | 21 +++++++++++
 .../syntax/parse/private/runtime-report.rkt   | 26 -------------
 racket/collects/unstable/error.rkt            | 37 ++++++++++++++++++-
 3 files changed, 57 insertions(+), 27 deletions(-)

diff --git a/pkgs/unstable-pkgs/unstable-doc/scribblings/error.scrbl b/pkgs/unstable-pkgs/unstable-doc/scribblings/error.scrbl
index 9cbabdc1e1..06e24c0e19 100644
--- a/pkgs/unstable-pkgs/unstable-doc/scribblings/error.scrbl
+++ b/pkgs/unstable-pkgs/unstable-doc/scribblings/error.scrbl
@@ -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?]
diff --git a/racket/collects/syntax/parse/private/runtime-report.rkt b/racket/collects/syntax/parse/private/runtime-report.rkt
index 58d24a4283..50a6243902 100644
--- a/racket/collects/syntax/parse/private/runtime-report.rkt
+++ b/racket/collects/syntax/parse/private/runtime-report.rkt
@@ -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)
diff --git a/racket/collects/unstable/error.rkt b/racket/collects/unstable/error.rkt
index a50d5aaa8b..159e258135 100644
--- a/racket/collects/unstable/error.rkt
+++ b/racket/collects/unstable/error.rkt
@@ -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]