perf(sarif): hash set for rule dedupe
ober
4d44d79fd97005715b21db648225c01ad2b408ab
--- a/lib/semgrep/output/sarif.sls +++ b/lib/semgrep/output/sarif.sls @@ -54,30 +54,27 @@ [(string=? severity "INFO") "note"] [(string=? severity "LOW") "note"] [else "warning"])) - (def (rule-seen? rule-id seen) - (and (not (null? seen)) - (or (string=? rule-id (car seen)) - (rule-seen? rule-id (cdr seen))))) (def (sarif-rules findings) - (let loop ([xs findings] [seen '()] [acc '()]) - (cond - [(null? xs) (reverse acc)] - [(rule-seen? (finding-rule-id (car xs)) seen) - (loop (cdr xs) seen acc)] - [else - (let ([finding (car xs)]) - (loop - (cdr xs) - (cons (finding-rule-id finding) seen) - (cons - (make-json-object - (cons "id" (finding-rule-id finding)) - (cons "name" (finding-rule-id finding)) - (cons - "shortDescription" - (make-json-object - (cons "text" (finding-message finding))))) - acc)))]))) + (let ([seen (make-hash-table)]) + (let loop ([xs findings] [acc '()]) + (cond + [(null? xs) (reverse acc)] + [(hash-key? seen (finding-rule-id (car xs))) + (loop (cdr xs) acc)] + [else + (let ([finding (car xs)]) + (hash-put! seen (finding-rule-id finding) #t) + (loop + (cdr xs) + (cons + (make-json-object + (cons "id" (finding-rule-id finding)) + (cons "name" (finding-rule-id finding)) + (cons + "shortDescription" + (make-json-object + (cons "text" (finding-message finding))))) + acc)))])))) (def (findings->sarif-json-string findings) (json-object->string (make-json-object --- a/src/semgrep/output/sarif.ss +++ b/src/semgrep/output/sarif.ss @@ -48,29 +48,25 @@ [(string=? severity "LOW") "note"] [else "warning"])) -(def (rule-seen? rule-id seen) - (and (not (null? seen)) - (or (string=? rule-id (car seen)) - (rule-seen? rule-id (cdr seen))))) - (def (sarif-rules findings) - (let loop ([xs findings] [seen '()] [acc '()]) - (cond - [(null? xs) (reverse acc)] - [(rule-seen? (finding-rule-id (car xs)) seen) - (loop (cdr xs) seen acc)] - [else - (let ([finding (car xs)]) - (loop (cdr xs) - (cons (finding-rule-id finding) seen) - (cons - (make-json-object - (cons "id" (finding-rule-id finding)) - (cons "name" (finding-rule-id finding)) - (cons "shortDescription" - (make-json-object - (cons "text" (finding-message finding))))) - acc)))]))) + (let ([seen (make-hash-table)]) + (let loop ([xs findings] [acc '()]) + (cond + [(null? xs) (reverse acc)] + [(hash-key? seen (finding-rule-id (car xs))) + (loop (cdr xs) acc)] + [else + (let ([finding (car xs)]) + (hash-put! seen (finding-rule-id finding) #t) + (loop (cdr xs) + (cons + (make-json-object + (cons "id" (finding-rule-id finding)) + (cons "name" (finding-rule-id finding)) + (cons "shortDescription" + (make-json-object + (cons "text" (finding-message finding))))) + acc)))])))) (def (findings->sarif-json-string findings) (json-object->string