From 0156d62399f68f73c4d5f4460eb44b39aebba377 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@hashcollision.org>
Date: Tue, 26 Feb 2013 12:56:34 -0700
Subject: [PATCH] Modify the src-pos error reporting in parser-tools to better
 show the token context.

Addresses PR 9924.

original commit: 9b86d4452fc4e1be823e12373aac2d5f432006da
---
 collects/parser-tools/yacc.rkt | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/collects/parser-tools/yacc.rkt b/collects/parser-tools/yacc.rkt
index efb1900..6584fd3 100644
--- a/collects/parser-tools/yacc.rkt
+++ b/collects/parser-tools/yacc.rkt
@@ -228,17 +228,29 @@
                                   "(or/c symbol? token?)"
                                   0 
                                   tok))))
+
+  ;; well-formed-position-token?: any -> boolean
+  ;; Returns true if pt is a position token whose position-token-token
+  ;; is itself a token or a symbol.
+  ;; This is meant to help raise more precise error messages when
+  ;; a tokenizer produces an erroneous position-token wrapped twice.
+  ;; (as often happens when omitting return-without-pos).
+  (define (well-formed-position-token? pt)
+    (and (position-token? pt) 
+         (let ([t (position-token-token pt)])
+           (or (symbol? t)
+               (token? t)))))
   
   ;; extract-src-pos : position-token -> symbol any any any
   (define (extract-src-pos ip)
     (cond
-      ((position-token? ip)
+      ((well-formed-position-token? ip)
        (extract-helper (position-token-token ip)
                        (position-token-start-pos ip)
                        (position-token-end-pos ip)))
       (else
        (raise-argument-error 'parser 
-                             "position-token?"
+                             "well-formed-position-token?"
                              0
                              ip))))