giles
10906d4ffc
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
lib/maude/reduce.sx — one-sided syntactic matching (non-linear patterns via bound-var equality), immutable substitutions, innermost fixpoint normalisation. Tested on Peano arithmetic, list ops, a propositional logic simplifier, and non-linear matching. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
121 lines
4.4 KiB
Plaintext
121 lines
4.4 KiB
Plaintext
;; lib/maude/tests/reduce.sx — Phase 2: syntactic equational reduction.
|
|
|
|
(define mrt-pass 0)
|
|
(define mrt-fail 0)
|
|
(define mrt-failures (list))
|
|
|
|
(define
|
|
mrt-check!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(= got expected)
|
|
(set! mrt-pass (+ mrt-pass 1))
|
|
(do
|
|
(set! mrt-fail (+ mrt-fail 1))
|
|
(append!
|
|
mrt-failures
|
|
(str name " expected: " expected " got: " got))))))
|
|
|
|
;; ---- Peano arithmetic ----
|
|
|
|
(define
|
|
mrt-peano
|
|
(mau/parse-module
|
|
"fmod PEANO is\n sort Nat .\n op 0 : -> Nat .\n op s_ : Nat -> Nat .\n op _+_ : Nat Nat -> Nat .\n op _*_ : Nat Nat -> Nat .\n vars X Y : Nat .\n eq 0 + Y = Y .\n eq s X + Y = s (X + Y) .\n eq 0 * Y = 0 .\n eq s X * Y = Y + (X * Y) .\nendfm"))
|
|
|
|
(mrt-check!
|
|
"add-2-1"
|
|
(mau/reduce->str mrt-peano "s s 0 + s 0")
|
|
"s_(s_(s_(0)))")
|
|
(mrt-check! "add-0-0" (mau/reduce->str mrt-peano "0 + 0") "0")
|
|
(mrt-check! "add-id-left" (mau/reduce->str mrt-peano "0 + s s 0") "s_(s_(0))")
|
|
(mrt-check!
|
|
"mul-2-2"
|
|
(mau/reduce->str mrt-peano "s s 0 * s s 0")
|
|
"s_(s_(s_(s_(0))))")
|
|
(mrt-check! "mul-zero" (mau/reduce->str mrt-peano "0 * s s s 0") "0")
|
|
(mrt-check! "mul-by-zero" (mau/reduce->str mrt-peano "s s 0 * 0") "0")
|
|
(mrt-check!
|
|
"nested"
|
|
(mau/reduce->str mrt-peano "(s 0 + s 0) * s s 0")
|
|
"s_(s_(s_(s_(0))))")
|
|
|
|
;; ---- list manipulation ----
|
|
|
|
(define
|
|
mrt-list
|
|
(mau/parse-module
|
|
"fmod NATLIST is\n sorts Nat List .\n op 0 : -> Nat .\n op s_ : Nat -> Nat .\n op nil : -> List .\n op cons : Nat List -> List .\n op append : List List -> List .\n op length : List -> Nat .\n op rev : List -> List .\n var X : Nat .\n vars L M : List .\n eq append(nil, M) = M .\n eq append(cons(X, L), M) = cons(X, append(L, M)) .\n eq length(nil) = 0 .\n eq length(cons(X, L)) = s length(L) .\n eq rev(nil) = nil .\n eq rev(cons(X, L)) = append(rev(L), cons(X, nil)) .\nendfm"))
|
|
|
|
(mrt-check!
|
|
"append"
|
|
(mau/reduce->str mrt-list "append(cons(0, nil), cons(s 0, nil))")
|
|
"cons(0, cons(s_(0), nil))")
|
|
(mrt-check!
|
|
"append-nil"
|
|
(mau/reduce->str mrt-list "append(nil, cons(0, nil))")
|
|
"cons(0, nil)")
|
|
(mrt-check!
|
|
"length-2"
|
|
(mau/reduce->str mrt-list "length(cons(0, cons(s 0, nil)))")
|
|
"s_(s_(0))")
|
|
(mrt-check! "length-0" (mau/reduce->str mrt-list "length(nil)") "0")
|
|
(mrt-check!
|
|
"rev"
|
|
(mau/reduce->str mrt-list "rev(cons(0, cons(s 0, nil)))")
|
|
"cons(s_(0), cons(0, nil))")
|
|
(mrt-check! "rev-empty" (mau/reduce->str mrt-list "rev(nil)") "nil")
|
|
|
|
;; ---- propositional logic simplifier ----
|
|
|
|
(define
|
|
mrt-prop
|
|
(mau/parse-module
|
|
"fmod PROPLOGIC is\n sort Bool .\n op tt : -> Bool .\n op ff : -> Bool .\n op not_ : Bool -> Bool .\n op _and_ : Bool Bool -> Bool .\n op _or_ : Bool Bool -> Bool .\n op _xor_ : Bool Bool -> Bool .\n vars P Q : Bool .\n eq not tt = ff .\n eq not ff = tt .\n eq tt and P = P .\n eq ff and P = ff .\n eq tt or P = tt .\n eq ff or P = P .\n eq P xor ff = P .\n eq P xor tt = not P .\nendfm"))
|
|
|
|
(mrt-check! "not-tt" (mau/reduce->str mrt-prop "not tt") "ff")
|
|
(mrt-check! "and-simpl" (mau/reduce->str mrt-prop "not (tt and ff)") "tt")
|
|
(mrt-check! "or-simpl" (mau/reduce->str mrt-prop "ff or (tt and tt)") "tt")
|
|
(mrt-check! "double-neg" (mau/reduce->str mrt-prop "not not tt") "tt")
|
|
(mrt-check! "xor-id" (mau/reduce->str mrt-prop "tt xor ff") "tt")
|
|
(mrt-check! "xor-tt" (mau/reduce->str mrt-prop "ff xor tt") "tt")
|
|
(mrt-check!
|
|
"deep"
|
|
(mau/reduce->str mrt-prop "(tt and tt) or (not not ff)")
|
|
"tt")
|
|
|
|
;; ---- non-linear pattern (repeated variable) + no-match leaves term ----
|
|
|
|
(define
|
|
mrt-same
|
|
(mau/parse-module
|
|
"fmod SAME is\n sorts Elt Bool .\n op a : -> Elt .\n op b : -> Elt .\n op tt : -> Bool .\n op same : Elt Elt -> Bool .\n var X : Elt .\n eq same(X, X) = tt .\nendfm"))
|
|
|
|
(mrt-check! "nonlinear-match" (mau/reduce->str mrt-same "same(a, a)") "tt")
|
|
(mrt-check!
|
|
"nonlinear-nomatch"
|
|
(mau/reduce->str mrt-same "same(a, b)")
|
|
"same(a, b)")
|
|
(mrt-check! "no-rule-stays" (mau/reduce->str mrt-same "b") "b")
|
|
|
|
;; ---- low-level matching ----
|
|
|
|
(mrt-check!
|
|
"match-var-binds"
|
|
(= nil (mau/match (mau/var "X" "Nat") (mau/const "0") {}))
|
|
false)
|
|
(mrt-check!
|
|
"match-mismatch"
|
|
(mau/match (mau/const "0") (mau/const "1") {})
|
|
nil)
|
|
(mrt-check!
|
|
"subst-apply"
|
|
(mau/term->str
|
|
(mau/subst-apply
|
|
(assoc {} "X" (mau/const "0"))
|
|
(mau/app "s_" (list (mau/var "X" "Nat")))))
|
|
"s_(0)")
|
|
|
|
(define mau-reduce-tests-run! (fn () {:failures mrt-failures :total (+ mrt-pass mrt-fail) :passed mrt-pass :failed mrt-fail}))
|