;; 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}))