diff --git a/brag/codegen/expander.rkt b/brag/codegen/expander.rkt index a81f3a0..b40aaac 100755 --- a/brag/codegen/expander.rkt +++ b/brag/codegen/expander.rkt @@ -15,10 +15,10 @@ ;; -> (listof symbol) (define-for-syntax (rules->token-types rules) - (let-values ([(implicit-tokens explicit-tokens) (rules-collect-token-types rules)]) - (remove-duplicates (append (for/list ([it (in-list implicit-tokens)]) - (string->symbol (syntax-e it))) - (map syntax-e explicit-tokens)) eq?))) + (define-values (implicit-tokens explicit-tokens) (rules-collect-token-types rules)) + (remove-duplicates (append (for/list ([it (in-list implicit-tokens)]) + (string->symbol (syntax-e it))) + (map syntax-e explicit-tokens)) eq?)) (define-syntax (brag-module-begin rules-stx) (syntax-case rules-stx () diff --git a/brag/codegen/reader.rkt b/brag/codegen/reader.rkt index 7ff3ae0..adc0066 100755 --- a/brag/codegen/reader.rkt +++ b/brag/codegen/reader.rkt @@ -10,45 +10,34 @@ brag/codegen/expander brag/rules/stx brag/rules/rule-structs) -(define (my-read in) - (syntax->datum (my-read-syntax #f in))) +(define (my-read in) (syntax->datum (my-read-syntax #f in))) + +(define ((my-parser-error-handler src) tok-ok? tok-name tok-value start-pos end-pos) + (raise-syntax-error + #f + (format "Error while parsing grammar near: ~a [line=~a, column=~a, position=~a]" + tok-value + (pos-line start-pos) + (pos-col start-pos) + (pos-offset start-pos)) + (datum->syntax #f + (string->symbol (format "~a" tok-value)) + (list src + (pos-line start-pos) + (pos-col start-pos) + (pos-offset start-pos) + (if (and (number? (pos-offset end-pos)) + (number? (pos-offset start-pos))) + (- (pos-offset end-pos) + (pos-offset start-pos)) + #f))))) (define (my-read-syntax src in) - (define-values (first-line first-column first-position) (port-next-location in)) (define tokenizer (tokenize in)) - (define rules - (parameterize ([current-parser-error-handler - (lambda (tok-ok? tok-name tok-value start-pos end-pos) - (raise-syntax-error - #f - (format "Error while parsing grammar near: ~a [line=~a, column=~a, position=~a]" - tok-value - (pos-line start-pos) - (pos-col start-pos) - (pos-offset start-pos)) - (datum->syntax #f - (string->symbol (format "~a" tok-value)) - (list src - (pos-line start-pos) - (pos-col start-pos) - (pos-offset start-pos) - (if (and (number? (pos-offset end-pos)) - (number? (pos-offset start-pos))) - (- (pos-offset end-pos) - (pos-offset start-pos)) - #f)))))]) - (grammar-parser tokenizer))) - (define-values (last-line last-column last-position) (port-next-location in)) - (rules->stx src rules - #:original-stx (datum->syntax #f 'original-stx - (list src - first-line - first-column - first-position - (if (and (number? last-position) - (number? first-position)) - (- last-position first-position) - #f))))) + (define rules (parameterize ([current-parser-error-handler (my-parser-error-handler src)]) + (grammar-parser tokenizer))) + (for/list ([r (in-list rules)]) + (rule->stx src r))) (define (my-get-info key default default-filter) (case key diff --git a/brag/rules/stx.rkt b/brag/rules/stx.rkt index 141c453..7573bda 100755 --- a/brag/rules/stx.rkt +++ b/brag/rules/stx.rkt @@ -5,15 +5,7 @@ racket/match syntax/strip-context) -(provide rules->stx) - -;; Given a sequence of rules, we translate these to syntax objects. - -;; rules->stx: (listof rule) -> syntax -(define (rules->stx source rules #:original-stx [original-stx #f]) - (datum->syntax #f (for/list ([stx (in-list rules)]) - (rule->stx source stx)) original-stx)) - +(provide rule->stx) (define (rule->stx source a-rule) (define id-stx