datalog: reject reserved relation names as rule/fact heads (246/246)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
Real bugs surfaced by parser/safety bug-hunt round: - `not(X) :- p(X).` parsed as a regular literal with relation "not". The user could accidentally define a `not` relation, silently shadowing the negation construct. - `count(N, X, p(X)) :- ...` defined a `count` relation that would conflict with the aggregate operator. - `<(X, 5) :- p(X).` defined a `<` relation. - `is(N, +(1, 2)) :- p(N).` defined an `is` relation. - `+.` (operator alone) parsed as a 0-ary fact. Fix: dl-add-fact! and dl-add-rule! now reject any literal whose head's relation name is in dl-reserved-rel-names — built-in operators (< <= > >= = != + - * /), aggregate operators (count sum min max findall), `is`, `not`, and the arrows (:-, ?-). 4 new eval tests cover the rejection cases. Note: an initial "no compound args in facts" check was overly strict — it would reject findall's list output (which derives a fact like (all_p (a b c))). Reverted that branch; treating findall results as opaque list values rather than function symbols.
This commit is contained in:
@@ -182,6 +182,20 @@
|
|||||||
((facts (get db :facts)))
|
((facts (get db :facts)))
|
||||||
(if (has-key? facts rel-key) (get facts rel-key) (list)))))
|
(if (has-key? facts rel-key) (get facts rel-key) (list)))))
|
||||||
|
|
||||||
|
;; Reserved relation names: built-in / aggregate / negation / arrow.
|
||||||
|
;; Rules and facts may not have these as their head's relation, since
|
||||||
|
;; the saturator treats them specially or they are not relation names
|
||||||
|
;; at all.
|
||||||
|
(define
|
||||||
|
dl-reserved-rel-names
|
||||||
|
(list "not" "count" "sum" "min" "max" "findall" "is"
|
||||||
|
"<" "<=" ">" ">=" "=" "!=" "+" "-" "*" "/" ":-" "?-"))
|
||||||
|
|
||||||
|
(define
|
||||||
|
dl-reserved-rel?
|
||||||
|
(fn
|
||||||
|
(name) (dl-member-string? name dl-reserved-rel-names)))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
dl-add-fact!
|
dl-add-fact!
|
||||||
(fn
|
(fn
|
||||||
@@ -189,6 +203,9 @@
|
|||||||
(cond
|
(cond
|
||||||
((not (and (list? lit) (> (len lit) 0)))
|
((not (and (list? lit) (> (len lit) 0)))
|
||||||
(error (str "dl-add-fact!: expected literal list, got " lit)))
|
(error (str "dl-add-fact!: expected literal list, got " lit)))
|
||||||
|
((dl-reserved-rel? (dl-rel-name lit))
|
||||||
|
(error (str "dl-add-fact!: '" (dl-rel-name lit)
|
||||||
|
"' is a reserved name (built-in / aggregate / negation)")))
|
||||||
((not (dl-ground? lit (dl-empty-subst)))
|
((not (dl-ground? lit (dl-empty-subst)))
|
||||||
(error (str "dl-add-fact!: expected ground literal, got " lit)))
|
(error (str "dl-add-fact!: expected ground literal, got " lit)))
|
||||||
(else
|
(else
|
||||||
@@ -301,6 +318,9 @@
|
|||||||
(error (str "dl-add-rule!: expected rule dict, got " rule)))
|
(error (str "dl-add-rule!: expected rule dict, got " rule)))
|
||||||
((not (has-key? rule :head))
|
((not (has-key? rule :head))
|
||||||
(error (str "dl-add-rule!: rule missing :head, got " rule)))
|
(error (str "dl-add-rule!: rule missing :head, got " rule)))
|
||||||
|
((dl-reserved-rel? (dl-rel-name (get rule :head)))
|
||||||
|
(error (str "dl-add-rule!: '" (dl-rel-name (get rule :head))
|
||||||
|
"' is a reserved name (built-in / aggregate / negation)")))
|
||||||
(else
|
(else
|
||||||
(let ((rule (dl-rename-anon-rule rule)))
|
(let ((rule (dl-rename-anon-rule rule)))
|
||||||
(let
|
(let
|
||||||
|
|||||||
@@ -1,13 +1,13 @@
|
|||||||
{
|
{
|
||||||
"lang": "datalog",
|
"lang": "datalog",
|
||||||
"total_passed": 242,
|
"total_passed": 246,
|
||||||
"total_failed": 0,
|
"total_failed": 0,
|
||||||
"total": 242,
|
"total": 246,
|
||||||
"suites": [
|
"suites": [
|
||||||
{"name":"tokenize","passed":26,"failed":0,"total":26},
|
{"name":"tokenize","passed":26,"failed":0,"total":26},
|
||||||
{"name":"parse","passed":20,"failed":0,"total":20},
|
{"name":"parse","passed":20,"failed":0,"total":20},
|
||||||
{"name":"unify","passed":28,"failed":0,"total":28},
|
{"name":"unify","passed":28,"failed":0,"total":28},
|
||||||
{"name":"eval","passed":32,"failed":0,"total":32},
|
{"name":"eval","passed":36,"failed":0,"total":36},
|
||||||
{"name":"builtins","passed":23,"failed":0,"total":23},
|
{"name":"builtins","passed":23,"failed":0,"total":23},
|
||||||
{"name":"semi_naive","passed":8,"failed":0,"total":8},
|
{"name":"semi_naive","passed":8,"failed":0,"total":8},
|
||||||
{"name":"negation","passed":10,"failed":0,"total":10},
|
{"name":"negation","passed":10,"failed":0,"total":10},
|
||||||
@@ -16,5 +16,5 @@
|
|||||||
{"name":"magic","passed":34,"failed":0,"total":34},
|
{"name":"magic","passed":34,"failed":0,"total":34},
|
||||||
{"name":"demo","passed":21,"failed":0,"total":21}
|
{"name":"demo","passed":21,"failed":0,"total":21}
|
||||||
],
|
],
|
||||||
"generated": "2026-05-09T13:11:25+00:00"
|
"generated": "2026-05-10T20:51:33+00:00"
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1,13 +1,13 @@
|
|||||||
# datalog scoreboard
|
# datalog scoreboard
|
||||||
|
|
||||||
**242 / 242 passing** (0 failure(s)).
|
**246 / 246 passing** (0 failure(s)).
|
||||||
|
|
||||||
| Suite | Passed | Total | Status |
|
| Suite | Passed | Total | Status |
|
||||||
|-------|--------|-------|--------|
|
|-------|--------|-------|--------|
|
||||||
| tokenize | 26 | 26 | ok |
|
| tokenize | 26 | 26 | ok |
|
||||||
| parse | 20 | 20 | ok |
|
| parse | 20 | 20 | ok |
|
||||||
| unify | 28 | 28 | ok |
|
| unify | 28 | 28 | ok |
|
||||||
| eval | 32 | 32 | ok |
|
| eval | 36 | 36 | ok |
|
||||||
| builtins | 23 | 23 | ok |
|
| builtins | 23 | 23 | ok |
|
||||||
| semi_naive | 8 | 8 | ok |
|
| semi_naive | 8 | 8 | ok |
|
||||||
| negation | 10 | 10 | ok |
|
| negation | 10 | 10 | ok |
|
||||||
|
|||||||
@@ -165,6 +165,28 @@
|
|||||||
((db (dl-program "edge(1, 2). edge(2, 3). edge(3, 1).\n reach(X, Y) :- edge(X, Y).\n reach(X, Z) :- edge(X, Y), reach(Y, Z).")))
|
((db (dl-program "edge(1, 2). edge(2, 3). edge(3, 1).\n reach(X, Y) :- edge(X, Y).\n reach(X, Z) :- edge(X, Y), reach(Y, Z).")))
|
||||||
(do (dl-saturate! db) (len (dl-relation db "reach"))))
|
(do (dl-saturate! db) (len (dl-relation db "reach"))))
|
||||||
9)
|
9)
|
||||||
|
;; Reserved relation names rejected as rule/fact heads.
|
||||||
|
(dl-et-test!
|
||||||
|
"reserved name `not` as head rejected"
|
||||||
|
(dl-et-throws? (fn () (dl-program "not(X) :- p(X).")))
|
||||||
|
true)
|
||||||
|
|
||||||
|
(dl-et-test!
|
||||||
|
"reserved name `count` as head rejected"
|
||||||
|
(dl-et-throws?
|
||||||
|
(fn () (dl-program "count(N, X, p(X)) :- p(X).")))
|
||||||
|
true)
|
||||||
|
|
||||||
|
(dl-et-test!
|
||||||
|
"reserved name `<` as head rejected"
|
||||||
|
(dl-et-throws? (fn () (dl-program "<(X, 5) :- p(X).")))
|
||||||
|
true)
|
||||||
|
|
||||||
|
(dl-et-test!
|
||||||
|
"reserved name `is` as head rejected"
|
||||||
|
(dl-et-throws? (fn () (dl-program "is(N, +(1, 2)) :- p(N).")))
|
||||||
|
true)
|
||||||
|
|
||||||
(dl-et-test!
|
(dl-et-test!
|
||||||
"unsafe head var"
|
"unsafe head var"
|
||||||
(dl-et-throws? (fn () (dl-program "p(X, Y) :- q(X).")))
|
(dl-et-throws? (fn () (dl-program "p(X, Y) :- q(X).")))
|
||||||
|
|||||||
Reference in New Issue
Block a user