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

syntax/parse: add "expected more terms" message

Browse Source 
Only for proper list patterns; otherwise, "more terms" might be
mischaracterization.
This commit is contained in:
Ryan Culpepper 2013-07-30 19:55:04 -04:00
parent d3c3726628
commit 2057b51f21
7 changed files with 57 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-pkgs/racket-test/tests/stxparse/test.rkt
View File

@ -44,7 +44,7 @@
#:pre [()] #:post [x:two])
;; check if wildcard, no attr bound
(terx (1) _:two "expected two")
(terx (1) _:two "expected more terms")
;(terx (1 2) _:one "expected one")
(terx (1 (2 3)) (_:one _:two) "expected one")
(terx ((1) 2) (_:one _:two) "expected two")

20
racket/collects/syntax/parse/private/opt.rkt
View File

@ -24,18 +24,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 Matrix) -- a submatrix with pair patterns in the first column unfolded
;; - (pk/pair boolean 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 (inner) #:prefab)
(struct pk/pair (proper? 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 inner) (sub1 (pk-columns inner))]
[(pk/pair proper? inner) (sub1 (pk-columns inner))]
[(pk/and inner) (sub1 (pk-columns inner))]))
;; Can factor pattern P given clauses like
@ -113,13 +113,14 @@
;; pattern->partitioner : pattern -> (values (pattern -> boolean) ((listof pk1) -> PK))
(define (pattern->partitioner pat1)
(match pat1
[(pat:pair attrs head tail)
(values pat:pair?
[(pat:pair proper? attrs head tail)
(values (lambda (p) (and (pat:pair? p) (eq? (pat:pair-proper? p) proper?)))
(lambda (rows)
(cond [(> (length rows) 1)
(when DEBUG-OPT-SUCCEED
(eprintf "** pairs (~s)\n" (length rows)))
(pk/pair (optimize-matrix
(pk/pair proper?
(optimize-matrix
(for/list ([row (in-list rows)])
(let* ([patterns (pk1-patterns row)]
[pat1 (car patterns)])
@ -191,7 +192,7 @@
(andmap pattern-factorable? patterns)]
[(pat:or _as patterns) #f]
[(pat:not _as pattern) #f] ;; FIXME: ?
[(pat:pair _as head tail)
[(pat:pair _as _p? head tail)
(and (pattern-factorable? head)
(pattern-factorable? tail))]
[(pat:vector _as pattern)
@ -263,7 +264,8 @@
[(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 (pattern-equal? (pat:pair-head a) (pat:pair-head b))
(and (eq? (pat:pair-proper? a) (pat:pair-proper? b))
(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))]
@ -402,7 +404,7 @@
[(? pat:literal?) `(quote ,(syntax->datum (pat:literal-id p)))]
[(pat:datum _as datum) datum]
[(? pat:action?) 'ACTION]
[(pat:pair _as head tail)
[(pat:pair _as _p? head tail)
(cons (pattern->sexpr head) (pattern->sexpr tail))]
[(pat:head _as head tail)
(cons (pattern->sexpr head) (pattern->sexpr tail))]

17
racket/collects/syntax/parse/private/parse.rkt
View File

@ -449,7 +449,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 inner))
[(parse:pk ((x cx pr es) . ins) #s(pk/pair proper? inner))
#'(let-values ([(datum tcx)
(if (syntax? x)
(values (syntax-e x) x)
@ -461,7 +461,8 @@ Conventions:
[tx (cdr datum)]
[tpr (ps-add-cdr pr)])
(parse:matrix ((hx hcx hpr es) (tx tcx tpr es) . ins) inner))
(fail (failure pr es))))]
(let ([es* (if (and 'proper? (null? datum)) (es-add-proper es) es)])
(fail (failure pr es*)))))]
[(parse:pk (in1 . ins) #s(pk/and inner))
#'(parse:matrix (in1 in1 . ins) inner)]))
@ -568,7 +569,7 @@ Conventions:
[cut-prompt fail-to-succeed]) ;; to be safe
(parse:S x cx subpattern pr es
(fh0 (failure pr0 es0)))))]
[#s(pat:pair _attrs head tail)
[#s(pat:pair _attrs proper? head tail)
#`(let-values ([(datum cx)
(if (syntax? x)
(values (syntax-e x) x)
@ -581,7 +582,8 @@ Conventions:
[tpr (ps-add-cdr pr)])
(parse:S hx hcx head hpr es
(parse:S tx cx tail tpr es k)))
(fail (failure pr es))))]
(let ([es* (if (and 'proper? (null? datum)) (es-add-proper-pair es) es)])
(fail (failure pr es*)))))]
[#s(pat:vector _attrs subpattern)
#`(let ([datum (if (syntax? x) (syntax-e x) x)])
(if (vector? datum)
@ -717,9 +719,9 @@ Conventions:
[#s(pat:dots attrs head tail)
(with-syntax ([tail (convert-list-pattern #'tail end-pattern)])
#'#s(pat:dots attrs head tail))]
[#s(pat:pair attrs head-part tail-part)
[#s(pat:pair attrs proper? head-part tail-part)
(with-syntax ([tail-part (convert-list-pattern #'tail-part end-pattern)])
#'#s(pat:pair attrs head-part tail-part))])))
#'#s(pat:pair attrs proper? 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.
@ -857,7 +859,8 @@ Conventions:
[_
(with-syntax ([attrs (pattern-attrs (wash #'head))])
#'(parse:S x cx
#s(pat:pair attrs head #s(internal-rest-pattern rest-x rest-cx rest-pr))
;; FIXME: consider proper-list-pattern? (yes is consistent with ~seq)
#s(pat:pair attrs #t 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]

20
racket/collects/syntax/parse/private/rep-patterns.rkt
View File

@ -31,7 +31,7 @@ A SinglePattern is one of
(pat:and Base (listof SinglePattern))
(pat:or Base (listof SinglePattern))
(pat:not Base SinglePattern)
(pat:pair Base SinglePattern SinglePattern)
(pat:pair Base boolean SinglePattern SinglePattern)
(pat:vector Base SinglePattern)
(pat:box Base SinglePattern)
(pat:pstruct Base key SinglePattern)
@ -46,7 +46,7 @@ A ListPattern is a subtype of SinglePattern; one of
(pat:datum Base '())
(pat:action Base ActionPattern ListPattern)
(pat:head Base HeadPattern ListPattern)
(pat:pair Base SinglePattern ListPattern)
(pat:pair Base #t SinglePattern ListPattern)
(pat:dots Base EllipsisHeadPattern SinglePattern)
|#
@ -60,7 +60,7 @@ A ListPattern is a subtype of SinglePattern; one of
(define-struct pat:and (attrs patterns) #:prefab)
(define-struct pat:or (attrs patterns) #:prefab)
(define-struct pat:not (attrs pattern) #:prefab)
(define-struct pat:pair (attrs head tail) #:prefab)
(define-struct pat:pair (attrs proper? head tail) #:prefab)
(define-struct pat:vector (attrs pattern) #:prefab)
(define-struct pat:box (attrs pattern) #:prefab)
(define-struct pat:pstruct (attrs key pattern) #:prefab)
@ -268,7 +268,9 @@ A SideClause is one of
(make pat:head attrs headp tailp)))
(define (create-pat:pair headp tailp)
(make pat:pair (append-iattrs (map pattern-attrs (list headp tailp))) headp tailp))
(let ([attrs (append-iattrs (map pattern-attrs (list headp tailp)))]
[proper? (proper-list-pattern? tailp #t)])
(make pat:pair attrs proper? headp tailp)))
(define (create-pat:vector pattern)
(make pat:vector (pattern-attrs pattern) pattern))
@ -412,3 +414,13 @@ A SideClause is one of
(define (action-pattern->single-pattern gp)
(create-pat:action gp (create-pat:any)))
(define (proper-list-pattern? p trust-pair?)
(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))))
(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?))))

18
racket/collects/syntax/parse/private/rep.rkt
View File

@ -911,7 +911,8 @@
(define (parse-hpat:seq stx list-stx decls)
(define pattern (parse-single-pattern list-stx decls))
(check-list-pattern pattern stx)
(unless (proper-list-pattern? pattern #t)
(wrong-syntax stx "expected proper list pattern"))
(create-hpat:seq pattern))
(define (parse-cdr-patterns stx decls allow-head? allow-action?)
@ -1014,21 +1015,6 @@
[(_ pattern)
(parse-single-pattern #'pattern decls)]))
(define (check-list-pattern pattern stx)
(match pattern
[(pat:datum _base '())
#t]
[(pat:head _base _head tail)
(check-list-pattern tail stx)]
[(pat:action _base _action tail)
(check-list-pattern tail stx)]
[(pat:dots _base _head tail)
(check-list-pattern tail stx)]
[(pat:pair _base _head tail)
(check-list-pattern tail stx)]
[_
(wrong-syntax stx "expected proper list pattern")]))
(define (parse-hpat:optional stx decls)
(define-values (head-stx head iattrs _name _tmm defaults)
(parse*-optional-pattern stx decls h-optional-directive-table))

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

@ -22,11 +22,13 @@
(struct-out expect:literal)
(struct-out expect:message)
(struct-out expect:disj)
(struct-out expect:proper-pair)
es-add-thing
es-add-message
es-add-atom
es-add-literal)
es-add-literal
es-add-proper-pair)
;; FIXME: add phase to expect:literal
@ -143,6 +145,7 @@ An ExpectStack (during parsing) is one of
* (make-expect:message string ExpectStack)
* (make-expect:atom atom ExpectStack)
* (make-expect:literal identifier ExpectStack)
* (make-expect:proper-pair ExpectStack)
The *-marked variants can only occur at the top of the stack.
@ -156,6 +159,7 @@ An Expect is one of
* (expect:message string _)
* (expect:atom atom _)
* (expect:literal identifier _)
* (expect:proper-pair _)
- (expect:disj (non-empty-listof Expect) _)
That is, next link always ignored (replace with #f for sake of equal? cmp)
@ -168,13 +172,15 @@ Goal during reporting is ease of manipulation.
(struct expect:atom (atom next) #:prefab)
(struct expect:literal (literal next) #:prefab)
(struct expect:disj (expects next) #:prefab)
(struct expect:proper-pair (next) #:prefab)
(define (expect? x)
(or (expect:thing? x)
(expect:message? x)
(expect:atom? x)
(expect:literal? x)
(expect:disj? x)))
(expect:disj? x)
(expect:proper-pair? x)))
(define (es-add-thing ps description transparent? role next)
(if description
@ -191,3 +197,6 @@ Goal during reporting is ease of manipulation.
(define (es-add-literal literal next)
(expect:literal literal next))
(define (es-add-proper-pair next)
(expect:proper-pair next))

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

@ -131,7 +131,9 @@ complicated.
[(expect:literal literal _)
(format "expected the identifier `~s'" (syntax-e literal))]
[(expect:message message _)
(format "~a" message)]))
(format "~a" message)]
[(expect:proper-pair _)
"expected more terms"]))
;; == Do Report ==
@ -201,7 +203,9 @@ complicated.
[(expect:atom atom rest-es)
(cons (expect:atom atom #f) (loop rest-es))]
[(expect:literal literal rest-es)
(cons (expect:literal literal #f) (loop rest-es))]))))
(cons (expect:literal literal #f) (loop rest-es))]
[(expect:proper-pair rest-es)
(cons (expect:proper-pair #f) (loop rest-es))]))))
#|
Simplification dilemma