diff --git a/collects/typed-racket/optimizer/tool/mzc.rkt b/collects/typed-racket/optimizer/tool/mzc.rkt index b4fb0b7d0a..b6cf7c0075 100644 --- a/collects/typed-racket/optimizer/tool/mzc.rkt +++ b/collects/typed-racket/optimizer/tool/mzc.rkt @@ -147,9 +147,7 @@ (define-values (inliner-logs tr-logs) (partition inliner-log-entry? log)) (define grouped-events - (group-by (lambda (x y) - (equal? (log-entry-pos x) ; right file, so that's enough - (log-entry-pos y))) + (group-by equal? #:key log-entry-pos ; right file, so that's enough inliner-logs)) (define new-inline-log-entries (for*/list ([g (in-list grouped-events)] diff --git a/collects/typed-racket/optimizer/tool/utilities.rkt b/collects/typed-racket/optimizer/tool/utilities.rkt index 7b85becf33..242ab3ad8a 100644 --- a/collects/typed-racket/optimizer/tool/utilities.rkt +++ b/collects/typed-racket/optimizer/tool/utilities.rkt @@ -8,10 +8,10 @@ (for/list ([l (in-list log)] #:when (regexp-match r l)) l)) -;; (x x -> bool) (listof x) -> (listof (listof x)) +;; (y y -> bool) (listof x) #:key (x -> y) -> (listof (listof x)) ;; groups together elements that are considered equal ;; =? should be reflexive, transitive and commutative -(define (group-by =? l) +(define (group-by =? l #:key [key values]) (for/fold ([res '()]) ; list of lists ([elt (in-list l)]) (let loop ([classes res] ; "zipper" of the equivalence classes @@ -19,7 +19,7 @@ (cond [(null? classes) ;; did not find an equivalence class, create a new one (cons (list elt) res)] - [(=? elt (car (car classes))) + [(=? (key elt) (key (car (car classes)))) ;; found the equivalence class (append rev-classes ; we keep what we skipped ;; we extend the current class @@ -31,4 +31,3 @@ ;; TODO add to unstable/list, and add tests. here's one ;; -> (group-by = '(1 2 1 2 54 2 5 43 7 2 643 1 2 0)) ;; '((0) (2 2 2 2 2) (7) (43) (5) (54) (643) (1 1 1)) -;; TODO needs a #:key arg