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

Avoid problematic reordering of Or patterns.

Browse Source 
This makes two changes to `(or ...)` pattern compilation.

* Avoid reordering the individual elements of an `or` pattern.
  Since this reordering has broken programs with `and` patterns,
  avoid it here as well.

* Avoid re-ordering sets of patterns that _contain_ an `or`. This
  is not semantically important for match itself, but Typed Racket
  relies on the previous behavior.

  Closes racket/typed-racket#150.

Merge to 6.3
This commit is contained in:
Sam Tobin-Hochstadt 2015-10-26 09:12:20 -04:00
parent 7338f45bd2
commit d589f6a8ed
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/collects/racket/match/compiler.rkt
View File

@ -234,7 +234,8 @@
#f #f
seen)) seen))
qs) qs)
#'esc*)]) #'esc*
#f)])
;; then compile the rest of the row ;; then compile the rest of the row
(if success? (if success?
#,(compile* xs #,(compile* xs
@ -242,7 +243,8 @@
(Row-rhs row) (Row-rhs row)
(Row-unmatch row) (Row-unmatch row)
(append (map cons vars vars) seen))) (append (map cons vars vars) seen)))
esc) esc
#f)
(#,esc))))))] (#,esc))))))]
;; the App rule ;; the App rule
[(App? first) [(App? first)
@ -271,7 +273,6 @@
(define pats (Row-pats row)) (define pats (Row-pats row))
;; all the patterns ;; all the patterns
(define qs (And-ps (car pats))) (define qs (And-ps (car pats)))
(printf ">>> calling compile ~a\n " (append qs (cdr pats)))
(compile* (append (map (lambda _ x) qs) xs) (compile* (append (map (lambda _ x) qs) xs)
(list (make-Row (append qs (cdr pats)) (list (make-Row (append qs (cdr pats))
(Row-rhs row) (Row-rhs row)
@ -473,7 +474,10 @@
;; and compile each block with a reference to its continuation ;; and compile each block with a reference to its continuation
[else [else
(let*-values (let*-values
([(rows vars) (if reorder? ([(rows vars) (if (and (>= 1 (length vars))
reorder?
;; moving Or patterns early breaks Typed Racket
(not (ormap Or? (apply append (map Row-pats rows)))))
(reorder-columns rows vars) (reorder-columns rows vars)
(values rows vars))] (values rows vars))]
[(fns) [(fns)