diff --git a/parser-tools/private-yacc/grammar.rkt b/parser-tools/private-yacc/grammar.rkt index d52d642..b97abd9 100644 --- a/parser-tools/private-yacc/grammar.rkt +++ b/parser-tools/private-yacc/grammar.rkt @@ -2,8 +2,7 @@ ;; Constructs to create and access grammars, the internal ;; representation of the input to the parser generator. -(require racket/class - yaragg/parser-tools/private-yacc/yacc-helper +(require yaragg/parser-tools/private-yacc/yacc-helper racket/contract) (provide @@ -19,7 +18,18 @@ ;; Things that work on precs 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 prod-index prod-prec prod-rhs prod-lhs prod-action @@ -204,64 +214,6 @@ (define (grammar-nullable-non-term? g 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 ;; determines which non-terminals can derive epsilon diff --git a/parser-tools/private-yacc/input-file-parser.rkt b/parser-tools/private-yacc/input-file-parser.rkt index e9895a6..0c1c35d 100644 --- a/parser-tools/private-yacc/input-file-parser.rkt +++ b/parser-tools/private-yacc/input-file-parser.rkt @@ -2,17 +2,15 @@ (require yaragg/parser-tools/private-yacc/yacc-helper yaragg/parser-tools/private-lex/token-syntax yaragg/parser-tools/private-yacc/grammar - racket/class racket/contract (for-template racket/base)) ;; routines for parsing the input to the parser generator and producing a ;; grammar (See grammar.rkt) -(define (is-a-grammar%? x) (is-a? x grammar%)) (provide/contract [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?))]) (define stx-for-original-property (read-syntax #f (open-input-string "original"))) @@ -287,10 +285,10 @@ #f #'values))) parsed-prods)) - - (make-object grammar% - new-prods - (map car start-prods) - terms - (append starts (append end-non-terms non-terms)) - (map (λ (term-name) (hash-ref term-table term-name)) end-terms))) + + (make-grammar + #:prods new-prods + #:init-prods (map car start-prods) + #:terms terms + #:non-terms (append starts (append end-non-terms non-terms)) + #:end-terms (map (λ (term-name) (hash-ref term-table term-name)) end-terms))) diff --git a/parser-tools/private-yacc/lalr.rkt b/parser-tools/private-yacc/lalr.rkt index b65ea5e..f2cf51b 100644 --- a/parser-tools/private-yacc/lalr.rkt +++ b/parser-tools/private-yacc/lalr.rkt @@ -14,12 +14,12 @@ (define ((compute-DR a g) tk) (define r (send a run-automaton (trans-key-st tk) (trans-key-gs tk))) (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: ;; LR0-automaton * grammar -> (trans-key -> trans-key list) (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) (define r (send a run-automaton (trans-key-st tk) (trans-key-gs tk))) (for/list ([non-term (in-list nullable-non-terms)] @@ -58,7 +58,7 @@ (cond [(and (> i 0) (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))) (cons (item prod (sub1 i)) (loop (sub1 i))) @@ -74,10 +74,10 @@ ;; comput-includes: lr0-automaton * grammar -> (trans-key -> trans-key list) (define (compute-includes a g) (define num-states (send a get-num-states)) - (define items-for-input-nt (make-vector (send g get-num-non-terms) null)) - (for ([input-nt (in-list (send g get-non-terms))]) + (define items-for-input-nt (make-vector (grammar-num-non-terms g) null)) + (for ([input-nt (in-list (grammar-non-terms g))]) (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) (define goal-state (trans-key-st tk)) (define non-term (trans-key-gs tk)) @@ -140,7 +140,7 @@ (printf "~a:\n" name) (send a for-each-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))) (when (not (null? res)) (printf "~a(~a, ~a) = ~a\n" @@ -154,8 +154,8 @@ (printf "~a:\n" name) (send a for-each-state (λ (state) - (for ([non-term (in-list (send g get-non-terms))]) - (for ([prod (in-list (send g get-prods-for-non-term non-term))]) + (for ([non-term (in-list (grammar-non-terms g))]) + (for ([prod (in-list (grammar-prods-for-non-term g non-term))]) (define res (f state prod)) (when (not (null? res)) (printf "~a(~a, ~a) = ~a\n" diff --git a/parser-tools/private-yacc/lr0.rkt b/parser-tools/private-yacc/lr0.rkt index 325878a..63a4f5a 100644 --- a/parser-tools/private-yacc/lr0.rkt +++ b/parser-tools/private-yacc/lr0.rkt @@ -155,8 +155,8 @@ (define (build-lr0-automaton grammar) ; (printf "LR(0) automaton:\n") (define epsilons (make-hash)) - (define grammar-symbols (append (send grammar get-non-terms) - (send grammar get-terms))) + (define grammar-symbols (append (grammar-non-terms grammar) + (grammar-terms grammar))) ;; first-non-term: non-term -> non-term list ;; given a non-terminal symbol C, return those non-terminal ;; 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 ;; of terms. (define first-non-term - (digraph (send grammar get-non-terms) + (digraph (grammar-non-terms grammar) (λ (nt) (filter non-term? (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)) (union non-termlist table)))) (num-reduces (let ((ht (make-hasheq))) diff --git a/parser-tools/private-yacc/table.rkt b/parser-tools/private-yacc/table.rkt index beb7825..9af4d23 100644 --- a/parser-tools/private-yacc/table.rkt +++ b/parser-tools/private-yacc/table.rkt @@ -9,9 +9,8 @@ ;; Routine to build the LALR table -(define (is-a-grammar%? x) (is-a? x grammar%)) (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?)))))) ;; A parse-table is (vectorof (listof (cons/c gram-sym? action))) @@ -208,8 +207,8 @@ ;; build-table: grammar string bool -> parse-table (define (build-table g file suppress) (define a (build-lr0-automaton g)) - (define term-vector (list->vector (send g get-terms))) - (define end-terms (send g get-end-terms)) + (define term-vector (list->vector (grammar-terms g))) + (define end-terms (grammar-end-terms g)) (define table (make-parse-table (send a get-num-states))) (define get-lookahead (compute-LA a g)) (define reduce-cache (make-hash)) @@ -254,6 +253,6 @@ (exn-message e))))] (call-with-output-file file (λ (port) - (display-parser a grouped-table (send g get-prods) port)) + (display-parser a grouped-table (grammar-all-prods g) port)) #:exists 'truncate))) (resolve-conflicts grouped-table suppress))