syntax/parse: remove unused field from pat:pair, pk/pair

2016-07-31 22:23:24 -04:00 · 2016-07-31 22:23:24 -04:00 · f968b87385
commit f968b87385
parent d6a3a22989
4 changed files with 29 additions and 39 deletions
--- a/racket/collects/syntax/parse/private/opt.rkt
+++ b/racket/collects/syntax/parse/private/opt.rkt
@ -18,18 +18,18 @@
 ;; A PK is one of
 ;;  - (pk1 (listof pattern) expr) -- a simple row in a parsing matrix
 ;;  - (pk/same pattern Matrix)    -- a submatrix with a common first column factored out
-;;  - (pk/pair boolean Matrix)    -- a submatrix with pair patterns in the first column unfolded
+;;  - (pk/pair Matrix)            -- a submatrix with pair patterns in the first column unfolded
 ;;  - (pk/and Matrix)             -- a submatrix with and patterns in the first column unfolded
 (struct pk1 (patterns k) #:prefab)
 (struct pk/same (pattern inner) #:prefab)
-(struct pk/pair (proper? inner) #:prefab)
+(struct pk/pair (inner) #:prefab)
 (struct pk/and (inner) #:prefab)

 (define (pk-columns pk)
  (match pk
    [(pk1 patterns k) (length patterns)]
    [(pk/same p inner) (add1 (pk-columns inner))]
-    [(pk/pair proper? inner) (sub1 (pk-columns inner))]
+    [(pk/pair inner) (sub1 (pk-columns inner))]
    [(pk/and inner) (sub1 (pk-columns inner))]))

 ;; Can factor pattern P given clauses like
@ -112,14 +112,13 @@
 ;; pattern->partitioner : pattern -> (values (pattern -> boolean) ((listof pk1) -> PK))
 (define (pattern->partitioner pat1)
  (match pat1
-    [(pat:pair proper? head tail)
-     (values (lambda (p) (and (pat:pair? p) (eq? (pat:pair-proper? p) proper?)))
+    [(pat:pair head tail)
+     (values (lambda (p) (pat:pair? p))
             (lambda (rows)
               (when DEBUG-OPT-SUCCEED
                 (eprintf "-- accumulated ~s rows like ~e\n" (length rows) (pattern->sexpr pat1)))
               (cond [(> (length rows) 1)
-                      (pk/pair proper?
-                               (optimize-matrix
+                      (pk/pair (optimize-matrix
                                (for/list ([row (in-list rows)])
                                  (let* ([patterns (pk1-patterns row)]
                                         [pat1 (car patterns)])
@ -192,7 +191,7 @@
     (andmap pattern-factorable? patterns)]
    [(pat:or patterns) #f]
    [(pat:not pattern) #f] ;; FIXME: ?
-    [(pat:pair _p? head tail)
+    [(pat:pair head tail)
     (and (pattern-factorable? head)
          (pattern-factorable? tail))]
    [(pat:vector pattern)
@ -268,8 +267,7 @@
          [(and (pat:not? a) (pat:not? b))
           (pattern-equal? (pat:not-pattern a) (pat:not-pattern b))]
          [(and (pat:pair? a) (pat:pair? b))
-           (and (eq? (pat:pair-proper? a) (pat:pair-proper? b))
-                (pattern-equal? (pat:pair-head a) (pat:pair-head b))
+           (and (pattern-equal? (pat:pair-head a) (pat:pair-head b))
                (pattern-equal? (pat:pair-tail a) (pat:pair-tail b)))]
          [(and (pat:vector? a) (pat:vector? b))
           (pattern-equal? (pat:vector-pattern a) (pat:vector-pattern b))]
@ -401,7 +399,7 @@
     (cons 'MATCH (map pattern->sexpr pats))]
    [(pk/same pat inner)
     (list 'SAME (pattern->sexpr pat) (matrix->sexpr inner))]
-    [(pk/pair proper? inner)
+    [(pk/pair inner)
     (list 'PAIR (matrix->sexpr inner))]
    [(pk/and inner)
     (list 'AND (matrix->sexpr inner))]))
@ -421,10 +419,8 @@
    [(? pat:literal?) `(quote ,(syntax->datum (pat:literal-id p)))]
    [(pat:datum _as datum) datum]
    [(? pat:action?) 'ACTION]
-    [(pat:pair _as '#t head tail)
+    [(pat:pair _as head tail)
     (cons (pattern->sexpr head) (pattern->sexpr tail))]
-    [(pat:pair _as '#f head tail)
-     (list '~pair (pattern->sexpr head) (pattern->sexpr tail))]
    [(pat:head _as head tail)
     (cons (pattern->sexpr head) (pattern->sexpr tail))]
    [(pat:dots _as (list eh) tail)
--- a/racket/collects/syntax/parse/private/parse.rkt
+++ b/racket/collects/syntax/parse/private/parse.rkt
@ -475,7 +475,7 @@ Conventions:
     #'(parse:S x cx pat1 pr es (parse:pk ins #s(pk1 pats k)))]
    [(parse:pk ((x cx pr es) . ins) #s(pk/same pat1 inner))
     #'(parse:S x cx pat1 pr es (parse:matrix ins inner))]
-    [(parse:pk ((x cx pr es) . ins) #s(pk/pair proper? inner))
+    [(parse:pk ((x cx pr es) . ins) #s(pk/pair inner))
     #'(let-values ([(datum tcx)
                     (if (syntax? x)
                         (values (syntax-e x) x)
@ -487,9 +487,7 @@ Conventions:
                   [tx (cdr datum)]
                   [tpr (ps-add-cdr pr)])
               (parse:matrix ((hx hcx hpr es) (tx tcx tpr es) . ins) inner))
-             (let ([es* (if (and 'proper? (null? datum))
-                            (es-add-proper-pair (first-desc:matrix inner) es)
-                            es)])
+             (let ([es* (if (null? datum) (es-add-proper-pair (first-desc:matrix inner) es) es)])
               (fail (failure pr es*)))))]
    [(parse:pk (in1 . ins) #s(pk/and inner))
     #'(parse:matrix (in1 in1 . ins) inner)]))
@ -610,7 +608,7 @@ Conventions:
                   [cut-prompt fail-to-succeed]) ;; to be safe
              (parse:S x cx subpattern pr es
                       (fh0 (failure pr0 es0)))))]
-       [#s(pat:pair proper? head tail)
+       [#s(pat:pair head tail)
        #`(let ([datum (if (syntax? x) (syntax-e x) x)]
                [cx (if (syntax? x) x cx)])  ;; FIXME: shadowing cx?!
            (if (pair? datum)
@ -621,7 +619,7 @@ Conventions:
                      [tpr (ps-add-cdr pr)])
                  (parse:S hx hcx head hpr es
                           (parse:S tx cx tail tpr es k)))
-                (let ([es* (if (and 'proper? (null? datum)) (es-add-proper-pair (first-desc:S head) es) es)])
+                (let ([es* (if (null? datum) (es-add-proper-pair (first-desc:S head) es) es)])
                  (fail (failure pr es*)))))]
       [#s(pat:vector subpattern)
        #`(let ([datum (if (syntax? x) (syntax-e x) x)])
@ -771,9 +769,9 @@ Conventions:
     [#s(pat:dots head tail)
      (with-syntax ([tail (convert-list-pattern #'tail end-pattern)])
        #'#s(pat:dots head tail))]
-     [#s(pat:pair proper? head-part tail-part)
+     [#s(pat:pair head-part tail-part)
      (with-syntax ([tail-part (convert-list-pattern #'tail-part end-pattern)])
-        #'#s(pat:pair proper? head-part tail-part))])))
+        #'#s(pat:pair head-part tail-part))])))

 ;; (parse:H x cx rest-x rest-cx rest-pr H-pattern pr es k)
 ;; In k: rest, rest-pr, attrs(H-pattern) are bound.
@ -901,7 +899,7 @@ Conventions:
       [_
        #'(parse:S x cx
                   ;; FIXME: consider proper-list-pattern? (yes is consistent with ~seq)
-                   #s(pat:pair #t head #s(internal-rest-pattern rest-x rest-cx rest-pr))
+                   #s(pat:pair head #s(internal-rest-pattern rest-x rest-cx rest-pr))
                   pr es k)])]))

 ;; (parse:dots x cx EH-pattern S-pattern pr es k) : expr[Ans]
--- a/racket/collects/syntax/parse/private/rep-patterns.rkt
+++ b/racket/collects/syntax/parse/private/rep-patterns.rkt
@ -22,7 +22,7 @@ A SinglePattern is one of
  (pat:and (listof SinglePattern))
  (pat:or (listof IAttr) (listof SinglePattern) (listof (listof IAttr)))
  (pat:not SinglePattern)
-  (pat:pair boolean SinglePattern SinglePattern)
+  (pat:pair SinglePattern SinglePattern)
  (pat:vector SinglePattern)
  (pat:box SinglePattern)
  (pat:pstruct key SinglePattern)
@ -38,7 +38,7 @@ A ListPattern is a subtype of SinglePattern; one of
  (pat:datum '())
  (pat:action ActionPattern ListPattern)
  (pat:head HeadPattern ListPattern)
-  (pat:pair #t SinglePattern ListPattern)
+  (pat:pair SinglePattern ListPattern)
  (pat:dots EllipsisHeadPattern ListPattern)
 |#

@ -53,7 +53,7 @@ A ListPattern is a subtype of SinglePattern; one of
 (define-struct pat:and (patterns) #:prefab)
 (define-struct pat:or (attrs patterns attrss) #:prefab)
 (define-struct pat:not (pattern) #:prefab)
-(define-struct pat:pair (proper? head tail) #:prefab)
+(define-struct pat:pair (head tail) #:prefab)
 (define-struct pat:vector (pattern) #:prefab)
 (define-struct pat:box (pattern) #:prefab)
 (define-struct pat:pstruct (key pattern) #:prefab)
@ -226,7 +226,7 @@ A RepConstraint is one of
     (append-iattrs (map pattern-attrs (list a sp)))]
    [(pat:head headp tailp)
     (append-iattrs (map pattern-attrs (list headp tailp)))]
-    [(pat:pair _proper? headp tailp)
+    [(pat:pair headp tailp)
     (append-iattrs (map pattern-attrs (list headp tailp)))]
    [(pat:vector sp)
     (pattern-attrs sp)]
@ -355,15 +355,12 @@ A RepConstraint is one of
 (define (action-pattern->single-pattern a)
  (pat:action a (pat:any)))

-(define (proper-list-pattern? p trust-pair?)
+(define (proper-list-pattern? p)
  (or (and (pat:datum? p) (eq? (pat:datum-datum p) '()))
-      (and (pat:pair? p)
-           (if trust-pair?
-               (pat:pair-proper? p)
-               (proper-list-pattern? (pat:pair-tail p) trust-pair?)))
-      (and (pat:head? p) (proper-list-pattern? (pat:head-tail p) trust-pair?))
-      (and (pat:dots? p) (proper-list-pattern? (pat:dots-tail p) trust-pair?))
-      (and (pat:action? p) (proper-list-pattern? (pat:action-inner p) trust-pair?))))
+      (and (pat:pair? p) (proper-list-pattern? (pat:pair-tail p)))
+      (and (pat:head? p) (proper-list-pattern? (pat:head-tail p)))
+      (and (pat:dots? p) (proper-list-pattern? (pat:dots-tail p)))
+      (and (pat:action? p) (proper-list-pattern? (pat:action-inner p)))))

 ;; ----

@ -474,7 +471,7 @@ A RepConstraint is one of
    [(pat:datum '()) 'yes]
    [(pat:action ap lp) (lpat-nullable lp)]
    [(pat:head hp lp) (3and (hpat-nullable hp) (lpat-nullable lp))]
-    [(pat:pair '#t sp lp) 'no]
+    [(pat:pair sp lp) 'no]
    [(pat:dots ehps lp) (3and (3andmap ehpat-nullable ehps) (lpat-nullable lp))]
    ;; For hpat:and, handle the following which are not ListPatterns
    [(pat:and lps) (3andmap lpat-nullable lps)]
--- a/racket/collects/syntax/parse/private/rep.rkt
+++ b/racket/collects/syntax/parse/private/rep.rkt
@ -592,8 +592,7 @@
              (pat:action headp tailp)]
             [(head-pattern? headp)
              (pat:head headp tailp)]
-             [else
-              (pat:pair (proper-list-pattern? tailp #t) headp tailp)]))]
+             [else (pat:pair headp tailp)]))]
    [#(a ...)
     (let ([lp (parse-single-pattern (syntax/loc stx (a ...)) decls)])
       (pat:vector lp))]
@ -968,7 +967,7 @@

 (define (parse-hpat:seq stx list-stx decls)
  (define pattern (parse-single-pattern list-stx decls))
-  (unless (proper-list-pattern? pattern #t)
+  (unless (proper-list-pattern? pattern)
    (wrong-syntax stx "expected proper list pattern"))
  (hpat:seq pattern))