Move Semgrep positive seed helpers
ober
c29ead25bc920392bab93192d75d79f10d610889
--- a/SEMGREP_JERBOA_IMPLEMENTATION.md +++ b/SEMGREP_JERBOA_IMPLEMENTATION.md @@ -516,6 +516,9 @@ Completed in the repo: `src/semgrep/engine/positive-dispatch.ss`, leaving `scan.ss` with the language-specific pattern callback ownership instead of the duplicated dispatch machinery + - moved positive-pattern seed selection helpers into + `src/semgrep/engine/positive-dispatch.ss` so the entry-shape and + entry-selection logic now live together - exported shared Python line-assignment analysis from `src/semgrep/engine/py-constant-prop.ss` so remaining Python fallbacks in `scan.ss` can reuse one assignment-info implementation --- a/lib/semgrep/engine/positive-dispatch.sls +++ b/lib/semgrep/engine/positive-dispatch.sls @@ -3,11 +3,9 @@ ;;; Source: src/semgrep/engine/positive-dispatch.ss (library (semgrep engine positive-dispatch) - (export - positive-pattern-entry? - pattern-inside-clause? - findings-without-metavars - scan-positive-entry-dispatch) + (export positive-pattern-entry? pattern-inside-clause? + seed-positive-clauses preferred-seed-positive-entry? + findings-without-metavars scan-positive-entry-dispatch) (import (except (chezscheme) make-hash-table hash-table? sort sort! printf fprintf format path-extension path-absolute? @@ -19,6 +17,13 @@ (def (alist-ref/default xs key default) (let ([found (assoc key xs)]) (if found (cdr found) default))) + (def (sg-filter pred xs) + (let loop ([remaining xs] [acc '()]) + (cond + [(null? remaining) (reverse acc)] + [(pred (car remaining)) + (loop (cdr remaining) (cons (car remaining) acc))] + [else (loop (cdr remaining) acc)]))) (def (positive-pattern-entry? entry) (case (car entry) [(pattern-regex pattern pattern-either pattern-as patterns) @@ -26,6 +31,26 @@ [else #f])) (def (pattern-inside-clause? entry) (eq? (car entry) 'pattern-inside)) + (def (pattern-either-inside-only-entry? entry) + (and (eq? (car entry) 'pattern-either) + (not (null? (cdr entry))) + (let loop ([xs (cdr entry)]) + (or (null? xs) + (and (pattern-inside-clause? (car xs)) + (loop (cdr xs))))))) + (def (seed-positive-clauses positive-clauses) + (let ([non-inside-either (sg-filter + (lambda (entry) + (not (pattern-either-inside-only-entry? + entry))) + positive-clauses)]) + (if (null? non-inside-either) + positive-clauses + non-inside-either))) + (def (preferred-seed-positive-entry? entry) + (case (car entry) + [(pattern-regex pattern pattern-as) #t] + [else #f])) (def (finding-without-metavars finding) (finding-with-extra finding --- a/lib/semgrep/scan.sls +++ b/lib/semgrep/scan.sls @@ -15152,26 +15152,6 @@ regex-captures? initial-bindings)) (scan-positive-entry-dispatch entry source regex-captures? scan-pattern-regex scan-pattern scan-patterns)) - (def (pattern-either-inside-only-entry? entry) - (and (eq? (car entry) 'pattern-either) - (not (null? (cdr entry))) - (let loop ([xs (cdr entry)]) - (or (null? xs) - (and (pattern-inside-clause? (car xs)) - (loop (cdr xs))))))) - (def (seed-positive-clauses positive-clauses) - (let ([non-inside-either (sg-filter - (lambda (entry) - (not (pattern-either-inside-only-entry? - entry))) - positive-clauses)]) - (if (null? non-inside-either) - positive-clauses - non-inside-either))) - (def (preferred-seed-positive-entry? entry) - (case (car entry) - [(pattern-regex pattern pattern-as) #t] - [else #f])) (def (finding-with-bindings rule finding bindings source) (let* ([match-text (source-slice source --- a/src/.jerbuild-hashes +++ b/src/.jerbuild-hashes @@ -42,13 +42,13 @@ ("src/semgrep/result/findings.ss" . "547811661239D9C7") ("src/semgrep/engine/positive-dispatch.ss" . - "E22A5FE7CB9EC4AD") + "221B0D787F146331") ("src/semgrep/engine/ts-query-scan.ss" . "51AD5339F6DE47B4") ("src/semgrep/rule/parse-rule.ss" . "EFA6D401699CEDEF") ("src/semgrep/output/json.ss" . "293881CFA2ADB7BC") ("src/semgrep/lang.ss" . "6982E07679D20836") ("src/semgrep/parse/parse-target.ss" . "97AA8FFEB12736DA") - ("src/semgrep/scan.ss" . "3154142AF39FB73B") + ("src/semgrep/scan.ss" . "A0AD8A558C4FAF6") ("src/semgrep/engine/generic-scan.ss" . "F69D0ACD0DD62610") ("src/semgrep/engine/js-constructor-scan.ss" . --- a/src/semgrep/engine/positive-dispatch.ss +++ b/src/semgrep/engine/positive-dispatch.ss @@ -1,6 +1,8 @@ (export positive-pattern-entry? pattern-inside-clause? + seed-positive-clauses + preferred-seed-positive-entry? findings-without-metavars scan-positive-entry-dispatch) @@ -13,6 +15,14 @@ (let ([found (assoc key xs)]) (if found (cdr found) default))) +(def (sg-filter pred xs) + (let loop ([remaining xs] [acc '()]) + (cond + [(null? remaining) (reverse acc)] + [(pred (car remaining)) + (loop (cdr remaining) (cons (car remaining) acc))] + [else (loop (cdr remaining) acc)]))) + (def (positive-pattern-entry? entry) (case (car entry) [(pattern-regex pattern pattern-either pattern-as patterns) #t] @@ -21,6 +31,29 @@ (def (pattern-inside-clause? entry) (eq? (car entry) 'pattern-inside)) +(def (pattern-either-inside-only-entry? entry) + (and (eq? (car entry) 'pattern-either) + (not (null? (cdr entry))) + (let loop ([xs (cdr entry)]) + (or (null? xs) + (and (pattern-inside-clause? (car xs)) + (loop (cdr xs))))))) + +(def (seed-positive-clauses positive-clauses) + (let ([non-inside-either + (sg-filter + (lambda (entry) + (not (pattern-either-inside-only-entry? entry))) + positive-clauses)]) + (if (null? non-inside-either) + positive-clauses + non-inside-either))) + +(def (preferred-seed-positive-entry? entry) + (case (car entry) + [(pattern-regex pattern pattern-as) #t] + [else #f])) + (def (finding-without-metavars finding) (finding-with-extra finding --- a/src/semgrep/scan.ss +++ b/src/semgrep/scan.ss @@ -15205,29 +15205,6 @@ scan-pattern scan-patterns)) -(def (pattern-either-inside-only-entry? entry) - (and (eq? (car entry) 'pattern-either) - (not (null? (cdr entry))) - (let loop ([xs (cdr entry)]) - (or (null? xs) - (and (pattern-inside-clause? (car xs)) - (loop (cdr xs))))))) - -(def (seed-positive-clauses positive-clauses) - (let ([non-inside-either - (sg-filter - (lambda (entry) - (not (pattern-either-inside-only-entry? entry))) - positive-clauses)]) - (if (null? non-inside-either) - positive-clauses - non-inside-either))) - -(def (preferred-seed-positive-entry? entry) - (case (car entry) - [(pattern-regex pattern pattern-as) #t] - [else #f])) - (def (finding-with-bindings rule finding bindings source) (let* ([match-text (source-slice source (finding-start-offset finding)