Get rid of the `grammar%` class

Also, get rid of some dead code.
remotes/jackfirth/master
Jack Firth 3 years ago
parent 19320eb0e2
commit b97a41c8ef

@ -2,8 +2,7 @@
;; Constructs to create and access grammars, the internal ;; Constructs to create and access grammars, the internal
;; representation of the input to the parser generator. ;; representation of the input to the parser generator.
(require racket/class (require yaragg/parser-tools/private-yacc/yacc-helper
yaragg/parser-tools/private-yacc/yacc-helper
racket/contract) racket/contract)
(provide (provide
@ -19,7 +18,18 @@
;; Things that work on precs ;; Things that work on precs
prec-num prec-assoc prec-num prec-assoc
grammar% grammar?
make-grammar
grammar-num-terms
grammar-num-non-terms
grammar-prods-for-non-term
grammar-all-prods
grammar-init-prods
grammar-terms
grammar-non-terms
grammar-num-prods
grammar-end-terms
grammar-nullable-non-term?
;; Things that work on productions ;; Things that work on productions
prod-index prod-prec prod-rhs prod-lhs prod-action prod-index prod-prec prod-rhs prod-lhs prod-action
@ -204,64 +214,6 @@
(define (grammar-nullable-non-term? g nt) (define (grammar-nullable-non-term? g nt)
(vector-ref (grammar-nullable-non-terms g) (non-term-index nt))) (vector-ref (grammar-nullable-non-terms g) (non-term-index nt)))
(define (grammar-nullable-after-dot? g item)
(define rhs (prod-rhs (item-prod item)))
(define prod-length (vector-length rhs))
(let loop ((i (item-dot-pos item)))
(cond
[(< i prod-length)
(and (non-term? (vector-ref rhs i))
(grammar-nullable-non-term? g (vector-ref rhs i))
(loop (add1 i)))]
[(= i prod-length)])))
(define ((grammar-nullable-non-term-thunk g) nt)
(grammar-nullable-non-term? g nt))
(define ((grammar-nullable-after-dot?-thunk g) item)
(grammar-nullable-after-dot? g item))
(define grammar%
(class object%
(super-instantiate ())
(init prods init-prods terms non-terms end-terms)
(define backing-struct
(make-grammar
#:prods prods
#:init-prods init-prods
#:terms terms
#:non-terms non-terms
#:end-terms end-terms))
(define/public (get-num-terms) (grammar-num-terms backing-struct))
(define/public (get-num-non-terms) (grammar-num-non-terms backing-struct))
(define/public (get-prods-for-non-term nt) (grammar-prods-for-non-term backing-struct nt))
(define/public (get-prods) (grammar-all-prods backing-struct))
(define/public (get-init-prods) (grammar-init-prods backing-struct))
(define/public (get-terms) (grammar-terms backing-struct))
(define/public (get-non-terms) (grammar-non-terms backing-struct))
(define/public (get-num-prods) (grammar-num-prods backing-struct))
(define/public (get-end-terms) (grammar-end-terms backing-struct))
(define/public (nullable-non-term? nt)
(grammar-nullable-non-term? backing-struct nt))
(define/public (nullable-after-dot? item)
(grammar-nullable-after-dot? backing-struct item))
(define/public (nullable-non-term-thunk)
(grammar-nullable-non-term-thunk backing-struct))
(define/public (nullable-after-dot?-thunk)
(grammar-nullable-after-dot?-thunk backing-struct))))
;; nullable: production list * int -> non-term set ;; nullable: production list * int -> non-term set
;; determines which non-terminals can derive epsilon ;; determines which non-terminals can derive epsilon

@ -2,17 +2,15 @@
(require yaragg/parser-tools/private-yacc/yacc-helper (require yaragg/parser-tools/private-yacc/yacc-helper
yaragg/parser-tools/private-lex/token-syntax yaragg/parser-tools/private-lex/token-syntax
yaragg/parser-tools/private-yacc/grammar yaragg/parser-tools/private-yacc/grammar
racket/class
racket/contract racket/contract
(for-template racket/base)) (for-template racket/base))
;; routines for parsing the input to the parser generator and producing a ;; routines for parsing the input to the parser generator and producing a
;; grammar (See grammar.rkt) ;; grammar (See grammar.rkt)
(define (is-a-grammar%? x) (is-a? x grammar%))
(provide/contract (provide/contract
[parse-input ((listof identifier?) (listof identifier?) (listof identifier?) [parse-input ((listof identifier?) (listof identifier?) (listof identifier?)
(or/c #f syntax?) syntax? any/c . -> . is-a-grammar%?)] (or/c #f syntax?) syntax? any/c . -> . grammar?)]
[get-term-list ((listof identifier?) . -> . (listof identifier?))]) [get-term-list ((listof identifier?) . -> . (listof identifier?))])
(define stx-for-original-property (read-syntax #f (open-input-string "original"))) (define stx-for-original-property (read-syntax #f (open-input-string "original")))
@ -287,10 +285,10 @@
#f #f
#'values))) #'values)))
parsed-prods)) parsed-prods))
(make-object grammar% (make-grammar
new-prods #:prods new-prods
(map car start-prods) #:init-prods (map car start-prods)
terms #:terms terms
(append starts (append end-non-terms non-terms)) #:non-terms (append starts (append end-non-terms non-terms))
(map (λ (term-name) (hash-ref term-table term-name)) end-terms))) #:end-terms (map (λ (term-name) (hash-ref term-table term-name)) end-terms)))

@ -14,12 +14,12 @@
(define ((compute-DR a g) tk) (define ((compute-DR a g) tk)
(define r (send a run-automaton (trans-key-st tk) (trans-key-gs tk))) (define r (send a run-automaton (trans-key-st tk) (trans-key-gs tk)))
(term-list->bit-vector (term-list->bit-vector
(filter (λ (term) (send a run-automaton r term)) (send g get-terms)))) (filter (λ (term) (send a run-automaton r term)) (grammar-terms g))))
;; compute-reads: ;; compute-reads:
;; LR0-automaton * grammar -> (trans-key -> trans-key list) ;; LR0-automaton * grammar -> (trans-key -> trans-key list)
(define (compute-reads a g) (define (compute-reads a g)
(define nullable-non-terms (filter (λ (nt) (send g nullable-non-term? nt)) (send g get-non-terms))) (define nullable-non-terms (filter (λ (nt) (grammar-nullable-non-term? g nt)) (grammar-non-terms g)))
(λ (tk) (λ (tk)
(define r (send a run-automaton (trans-key-st tk) (trans-key-gs tk))) (define r (send a run-automaton (trans-key-st tk) (trans-key-gs tk)))
(for/list ([non-term (in-list nullable-non-terms)] (for/list ([non-term (in-list nullable-non-terms)]
@ -58,7 +58,7 @@
(cond (cond
[(and (> i 0) [(and (> i 0)
(non-term? (vector-ref rhs i)) (non-term? (vector-ref rhs i))
(send g nullable-non-term? (vector-ref rhs i))) (grammar-nullable-non-term? g (vector-ref rhs i)))
(if (eq? nt (vector-ref rhs (sub1 i))) (if (eq? nt (vector-ref rhs (sub1 i)))
(cons (item prod (sub1 i)) (cons (item prod (sub1 i))
(loop (sub1 i))) (loop (sub1 i)))
@ -74,10 +74,10 @@
;; comput-includes: lr0-automaton * grammar -> (trans-key -> trans-key list) ;; comput-includes: lr0-automaton * grammar -> (trans-key -> trans-key list)
(define (compute-includes a g) (define (compute-includes a g)
(define num-states (send a get-num-states)) (define num-states (send a get-num-states))
(define items-for-input-nt (make-vector (send g get-num-non-terms) null)) (define items-for-input-nt (make-vector (grammar-num-non-terms g) null))
(for ([input-nt (in-list (send g get-non-terms))]) (for ([input-nt (in-list (grammar-non-terms g))])
(vector-set! items-for-input-nt (non-term-index input-nt) (vector-set! items-for-input-nt (non-term-index input-nt)
(prod-list->items-for-include g (send g get-prods) input-nt))) (prod-list->items-for-include g (grammar-all-prods g) input-nt)))
(λ (tk) (λ (tk)
(define goal-state (trans-key-st tk)) (define goal-state (trans-key-st tk))
(define non-term (trans-key-gs tk)) (define non-term (trans-key-gs tk))
@ -140,7 +140,7 @@
(printf "~a:\n" name) (printf "~a:\n" name)
(send a for-each-state (send a for-each-state
(λ (state) (λ (state)
(for ([non-term (in-list (send g get-non-terms))]) (for ([non-term (in-list (grammar-non-terms g))])
(define res (f (trans-key state non-term))) (define res (f (trans-key state non-term)))
(when (not (null? res)) (when (not (null? res))
(printf "~a(~a, ~a) = ~a\n" (printf "~a(~a, ~a) = ~a\n"
@ -154,8 +154,8 @@
(printf "~a:\n" name) (printf "~a:\n" name)
(send a for-each-state (send a for-each-state
(λ (state) (λ (state)
(for ([non-term (in-list (send g get-non-terms))]) (for ([non-term (in-list (grammar-non-terms g))])
(for ([prod (in-list (send g get-prods-for-non-term non-term))]) (for ([prod (in-list (grammar-prods-for-non-term g non-term))])
(define res (f state prod)) (define res (f state prod))
(when (not (null? res)) (when (not (null? res))
(printf "~a(~a, ~a) = ~a\n" (printf "~a(~a, ~a) = ~a\n"

@ -155,8 +155,8 @@
(define (build-lr0-automaton grammar) (define (build-lr0-automaton grammar)
; (printf "LR(0) automaton:\n") ; (printf "LR(0) automaton:\n")
(define epsilons (make-hash)) (define epsilons (make-hash))
(define grammar-symbols (append (send grammar get-non-terms) (define grammar-symbols (append (grammar-non-terms grammar)
(send grammar get-terms))) (grammar-terms grammar)))
;; first-non-term: non-term -> non-term list ;; first-non-term: non-term -> non-term list
;; given a non-terminal symbol C, return those non-terminal ;; given a non-terminal symbol C, return those non-terminal
;; symbols A s.t. C -> An for some string of terminals and ;; symbols A s.t. C -> An for some string of terminals and
@ -164,11 +164,11 @@
;; steps. Assumes that each non-term can be reduced to a string ;; steps. Assumes that each non-term can be reduced to a string
;; of terms. ;; of terms.
(define first-non-term (define first-non-term
(digraph (send grammar get-non-terms) (digraph (grammar-non-terms grammar)
(λ (nt) (λ (nt)
(filter non-term? (filter non-term?
(map (λ (prod) (sym-at-dot (item prod 0))) (map (λ (prod) (sym-at-dot (item prod 0)))
(send grammar get-prods-for-non-term nt)))) (grammar-prods-for-non-term grammar nt))))
(λ (nt) (list nt)) (λ (nt) (list nt))
(union non-term<?) (union non-term<?)
(λ () null))) (λ () null)))
@ -186,9 +186,7 @@
(cons (car i) (cons (car i)
(append (append
(for*/list ([non-term (in-list (first-non-term next-gsym))] (for*/list ([non-term (in-list (first-non-term next-gsym))]
[x (in-list (send grammar [x (in-list (grammar-prods-for-non-term grammar non-term))])
get-prods-for-non-term
non-term))])
(item x 0)) (item x 0))
(LR0-closure (cdr i))))] (LR0-closure (cdr i))))]
[else (cons (car i) (LR0-closure (cdr i)))])])) [else (cons (car i) (LR0-closure (cdr i)))])]))
@ -272,7 +270,7 @@
(and new unique-kernel)))) (and new unique-kernel))))
(define starts (map (λ (init-prod) (list (item init-prod 0))) (define starts (map (λ (init-prod) (list (item init-prod 0)))
(send grammar get-init-prods))) (grammar-init-prods grammar)))
(define startk (for/list ([start (in-list starts)]) (define startk (for/list ([start (in-list starts)])
(define k (kernel start counter)) (define k (kernel start counter))
(hash-set! kernels start k) (hash-set! kernels start k)

@ -2,7 +2,6 @@
(require yaragg/parser-tools/private-yacc/input-file-parser (require yaragg/parser-tools/private-yacc/input-file-parser
yaragg/parser-tools/private-yacc/grammar yaragg/parser-tools/private-yacc/grammar
yaragg/parser-tools/private-yacc/table yaragg/parser-tools/private-yacc/table
racket/class
racket/contract) racket/contract)
(require (for-template racket/base)) (require (for-template racket/base))
@ -68,14 +67,14 @@
(define grammar (parse-input input-terms start end assocs prods src-pos)) (define grammar (parse-input input-terms start end assocs prods src-pos))
(define table (build-table grammar filename suppress)) (define table (build-table grammar filename suppress))
(define all-tokens (make-hasheq)) (define all-tokens (make-hasheq))
(define actions-code `(vector ,@(map prod-action (send grammar get-prods)))) (define actions-code `(vector ,@(map prod-action (grammar-all-prods grammar))))
(for ([term (in-list (send grammar get-terms))]) (for ([term (in-list (grammar-terms grammar))])
(hash-set! all-tokens (gram-sym-symbol term) #t)) (hash-set! all-tokens (gram-sym-symbol term) #t))
#;(let ((num-states (vector-length table)) #;(let ((num-states (vector-length table))
(num-gram-syms (+ (send grammar get-num-terms) (num-gram-syms (+ (grammar-num-terms grammar)
(send grammar get-num-non-terms))) (grammar-num-non-terms grammar)))
(num-ht-entries (apply + (map length (vector->list table)))) (num-ht-entries (apply + (map length (vector->list table))))
(num-reduces (num-reduces
(let ((ht (make-hasheq))) (let ((ht (make-hasheq)))

@ -9,9 +9,8 @@
;; Routine to build the LALR table ;; Routine to build the LALR table
(define (is-a-grammar%? x) (is-a? x grammar%))
(provide/contract (provide/contract
(build-table (-> is-a-grammar%? string? any/c (build-table (-> grammar? string? any/c
(vectorof (listof (cons/c (or/c term? non-term?) action?)))))) (vectorof (listof (cons/c (or/c term? non-term?) action?))))))
;; A parse-table is (vectorof (listof (cons/c gram-sym? action))) ;; A parse-table is (vectorof (listof (cons/c gram-sym? action)))
@ -208,8 +207,8 @@
;; build-table: grammar string bool -> parse-table ;; build-table: grammar string bool -> parse-table
(define (build-table g file suppress) (define (build-table g file suppress)
(define a (build-lr0-automaton g)) (define a (build-lr0-automaton g))
(define term-vector (list->vector (send g get-terms))) (define term-vector (list->vector (grammar-terms g)))
(define end-terms (send g get-end-terms)) (define end-terms (grammar-end-terms g))
(define table (make-parse-table (send a get-num-states))) (define table (make-parse-table (send a get-num-states)))
(define get-lookahead (compute-LA a g)) (define get-lookahead (compute-LA a g))
(define reduce-cache (make-hash)) (define reduce-cache (make-hash))
@ -254,6 +253,6 @@
(exn-message e))))] (exn-message e))))]
(call-with-output-file file (call-with-output-file file
(λ (port) (λ (port)
(display-parser a grouped-table (send g get-prods) port)) (display-parser a grouped-table (grammar-all-prods g) port))
#:exists 'truncate))) #:exists 'truncate)))
(resolve-conflicts grouped-table suppress)) (resolve-conflicts grouped-table suppress))

Loading…
Cancel
Save