syntax/parse: expect:thing stores stx being matched
This commit is contained in:
parent
6cf3127cf9
commit
5db8553ea1
|
@ -50,7 +50,7 @@
|
|||
((error)
|
||||
(let ([es
|
||||
(list* (expect:message (cadr result))
|
||||
(expect:thing (get-description param ...) #f rl)
|
||||
(expect:thing pr (get-description param ...) #f rl)
|
||||
es)])
|
||||
(fh (failure pr es))))))))))
|
||||
(define-syntax name
|
||||
|
|
|
@ -76,7 +76,7 @@
|
|||
(define (parser x cx pr es fh0 cp0 rl success)
|
||||
(if (predicate x)
|
||||
(success fh0)
|
||||
(let ([es (cons (expect:thing 'description #t rl) es)])
|
||||
(let ([es (cons (expect:thing pr 'description #t rl) es)])
|
||||
(fh0 (failure pr es)))))))]))
|
||||
|
||||
(define-syntax (parser/rhs stx)
|
||||
|
@ -260,7 +260,7 @@ Conventions:
|
|||
(syntax-parameterize ((this-context-syntax
|
||||
(syntax-rules ()
|
||||
[(tbs) (ps-context-syntax pr)])))
|
||||
(let ([es (cons (expect:thing description 'transparent? rl) es)]
|
||||
(let ([es (cons (expect:thing pr description 'transparent? rl) es)]
|
||||
[pr (if 'transparent? pr (ps-add-opaque pr))])
|
||||
(with ([fail-handler fh0]
|
||||
[cut-prompt cp0])
|
||||
|
@ -549,7 +549,7 @@ Conventions:
|
|||
(parse:S datum scx subpattern pr es k))
|
||||
(fail (failure pr es))))]
|
||||
[#s(pat:describe attrs pattern description transparent? role)
|
||||
#`(let ([es (cons (expect:thing description transparent? role) es)]
|
||||
#`(let ([es (cons (expect:thing pr description transparent? role) es)]
|
||||
[pr (if 'transparent? pr (ps-add-opaque pr))])
|
||||
(parse:S x cx pattern pr es k))]
|
||||
[#s(pat:delimit attrs pattern)
|
||||
|
@ -575,7 +575,7 @@ Conventions:
|
|||
#'(let ([x* (datum->syntax cx x cx)])
|
||||
(if (predicate x*)
|
||||
(let-attributes (name-attr ...) k)
|
||||
(let ([es (cons (expect:thing 'description #t role) es)])
|
||||
(let ([es (cons (expect:thing pr 'description #t role) es)])
|
||||
(fail (failure pr es))))))])]))
|
||||
|
||||
;; (disjunct ???-pattern success (pre:expr ...) (id:id ...)) : expr[Ans]
|
||||
|
@ -669,7 +669,7 @@ Conventions:
|
|||
[(parse:H x cx rest-x rest-cx rest-pr head pr es k)
|
||||
(syntax-case #'head ()
|
||||
[#s(hpat:describe _ pattern description transparent? role)
|
||||
#`(let ([es* (cons (expect:thing description transparent? role) es)]
|
||||
#`(let ([es* (cons (expect:thing pr description transparent? role) es)]
|
||||
[pr (if 'transparent? pr (ps-add-opaque pr))])
|
||||
(parse:H x cx rest-x rest-cx rest-pr pattern pr es*
|
||||
(let ([rest-pr (if 'transparent? rest-pr (ps-pop-opaque rest-pr))])
|
||||
|
|
|
@ -215,7 +215,7 @@
|
|||
(loop (cdr x) cx (add1 i))
|
||||
(let* ([pr (ps-add-cdr pr i)]
|
||||
[pr (ps-add-car pr)]
|
||||
[es (cons (expect:thing desc #t rl) es)])
|
||||
[es (cons (expect:thing pr desc #t rl) es)])
|
||||
(values 'fail (failure pr es))))]
|
||||
[else ;; not null, because stx->list failed
|
||||
(let ([pr (ps-add-cdr pr i)]
|
||||
|
|
|
@ -30,23 +30,29 @@
|
|||
#|
|
||||
Progress (PS) is a non-empty list of Progress Frames (PF).
|
||||
|
||||
A PF is one of
|
||||
A Progress Frame (PF) is one of
|
||||
- stx ;; "Base" frame
|
||||
- 'car
|
||||
- 'car ;; car of pair; also vector->list, unbox, struct->list, etc
|
||||
- nat ;; Represents that many repeated cdrs
|
||||
- 'post
|
||||
- 'opaque
|
||||
|
||||
stx frame introduced
|
||||
The error-reporting context (ie, syntax-parse #:context arg) is always
|
||||
the final frame.
|
||||
|
||||
All non-stx frames (eg car, cdr) interpreted as applying to nearest following
|
||||
stx frame.
|
||||
|
||||
A stx frame is introduced
|
||||
- always at base (that is, by syntax-parse)
|
||||
- if syntax-parse has #:context arg, then two stx frames at bottom:
|
||||
(list to-match-stx context-stx)
|
||||
- by #:with/~parse
|
||||
- by #:fail-*/#:when/~fail & stx
|
||||
|
||||
Interpretation: Inner PS structures are applied first.
|
||||
eg, (list 'car 1 #'___)
|
||||
means ( car of ( cdr once of the term ) )
|
||||
Interpretation: later frames are applied first.
|
||||
eg, (list 'car 1 stx)
|
||||
means ( car of ( cdr once of stx ) )
|
||||
NOT apply car, then apply cdr once, then stop
|
||||
|#
|
||||
|
||||
|
@ -154,6 +160,7 @@ Interpretation: Inner PS structures are applied first.
|
|||
(reverse (ps-truncate-opaque ps)))
|
||||
|
||||
;; ps-pop-opaque : PS -> IPS
|
||||
;; Used to continue with progress from opaque head pattern.
|
||||
(define (ps-pop-opaque ps)
|
||||
(match ps
|
||||
[(cons (? exact-positive-integer? n) (cons 'opaque ps*))
|
||||
|
@ -164,7 +171,8 @@ Interpretation: Inner PS structures are applied first.
|
|||
|
||||
;; ==== Failure ====
|
||||
|
||||
;; A Failure is (make-failure PS ExpectStack)
|
||||
;; A Failure is (failure PS ExpectStack)
|
||||
|
||||
;; A FailureSet is one of
|
||||
;; - Failure
|
||||
;; - (cons FailureSet FailureSet)
|
||||
|
@ -181,15 +189,19 @@ Interpretation: Inner PS structures are applied first.
|
|||
An ExpectStack is (listof Expect)
|
||||
|
||||
An Expect is one of
|
||||
- (make-expect:thing string boolean string/#f)
|
||||
- (make-expect:thing ??? string boolean string/#f)
|
||||
* (make-expect:message string)
|
||||
* (make-expect:atom atom)
|
||||
* (make-expect:literal identifier)
|
||||
* (make-expect:disj (non-empty-listof Expect))
|
||||
|
||||
The *-marked variants can only occur at the top of the stack.
|
||||
|
||||
expect:thing frame contains representation of term:
|
||||
- during parsing, represent as progress
|
||||
- during reporting, convert to stx
|
||||
|#
|
||||
(define-struct expect:thing (description transparent? role) #:prefab)
|
||||
(define-struct expect:thing (term description transparent? role) #:prefab)
|
||||
(define-struct expect:message (message) #:prefab)
|
||||
(define-struct expect:atom (atom) #:prefab)
|
||||
(define-struct expect:literal (literal) #:prefab)
|
||||
|
@ -226,7 +238,10 @@ The *-marked variants can only occur at the top of the stack.
|
|||
(map expect->sexpr es))
|
||||
|
||||
(define (expect->sexpr e)
|
||||
e)
|
||||
(match e
|
||||
[(expect:thing term description transparent? role)
|
||||
(expect:thing '<Term> description transparent? role)]
|
||||
[else e]))
|
||||
|
||||
(define (progress->sexpr ps)
|
||||
(for/list ([pf (in-list (invert-ps ps))])
|
||||
|
|
|
@ -12,8 +12,8 @@
|
|||
exn:syntax-parse-info)
|
||||
|
||||
#|
|
||||
TODO: given (expect:thing D _ R) and (expect:thing D _ #f),
|
||||
simplify to (expect:thing D _ #f)
|
||||
TODO: given (expect:thing _ D _ R) and (expect:thing _ D _ #f),
|
||||
simplify to (expect:thing _ D _ #f)
|
||||
thus, "expected D" rather than "expected D or D for R" (?)
|
||||
|#
|
||||
|
||||
|
@ -113,7 +113,7 @@ complicated.
|
|||
;; prose-for-expect : Expect -> string
|
||||
(define (prose-for-expect e)
|
||||
(match e
|
||||
[(expect:thing description transparent? role)
|
||||
[(expect:thing ??? description transparent? role)
|
||||
(if role
|
||||
(format "expected ~a for ~a" description role)
|
||||
(format "expected ~a" description))]
|
||||
|
@ -159,7 +159,6 @@ complicated.
|
|||
|
||||
;; ==== Failure analysis ====
|
||||
|
||||
|
||||
;; == Failure simplification ==
|
||||
|
||||
;; maximal-failures : FailureSet -> (listof (listof Failure))
|
||||
|
@ -173,7 +172,9 @@ complicated.
|
|||
|
||||
;; normalize-expectstack : ExpectStack -> ExpectStack
|
||||
(define (normalize-expectstack es)
|
||||
(filter-expectstack (truncate-opaque-expectstack es)))
|
||||
(convert-expectstack
|
||||
(filter-expectstack
|
||||
(truncate-opaque-expectstack es))))
|
||||
|
||||
;; truncate-opaque-expectstack : ExpectStack -> ExpectStack
|
||||
;; Eliminates expectations on top of opaque (ie, transparent=#f) frames.
|
||||
|
@ -182,20 +183,37 @@ complicated.
|
|||
(let loop ([es es])
|
||||
(match es
|
||||
['() '()]
|
||||
[(cons (expect:thing description '#f role) rest-es)
|
||||
[(cons (expect:thing ps description '#f role) rest-es)
|
||||
;; Tricky! If multiple opaque frames, multiple "returns",
|
||||
;; but innermost one called first, so jumps past the rest.
|
||||
;; Also, flip opaque to transparent for sake of equality.
|
||||
(return (cons (expect:thing description #t role) (loop rest-es)))]
|
||||
(return (cons (expect:thing ps description #t role) (loop rest-es)))]
|
||||
[(cons (expect:thing ps description '#t role) rest-es)
|
||||
(cons (expect:thing ps description #t role) (loop rest-es))]
|
||||
[(cons expect rest-es)
|
||||
(cons expect (loop rest-es))]))))
|
||||
|
||||
;; convert-expectstack : ExpectStack -> ExpectStack
|
||||
;; Converts expect:thing term rep from progress to (cons stx index).
|
||||
(define (convert-expectstack es)
|
||||
(define (convert-ps ps)
|
||||
(let-values ([(stx index) (ps->stx+index ps)])
|
||||
(cons stx index)))
|
||||
(map (lambda (expect)
|
||||
(match expect
|
||||
[(expect:thing ps de tr? rl)
|
||||
(expect:thing (convert-ps ps) de tr? rl)]
|
||||
[_ expect]))
|
||||
es))
|
||||
|
||||
;; filter-expectstack : ExpectStack -> ExpectStack
|
||||
;; Eliminates missing (ie, #f) messages and descriptions
|
||||
;; FIXME: Change parsing code to avoid useless frame allocations?
|
||||
;; Or are they worth retaining for debugging?
|
||||
(define (filter-expectstack es)
|
||||
(filter (lambda (expect)
|
||||
(match expect
|
||||
[(expect:thing '#f _)
|
||||
[(expect:thing _ '#f _ _)
|
||||
#f]
|
||||
[(expect:message '#f)
|
||||
#f]
|
||||
|
@ -220,7 +238,6 @@ So we go with option 2.
|
|||
|#
|
||||
|
||||
;; simplify-common-expectstacks : (listof ExpectStack) -> (listof ExpectStack)
|
||||
;; Should call remove-duplicates first.
|
||||
(define (simplify-common-expectstacks ess)
|
||||
;; simplify : (listof ReversedExpectStack) -> (listof ReversedExpectStack)
|
||||
(define (simplify ress)
|
||||
|
|
Loading…
Reference in New Issue
Block a user