diff --git a/lib/mod/policy.sx b/lib/mod/policy.sx index 0853ff50..3d1cde58 100644 --- a/lib/mod/policy.sx +++ b/lib/mod/policy.sx @@ -45,6 +45,7 @@ ;; (:attr "verified") → attr(Id, verified) ;; (:not ) → not() (negation as failure) ;; (:count-at-least 3) → report(Id, B, S), report_count(S, N), N >= 3 +;; (:score-at-least 5) → aggregate_all(sum(W), signal(Id, _, W), T), T >= 5 (define mod/cond->goal @@ -71,6 +72,12 @@ idterm ", B, S), report_count(S, N), N >= " (nth c 1))) + ((= tag :score-at-least) + (str + "aggregate_all(sum(W), signal(" + idterm + ", _, W), T), T >= " + (nth c 1))) (true "true"))))) (define diff --git a/lib/mod/schema.sx b/lib/mod/schema.sx index cc277de8..32d907c6 100644 --- a/lib/mod/schema.sx +++ b/lib/mod/schema.sx @@ -1,13 +1,14 @@ ;; lib/mod/schema.sx — report representation + Prolog fact generation. ;; -;; A report is a dict {:id :by :about :reason :evidence :attrs}. :evidence is a -;; list of accumulated evidence entries {:kind :val} (human review, automated -;; scanners). :attrs is a list of attribute names (e.g. "verified") used by -;; negation-as-failure conditions. The engine derives keyword classifications -;; from the reason text and projects the report, its classifications, evidence, -;; and attributes into Prolog facts that policy clauses match against. +;; A report is a dict {:id :by :about :reason :evidence :attrs :signals}. +;; :evidence — accumulated {:kind :val} entries (human review, scanners) +;; :attrs — attribute names ("verified") for negation-as-failure conditions +;; :signals — weighted {:kind :weight} entries for aggregate scoring rules +;; The engine derives keyword classifications from the reason text and projects +;; the report, its classifications, evidence, attributes, and signals into Prolog +;; facts that policy clauses match against. -(define mod/mk-report (fn (id by about reason) {:attrs (list) :id id :by by :evidence (list) :about about :reason reason})) +(define mod/mk-report (fn (id by about reason) {:attrs (list) :id id :signals (list) :by by :evidence (list) :about about :reason reason})) (define mod/report-id (fn (r) (get r :id))) (define mod/report-by (fn (r) (get r :by))) @@ -22,19 +23,37 @@ mod/report-attrs (fn (r) (let ((a (get r :attrs))) (if (nil? a) (list) a)))) +(define + mod/report-signals + (fn (r) (let ((s (get r :signals))) (if (nil? s) (list) s)))) + (define mod/mk-evidence (fn (kind val) {:val val :kind kind})) (define mod/evidence-kind (fn (e) (get e :kind))) (define mod/evidence-val (fn (e) (get e :val))) -(define mod/report* (fn (r evs attrs) {:attrs attrs :id (mod/report-id r) :by (mod/report-by r) :evidence evs :about (mod/report-about r) :reason (mod/report-reason r)})) +(define mod/mk-signal (fn (kind weight) {:kind kind :weight weight})) +(define mod/signal-kind (fn (s) (get s :kind))) +(define mod/signal-weight (fn (s) (get s :weight))) + +(define mod/report* (fn (r evs attrs sigs) {:attrs attrs :id (mod/report-id r) :signals sigs :by (mod/report-by r) :evidence evs :about (mod/report-about r) :reason (mod/report-reason r)})) (define mod/with-evidence - (fn (r evs) (mod/report* r evs (mod/report-attrs r)))) + (fn + (r evs) + (mod/report* r evs (mod/report-attrs r) (mod/report-signals r)))) (define mod/with-attrs - (fn (r attrs) (mod/report* r (mod/report-evidence r) attrs))) + (fn + (r attrs) + (mod/report* r (mod/report-evidence r) attrs (mod/report-signals r)))) + +(define + mod/with-signals + (fn + (r sigs) + (mod/report* r (mod/report-evidence r) (mod/report-attrs r) sigs))) (define mod/attach-evidence @@ -46,6 +65,10 @@ mod/attach-attr (fn (r a) (mod/with-attrs r (append (mod/report-attrs r) (list a))))) +(define + mod/attach-signal + (fn (r s) (mod/with-signals r (append (mod/report-signals r) (list s))))) + ;; ── substring search (the prolog-loaded env lacks includes?; slice/len do work) ── (define @@ -162,6 +185,25 @@ (id attrs) (mod/join-with "\n" (map (fn (a) (str "attr(" id ", " a ").")) attrs)))) +(define + mod/signal-facts + (fn + (id sigs) + (mod/join-with + "\n" + (map + (fn + (s) + (str + "signal(" + id + ", " + (mod/pl-quote (mod/signal-kind s)) + ", " + (mod/signal-weight s) + ").")) + sigs)))) + (define mod/report-facts (fn @@ -173,7 +215,8 @@ (let ((cls (mod/classification-facts id (mod/classify-keywords r))) (evs (mod/evidence-facts id (mod/report-evidence r))) - (ats (mod/attr-facts id (mod/report-attrs r)))) + (ats (mod/attr-facts id (mod/report-attrs r))) + (sgs (mod/signal-facts id (mod/report-signals r)))) (mod/join-with "\n" (list @@ -181,4 +224,5 @@ (str "report_count(" about ", " count ").") cls evs - ats)))))) + ats + sgs)))))) diff --git a/lib/mod/scoreboard.json b/lib/mod/scoreboard.json index 2cb967d6..d8930e4f 100644 --- a/lib/mod/scoreboard.json +++ b/lib/mod/scoreboard.json @@ -1,14 +1,14 @@ { "lang": "mod", - "total_passed": 146, + "total_passed": 154, "total_failed": 0, - "total": 146, + "total": 154, "suites": [ {"name":"decide","passed":31,"failed":0,"total":31}, {"name":"audit","passed":29,"failed":0,"total":29}, {"name":"escalation","passed":46,"failed":0,"total":46}, {"name":"fed","passed":26,"failed":0,"total":26}, - {"name":"extensions","passed":14,"failed":0,"total":14} + {"name":"extensions","passed":22,"failed":0,"total":22} ], - "generated": "2026-06-06T17:58:37+00:00" + "generated": "2026-06-06T18:02:25+00:00" } diff --git a/lib/mod/scoreboard.md b/lib/mod/scoreboard.md index b830428f..353b11ca 100644 --- a/lib/mod/scoreboard.md +++ b/lib/mod/scoreboard.md @@ -1,6 +1,6 @@ # mod scoreboard -**146 / 146 passing** (0 failure(s)). +**154 / 154 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -8,4 +8,4 @@ | audit | 29 | 29 | ok | | escalation | 46 | 46 | ok | | fed | 26 | 26 | ok | -| extensions | 14 | 14 | ok | +| extensions | 22 | 22 | ok | diff --git a/lib/mod/tests/extensions.sx b/lib/mod/tests/extensions.sx index 23cf6b1d..46090632 100644 --- a/lib/mod/tests/extensions.sx +++ b/lib/mod/tests/extensions.sx @@ -1,9 +1,12 @@ ;; lib/mod/tests/extensions.sx — beyond-roadmap extensions. ;; ;; Ext 1: negation-as-failure conditions (:not / :attr) + report attributes. -;; These exercise closed-world reasoning: "hide spam UNLESS the author is -;; verified". Demonstrated with custom rule sets so the default policy (and its -;; 132 conformance tests) stays untouched. +;; "hide spam UNLESS the author is verified" (closed-world reasoning). +;; Ext 2: weighted/aggregate evidence scoring (:score-at-least) + report signals. +;; Many low-confidence signals accumulate past a threshold via Prolog +;; aggregate_all(sum(W), ...). +;; Demonstrated with custom rule sets so the default policy (and its conformance +;; tests) stays untouched. (define mod-ext-count 0) (define mod-ext-pass 0) @@ -25,7 +28,7 @@ mod-ext-failures (str name "\n expected: " expected "\n got: " got))))))) -;; ── report attributes ── +;; ── Ext 1: report attributes ── (define mod-ext-r0 (mod/mk-report "r1" "a" "b" "this is spam")) (mod-ext-test! @@ -50,7 +53,7 @@ (mod/attach-evidence mod-ext-rv (mod/mk-evidence "x" "y")))) 1) -;; ── negation-as-failure: spam hidden unless author verified ── +;; ── Ext 1: negation-as-failure: spam hidden unless author verified ── (define mod-ext-rules @@ -93,7 +96,7 @@ :action) "keep") -;; ── negation appears in the goal text + proof ── +;; ── Ext 1: negation appears in the goal text + proof ── (define mod-ext-dec @@ -117,7 +120,7 @@ (get (nth mod-ext-goals 1) :solved) true) -;; ── cond->goal compiles :attr and :not directly ── +;; ── Ext 1: cond->goal compiles :attr and :not directly ── (mod-ext-test! "cond->goal :attr" @@ -128,7 +131,7 @@ (mod/cond->goal (list :not (list :classification "spam")) "Id") "not(classification(Id, spam))") -;; ── positive :attr condition (allowlist-style) ── +;; ── Ext 1: positive :attr condition (allowlist-style) ── (define mod-ext-allow-rules @@ -150,4 +153,98 @@ :action) "keep") +;; ── Ext 2: weighted signals + aggregate scoring ── + +(define mod-ext-s0 (mod/mk-report "s1" "a" "b" "neutral")) +(mod-ext-test! + "fresh report has no signals" + (len (mod/report-signals mod-ext-s0)) + 0) +(define + mod-ext-s1 + (mod/attach-signal mod-ext-s0 (mod/mk-signal "link" 2))) +(mod-ext-test! + "attach-signal adds one" + (len (mod/report-signals mod-ext-s1)) + 1) +(mod-ext-test! + "attach-signal preserves attrs" + (len + (mod/report-attrs + (mod/attach-signal mod-ext-rv (mod/mk-signal "x" 1)))) + 1) + +(define + mod-ext-score-rules + (list + (mod/mk-rule + "high-score-hide" + :hide (list (list :score-at-least 5))) + (mod/mk-rule "default-keep" :keep (list)))) + +;; one weak signal (2) — below threshold +(define + mod-ext-weak + (mod/attach-signal + (mod/mk-report "w1" "a" "b" "neutral") + (mod/mk-signal "link" 2))) +(mod-ext-test! + "single weak signal → keep (below threshold)" + (get + (mod/decide-report mod-ext-weak (list mod-ext-weak) mod-ext-score-rules) + :action) + "keep") + +;; three signals summing to 6 — over threshold +(define + mod-ext-strong0 + (mod/attach-signal + (mod/mk-report "w2" "a" "b" "neutral") + (mod/mk-signal "link" 2))) +(define + mod-ext-strong1 + (mod/attach-signal mod-ext-strong0 (mod/mk-signal "newaccount" 2))) +(define + mod-ext-strong + (mod/attach-signal mod-ext-strong1 (mod/mk-signal "burst" 2))) +(mod-ext-test! + "accumulated signals (2+2+2=6) → hide" + (get + (mod/decide-report + mod-ext-strong + (list mod-ext-strong) + mod-ext-score-rules) + :action) + "hide") +(mod-ext-test! + "scoring rule named in decision" + (get + (mod/decide-report + mod-ext-strong + (list mod-ext-strong) + mod-ext-score-rules) + :rule) + "high-score-hide") + +;; exactly at threshold (5) fires +(define + mod-ext-exact0 + (mod/attach-signal + (mod/mk-report "w3" "a" "b" "neutral") + (mod/mk-signal "link" 3))) +(define + mod-ext-exact + (mod/attach-signal mod-ext-exact0 (mod/mk-signal "burst" 2))) +(mod-ext-test! + "exactly at threshold (5) → hide" + (get + (mod/decide-report mod-ext-exact (list mod-ext-exact) mod-ext-score-rules) + :action) + "hide") + +(mod-ext-test! + "cond->goal :score-at-least" + (mod/cond->goal (list :score-at-least 5) "Id") + "aggregate_all(sum(W), signal(Id, _, W), T), T >= 5") + (define mod-extensions-tests-run! (fn () {:failures mod-ext-failures :total mod-ext-count :passed mod-ext-pass :failed mod-ext-fail})) diff --git a/plans/mod-on-sx.md b/plans/mod-on-sx.md index 4c70baf3..f7c9c690 100644 --- a/plans/mod-on-sx.md +++ b/plans/mod-on-sx.md @@ -16,7 +16,7 @@ federation extension. ## Status (rolling) -`bash lib/mod/conformance.sh` → **146/146** (roadmap done + extensions in progress) +`bash lib/mod/conformance.sh` → **154/154** (roadmap done + extensions in progress) ## Ground rules @@ -137,12 +137,23 @@ lib/mod/fed.sx prefix `\+` operator). Closed-world example: "hide spam UNLESS author verified". Default policy untouched — demonstrated via custom rule sets, so all 132 base tests stay green. -- [ ] Ext 2 — weighted/aggregate evidence scoring + threshold rules +- [x] **Ext 2 — weighted/aggregate scoring** (+8). Report `:signals` ({:kind + :weight}) project to `signal(Id, 'kind', weight)` facts; condition + `(:score-at-least N)` → `aggregate_all(sum(W), signal(Id, _, W), T), T >= N`. + Many weak signals accumulate past a threshold — genuine Prolog arithmetic + aggregation. Default policy untouched. - [ ] Ext 3 — human-readable proof explanation (render a decision's `:goals`) - [ ] Ext 4 — report linking / dedup (relations between reports about one subject) ## Progress log +- **Ext 2 — weighted/aggregate scoring, 154/154** (+8). `:signals` + the + `(:score-at-least N)` condition push aggregation into Prolog + (`aggregate_all(sum(W), …)`), so low-confidence signals can accumulate to a + takedown. The schema's report-rebuild helpers (`report*` / `with-*`) now thread + six fields; each addition stays non-breaking because empty collections project + to empty fact blocks. Default policy and its 132 tests untouched (proven via + custom rule sets). - **Ext 1 — negation-as-failure, 146/146** (+14). `:attr` and `:not` conditions give the policy closed-world reasoning. The substrate's negation is a functor (`not(Goal)`), not the ISO prefix `\+` operator (that doesn't parse here) —