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

Fixing struct pattern optimization

Browse Source
This commit is contained in:
Jay McCarthy 2010-10-05 09:55:16 -06:00
parent ad3ee86863
commit 57d27373ac
2 changed files with 17 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/racket/match/parse-helper.rkt
View File

@ -106,7 +106,7 @@
(syntax-property
pred
'disappeared-use (list struct-name))
lineage complete?
lineage (and (checked-struct-info? v) complete?)
acc
(cond [(eq? '_ (syntax-e pats))
(map make-Dummy acc)]

17
collects/tests/match/plt-match-tests.rkt
View File

@ -179,7 +179,7 @@
(else #f)))
(check-true (origin? (make-point 0 0)))
(check-false (origin? (make-point 1 1)))))
; This test ensures that the unsafe struct optimization is correct
; These tests ensures that the unsafe struct optimization is correct
(test-case "struct patterns (with opaque parent)"
(let ()
(define-struct opq (any))
@ -191,6 +191,21 @@
(else #f)))
(check-true (origin? (make-point 'a 0 0)))
(check-false (origin? (make-point 'a 1 1))))))
(test-case "struct patterns (with fake struct info)"
(let ()
(define (point? x)
(and (list? x) (= 2 (length x))))
(define-syntax point
(list #f #f #'point? (list #'cadr #'car) (list #f #f) #t))
(define (origin? pt)
(match pt
((struct point (0 1)) #t)
(else #f)))
(check-true (origin? (list 0 1)))
(check-false (origin? (list 1 1)))
(check-false (origin? (list 1 1 1)))
(check-false (origin? (list 1)))
(check-false (origin? 1))))
))
(define nonlinear-tests