Use `struct` instead of `define-struct`

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)))))))))]))
 

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 ()

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?

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)))

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))

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))

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)
   
 

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))

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

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))

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

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<? so that equal? can
 ;;   be used to compare kernels
 ;;   Each kernel is assigned a unique index, 0 <= index < number of states
-;; trans-key = (make-trans-key kernel gram-sym)
-(define-struct kernel (items index) #:inspector (make-inspector))
-(define-struct trans-key (st gs) #:inspector (make-inspector))
+;; trans-key = (trans-key kernel gram-sym)
+(struct kernel (items index) #:inspector (make-inspector))
+(struct trans-key (st gs) #:inspector (make-inspector))
 
 (define (trans-key<? a b)
   (define kia (kernel-index (trans-key-st a)))
@@ -63,7 +63,7 @@
   (for ([trans-key/kernel (in-list assoc)])
        (define tk (car trans-key/kernel))
        (hash-table-add! reverse-hash 
-                        (make-trans-key (cdr trans-key/kernel)
+                        (trans-key (cdr trans-key/kernel)
                                         (trans-key-gs tk))
                         (trans-key-st tk)))
   (hash-map reverse-hash cons))
@@ -167,7 +167,7 @@
     (digraph (send grammar get-non-terms)
              (λ (nt)
                (filter non-term?
-                       (map (λ (prod) (sym-at-dot (make-item prod 0)))
+                       (map (λ (prod) (sym-at-dot (item prod 0)))
                             (send grammar get-prods-for-non-term nt))))
              (λ (nt) (list nt))
              (union non-term<?)
@@ -189,7 +189,7 @@
                              [x (in-list (send grammar 
                                                get-prods-for-non-term
                                                non-term))])
-                            (make-item x 0))
+                            (item x 0))
                  (LR0-closure (cdr i))))]
          [else (cons (car i) (LR0-closure (cdr i)))])]))
   
@@ -207,7 +207,7 @@
   ;; LR0-closure of kernel to the right, and grouping them by 
   ;; the term/non-term moved over.  Returns the kernels not
   ;; yet seen, and places the trans-keys into automaton
-  (define (goto kernel)
+  (define (goto ker)
     ;; maps a gram-syms to a list of items
     (define table (make-hasheq))
 
@@ -222,12 +222,12 @@
             (unless (member i already)
               (hash-set! table (gram-sym-symbol gs) (cons i already)))]
         ((zero? (vector-length (prod-rhs (item-prod i))))
-         (define current (hash-ref epsilons kernel (λ () null)))
-         (hash-set! epsilons kernel (cons i current)))))
+         (define current (hash-ref epsilons ker (λ () null)))
+         (hash-set! epsilons ker (cons i current)))))
     
     ;; Group the items of the LR0 closure of the kernel
     ;; by the character after the dot
-    (for ([item (in-list (LR0-closure (kernel-items kernel)))])
+    (for ([item (in-list (LR0-closure (kernel-items ker)))])
          (add-item! table item))
                   
     ;; each group is a new kernel, with the dot advanced.
@@ -253,16 +253,16 @@
                (define new-kernel (sort (filter values (map move-dot-right items)) item<?))
                (define unique-kernel (hash-ref kernels new-kernel
                                                (λ ()
-                                                 (define k (make-kernel new-kernel counter))
+                                                 (define k (kernel new-kernel counter))
                                                  (set! new #t)
                                                  (set! counter (add1 counter))
                                                  (hash-set! kernels new-kernel k)
                                                  k)))
                (if (term? gs)
-                   (set! automaton-term (cons (cons (make-trans-key kernel gs)
+                   (set! automaton-term (cons (cons (trans-key ker gs)
                                                     unique-kernel)
                                               automaton-term))
-                   (set! automaton-non-term (cons (cons (make-trans-key kernel gs)
+                   (set! automaton-non-term (cons (cons (trans-key ker gs)
                                                         unique-kernel)
                                                   automaton-non-term)))
                #;(printf "~a -> ~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

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)

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

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

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)

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].}