prolog: Hyperscript bridge (+19)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s

pl-hs-query, pl-hs-predicate/1,2,3, pl-hs-install in hs-bridge.sx.
No parser/compiler changes: Hyperscript already compiles
`when allowed(user, action)` to (allowed user action).
Total 590/590.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-05-06 08:30:46 +00:00
parent ef736112ef
commit f07b6e497e
6 changed files with 249 additions and 8 deletions

View File

@@ -0,0 +1,165 @@
;; lib/prolog/tests/hs_bridge.sx — tests for Prolog↔Hyperscript bridge
;;
;; Verifies pl-hs-query, pl-hs-predicate/N, and pl-hs-install.
;; Also demonstrates the end-to-end DSL pattern:
;; (define allowed (pl-hs-predicate/2 db "allowed"))
;; → (allowed "alice" "edit") is what Hyperscript compiles
;; `when allowed(alice, edit)` to.
(define pl-hsb-test-count 0)
(define pl-hsb-test-pass 0)
(define pl-hsb-test-fail 0)
(define pl-hsb-test-failures (list))
(define
pl-hsb-test!
(fn
(name got expected)
(begin
(set! pl-hsb-test-count (+ pl-hsb-test-count 1))
(if
(= got expected)
(set! pl-hsb-test-pass (+ pl-hsb-test-pass 1))
(begin
(set! pl-hsb-test-fail (+ pl-hsb-test-fail 1))
(append!
pl-hsb-test-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── shared KB ──
(define
pl-hsb-perm-src
"role(alice, admin). role(bob, editor). role(charlie, viewer). permission(admin, read). permission(admin, write). permission(admin, delete). permission(editor, read). permission(editor, write). permission(viewer, read). allowed(U, A) :- role(U, R), permission(R, A).")
(define pl-hsb-db (pl-load pl-hsb-perm-src))
;; ── pl-hs-query ──
(pl-hsb-test!
"pl-hs-query: ground fact succeeds"
(pl-hs-query pl-hsb-db "role(alice, admin)")
true)
(pl-hsb-test!
"pl-hs-query: absent fact fails"
(pl-hs-query pl-hsb-db "role(alice, viewer)")
false)
(pl-hsb-test!
"pl-hs-query: rule derivation succeeds"
(pl-hs-query pl-hsb-db "allowed(alice, delete)")
true)
(pl-hsb-test!
"pl-hs-query: rule derivation fails"
(pl-hs-query pl-hsb-db "allowed(charlie, delete)")
false)
(pl-hsb-test!
"pl-hs-query: arithmetic goal"
(pl-hs-query pl-hsb-db "X is 3 + 4, X = 7")
true)
;; ── pl-hs-predicate/2 ──
(define pl-hsb-allowed (pl-hs-predicate/2 pl-hsb-db "allowed"))
(pl-hsb-test!
"predicate/2: alice can read"
(pl-hsb-allowed "alice" "read")
true)
(pl-hsb-test!
"predicate/2: alice can delete"
(pl-hsb-allowed "alice" "delete")
true)
(pl-hsb-test!
"predicate/2: charlie cannot write"
(pl-hsb-allowed "charlie" "write")
false)
(pl-hsb-test!
"predicate/2: bob can write"
(pl-hsb-allowed "bob" "write")
true)
(pl-hsb-test!
"predicate/2: unknown user fails"
(pl-hsb-allowed "eve" "read")
false)
;; ── DSL simulation ──
;; Hyperscript compiles `when allowed(user, action) then …`
;; to `(allowed user action)` — a direct SX function call.
;; Here we verify that pattern works end-to-end.
(define pl-hsb-user "alice")
(define pl-hsb-action "write")
(pl-hsb-test!
"DSL simulation: (allowed user action) true path"
(pl-hsb-allowed pl-hsb-user pl-hsb-action)
true)
(define pl-hsb-user2 "charlie")
(pl-hsb-test!
"DSL simulation: (allowed user action) false path"
(pl-hsb-allowed pl-hsb-user2 pl-hsb-action)
false)
;; ── pl-hs-predicate/1 ──
(define pl-hsb-viewer-src "color(red). color(green). color(blue).")
(define pl-hsb-color-db (pl-load pl-hsb-viewer-src))
(define pl-hsb-color? (pl-hs-predicate/1 pl-hsb-color-db "color"))
(pl-hsb-test! "predicate/1: color(red) succeeds" (pl-hsb-color? "red") true)
(pl-hsb-test!
"predicate/1: color(purple) fails"
(pl-hsb-color? "purple")
false)
;; ── pl-hs-predicate/3 ──
(define pl-hsb-3ary-src "between_vals(X, Lo, Hi) :- X >= Lo, X =< Hi.")
(define pl-hsb-3ary-db (pl-load pl-hsb-3ary-src))
(define pl-hsb-in-range? (pl-hs-predicate/3 pl-hsb-3ary-db "between_vals"))
(pl-hsb-test!
"predicate/3: 5 in range [1,10]"
(pl-hsb-in-range? "5" "1" "10")
true)
(pl-hsb-test!
"predicate/3: 15 not in range [1,10]"
(pl-hsb-in-range? "15" "1" "10")
false)
;; ── pl-hs-install ──
(define
pl-hsb-installed
(pl-hs-install
pl-hsb-db
(list (list "allowed" 2) (list "role" 2) (list "permission" 2))))
(pl-hsb-test!
"pl-hs-install: returns dict with allowed key"
(not (nil? (dict-get pl-hsb-installed "allowed")))
true)
(pl-hsb-test!
"pl-hs-install: installed allowed fn works"
((dict-get pl-hsb-installed "allowed") "alice" "delete")
true)
(pl-hsb-test!
"pl-hs-install: installed role fn works"
((dict-get pl-hsb-installed "role") "bob" "editor")
true)
(define pl-hs-bridge-tests-run! (fn () {:failed pl-hsb-test-fail :passed pl-hsb-test-pass :total pl-hsb-test-count :failures pl-hsb-test-failures}))