;; lib/maude/tests/gather.sx — gather / parse-time associativity.

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

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

(define
  mga-m
  (mau/parse-module
    "fmod L is\n  sorts Nat List .\n  op 0 : -> Nat .\n  op s_ : Nat -> Nat .\n  op nil : -> List .\n  op _:_ : Nat List -> List [gather (e E)] .\n  op _+_ : Nat Nat -> Nat .\n  op _-_ : Nat Nat -> Nat [gather (E e)] .\n  vars X Y : Nat .\nendfm"))

;; cons is right-associative: a : b : c  ==  a : (b : c)
(mga-check!
  "cons-right"
  (mau/term->str (mau/parse-term-in mga-m "0 : s 0 : nil"))
  "_:_(0, _:_(s_(0), nil))")
;; + has no gather -> default left-assoc
(mga-check!
  "plus-left"
  (mau/term->str (mau/parse-term-in mga-m "X + Y + X"))
  "_+_(_+_(X, Y), X)")
;; explicit (E e) is left
(mga-check!
  "minus-left"
  (mau/term->str (mau/parse-term-in mga-m "X - Y - X"))
  "_-_(_-_(X, Y), X)")
;; gather attr recorded
(mga-check!
  "gather-recorded"
  (get (get (first (mau/ops-named mga-m "_:_")) :attrs) :gather)
  (list "e" "E"))

;; ---- full insertion sort over BARE cons lists (no parens needed) ----

(define
  mga-sort
  (mau/parse-module
    "fmod SORT is\n  sorts Nat List Bool .\n  op 0 : -> Nat .\n  op s_ : Nat -> Nat .\n  op true : -> Bool .\n  op false : -> Bool .\n  op _<=_ : Nat Nat -> Bool .\n  op nil : -> List .\n  op _:_ : Nat List -> List [gather (e E)] .\n  op insert : Nat List -> List .\n  op sort : List -> List .\n  vars M N : Nat .\n  var L : List .\n  eq 0 <= N = true .\n  eq s M <= 0 = false .\n  eq s M <= s N = M <= N .\n  eq insert(N, nil) = N : nil .\n  ceq insert(N, M : L) = N : M : L if N <= M = true .\n  ceq insert(N, M : L) = M : insert(N, L) if N <= M = false .\n  eq sort(nil) = nil .\n  eq sort(N : L) = insert(N, sort(L)) .\nendfm"))

(mga-check!
  "sort-bare"
  (mau/creduce->str mga-sort "sort(s s s 0 : s 0 : s s 0 : nil)")
  "_:_(s_(0), _:_(s_(s_(0)), _:_(s_(s_(s_(0))), nil)))")
(mga-check!
  "sort-bare-5"
  (mau/creduce->str mga-sort "sort(s s 0 : 0 : s 0 : nil)")
  "_:_(0, _:_(s_(0), _:_(s_(s_(0)), nil)))")
(mga-check!
  "insert-bare"
  (mau/creduce->str mga-sort "insert(s 0, 0 : s s 0 : nil)")
  "_:_(0, _:_(s_(0), _:_(s_(s_(0)), nil)))")

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