suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

syntax/parse: expect:thing stores stx being matched

Browse Source
This commit is contained in:
Ryan Culpepper 2012-03-13 18:29:09 -06:00
parent 6cf3127cf9
commit 5db8553ea1
5 changed files with 58 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/syntax/parse/experimental/splicing.rkt
View File

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

10
collects/syntax/parse/private/parse.rkt
View File

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

2
collects/syntax/parse/private/residual.rkt
View File

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

35
collects/syntax/parse/private/runtime-progress.rkt
View File

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

35
collects/syntax/parse/private/runtime-report.rkt
View File

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