perf(fix): sort fixable findings once; emit fixed source in one pass
ober
ac527988588fbad5572825d6dc9f230808588e40
--- a/lib/semgrep/fix.sls +++ b/lib/semgrep/fix.sls @@ -18,44 +18,37 @@ (alist-ref/default (finding-extra finding) 'fix #f)) (def (fixable-finding? finding) (if (finding-fix finding) #t #f)) - (def (insert-finding-by-start-desc finding findings) - (cond - [(null? findings) (list finding)] - [(> (finding-start-offset finding) - (finding-start-offset (car findings))) - (cons finding findings)] - [else - (cons - (car findings) - (insert-finding-by-start-desc finding (cdr findings)))])) (def (sorted-fixable-findings findings) - (let loop ([xs findings] [acc '()]) - (cond - [(null? xs) acc] - [(fixable-finding? (car xs)) - (loop (cdr xs) (insert-finding-by-start-desc (car xs) acc))] - [else (loop (cdr xs) acc)]))) - (def (replace-range source start end replacement) - (string-append - (substring source 0 start) - replacement - (substring source end (string-length source)))) + (stable-sort + (filter fixable-finding? findings) + (lambda (a b) + (> (finding-start-offset a) (finding-start-offset b))))) (def (apply-fixes-to-string source findings) - (let loop ([current source] - [xs (sorted-fixable-findings findings)] - [frontier #f]) - (if (null? xs) - current - (let* ([finding (car xs)] - [start (finding-start-offset finding)] - [end (finding-end-offset finding)]) - (if (and frontier (> end frontier)) - (loop current (cdr xs) frontier) - (loop - (replace-range - current - start - end - (finding-fix finding)) - (cdr xs) - start))))))) + (let loop ([xs (sorted-fixable-findings findings)] + [frontier #f] + [applied '()]) + (cond + [(null? xs) (build-fixed-string source applied)] + [else + (let* ([finding (car xs)] + [start (finding-start-offset finding)] + [end (finding-end-offset finding)]) + (if (and frontier (> end frontier)) + (loop (cdr xs) frontier applied) + (loop (cdr xs) start (cons finding applied))))]))) + (def (build-fixed-string source applied) + (let ([out (open-output-string)] + [len (string-length source)]) + (let loop ([xs applied] [pos 0]) + (cond + [(null? xs) + (when (< pos len) (display (substring source pos len) out)) + (get-output-string out)] + [else + (let* ([f (car xs)] + [start (finding-start-offset f)] + [end (finding-end-offset f)]) + (when (> start pos) + (display (substring source pos start) out)) + (display (finding-fix f) out) + (loop (cdr xs) end))]))))) --- a/src/semgrep/fix.ss +++ b/src/semgrep/fix.ss @@ -14,46 +14,46 @@ (def (fixable-finding? finding) (if (finding-fix finding) #t #f)) -(def (insert-finding-by-start-desc finding findings) - (cond - [(null? findings) (list finding)] - [(> (finding-start-offset finding) - (finding-start-offset (car findings))) - (cons finding findings)] - [else - (cons (car findings) - (insert-finding-by-start-desc finding (cdr findings)))])) - (def (sorted-fixable-findings findings) - (let loop ([xs findings] [acc '()]) - (cond - [(null? xs) acc] - [(fixable-finding? (car xs)) - (loop (cdr xs) (insert-finding-by-start-desc (car xs) acc))] - [else (loop (cdr xs) acc)]))) - -(def (replace-range source start end replacement) - (string-append - (substring source 0 start) - replacement - (substring source end (string-length source)))) + (stable-sort (filter fixable-finding? findings) + (lambda (a b) + (> (finding-start-offset a) (finding-start-offset b))))) ;; Fixes are applied from the end of the string backward (descending start ;; offset), so earlier offsets stay valid. `frontier` is the smallest start ;; offset of an already-applied fix; because applied fixes never overlap, a ;; candidate overlaps an applied fix exactly when its end reaches past ;; `frontier`. Such candidates are skipped rather than corrupting the output. +;; Walking the descending list conses applied findings into ascending start +;; order, which build-fixed-string then emits in one left-to-right pass. (def (apply-fixes-to-string source findings) - (let loop ([current source] - [xs (sorted-fixable-findings findings)] - [frontier #f]) - (if (null? xs) - current + (let loop ([xs (sorted-fixable-findings findings)] + [frontier #f] + [applied '()]) + (cond + [(null? xs) (build-fixed-string source applied)] + [else (let* ([finding (car xs)] [start (finding-start-offset finding)] [end (finding-end-offset finding)]) (if (and frontier (> end frontier)) - (loop current (cdr xs) frontier) - (loop (replace-range current start end (finding-fix finding)) - (cdr xs) - start)))))) + (loop (cdr xs) frontier applied) + (loop (cdr xs) start (cons finding applied))))]))) + +(def (build-fixed-string source applied) + (let ([out (open-output-string)] + [len (string-length source)]) + (let loop ([xs applied] [pos 0]) + (cond + [(null? xs) + (when (< pos len) + (display (substring source pos len) out)) + (get-output-string out)] + [else + (let* ([f (car xs)] + [start (finding-start-offset f)] + [end (finding-end-offset f)]) + (when (> start pos) + (display (substring source pos start) out)) + (display (finding-fix f) out) + (loop (cdr xs) end))]))))