From 9c78ffcc052ae78ef5a99ef76d7ab8da8b1a69eb Mon Sep 17 00:00:00 2001 From: Jack Firth Date: Mon, 28 Mar 2022 17:41:23 -0700 Subject: [PATCH] Use `struct` instead of `define-struct` --- parser-tools/cfg-parser.rkt | 132 +++++++++--------- parser-tools/lex.rkt | 10 +- parser-tools/private-lex/deriv.rkt | 26 ++-- parser-tools/private-lex/front.rkt | 6 +- parser-tools/private-lex/re.rkt | 50 +++---- parser-tools/private-lex/token-syntax.rkt | 8 +- parser-tools/private-lex/token.rkt | 18 +-- parser-tools/private-lex/util.rkt | 4 +- parser-tools/private-yacc/grammar.rkt | 24 ++-- .../private-yacc/input-file-parser.rkt | 19 ++- parser-tools/private-yacc/lalr.rkt | 12 +- parser-tools/private-yacc/lr0.rkt | 36 ++--- parser-tools/private-yacc/parser-actions.rkt | 34 ++--- parser-tools/private-yacc/table.rkt | 10 +- parser-tools/yacc.rkt | 14 +- rules/lexer.rkt | 6 +- yaragg-parser-tools.scrbl | 6 +- 17 files changed, 207 insertions(+), 208 deletions(-) diff --git a/parser-tools/cfg-parser.rkt b/parser-tools/cfg-parser.rkt index 2fa37cc..f1087d8 100755 --- a/parser-tools/cfg-parser.rkt +++ b/parser-tools/cfg-parser.rkt @@ -41,10 +41,10 @@ (provide cfg-parser) ;; A raw token, wrapped so that we can recognize it: -(define-struct tok (name orig-name val start end)) +(struct tok (name orig-name val start end)) ;; Represents the thread scheduler: -(define-struct tasks (active active-back waits multi-waits cache progress?)) +(struct tasks (active active-back waits multi-waits cache progress?)) (define-for-syntax make-token-identifier-mapping make-hasheq) (define-for-syntax (token-identifier-mapping-get t tok [fail #f]) @@ -187,50 +187,50 @@ max-depth tasks)) ;; Starts a thread -(define (queue-task tasks t [progress? #t]) - (make-tasks (tasks-active tasks) - (cons t (tasks-active-back tasks)) - (tasks-waits tasks) - (tasks-multi-waits tasks) - (tasks-cache tasks) - (or progress? (tasks-progress? tasks)))) +(define (queue-task ts t [progress? #t]) + (tasks (tasks-active ts) + (cons t (tasks-active-back ts)) + (tasks-waits ts) + (tasks-multi-waits ts) + (tasks-cache ts) + (or progress? (tasks-progress? ts)))) ;; Reports an answer to a waiting thread: -(define (report-answer answer-key max-depth tasks val) - (define v (hash-ref (tasks-waits tasks) answer-key (λ () #f))) +(define (report-answer answer-key max-depth ts val) + (define v (hash-ref (tasks-waits ts) answer-key (λ () #f))) (if v - (let ([tasks (make-tasks (cons (v val) (tasks-active tasks)) - (tasks-active-back tasks) - (tasks-waits tasks) - (tasks-multi-waits tasks) - (tasks-cache tasks) + (let ([ts (tasks (cons (v val) (tasks-active ts)) + (tasks-active-back ts) + (tasks-waits ts) + (tasks-multi-waits ts) + (tasks-cache ts) #t)]) - (hash-remove! (tasks-waits tasks) answer-key) - (swap-task max-depth tasks)) + (hash-remove! (tasks-waits ts) answer-key) + (swap-task max-depth ts)) ;; We have an answer ready too fast; wait (swap-task max-depth - (queue-task tasks + (queue-task ts (λ (max-depth tasks) (report-answer answer-key max-depth tasks val)) #f)))) ;; Reports an answer to multiple waiting threads: -(define (report-answer-all answer-key max-depth tasks val k) - (define v (hash-ref (tasks-multi-waits tasks) answer-key (λ () null))) - (hash-remove! (tasks-multi-waits tasks) answer-key) - (let ([tasks (make-tasks (append (map (λ (a) (a val)) v) - (tasks-active tasks)) - (tasks-active-back tasks) - (tasks-waits tasks) - (tasks-multi-waits tasks) - (tasks-cache tasks) +(define (report-answer-all answer-key max-depth ts val k) + (define v (hash-ref (tasks-multi-waits ts) answer-key (λ () null))) + (hash-remove! (tasks-multi-waits ts) answer-key) + (let ([ts (tasks (append (map (λ (a) (a val)) v) + (tasks-active ts)) + (tasks-active-back ts) + (tasks-waits ts) + (tasks-multi-waits ts) + (tasks-cache ts) #t)]) - (k max-depth tasks))) + (k max-depth ts))) ;; Waits for an answer; if `multi?' is #f, this is sole waiter, otherwise ;; there might be many. Use wither #t or #f (and `report-answer' or ;; `report-answer-all', resptively) consistently for a particular answer key. -(define (wait-for-answer multi? max-depth tasks answer-key success-k fail-k deadlock-k) +(define (wait-for-answer multi? max-depth ts answer-key success-k fail-k deadlock-k) (let ([wait (λ (val) (λ (max-depth tasks) (if val @@ -240,58 +240,58 @@ (success-k val stream last-consumed-token depth max-depth tasks next-k))) (deadlock-k max-depth tasks))))]) (if multi? - (hash-set! (tasks-multi-waits tasks) answer-key - (cons wait (hash-ref (tasks-multi-waits tasks) answer-key + (hash-set! (tasks-multi-waits ts) answer-key + (cons wait (hash-ref (tasks-multi-waits ts) answer-key (λ () null)))) - (hash-set! (tasks-waits tasks) answer-key wait)) - (let ([tasks (make-tasks (tasks-active tasks) - (tasks-active-back tasks) - (tasks-waits tasks) - (tasks-multi-waits tasks) - (tasks-cache tasks) + (hash-set! (tasks-waits ts) answer-key wait)) + (let ([ts (tasks (tasks-active ts) + (tasks-active-back ts) + (tasks-waits ts) + (tasks-multi-waits ts) + (tasks-cache ts) #t)]) - (swap-task max-depth tasks)))) + (swap-task max-depth ts)))) ;; Swap thread -(define (swap-task max-depth tasks) +(define (swap-task max-depth ts) ;; Swap in first active: - (if (null? (tasks-active tasks)) - (if (tasks-progress? tasks) + (if (null? (tasks-active ts)) + (if (tasks-progress? ts) (swap-task max-depth - (make-tasks (reverse (tasks-active-back tasks)) + (tasks (reverse (tasks-active-back ts)) null - (tasks-waits tasks) - (tasks-multi-waits tasks) - (tasks-cache tasks) + (tasks-waits ts) + (tasks-multi-waits ts) + (tasks-cache ts) #f)) ;; No progress, so issue failure for all multi-waits - (if (zero? (hash-count (tasks-multi-waits tasks))) + (if (zero? (hash-count (tasks-multi-waits ts))) (error 'swap-task "Deadlock") (swap-task max-depth - (make-tasks (apply + (tasks (apply append - (hash-map (tasks-multi-waits tasks) + (hash-map (tasks-multi-waits ts) (λ (k l) (map (λ (v) (v #f)) l)))) - (tasks-active-back tasks) - (tasks-waits tasks) + (tasks-active-back ts) + (tasks-waits ts) (make-hasheq) - (tasks-cache tasks) + (tasks-cache ts) #t)))) - (let ([t (car (tasks-active tasks))] - [tasks (make-tasks (cdr (tasks-active tasks)) - (tasks-active-back tasks) - (tasks-waits tasks) - (tasks-multi-waits tasks) - (tasks-cache tasks) - (tasks-progress? tasks))]) - (t max-depth tasks)))) + (let ([t (car (tasks-active ts))] + [ts (tasks (cdr (tasks-active ts)) + (tasks-active-back ts) + (tasks-waits ts) + (tasks-multi-waits ts) + (tasks-cache ts) + (tasks-progress? ts))]) + (t max-depth ts)))) ;; Finds the symbolic representative of a token class (define-for-syntax (map-token toks tok) (car (token-identifier-mapping-get toks tok))) -(define no-pos-val (make-position #f #f #f)) +(define no-pos-val (position #f #f #f)) (define-for-syntax no-pos (let ([npv ((syntax-local-certifier) #'no-pos-val)]) (λ (stx) npv))) @@ -642,7 +642,7 @@ cfg-error src-pos? (list* - (with-syntax ([((tok tok-id . $e) ...) + (with-syntax ([((tk tok-id . $e) ...) (token-identifier-mapping-map toks (λ (k v) (list* k @@ -661,7 +661,7 @@ [%atok atok-id-temp]) #`(grammar (%start [() null] [(%atok %start) (cons $1 $2)]) - (%atok [(tok) (make-tok 'tok-id 'tok $e pos ...)] ...))) + (%atok [(tk) (tok 'tok-id 'tk $e pos ...)] ...))) (with-syntax ([%start start-id-temp]) #`(start %start)) parser-clauses)))] @@ -705,8 +705,8 @@ (error-proc #t 'no-tokens #f - (make-position #f #f #f) - (make-position #f #f #f)) + (position #f #f #f) + (position #f #f #f)) (error 'cfg-parse "no tokens"))] @@ -745,7 +745,7 @@ success-k fail-k 0 - (make-tasks null null + (tasks null null (make-hasheq) (make-hasheq) (make-hash) #t)))))))))])) diff --git a/parser-tools/lex.rkt b/parser-tools/lex.rkt index e4602d0..5bf0736 100644 --- a/parser-tools/lex.rkt +++ b/parser-tools/lex.rkt @@ -44,12 +44,12 @@ #`(let/ec ret (syntax-parameterize ([return-without-pos (make-rename-transformer #'ret)]) - (make-position-token #,action start-pos end-pos)))] + (position-token #,action start-pos end-pos)))] [(eq? src-loc-style 'lexer-srcloc) #`(let/ec ret (syntax-parameterize ([return-without-srcloc (make-rename-transformer #'ret)]) - (make-srcloc-token #,action lexeme-srcloc)))] + (srcloc-token #,action lexeme-srcloc)))] [else action])]) (syntax/loc action (λ (start-pos-p end-pos-p lexeme-p input-port-p) @@ -151,7 +151,7 @@ [(_ NAME RE) (identifier? #'NAME) (syntax/loc stx (define-syntax NAME - (make-lex-abbrev (λ () (quote-syntax RE)))))] + (lex-abbrev (λ () (quote-syntax RE)))))] [_ (raise-syntax-error 'define-lex-abbrev "form should be (define-lex-abbrev name re)" stx)])) (define-syntax (define-lex-abbrevs stx) @@ -183,7 +183,7 @@ (raise-syntax-error 'define-lex-trans "expected a procedure as the transformer, got ~e" func)) (unless (procedure-arity-includes? func 1) (raise-syntax-error 'define-lex-trans "expected a procedure that accepts 1 argument as the transformer, got ~e" func)) - (make-lex-trans func))))] + (lex-trans func))))] [_ (raise-syntax-error #f @@ -305,7 +305,7 @@ (define (get-position ip) (define-values (line col off) (port-next-location ip)) - (make-position off line col)) + (position off line col)) (define-syntax (create-unicode-abbrevs stx) (syntax-case stx () diff --git a/parser-tools/private-lex/deriv.rkt b/parser-tools/private-lex/deriv.rkt index 9b55eec..69fb846 100644 --- a/parser-tools/private-lex/deriv.rkt +++ b/parser-tools/private-lex/deriv.rkt @@ -179,8 +179,8 @@ ((get-final b) 4)) -;; A state is (make-state (list-of re-action) nat) -(define-struct state (spec index)) +;; A state is (state (list-of re-action) nat) +(struct state (spec index)) ;; get->key : re-action -> (list-of nat) ;; states are indexed by the list of indexes of their res @@ -205,20 +205,20 @@ (r1 (->re `(char-range #\1 #\4) c)) (r2 (->re `(char-range #\2 #\3) c))) ((compute-chars null) null) - ((compute-chars (list (make-state null 1))) null) + ((compute-chars (list (state null 1))) null) ((map is:integer-set-contents - (compute-chars (list (make-state (list (cons r1 1) (cons r2 2)) 2)))) + (compute-chars (list (state (list (cons r1 1) (cons r2 2)) 2)))) (list (is:integer-set-contents (is:make-range (c->i #\2) (c->i #\3))) (is:integer-set-contents (is:union (is:make-range (c->i #\1)) (is:make-range (c->i #\4))))))) -;; A dfa is (make-dfa int int +;; A dfa is (dfa int int ;; (list-of (cons int syntax-object)) ;; (list-of (cons int (list-of (cons char-set int))))) ;; Each transitions is a state and a list of chars with the state to transition to. ;; The finals and transitions are sorted by state number, and duplicate free. -(define-struct dfa (num-states start-state final-states/actions transitions) #:inspector (make-inspector)) +(struct dfa (num-states start-state final-states/actions transitions) #:inspector (make-inspector)) (define loc:get-integer is:get-integer) @@ -226,7 +226,7 @@ (define (build-dfa rs cache) (let* ([transitions (make-hash)] [get-state-number (make-counter)] - [start (make-state rs (get-state-number))]) + [start (state rs (get-state-number))]) (cache (cons 'state (get-key rs)) (λ () start)) (let loop ([old-states (list start)] [new-states null] @@ -234,7 +234,7 @@ [cs (compute-chars (list start))]) (cond [(and (null? old-states) (null? new-states)) - (make-dfa (get-state-number) (state-index start) + (dfa (get-state-number) (state-index start) (sort (for*/list ([state (in-list all-states)] [val (in-value (cons (state-index state) (get-final (state-spec state))))] #:when (cdr val)) @@ -252,21 +252,21 @@ [(null? cs) (loop (cdr old-states) new-states all-states (compute-chars (cdr old-states)))] [else - (define state (car old-states)) + (define s (car old-states)) (define c (car cs)) - (define new-re (derive (state-spec state) (loc:get-integer c) cache)) + (define new-re (derive (state-spec s) (loc:get-integer c) cache)) (cond [new-re (let* ([new-state? #f] [new-state (cache (cons 'state (get-key new-re)) (λ () (set! new-state? #t) - (make-state new-re (get-state-number))))] + (state new-re (get-state-number))))] [new-all-states (if new-state? (cons new-state all-states) all-states)]) (hash-set! transitions - state + s (cons (cons c new-state) - (hash-ref transitions state + (hash-ref transitions s (λ () null)))) (cond [new-state? diff --git a/parser-tools/private-lex/front.rkt b/parser-tools/private-lex/front.rkt index 467ac4d..550a03a 100644 --- a/parser-tools/private-lex/front.rkt +++ b/parser-tools/private-lex/front.rkt @@ -89,12 +89,12 @@ (vector-set! no-look (car trans) #f)) no-look) -(test-block ((d1 (make-dfa 1 1 (list) (list))) - (d2 (make-dfa 4 1 (list (cons 2 2) (cons 3 3)) +(test-block ((d1 (dfa 1 1 (list) (list))) + (d2 (dfa 4 1 (list (cons 2 2) (cons 3 3)) (list (cons 1 (list (cons (is:make-range 49 50) 1) (cons (is:make-range 51) 2))) (cons 2 (list (cons (is:make-range 49) 3)))))) - (d3 (make-dfa 4 1 (list (cons 2 2) (cons 3 3)) + (d3 (dfa 4 1 (list (cons 2 2) (cons 3 3)) (list (cons 1 (list (cons (is:make-range 100 200) 0) (cons (is:make-range 49 50) 1) (cons (is:make-range 51) 2))) diff --git a/parser-tools/private-lex/re.rkt b/parser-tools/private-lex/re.rkt index e319d69..3221e4d 100644 --- a/parser-tools/private-lex/re.rkt +++ b/parser-tools/private-lex/re.rkt @@ -14,34 +14,34 @@ (define get-index (make-counter)) ;; An re is either -;; - (make-epsilonR bool nat) -;; - (make-zeroR bool nat) -;; - (make-char-setR bool nat char-set) -;; - (make-concatR bool nat re re) -;; - (make-repeatR bool nat nat nat-or-+inf.0 re) -;; - (make-orR bool nat (list-of re)) Must not directly contain any orRs -;; - (make-andR bool nat (list-of re)) Must not directly contain any andRs -;; - (make-negR bool nat re) +;; - (epsilonR bool nat) +;; - (zeroR bool nat) +;; - (char-setR bool nat char-set) +;; - (concatR bool nat re re) +;; - (repeatR bool nat nat nat-or-+inf.0 re) +;; - (orR bool nat (list-of re)) Must not directly contain any orRs +;; - (andR bool nat (list-of re)) Must not directly contain any andRs +;; - (negR bool nat re) ;; ;; Every re must have an index field globally different from all ;; other re index fields. -(define-struct re (nullable? index) #:inspector (make-inspector)) -(define-struct (epsilonR re) () #:inspector (make-inspector)) -(define-struct (zeroR re) () #:inspector (make-inspector)) -(define-struct (char-setR re) (chars) #:inspector (make-inspector)) -(define-struct (concatR re) (re1 re2) #:inspector (make-inspector)) -(define-struct (repeatR re) (low high re) #:inspector (make-inspector)) -(define-struct (orR re) (res) #:inspector (make-inspector)) -(define-struct (andR re) (res) #:inspector (make-inspector)) -(define-struct (negR re) (re) #:inspector (make-inspector)) +(struct re (nullable? index) #:inspector (make-inspector)) +(struct epsilonR re () #:inspector (make-inspector)) +(struct zeroR re () #:inspector (make-inspector)) +(struct char-setR re (chars) #:inspector (make-inspector)) +(struct concatR re (re1 re2) #:inspector (make-inspector)) +(struct repeatR re (low high re) #:inspector (make-inspector)) +(struct orR re (res) #:inspector (make-inspector)) +(struct andR re (res) #:inspector (make-inspector)) +(struct negR re (re) #:inspector (make-inspector)) ;; e : re ;; The unique epsilon re -(define e (make-epsilonR #t (get-index))) +(define e (epsilonR #t (get-index))) ;; z : re ;; The unique zero re -(define z (make-zeroR #f (get-index))) +(define z (zeroR #f (get-index))) ;; s-re = char constant @@ -145,7 +145,7 @@ [else (cache l (λ () - (make-char-setR #f (get-index) cs)))])) + (char-setR #f (get-index) cs)))])) @@ -158,7 +158,7 @@ [else (cache (cons 'concat (cons (re-index r1) (re-index r2))) (λ () - (make-concatR (and (re-nullable? r1) (re-nullable? r2)) + (concatR (and (re-nullable? r1) (re-nullable? r2)) (get-index) r1 r2)))])) @@ -180,7 +180,7 @@ [else (cache (cons 'repeat (cons low (cons high (re-index r)))) (λ () - (make-repeatR (or (re-nullable? r) (= 0 low)) (get-index) low high r)))]))) + (repeatR (or (re-nullable? r) (= 0 low)) (get-index) low high r)))]))) ;; build-or : (list-of re) cache -> re @@ -196,7 +196,7 @@ [else (cache (cons 'or (map re-index rs)) (λ () - (make-orR (ormap re-nullable? rs) (get-index) rs)))]))) + (orR (ormap re-nullable? rs) (get-index) rs)))]))) ;; build-and : (list-of re) cache -> re (define (build-and rs cache) @@ -208,7 +208,7 @@ [else (cache (cons 'and (map re-index rs)) (λ () - (make-andR (andmap re-nullable? rs) (get-index) rs)))]))) + (andR (andmap re-nullable? rs) (get-index) rs)))]))) ;; build-neg : re cache -> re (define (build-neg r cache) @@ -217,7 +217,7 @@ [else (cache (cons 'neg (re-index r)) (λ () - (make-negR (not (re-nullable? r)) (get-index) r)))])) + (negR (not (re-nullable? r)) (get-index) r)))])) ;; Tests for the build-functions (test-block ((c (make-cache)) diff --git a/parser-tools/private-lex/token-syntax.rkt b/parser-tools/private-lex/token-syntax.rkt index ccb55cf..1ff817c 100644 --- a/parser-tools/private-lex/token-syntax.rkt +++ b/parser-tools/private-lex/token-syntax.rkt @@ -1,7 +1,7 @@ #lang racket/base -(provide make-terminals-def terminals-def-t terminals-def? - make-e-terminals-def e-terminals-def-t e-terminals-def?) +(provide terminals-def terminals-def-t terminals-def? + e-terminals-def e-terminals-def-t e-terminals-def?) ;; The things needed at compile time to handle definition of tokens -(define-struct terminals-def (t)) -(define-struct e-terminals-def (t)) +(struct terminals-def (t)) +(struct e-terminals-def (t)) diff --git a/parser-tools/private-lex/token.rkt b/parser-tools/private-lex/token.rkt index afc22c7..62ea457 100644 --- a/parser-tools/private-lex/token.rkt +++ b/parser-tools/private-lex/token.rkt @@ -3,7 +3,7 @@ ;; Defining tokens -(provide define-tokens define-empty-tokens make-token token? +(provide define-tokens define-empty-tokens token token? (protect-out (rename-out [token-name real-token-name])) (protect-out (rename-out [token-value real-token-value])) (rename-out [token-name* token-name][token-value* token-value]) @@ -14,8 +14,8 @@ ;; A token is either ;; - symbol -;; - (make-token symbol any) -(define-struct token (name value) #:inspector (make-inspector)) +;; - (token symbol any) +(struct token (name value) #:inspector (make-inspector)) ;; token-name*: token -> symbol (define (token-name* t) @@ -48,8 +48,8 @@ (begin (define-syntax NAME #,(if empty? - #'(make-e-terminals-def (quote-syntax (marked-token ...))) - #'(make-terminals-def (quote-syntax (marked-token ...))))) + #'(e-terminals-def (quote-syntax (marked-token ...))) + #'(terminals-def (quote-syntax (marked-token ...))))) #,@(map (λ (n) (when (eq? (syntax-e n) 'error) @@ -61,7 +61,7 @@ #`(define (#,(make-ctor-name n)) '#,n) #`(define (#,(make-ctor-name n) x) - (make-token '#,n x)))) + (token '#,n x)))) (syntax->list #'(TOKEN ...))) #;(define marked-token #f) #;...)))] [(_ ...) @@ -72,9 +72,9 @@ (define-syntax define-tokens (make-define-tokens #f)) (define-syntax define-empty-tokens (make-define-tokens #t)) -(define-struct position (offset line col) #:inspector #f) -(define-struct position-token (token start-pos end-pos) #:inspector #f) +(struct position (offset line col) #:inspector #f) +(struct position-token (token start-pos end-pos) #:inspector #f) -(define-struct srcloc-token (token srcloc) #:inspector #f) +(struct srcloc-token (token srcloc) #:inspector #f) diff --git a/parser-tools/private-lex/util.rkt b/parser-tools/private-lex/util.rkt index bbcb447..82347a1 100644 --- a/parser-tools/private-lex/util.rkt +++ b/parser-tools/private-lex/util.rkt @@ -5,8 +5,8 @@ (define max-char-num #x10FFFF) -(define-struct lex-abbrev (get-abbrev)) -(define-struct lex-trans (f)) +(struct lex-abbrev (get-abbrev)) +(struct lex-trans (f)) (module+ test (require rackunit)) diff --git a/parser-tools/private-yacc/grammar.rkt b/parser-tools/private-yacc/grammar.rkt index 17eefd2..8364f2c 100644 --- a/parser-tools/private-yacc/grammar.rkt +++ b/parser-tools/private-yacc/grammar.rkt @@ -7,29 +7,29 @@ racket/contract) ;; Each production has a unique index 0 <= index <= number of productions -(define-struct prod (lhs rhs index prec action) #:inspector (make-inspector) #:mutable) +(struct prod (lhs rhs index prec action) #:inspector (make-inspector) #:mutable) ;; The dot-pos field is the index of the element in the rhs ;; of prod that the dot immediately precedes. ;; Thus 0 <= dot-pos <= (vector-length rhs). -(define-struct item (prod dot-pos) #:inspector (make-inspector)) +(struct item (prod dot-pos) #:inspector (make-inspector)) ;; gram-sym = (union term? non-term?) ;; Each term has a unique index 0 <= index < number of terms ;; Each non-term has a unique index 0 <= index < number of non-terms -(define-struct term (sym index prec) #:inspector (make-inspector) #:mutable) -(define-struct non-term (sym index) #:inspector (make-inspector) #:mutable) +(struct term (sym index prec) #:inspector (make-inspector) #:mutable) +(struct non-term (sym index) #:inspector (make-inspector) #:mutable) ;; a precedence declaration. -(define-struct prec (num assoc) #:inspector (make-inspector)) +(struct prec (num assoc) #:inspector (make-inspector)) (provide/contract - [make-item (prod? (or/c #f natural-number/c) . -> . item?)] - [make-term (symbol? (or/c #f natural-number/c) (or/c prec? #f) . -> . term?)] - [make-non-term (symbol? (or/c #f natural-number/c) . -> . non-term?)] - [make-prec (natural-number/c (or/c 'left 'right 'nonassoc) . -> . prec?)] - [make-prod (non-term? (vectorof (or/c non-term? term?)) - (or/c #f natural-number/c) (or/c #f prec?) syntax? . -> . prod?)]) + [item (prod? (or/c #f natural-number/c) . -> . item?)] + [term (symbol? (or/c #f natural-number/c) (or/c prec? #f) . -> . term?)] + [non-term (symbol? (or/c #f natural-number/c) . -> . non-term?)] + [prec (natural-number/c (or/c 'left 'right 'nonassoc) . -> . prec?)] + [prod (non-term? (vectorof (or/c non-term? term?)) + (or/c #f natural-number/c) (or/c #f prec?) syntax? . -> . prod?)]) (provide ;; Things that work on items @@ -73,7 +73,7 @@ (define (move-dot-right i) (cond [(= (item-dot-pos i) (vector-length (prod-rhs (item-prod i)))) #f] - [else (make-item (item-prod i) + [else (item (item-prod i) (add1 (item-dot-pos i)))])) ;; sym-at-dot: LR-item -> gram-sym | #f diff --git a/parser-tools/private-yacc/input-file-parser.rkt b/parser-tools/private-yacc/input-file-parser.rkt index 8dfb6d7..ccf201c 100644 --- a/parser-tools/private-yacc/input-file-parser.rkt +++ b/parser-tools/private-yacc/input-file-parser.rkt @@ -65,12 +65,12 @@ (for ([p-decl (in-list precs)]) (define assoc (car p-decl)) (for ([term-sym (in-list (cdr p-decl))]) - (hash-set! prec-table term-sym (make-prec counter assoc))) + (hash-set! prec-table term-sym (prec counter assoc))) (set! counter (add1 counter))) ;; Build the terminal structures (for/list ([term-sym (in-list term-list)]) - (make-term term-sym + (term term-sym #f (hash-ref prec-table term-sym (λ () #f))))) @@ -158,8 +158,7 @@ prec-decls)])) (define terms (build-terms list-of-terms precs)) - (define non-terms (map (λ (non-term) (make-non-term non-term #f)) - list-of-non-terms)) + (define non-terms (map (λ (nt) (non-term nt #f)) list-of-non-terms)) (define term-table (make-hasheq)) (define non-term-table (make-hasheq)) @@ -215,7 +214,7 @@ (syntax-case prod-so () [(PROD-RHS ACTION) (let ([p (parse-prod #'PROD-RHS)]) - (make-prod + (prod nt p #f @@ -230,7 +229,7 @@ [(PROD-RHS (PREC TERM) ACTION) (identifier? #'TERM) (let ([p (parse-prod #'PROD-RHS)]) - (make-prod + (prod nt p #f @@ -269,18 +268,18 @@ (format "Start symbol ~a not defined as a non-terminal" ssym) sstx)) - (define starts (map (λ (x) (make-non-term (gensym) #f)) start-syms)) - (define end-non-terms (map (λ (x) (make-non-term (gensym) #f)) start-syms)) + (define starts (map (λ (x) (non-term (gensym) #f)) start-syms)) + (define end-non-terms (map (λ (x) (non-term (gensym) #f)) start-syms)) (define parsed-prods (map parse-prods-for-nt (syntax->list prods))) (define start-prods (for/list ([start (in-list starts)] [end-non-term (in-list end-non-terms)]) - (list (make-prod start (vector end-non-term) #f #f #'values)))) + (list (prod start (vector end-non-term) #f #f #'values)))) (define new-prods (append start-prods (for/list ([end-nt (in-list end-non-terms)] [start-sym (in-list start-syms)]) (for/list ([end (in-list end-terms)]) - (make-prod end-nt + (prod end-nt (vector (hash-ref non-term-table start-sym) (hash-ref term-table end)) diff --git a/parser-tools/private-yacc/lalr.rkt b/parser-tools/private-yacc/lalr.rkt index 0ed19b7..0730c92 100644 --- a/parser-tools/private-yacc/lalr.rkt +++ b/parser-tools/private-yacc/lalr.rkt @@ -24,7 +24,7 @@ (define r (send a run-automaton (trans-key-st tk) (trans-key-gs tk))) (for/list ([non-term (in-list nullable-non-terms)] #:when (send a run-automaton r non-term)) - (make-trans-key r non-term)))) + (trans-key r non-term)))) ;; compute-read: LR0-automaton * grammar -> (trans-key -> term set) ;; output term set is represented in bit-vector form @@ -52,7 +52,7 @@ (define rhs (prod-rhs prod)) (define rhs-l (vector-length rhs)) (append (if (and (> rhs-l 0) (eq? nt (vector-ref rhs (sub1 rhs-l)))) - (list (make-item prod (sub1 rhs-l))) + (list (item prod (sub1 rhs-l))) null) (let loop ([i (sub1 rhs-l)]) (cond @@ -60,7 +60,7 @@ (non-term? (vector-ref rhs i)) (send g nullable-non-term? (vector-ref rhs i))) (if (eq? nt (vector-ref rhs (sub1 i))) - (cons (make-item prod (sub1 i)) + (cons (item prod (sub1 i)) (loop (sub1 i))) (loop (sub1 i)))] [else null])))) @@ -88,7 +88,7 @@ (define prod (item-prod item)) (define rhs (prod-rhs prod)) (define lhs (prod-lhs prod)) - (map (λ (state) (make-trans-key state lhs)) + (map (λ (state) (trans-key state lhs)) (run-lr0-backward a rhs (item-dot-pos item) @@ -99,7 +99,7 @@ (define (compute-lookback a g) (define num-states (send a get-num-states)) (λ (state prod) - (map (λ (k) (make-trans-key k (prod-lhs prod))) + (map (λ (k) (trans-key k (prod-lhs prod))) (run-lr0-backward a (prod-rhs prod) (vector-length (prod-rhs prod)) state num-states)))) ;; compute-follow: LR0-automaton * grammar -> (trans-key -> term set) @@ -142,7 +142,7 @@ (λ (state) (for-each (λ (non-term) - (let ([res (f (make-trans-key state non-term))]) + (let ([res (f (trans-key state non-term))]) (when (not (null? res)) (printf "~a(~a, ~a) = ~a\n" name diff --git a/parser-tools/private-yacc/lr0.rkt b/parser-tools/private-yacc/lr0.rkt index dc773da..80b7011 100644 --- a/parser-tools/private-yacc/lr0.rkt +++ b/parser-tools/private-yacc/lr0.rkt @@ -9,13 +9,13 @@ (struct-out trans-key) trans-key-list-remove-dups kernel-items kernel-index) -;; kernel = (make-kernel (LR1-item list) index) +;; kernel = (kernel (LR1-item list) index) ;; the list must be kept sorted according to item ~a on ~a\n" @@ -271,10 +271,10 @@ (gram-sym-symbol gs)) (and new unique-kernel)))) - (define starts (map (λ (init-prod) (list (make-item init-prod 0))) + (define starts (map (λ (init-prod) (list (item init-prod 0))) (send grammar get-init-prods))) (define startk (for/list ([start (in-list starts)]) - (define k (make-kernel start counter)) + (define k (kernel start counter)) (hash-set! kernels start k) (set! counter (add1 counter)) k)) @@ -290,9 +290,9 @@ (enq! new-kernels (goto (car old-kernels))) (loop (cdr old-kernels) (cons (car old-kernels) seen-kernels))]))) -(define-struct q (f l) #:inspector (make-inspector) #:mutable) +(struct q (f l) #:inspector (make-inspector) #:mutable) (define (empty-queue? q) (null? (q-f q))) -(define (make-queue) (make-q null null)) +(define (make-queue) (q null null)) (define (enq! q i) (cond diff --git a/parser-tools/private-yacc/parser-actions.rkt b/parser-tools/private-yacc/parser-actions.rkt index 37699b9..765305b 100644 --- a/parser-tools/private-yacc/parser-actions.rkt +++ b/parser-tools/private-yacc/parser-actions.rkt @@ -1,29 +1,29 @@ #lang racket/base (require yaragg/parser-tools/private-yacc/grammar) -(provide (except-out (all-defined-out) make-reduce make-reduce*) - (rename-out [make-reduce* make-reduce])) +(provide (except-out (all-defined-out) reduce reduce*) + (rename-out [reduce* reduce])) ;; An action is -;; - (make-shift int) -;; - (make-reduce prod runtime-action) -;; - (make-accept) -;; - (make-goto int) +;; - (shift int) +;; - (reduce prod runtime-action) +;; - (accept) +;; - (goto int) ;; - (no-action) ;; A reduce contains a runtime-reduce so that sharing of the reduces can ;; be easily transferred to sharing of runtime-reduces. -(define-struct action () #:inspector (make-inspector)) -(define-struct (shift action) (state) #:inspector (make-inspector)) -(define-struct (reduce action) (prod runtime-reduce) #:inspector (make-inspector)) -(define-struct (accept action) () #:inspector (make-inspector)) -(define-struct (goto action) (state) #:inspector (make-inspector)) -(define-struct (no-action action) () #:inspector (make-inspector)) +(struct action () #:inspector (make-inspector)) +(struct shift action (state) #:inspector (make-inspector)) +(struct reduce action (prod runtime-reduce) #:inspector (make-inspector)) +(struct accept action () #:inspector (make-inspector)) +(struct goto action (state) #:inspector (make-inspector)) +(struct no-action action () #:inspector (make-inspector)) -(define (make-reduce* p) - (make-reduce p - (vector (prod-index p) - (gram-sym-symbol (prod-lhs p)) - (vector-length (prod-rhs p))))) +(define (reduce* p) + (reduce p + (vector (prod-index p) + (gram-sym-symbol (prod-lhs p)) + (vector-length (prod-rhs p))))) ;; A runtime-action is ;; non-negative-int (shift) diff --git a/parser-tools/private-yacc/table.rkt b/parser-tools/private-yacc/table.rkt index ebf0e51..f914687 100644 --- a/parser-tools/private-yacc/table.rkt +++ b/parser-tools/private-yacc/table.rkt @@ -121,7 +121,7 @@ ;; resolve-conflict : (listof action?) -> action? bool bool (define (resolve-conflict actions) (cond - [(null? actions) (values (make-no-action) #f #f)] + [(null? actions) (values (no-action) #f #f)] [(null? (cdr actions)) (values (car actions) #f #f)] [else (define SR-conflict? (> (count shift? actions) 0)) @@ -221,11 +221,11 @@ (table-add! table from-state-index gs (cond ((non-term? gs) - (make-goto (kernel-index to-state))) + (goto (kernel-index to-state))) ((member gs end-terms) - (make-accept)) + (accept)) (else - (make-shift + (shift (kernel-index to-state)))))) (send a for-each-state (λ (state) @@ -239,7 +239,7 @@ (unless (start-item? item) (let ((r (hash-ref reduce-cache item-prod (λ () - (let ((r (make-reduce item-prod))) + (let ((r (reduce item-prod))) (hash-set! reduce-cache item-prod r) r))))) (table-add! table diff --git a/parser-tools/yacc.rkt b/parser-tools/yacc.rkt index 107d0a4..43136ce 100644 --- a/parser-tools/yacc.rkt +++ b/parser-tools/yacc.rkt @@ -205,9 +205,9 @@ (define (extract-no-src-pos ip) (extract-helper ip #f #f)) -(define-struct stack-frame (state value start-pos end-pos) #:inspector (make-inspector)) +(struct stack-frame (state value start-pos end-pos) #:inspector (make-inspector)) -(define (make-empty-stack i) (list (make-stack-frame i #f #f #f))) +(define (make-empty-stack i) (list (stack-frame i #f #f #f))) ;; The table is a vector that maps each state to a hash-table that maps a @@ -230,7 +230,7 @@ (cond [(runtime-shift? a) ;; (printf "shift:~a\n" (runtime-shift-state a)) - (cons (make-stack-frame (runtime-shift-state a) + (cons (stack-frame (runtime-shift-state a) val start-pos end-pos) @@ -247,7 +247,7 @@ ;; (printf "shift:~a\n" (runtime-shift-state a)) (set! stack (cons - (make-stack-frame (runtime-shift-state a) + (stack-frame (runtime-shift-state a) #f start-pos end-pos) @@ -283,7 +283,7 @@ (cond [(runtime-shift? action) ;; (printf "shift:~a\n" (runtime-shift-state action)) - (parsing-loop (cons (make-stack-frame (runtime-shift-state action) + (parsing-loop (cons (stack-frame (runtime-shift-state action) val start-pos end-pos) @@ -304,14 +304,14 @@ (parsing-loop (cons (if src-pos - (make-stack-frame + (stack-frame goto (apply (vector-ref actions (runtime-reduce-prod-num action)) args) (if (null? args) start-pos (cadr args)) (if (null? args) end-pos (list-ref args (- (* (runtime-reduce-rhs-length action) 3) 1)))) - (make-stack-frame + (stack-frame goto (apply (vector-ref actions (runtime-reduce-prod-num action)) args) #f diff --git a/rules/lexer.rkt b/rules/lexer.rkt index 612cd37..842a8b9 100755 --- a/rules/lexer.rkt +++ b/rules/lexer.rkt @@ -133,9 +133,9 @@ (define-values (line-start col-start pos-start) (port-next-location ip)) (define str (read ip)) (define-values (line-end col-end pos-end) (port-next-location ip)) - (make-position-token (token-LIT (string-append "\"" str "\"")) - (make-position pos-start line-start col-start) - (make-position pos-end line-end col-end))) + (position-token (token-LIT (string-append "\"" str "\"")) + (position pos-start line-start col-start) + (position pos-end line-end col-end))) (define (lex/1 ip) (match (peek-bytes 1 0 ip) diff --git a/yaragg-parser-tools.scrbl b/yaragg-parser-tools.scrbl index ff3a13b..114d073 100644 --- a/yaragg-parser-tools.scrbl +++ b/yaragg-parser-tools.scrbl @@ -246,14 +246,14 @@ are a few examples, using @racket[:] prefixed SRE syntax: @defform[(lexer-src-pos (trigger action-expr) ...)]{ Like @racket[lexer], but for each @racket[_action-result] produced by -an @racket[action-expr], returns @racket[(make-position-token +an @racket[action-expr], returns @racket[(position-token _action-result start-pos end-pos)] instead of simply @racket[_action-result].} @defform[(lexer-srcloc (trigger action-expr) ...)]{ Like @racket[lexer], but for each @racket[_action-result] produced by -an @racket[action-expr], returns @racket[(make-srcloc-token +an @racket[action-expr], returns @racket[(srcloc-token _action-result lexeme-srcloc)] instead of simply @racket[_action-result].} @@ -646,7 +646,7 @@ be the right choice when using @racket[lexer] in other situations. @item{@racket[(src-pos)] @italic{OPTIONAL} Causes the generated parser to expect input in the form - @racket[(make-position-token _token _start-pos _end-pos)] instead + @racket[(position-token _token _start-pos _end-pos)] instead of simply @racket[_token]. Include this option when using the parser with a lexer generated with @racket[lexer-src-pos].}