simplify more

hide-top-rule-name
Matthew Butterick 6 years ago
parent 1d8ff90769
commit cf5e686ea6

@ -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 ()

@ -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

@ -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

Loading…
Cancel
Save