;; lib/maude/tests/pretty.sx — mixfix surface-syntax printer.

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

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

(define
  mpp-m
  (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 .\n  op f : Nat Nat -> Nat .\n  vars X Y : Nat .\n  eq 0 + Y = Y .\n  eq s X + Y = s (X + Y) .\nendfm"))

(define
  mpp-render
  (fn (src) (mau/term->maude mpp-m (mau/parse-term-in mpp-m src))))

(mpp-check! "const" (mpp-render "0") "0")
(mpp-check! "var" (mau/term->maude mpp-m (mau/var "X" "Nat")) "X")
(mpp-check! "prefix" (mpp-render "s 0") "(s 0)")
(mpp-check! "infix" (mpp-render "X + Y") "(X + Y)")
(mpp-check! "nested" (mpp-render "s X + Y") "((s X) + Y)")
(mpp-check! "paren" (mpp-render "s (X + Y)") "(s (X + Y))")
;; postfix: built directly (the parser does not produce postfix applications)
(mpp-check!
  "postfix"
  (mau/term->maude mpp-m (mau/app "_!" (list (mau/var "X" "Nat"))))
  "(X !)")
(mpp-check! "funcall" (mpp-render "f(0, s 0)") "f(0, (s 0))")
(mpp-check! "prefix-form-infix" (mpp-render "_+_(0, 0)") "(0 + 0)")

;; reduce then render in surface syntax
(mpp-check!
  "red-surface"
  (mau/red->maude mpp-m "s 0 + s s 0")
  "(s (s (s 0)))")
(mpp-check! "red-zero" (mau/red->maude mpp-m "0 + 0") "0")

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