giles
4018671087
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
lib/maude/meta.sx — up-term/down-term encode terms as data (mt-var/mt-app), reflective meta-reduce/meta-rewrite/meta-apply, the meta-circular law down(metaReduce(up t)) =AC= reduce t, and meta-prove-equal? as a generic equational theorem helper. Verified round-trips, reflection agreement, single-rule meta-apply, and proving commutativity/associativity instances. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
145 lines
3.7 KiB
Plaintext
145 lines
3.7 KiB
Plaintext
;; lib/maude/tests/meta.sx — Phase 7: reflection (META-LEVEL).
|
|
|
|
(define mmtt-pass 0)
|
|
(define mmtt-fail 0)
|
|
(define mmtt-failures (list))
|
|
|
|
(define
|
|
mmtt-check!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(= got expected)
|
|
(set! mmtt-pass (+ mmtt-pass 1))
|
|
(do
|
|
(set! mmtt-fail (+ mmtt-fail 1))
|
|
(append!
|
|
mmtt-failures
|
|
(str name " expected: " expected " got: " got))))))
|
|
|
|
(define
|
|
mmtt-peano
|
|
(mau/parse-module
|
|
"fmod PEANO is\n sort Nat .\n op 0 : -> Nat .\n op s_ : Nat -> Nat .\n op _+_ : Nat Nat -> Nat [assoc comm] .\n vars X Y : Nat .\n eq 0 + Y = Y .\n eq s X + Y = s (X + Y) .\nendfm"))
|
|
|
|
(define
|
|
mmtt-ndet
|
|
(mau/parse-module
|
|
"mod NDET is\n sort S .\n ops a b c : -> S .\n rl [r1] : a => b .\n rl [r2] : b => c .\nendm"))
|
|
|
|
;; ---- terms-as-data: up / down ----
|
|
|
|
(mmtt-check!
|
|
"up-const"
|
|
(mau/term->str (mau/meta-up mmtt-peano "0"))
|
|
"mt-app(0)")
|
|
(mmtt-check!
|
|
"up-s0"
|
|
(mau/term->str (mau/meta-up mmtt-peano "s 0"))
|
|
"mt-app(s_, mt-app(0))")
|
|
(mmtt-check!
|
|
"up-var"
|
|
(mau/term->str (mau/up-term (mau/var "X" "Nat")))
|
|
"mt-var(X, Nat)")
|
|
(mmtt-check!
|
|
"up-plus"
|
|
(mau/term->str (mau/meta-up mmtt-peano "s 0 + 0"))
|
|
"mt-app(_+_, mt-app(s_, mt-app(0)), mt-app(0))")
|
|
|
|
;; round trip: down(up(t)) = t
|
|
(mmtt-check!
|
|
"roundtrip-const"
|
|
(mau/term=?
|
|
(mau/down-term (mau/meta-up mmtt-peano "0"))
|
|
(mau/parse-term-in mmtt-peano "0"))
|
|
true)
|
|
(mmtt-check!
|
|
"roundtrip-nested"
|
|
(mau/term=?
|
|
(mau/down-term (mau/meta-up mmtt-peano "s (s 0 + 0)"))
|
|
(mau/parse-term-in mmtt-peano "s (s 0 + 0)"))
|
|
true)
|
|
(mmtt-check!
|
|
"roundtrip-var"
|
|
(mau/term=?
|
|
(mau/down-term (mau/up-term (mau/var "X" "Nat")))
|
|
(mau/var "X" "Nat"))
|
|
true)
|
|
|
|
;; ---- reflective metaReduce ----
|
|
|
|
(mmtt-check!
|
|
"meta-reduce"
|
|
(mau/term->str (mau/meta-reduce-src mmtt-peano "s 0 + s s 0"))
|
|
"s_(s_(s_(0)))")
|
|
;; metaReduce returns a REPRESENTED result (a meta-term)
|
|
(mmtt-check!
|
|
"meta-reduce-is-meta"
|
|
(=
|
|
(mau/op (mau/meta-reduce mmtt-peano (mau/meta-up mmtt-peano "s 0 + 0")))
|
|
"mt-app")
|
|
true)
|
|
|
|
;; ---- meta-circular law: down(metaReduce(up t)) =AC= reduce t ----
|
|
|
|
(mmtt-check!
|
|
"meta-circular-1"
|
|
(mau/meta-circular? mmtt-peano "s 0 + s s 0")
|
|
true)
|
|
(mmtt-check!
|
|
"meta-circular-2"
|
|
(mau/meta-circular? mmtt-peano "s (s 0 + s 0)")
|
|
true)
|
|
(mmtt-check!
|
|
"meta-reduce-eq-up"
|
|
(mau/term=?
|
|
(mau/meta-reduce mmtt-peano (mau/meta-up mmtt-peano "s 0 + s 0"))
|
|
(mau/up-term (mau/creduce-term mmtt-peano "s 0 + s 0")))
|
|
true)
|
|
|
|
;; ---- metaApply: reflect a single rule step ----
|
|
|
|
(mmtt-check!
|
|
"meta-apply-r1"
|
|
(mau/term=?
|
|
(mau/down-term
|
|
(mau/meta-apply mmtt-ndet "r1" (mau/meta-up mmtt-ndet "a")))
|
|
(mau/parse-term-in mmtt-ndet "b"))
|
|
true)
|
|
(mmtt-check!
|
|
"meta-apply-fail"
|
|
(mau/meta-apply mmtt-ndet "r2" (mau/meta-up mmtt-ndet "a"))
|
|
nil)
|
|
|
|
;; ---- generic theorem helper: equational proof by reduction ----
|
|
|
|
;; commutativity instance: 1 + 2 and 2 + 1 reduce to the same normal form.
|
|
(mmtt-check!
|
|
"prove-comm-instance"
|
|
(mau/meta-prove-equal? mmtt-peano "s 0 + s s 0" "s s 0 + s 0")
|
|
true)
|
|
;; associativity instance
|
|
(mmtt-check!
|
|
"prove-assoc-instance"
|
|
(mau/meta-prove-equal? mmtt-peano "(s 0 + s 0) + s 0" "s 0 + (s 0 + s 0)")
|
|
true)
|
|
;; a non-theorem
|
|
(mmtt-check!
|
|
"prove-false"
|
|
(mau/meta-prove-equal? mmtt-peano "s 0 + s 0" "s 0")
|
|
false)
|
|
|
|
;; ---- build a program meta-level, then run it ----
|
|
|
|
;; construct the meta-representation of s(s(0)) by hand, down it, reduce.
|
|
(define
|
|
mmtt-built
|
|
(mau/up-term
|
|
(mau/app "s_" (list (mau/app "s_" (list (mau/const "0")))))))
|
|
(mmtt-check!
|
|
"built-down-reduce"
|
|
(mau/term->str (mau/creduce mmtt-peano (mau/down-term mmtt-built)))
|
|
"s_(s_(0))")
|
|
|
|
(define mau-meta-tests-run! (fn () {:failures mmtt-failures :total (+ mmtt-pass mmtt-fail) :passed mmtt-pass :failed mmtt-fail}))
|