From c9fd206a1c5adc5006d5c60b3b614901f5511729 Mon Sep 17 00:00:00 2001 From: Ben Noordhuis Date: Sat, 15 Apr 2017 19:27:50 +0200 Subject: [PATCH] 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 --- .../parser-tools/parser-tools.scrbl | 25 +++++++++-- .../private-yacc/parser-builder.rkt | 19 +++++++-- .../parser-tools/private-yacc/table.rkt | 42 ++++++++++++++----- parser-tools-lib/parser-tools/yacc.rkt | 12 +++++- 4 files changed, 79 insertions(+), 19 deletions(-) diff --git a/parser-tools-doc/parser-tools/parser-tools.scrbl b/parser-tools-doc/parser-tools/parser-tools.scrbl index b8657cf..bb019f0 100644 --- a/parser-tools-doc/parser-tools/parser-tools.scrbl +++ b/parser-tools-doc/parser-tools/parser-tools.scrbl @@ -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].} ] } diff --git a/parser-tools-lib/parser-tools/private-yacc/parser-builder.rkt b/parser-tools-lib/parser-tools/private-yacc/parser-builder.rkt index 1be421c..3895483 100644 --- a/parser-tools-lib/parser-tools/private-yacc/parser-builder.rkt +++ b/parser-tools-lib/parser-tools/private-yacc/parser-builder.rkt @@ -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))))) diff --git a/parser-tools-lib/parser-tools/private-yacc/table.rkt b/parser-tools-lib/parser-tools/private-yacc/table.rkt index f97e4d2..7221ee9 100644 --- a/parser-tools-lib/parser-tools/private-yacc/table.rkt +++ b/parser-tools-lib/parser-tools/private-yacc/table.rkt @@ -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)))) diff --git a/parser-tools-lib/parser-tools/yacc.rkt b/parser-tools-lib/parser-tools/yacc.rkt index 6584fd3..1d4eae2 100644 --- a/parser-tools-lib/parser-tools/yacc.rkt +++ b/parser-tools-lib/parser-tools/yacc.rkt @@ -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