;; lib/maude/tests/sorts.sx — order-sorted least-sort inference.

(define mso-pass 0)
(define mso-fail 0)
(define mso-failures (list))

(define
  mso-check!
  (fn
    (name got expected)
    (if
      (= got expected)
      (set! mso-pass (+ mso-pass 1))
      (do
        (set! mso-fail (+ mso-fail 1))
        (append!
          mso-failures
          (str name "  expected: " expected "  got: " got))))))

(define
  mso-m
  (mau/parse-module
    "fmod NUMS is\n  sorts Zero NzNat Nat .\n  subsort Zero < Nat .\n  subsort NzNat < Nat .\n  op 0 : -> Zero .\n  op 1 : -> NzNat .\n  op s_ : Nat -> Nat .\n  op _+_ : Nat Nat -> Nat .\n  op p : NzNat -> NzNat .\n  op f : Nat -> Nat .\n  op f : NzNat -> NzNat .\nendfm"))

;; constants take their declared result sort
(mso-check! "sort-zero" (mau/term-sort-src mso-m "0") "Zero")
(mso-check! "sort-one" (mau/term-sort-src mso-m "1") "NzNat")

;; application: arg subsort of declared domain
(mso-check! "sort-s0" (mau/term-sort-src mso-m "s 0") "Nat")
(mso-check! "sort-plus" (mau/term-sort-src mso-m "0 + 1") "Nat")
(mso-check! "sort-p" (mau/term-sort-src mso-m "p(1)") "NzNat")

;; variable keeps its sort
(mso-check! "sort-var" (mau/term-sort mso-m (mau/var "X" "Nat")) "Nat")

;; LEAST sort under overloading: f(1) fits both f decls -> the smaller, NzNat
(mso-check! "least-f-1" (mau/term-sort-src mso-m "f(1)") "NzNat")
;; f(s 0): s 0 is Nat, only fits f : Nat -> Nat
(mso-check! "least-f-s0" (mau/term-sort-src mso-m "f(s 0)") "Nat")
;; nested: f(f(1)) -> f(NzNat) -> NzNat
(mso-check! "least-nested" (mau/term-sort-src mso-m "f(f(1))") "NzNat")

;; membership-style sort checks
(mso-check! "has-zero-nat" (mau/has-sort-src? mso-m "0" "Nat") true)
(mso-check! "has-one-nat" (mau/has-sort-src? mso-m "1" "Nat") true)
(mso-check! "has-zero-not-nznat" (mau/has-sort-src? mso-m "0" "NzNat") false)
(mso-check! "has-refl" (mau/has-sort-src? mso-m "1" "NzNat") true)

;; unknown operator -> "?"
(mso-check! "sort-unknown" (mau/term-sort mso-m (mau/const "ghost")) "?")

(define mau-sorts-tests-run! (fn () {:failures mso-failures :total (+ mso-pass mso-fail) :passed mso-pass :failed mso-fail}))