syntax/parse: removed stx from expectstack

collects/syntax/parse/experimental/splicing.rkt

@@ -40,8 +40,8 @@
                               (cdr result))))
                      ((error)
                       (let ([es
-                             (list* (cons (expect:thing (get-description param ...) #f) stx)
-                                    (cons (expect:message (cadr result)) (caddr result))
+                             (list* (expect:message (cadr result))
+                                    (expect:thing (get-description param ...) #f)
                                     es)])
                         (fh (failure pr es))))))))))
          (define-syntax name

collects/syntax/parse/private/parse.rkt

@@ -103,7 +103,7 @@ Conventions:
             (syntax-parameterize ((this-context-syntax
                                    (syntax-rules ()
                                      [(tbs) (ps-context-syntax pr)])))
-              (let ([es (cons (cons (expect:thing description 'transparent?) x) es)]
+              (let ([es (cons (expect:thing description 'transparent?) es)]
                     [pr (if 'transparent? pr (ps-add-opaque pr))])
                 (with ([fail-handler fh0]
                        [cut-prompt cp0])
@@ -288,14 +288,14 @@ Conventions:
         #`(let ([d (if (syntax? x) (syntax-e x) x)])
             (if (equal? d (quote datum))
                 k
-                (fail (failure pr (cons (cons (expect:atom 'datum) x) es)))))]
+                (fail (failure pr (cons(expect:atom 'datum) es)))))]
        [#s(pat:literal attrs literal input-phase lit-phase)
         #`(if (and (identifier? x)
                    (free-identifier=?/phases
                     x input-phase
                     (quote-syntax literal) lit-phase))
               k
-              (fail (failure pr (cons (cons (expect:literal (quote-syntax literal)) x) es))))]
+              (fail (failure pr (cons(expect:literal (quote-syntax literal)) es))))]
        [#s(pat:action attrs action subpattern)
         #'(parse:A x cx action pr es (parse:S x cx subpattern pr es k))]
        [#s(pat:head attrs head tail)
@@ -370,7 +370,7 @@ Conventions:
                   (parse:S datum scx subpattern pr es k))
                 (fail (failure pr es))))]
        [#s(pat:describe attrs description transparent? pattern)
-        #`(let ([es (cons (cons (expect:thing description transparent?) x) es)]
+        #`(let ([es (cons (expect:thing description transparent?) es)]
                 [pr (if 'transparent? pr (ps-add-opaque pr))])
             (parse:S x cx pattern pr es k))]
        [#s(pat:delimit attrs pattern)
@@ -396,7 +396,7 @@ Conventions:
           ;; NOTE: predicate must not assume x (ie, this-syntax) is stx
           #'(if (app-argu predicate x argu)
                 (let-attributes (name-attr ...) k)
-                (let ([es (cons (cons (expect:thing 'description #t) x) es)])
+                (let ([es (cons (expect:thing 'description #t) es)])
                   (fail (failure pr es)))))])]))
 
 ;; (disjunct ???-pattern success (pre:expr ...) (id:id ...)) : expr[Ans]
@@ -437,9 +437,7 @@ Conventions:
                 (let ([pr* (if (syntax? c)
                                (ps-add-stx pr c)
                                pr)]
-                      [es* (cons (cons (expect:message message)
-                                       (if (syntax? c) c x))
-                                 es)])
+                      [es* (cons (expect:message message) es)])
                   (fail (failure pr* es*)))
                 k))]
        [#s(action:parse _ pattern expr)
@@ -492,7 +490,7 @@ Conventions:
     [(parse:H x cx rest-x rest-cx rest-pr head pr es k)
      (syntax-case #'head ()
        [#s(hpat:describe _ description transparent? pattern)
-        #`(let ([es (cons (cons (expect:thing description transparent?) x) es)])
+        #`(let ([es (cons (expect:thing description transparent?) es)])
             (parse:H x cx rest-x rest-cx rest-pr pattern pr es k))]
        [#s(hpat:var _attrs name parser argu (nested-a ...) attr-count commit?)
         (with-syntax ([(av ...) (generate-n-temporaries (syntax-e #'attr-count))]
@@ -669,7 +667,7 @@ Conventions:
                                   head es loop-k)
                         ...)
                    (cond [(< rel-rep (rep:min-number rel-repc))
-                          (let ([es (cons (cons (expectation-of-reps/too-few rel-rep rel-repc) dx) es)])
+                          (let ([es (cons (expectation-of-reps/too-few rel-rep rel-repc) es)])
                             (fail (failure loop-pr es)))]
                          ...
                          [else
@@ -714,7 +712,7 @@ Conventions:
          [_  #`(parse:H x cx x* cx* pr* head pr es
                         (if (< rep (rep:max-number repc))
                             (let ([rep (add1 rep)]) k*)
-                            (let ([es (cons (cons (expectation-of-reps/too-many rep repc) x*) es)])
+                            (let ([es (cons (expectation-of-reps/too-many rep repc) es)])
                               (fail (failure pr* es)))))]))]))
 
 ;; (rep:initial-value RepConstraint) : expr

collects/syntax/parse/private/runtime-failure.rkt

@@ -29,10 +29,7 @@
 ;; FIXME: add phase to expect:literal
 
 #|
-An ExpectStack is (listof (cons Expect syntax))
-
-FIXME: (cons Expect syntax) -> struct instead?
-FIXME: replace syntax with progress (better cdr handling)
+An ExpectStack is (listof Expect)
 
 An Expect is one of
   - (make-expect:thing string boolean)
@@ -85,21 +82,21 @@ The *-marked variants can only occur at the top of the stack.
     (let loop ([es es])
       (match es
         ['() '()]
-        [(cons (cons (expect:thing description '#f) stx) rest-es)
+        [(cons (expect:thing description '#f) rest-es)
          ;; Tricky! If multiple opaque frames, multiple "returns",
          ;; but innermost one called first, so jumps past the rest.
          (return (cons (car es) (loop rest-es)))]
-        [(cons expect+stx rest-es)
-         (cons expect+stx (loop rest-es))]))))
+        [(cons expect rest-es)
+         (cons expect (loop rest-es))]))))
 
 ;; filter-expectstack : ExpectStack -> ExpectStack
 ;; Eliminates missing (ie, #f) messages and descriptions
 (define (filter-expectstack es)
   (filter (lambda (expect)
             (match expect
-              [(cons (expect:thing '#f _) _)
+              [(expect:thing '#f _)
                #f]
-              [(cons (expect:message '#f) _)
+              [(expect:message '#f)
                #f]
               [_ #t]))
           es))
@@ -139,13 +136,10 @@ So we go with option 2.
   (define (simplify/check-leafs ress)
     (let ([ress (simplify ress)])
       (cond [(andmap singleton? ress)
-             ;; Assume the syntax parts are the same
-             (let* ([frames (map car ress)]
-                    [frame-stx (cdr (car frames))])
-               (list (list (cons (if (singleton? frames)
-                                     (car (car frames))
-                                     (expect:disj (map car frames)))
-                                 frame-stx))))]
+             (let* ([frames (map car ress)])
+               (list (list (if (singleton? frames)
+                               (car frames)
+                               (expect:disj frames)))))]
             [else ress])))
   ;; singleton? : list -> boolean
   (define (singleton? res)

collects/syntax/parse/private/runtime-progress.rkt

@@ -96,15 +96,16 @@ Interpretation: Inner PS structures are applied first.
          (stx-cdr stx))]
       [(cons 'post parent)
        (interp parent)]))
-  (match ps
-    [(cons (? syntax? stx) _)
-     (values stx 0)]
-    [(cons 'car parent)
-     (values (interp ps) 0)]
-    [(cons (? exact-positive-integer? n) parent)
-     (values (interp parent) n)]
-    [(cons 'post parent)
-     (ps->stx+index parent)]))
+  (let ([ps (ps-truncate-opaque ps)])
+    (match ps
+      [(cons (? syntax? stx) _)
+       (values stx 0)]
+      [(cons 'car parent)
+       (values (interp ps) 0)]
+      [(cons (? exact-positive-integer? n) parent)
+       (values (interp parent) n)]
+      [(cons 'post parent)
+       (ps->stx+index parent)])))
 
 ;; ps-difference : PS PS -> nat
 ;; Returns N s.t. B = (ps-add-cdr^N A)

collects/syntax/parse/private/runtime-report.rkt

@@ -57,12 +57,11 @@ complicated.
 
 ;; report/expectstack : ExpectStack syntax nat -> Report
 (define (report/expectstack es stx index)
-  (let ([top-frame (and (pair? es) (car es))])
-    (cond [(not top-frame)
+  (let ([frame-expect (and (pair? es) (car es))])
+    (cond [(not frame-expect)
            (report "bad syntax" #f)]
           [else
-           (let ([frame-expect (and top-frame (car top-frame))]
-                 [frame-stx
+           (let ([frame-stx
                   (let-values ([(x cx) (stx-list-drop/cx stx stx index)])
                     (datum->syntax cx x cx))])
              (cond [(equal? frame-expect (expect:atom '()))