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

Fix uses of make-Dummy.

Browse Source 
Fix handling of seen vars in ...

svn: r9870
This commit is contained in:
Sam Tobin-Hochstadt 2008-05-16 19:56:07 +00:00
parent 1d67f058fc
commit 61a80e85fb
2 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/scheme/match/compiler.ss
View File

@ -118,6 +118,7 @@
(compile-con-pat accs pred Struct-ps))]
[else (error 'compile "bad key: ~a" k)]))
;; produces the syntax for a let clause
(define (compile-one vars block esc)
(define-values (first rest-pats) (Row-split-pats (car block)))
@ -147,7 +148,7 @@
(lambda (row)
(define-values (p ps) (Row-split-pats row))
(define v (Var-v p))
(define seen (Row-vars-seen row))
(define seen (Row-vars-seen row))
;; a new row with the rest of the patterns
(cond
;; if this was a wild-card variable, don't bind
@ -157,10 +158,9 @@
(Row-vars-seen row))]
;; if we've seen this variable before, check that it's equal to
;; the one we saw
[(ormap (lambda (e)
(let ([v* (car e)] [id (cdr e)])
(and (bound-identifier=? v v*) id)))
seen)
[(for/or ([e seen])
(let ([v* (car e)] [id (cdr e)])
(and (bound-identifier=? v v*) id)))
=>
(lambda (id)
(make-Row ps
@ -390,13 +390,15 @@
(make-Row pats
rhs
(Row-unmatch (car block))
null))
(Row-vars-seen
(car block))))
(map list heads)
(syntax->list #'(rhs ...)))
(list (make-Row (list tail)
#`tail-rhs
(Row-unmatch (car block))
null)))
(Row-vars-seen
(car block)))))
#'failkv)))]
[else (error 'compile "unsupported pattern: ~a~n" first)]))

8
collects/scheme/match/parse.ss
View File

@ -104,7 +104,7 @@
(cons max (map (lambda _ 1) ps))
;; vars in lp are lists, vars elsewhere are not
(cons #f (map (lambda _ #t) ps))
(make-Null (make-Dummy #f))
(make-Null (make-Dummy (syntax/loc stx _)))
#f))]
[(list-no-order p ...)
(ormap ddk? (syntax->list #'(p ...)))
@ -119,10 +119,10 @@
(map (lambda _ 1) ps)
;; all of these patterns get bound to only one thing
(map (lambda _ #t) ps)
(make-Null (make-Dummy #f))
(make-Null (make-Dummy (syntax/loc stx _)))
#f))]
[(list) (make-Null (make-Dummy stx))]
[(mlist) (make-Null (make-Dummy stx))]
[(list) (make-Null (make-Dummy (syntax/loc stx _)))]
[(mlist) (make-Null (make-Dummy (syntax/loc stx _)))]
[(list ..)
(ddk? #'..)
(raise-syntax-error 'match "incorrect use of ... in pattern" stx #'..)]