use lexer-srloc

beautiful-racket-demo/basic-demo/tokenizer.rkt

@@ -5,7 +5,7 @@
 (provide (all-defined-out))
 
 (define basic-lexer
-  (lexer-src-pos
+  (lexer-srcloc
    [(eof) eof]
    [whitespace (token lexeme #:skip? #t)]
    [(from/to "rem" "\n") (token 'REM (string-downcase lexeme))]

brag/brag/codegen/runtime.rkt

@@ -118,6 +118,16 @@
                                  e
                                  (lex:position-token-end-pos a-position-token)))]
 
+        [(lex:srcloc-token t loc)
+         (define a-position-token (loop t))
+         (lex:position-token (lex:position-token-token a-position-token)
+                             (if (no-position? (lex:position-token-start-pos a-position-token))
+                                 (lex:position (srcloc-position loc) (srcloc-line loc) (srcloc-column loc))
+                                 (lex:position-token-start-pos a-position-token))
+                             (if (no-position? (lex:position-token-start-pos a-position-token))
+                                 (lex:position (+ (srcloc-position loc) (srcloc-span loc)) #f #f)
+                                 (lex:position-token-end-pos a-position-token)))]
+        
         [else
          ;; Otherwise, we have no idea how to treat this as a token.
          ((current-tokenizer-error-handler) 'unknown-type (format "~a" next-token)

brag/brag/support.rkt

@@ -35,9 +35,9 @@
 ;; This is intended to be a general token structure constructor that's nice
 ;; to work with.
 ;; It should cooperate with the tokenizers constructed with make-permissive-tokenizer.
-(define token
-  (lambda (type                 ;; (U symbol string)
+(define (token type                 ;; (U symbol string)
                [val #f]  ;; any
+               [srcloc #f]
                #:position [position #f] ;; (U #f number)
                #:line [line #f]     ;; (U #f number)
                #:column [column #f] ;; (U #f number)
@@ -45,7 +45,12 @@
                #:skip? [skip? #f])
   (token-struct (if (string? type) (string->symbol type) type)
                 val
-                  position line column span skip?)))
+                ;; keyword values take precedence over srcloc values
+                (or position (and srcloc (srcloc-position srcloc)))
+                (or line (and srcloc (srcloc-line srcloc)))
+                (or column (and srcloc (srcloc-column srcloc)))
+                (or span (and srcloc (srcloc-span srcloc)))
+                skip?))
 
 
 ;; When bad things happen, we need to emit errors with source location.
@@ -62,10 +67,14 @@
                          in))
   (define token-producer (tokenize input-port))
   (for/list ([token (in-producer token-producer (λ(tok)
-                                                  ;; position-tokens are produced by lexer-src-pos
-                                                  (eq? eof (if (position-token? tok)
-                                                               (position-token-token tok)
-                                                               tok))))])
+                                                  (eq? eof (cond
+                                                             ;; position-tokens are produced by lexer-src-pos,
+                                                             [(position-token? tok)
+                                                              (position-token-token tok)]
+                                                             ;; and srcloc-tokens by lexer-srcloc
+                                                             [(srcloc-token? tok)
+                                                              (srcloc-token-token tok)]
+                                                             [else tok]))))])
             token))
 
 (provide trim-ends)