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

use group-by

Browse Source
This commit is contained in:
Ryan Culpepper 2016-04-16 23:45:33 -04:00
parent 6da3e88bd8
commit 837fe2a91a
1 changed files with 7 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -56,7 +56,7 @@ deals with the fact that they might not be talking about the same terms.
;; handle-failureset : (list Symbol/#f Syntax) FailureSet -> escapes ;; handle-failureset : (list Symbol/#f Syntax) FailureSet -> escapes
(define (handle-failureset ctx fs) (define (handle-failureset ctx fs)
(define inverted-fs (map invert-failure (flatten fs))) (define inverted-fs (map invert-failure (reverse (flatten fs))))
(define maximal-classes (maximal-failures inverted-fs)) (define maximal-classes (maximal-failures inverted-fs))
(define ess (map failure-expectstack (append* maximal-classes))) (define ess (map failure-expectstack (append* maximal-classes)))
(define report (report/sync-shared ess)) (define report (report/sync-shared ess))
@ -199,18 +199,13 @@ ie (ps->stx+index ps1) = (ps->stx+index ps2).
(loop (cdr items) best-items best-index)])]))) (loop (cdr items) best-items best-index)])])))
;; maximal/stx : (listof (cons A IPS)) -> (listof (listof A)) ;; maximal/stx : (listof (cons A IPS)) -> (listof (listof A))
;; PRE: Each IPS starts with a stx frame.
(define (maximal/stx rSTX) (define (maximal/stx rSTX)
(let ([stxs null] ;; groups : (Listof (Listof (cons A IPS)))
[table (make-hasheq)]) (define groups (group-by (lambda (a+ips) (car (cdr a+ips))) rSTX))
(for ([a+ips (in-list rSTX)])
(let* ([ips (cdr a+ips)]
[entry (hash-ref table (car ips) null)])
(when (null? entry)
(set! stxs (cons (car ips) stxs)))
(hash-set! table (car ips) (cons a+ips entry))))
(append* (append*
(for/list ([key (in-list stxs)]) (for/list ([group (in-list groups)])
(maximal/progress (map pop-item-ips (hash-ref table key))))))) (maximal/progress (map pop-item-ips group)))))
;; pop-item-ips : (cons A IPS) -> (cons A IPS) ;; pop-item-ips : (cons A IPS) -> (cons A IPS)
(define (pop-item-ips a+ips) (define (pop-item-ips a+ips)