use Racket lexer for double-quoted strings

brag-lib/brag/examples/codepoints.rkt

@@ -2,5 +2,5 @@
 start: A c def hello-world
 A : "\"\101\\" ; A
 c : '\'\U0063\\' ; c
-def : "*\u64\\\x65f\"" ; de
+def : "*\u64\\\"\\\x65f\"" ; de
 hello-world : "\150\145\154\154\157\40\167\157\162\154\144"

brag-lib/brag/rules/lexer.rkt

@@ -1,11 +1,12 @@
-#lang at-exp racket/base
+#lang debug racket/base
 (require (for-syntax racket/base "parser.rkt"))
 (require br-parser-tools/lex
          (prefix-in : br-parser-tools/lex-sre)
          "parser.rkt"
          "rule-structs.rkt"
          (only-in brag/support from/to)
-         racket/string)
+         racket/string
+         syntax-color/racket-lexer)
 
 (provide lex/1 tokenize)
 (module+ lex-abbrevs
@@ -66,9 +67,10 @@
 (define-lex-abbrev escaped-double-quote (:: backslash double-quote))
 (define-lex-abbrev escaped-backslash (:: backslash backslash))
 
-(define lex/1
+(define brag-lex
   (lexer-src-pos
-   [(:: double-quote ;; start with double quote
+   ;; we are delegating lexing of double-quoted strings to the Racket lexer (see below)
+   #;[(:: double-quote ;; start with double quote
         (intersection ;; two conditions need to be true inside the quotes:
          ;; we can have anything except
          ;; a plain double-quote (which would close the quote)
@@ -146,6 +148,21 @@
        (position->pos start-pos)
        (position->pos end-pos-2)))]))
 
+(define (lex/1 ip)
+  (cond
+    [(equal? (peek-bytes 1 0 ip) #"\"")
+     ;; delegate lexing of strings to the default Racket lexer
+     ;; this doesn't yet work with single-quoted strings
+     ;; but maybe there's a way to do that by messing with the readtable
+     (define-values (line-start col-start pos-start) (port-next-location ip))
+     (define-values (str type paren also-pos-start also-pos-end) (racket-lexer ip))
+     (define-values (line-end col-end pos-end) (port-next-location ip))
+     (make-position-token (token-LIT (string-append "\""
+                                                    (read (open-input-string str))
+                                                    "\""))
+                          (make-position pos-start line-start col-start)
+                          (make-position pos-end line-end col-end))]
+    [else (brag-lex ip)]))
 
 ;; This is the helper for the error production.
 (define lex-nonwhitespace
@@ -157,8 +174,6 @@
    [(eof)
     (values "" end-pos)]))
 
-
-
 ;; position->pos: position -> pos
 ;; Converts position structures from br-parser-tools/lex to our own pos structures.
 (define (position->pos a-pos)

brag-lib/brag/test/test-codepoints.rkt

@@ -3,8 +3,8 @@
 (require brag/examples/codepoints
          rackunit)
 
-(check-equal? (parse-to-datum '("\"A\\" "'c\\" "*d\\ef\"" "hello world"))
+(check-equal? (parse-to-datum '("\"A\\" "'c\\" "*d\\\"\\ef\"" "hello world"))
               '(start (A "\"A\\")
                       (c "'c\\")
-                      (def "*d\\ef\"")
+                      (def "*d\\\"\\ef\"")
                       (hello-world "hello world")))