You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
35 lines
1.4 KiB
Racket
35 lines
1.4 KiB
Racket
9 years ago
|
#lang racket/base
|
||
|
|
(require parser-tools/lex)
|
||
|
|
|
||
|
|
(provide (all-defined-out))
|
||
|
|
|
||
|
|
;; During parsing, we should define the source of the input.
|
||
|
|
(define current-source (make-parameter #f))
|
||
|
|
|
||
|
|
|
||
|
|
;; When bad things happen, we need to emit errors with source location.
|
||
|
|
(struct exn:fail:parse-grammar exn:fail (srclocs)
|
||
|
|
#:transparent
|
||
|
|
#:property prop:exn:srclocs (lambda (instance)
|
||
|
|
(exn:fail:parse-grammar-srclocs instance)))
|
||
|
|
|
||
|
|
(define current-parser-error-handler
|
||
|
|
(make-parameter
|
||
|
|
(lambda (tok-ok? tok-name tok-value start-pos end-pos)
|
||
|
|
(raise (exn:fail:parse-grammar
|
||
|
|
(format "Error while parsing grammar near: ~e [line=~a, column~a, position=~a]"
|
||
|
|
tok-value
|
||
|
|
(position-line start-pos)
|
||
|
|
(position-col start-pos)
|
||
|
|
(position-offset start-pos))
|
||
|
|
(current-continuation-marks)
|
||
|
|
(list (srcloc (current-source)
|
||
|
|
(position-line start-pos)
|
||
|
|
(position-col start-pos)
|
||
|
|
(position-offset start-pos)
|
||
|
|
(if (and (number? (position-offset end-pos))
|
||
|
|
(number? (position-offset start-pos)))
|
||
|
|
(- (position-offset end-pos)
|
||
|
|
(position-offset start-pos))
|
||
|
|
#f))))))))
|