Add expected-SR-conflicts + expected-RR-conflicts.

Add options for informing the yacc parser how many shift/reduce and
reduce/reduce conflicts to expect.

The options are inherited by cfg-parser but probably not useful there.

Closes racket/racket#1669
Ben Noordhuis 8 years ago committed by Matthew Flatt
parent 3e71cfa350
commit c9fd206a1c

@ -495,7 +495,8 @@ be the right choice when using @racket[lexer] in other situations.
@defmodule[parser-tools/yacc]
@defform/subs[#:literals (grammar tokens start end precs src-pos
suppress debug yacc-output prec)
suppress expected-SR-conflicts expected-RR-conflicts
debug yacc-output prec)
(parser clause ...)
([clause (grammar (non-terminal-id
((grammar-id ...) maybe-prec expr)
@ -508,6 +509,8 @@ be the right choice when using @racket[lexer] in other situations.
(precs (assoc token-id ...) ...)
(src-pos)
(suppress)
(expected-SR-conflicts num)
(expected-RR-conflicts num)
(debug filename)
(yacc-output filename)]
[maybe-prec code:blank
@ -656,6 +659,18 @@ be the right choice when using @racket[lexer] in other situations.
Causes the parser generator not to report shift/reduce or
reduce/reduce conflicts.}
@item{@racket[(expected-SR-conflicts _n)] @italic{OPTIONAL}
Causes the parser generator to expect exactly @racket[_num]
shift/reduce conflicts, where @racket[_num] must be a literal number.
The @racket[suppress] option overrides this option.}
@item{@racket[(expected-RR-conflicts _n)] @italic{OPTIONAL}
Causes the parser generator to expect exactly @racket[_num]
reduce/reduce conflicts, where @racket[_num] must be a literal number.
The @racket[suppress] option overrides this option.}
]
The result of a @racket[parser] expression with one @racket[start]
@ -696,7 +711,8 @@ library provides a parser generator that is an alternative to that of
@racketmodname[parser-tools/yacc].}
@defform/subs[#:literals (grammar tokens start end precs src-pos
suppress debug yacc-output prec)
suppress expected-SR-conflicts expected-RR-conflicts
debug yacc-output prec)
(cfg-parser clause ...)
([clause (grammar (non-terminal-id
((grammar-id ...) maybe-prec expr)
@ -721,8 +737,9 @@ library provides a parser generator that is an alternative to that of
a single non-terminal-id.}
@item{The @racket[cfg-parser] form does not support the @racket[precs],
@racket[suppress], @racket[debug], or @racket[yacc-output]
options of @racket[parser].}
@racket[suppress], @racket[expected-SR-conflicts],
@racket[expected-RR-conflicts], @racket[debug],
or @racket[yacc-output] options of @racket[parser].}
]
}

@ -8,7 +8,7 @@
(require-for-template mzscheme)
(provide/contract
(build-parser (-> string? any/c any/c
(build-parser (-> string? any/c any/c any/c any/c
(listof identifier?)
(listof identifier?)
(listof identifier?)
@ -74,9 +74,22 @@
(let ((bind void) ... (tmp void) ...)
(void bound ... ... term-group ... start ... end ... prec ...))))))
(require mzlib/list "parser-actions.rkt")
(define (build-parser filename src-pos suppress input-terms start end assocs prods)
(define (build-parser filename
src-pos
suppress
expected-SR-conflicts
expected-RR-conflicts
input-terms
start
end
assocs
prods)
(let* ((grammar (parse-input input-terms start end assocs prods src-pos))
(table (build-table grammar filename suppress))
(table (build-table grammar
filename
suppress
expected-SR-conflicts
expected-RR-conflicts))
(all-tokens (make-hash-table))
(actions-code
`(vector ,@(map prod-action (send grammar get-prods)))))

@ -12,7 +12,7 @@
(define (is-a-grammar%? x) (is-a? x grammar%))
(provide/contract
(build-table (-> is-a-grammar%? string? any/c
(build-table (-> is-a-grammar%? string? any/c any/c any/c
(vectorof (listof (cons/c (or/c term? non-term?) action?))))))
;; A parse-table is (vectorof (listof (cons/c gram-sym? action)))
@ -164,7 +164,10 @@
(else (loop current-guess (cdr rest)))))))))
;; resolve-conflicts : grouped-parse-table bool -> parse-table
(define (resolve-conflicts grouped-table suppress)
(define (resolve-conflicts grouped-table
suppress
expected-SR-conflicts
expected-RR-conflicts)
(let* ((SR-conflicts 0)
(RR-conflicts 0)
(table (table-map
@ -178,14 +181,24 @@
action))
grouped-table)))
(unless suppress
(when (> SR-conflicts 0)
(eprintf "~a shift/reduce conflict~a\n"
(when (if expected-SR-conflicts
(not (= SR-conflicts expected-SR-conflicts))
(> SR-conflicts 0))
(eprintf "~a shift/reduce conflict~a~a\n"
SR-conflicts
(if (= SR-conflicts 1) "" "s")))
(when (> RR-conflicts 0)
(eprintf "~a reduce/reduce conflict~a\n"
(if (= SR-conflicts 1) "" "s")
(if expected-SR-conflicts
(format ", expected ~a" expected-SR-conflicts)
"")))
(when (if expected-RR-conflicts
(not (= RR-conflicts expected-RR-conflicts))
(> RR-conflicts 0))
(eprintf "~a reduce/reduce conflict~a~a\n"
RR-conflicts
(if (= RR-conflicts 1) "" "s"))))
(if (= RR-conflicts 1) "" "s")
(if expected-RR-conflicts
(format ", expected ~a" expected-RR-conflicts)
""))))
table))
@ -227,8 +240,12 @@
(else actions)))
(group-table table)))
;; build-table: grammar string bool -> parse-table
(define (build-table g file suppress)
;; build-table: grammar string bool #f|int #f|int -> parse-table
(define (build-table g
file
suppress
expected-SR-conflicts
expected-RR-conflicts)
(let* ((a (build-lr0-automaton g))
(term-vector (list->vector (send g get-terms)))
(end-terms (send g get-end-terms))
@ -287,4 +304,7 @@
(lambda (port)
(display-parser a grouped-table (send g get-prods) port))
#:exists 'truncate)))
(resolve-conflicts grouped-table suppress))))
(resolve-conflicts grouped-table
suppress
expected-SR-conflicts
expected-RR-conflicts))))

@ -42,12 +42,16 @@
(end #f)
(precs #f)
(suppress #f)
(expected-SR-conflicts #f)
(expected-RR-conflicts #f)
(grammar #f)
(yacc-output #f))
(for-each
(lambda (arg)
(syntax-case* arg (debug error tokens start end precs grammar
suppress src-pos yacc-output)
suppress src-pos yacc-output
expected-SR-conflicts
expected-RR-conflicts)
(lambda (a b)
(eq? (syntax-e a) (syntax-e b)))
((debug filename)
@ -64,6 +68,10 @@
(set! debug (syntax-e (syntax filename))))))
((suppress)
(set! suppress #t))
((expected-SR-conflicts n)
(set! expected-SR-conflicts (syntax-e (syntax n))))
((expected-RR-conflicts n)
(set! expected-RR-conflicts (syntax-e (syntax n))))
((src-pos)
(set! src-pos #t))
((error expression)
@ -164,6 +172,8 @@
(build-parser (if debug debug "")
src-pos
suppress
expected-SR-conflicts
expected-RR-conflicts
tokens
start
end

Loading…
Cancel
Save