;; lib/maude/term.sx — Maude term representation.
;;
;; A term is one of:
;;   variable     {:t :var :name "X" :sort "Nat"}
;;   application  {:t :app :op "_+_" :args (a b ...)}   (constant: empty args)
;;
;; Sorts attach to variables; operator/result sorts live on op declarations
;; in the module signature, not on the term node. Overloading is resolved at
;; reduction time, so the parser only records the operator name.

(define mau/var (fn (name sort) {:name name :t :var :sort sort}))

(define mau/app (fn (op args) {:op op :t :app :args args}))

(define mau/const (fn (op) {:op op :t :app :args (list)}))

(define mau/var? (fn (t) (and (dict? t) (= (get t :t) "var"))))

(define mau/app? (fn (t) (and (dict? t) (= (get t :t) "app"))))

(define mau/term? (fn (t) (or (mau/var? t) (mau/app? t))))

(define mau/op (fn (t) (get t :op)))
(define mau/args (fn (t) (get t :args)))
(define mau/vname (fn (t) (get t :name)))
(define mau/vsort (fn (t) (get t :sort)))
(define mau/arity (fn (t) (len (get t :args))))

(define mau/const? (fn (t) (and (mau/app? t) (empty? (mau/args t)))))

(define
  mau/args=?
  (fn
    (as bs)
    (cond
      ((and (empty? as) (empty? bs)) true)
      ((or (empty? as) (empty? bs)) false)
      (else
        (and
          (mau/term=? (first as) (first bs))
          (mau/args=? (rest as) (rest bs)))))))

(define
  mau/term=?
  (fn
    (a b)
    (cond
      ((and (mau/var? a) (mau/var? b))
        (and
          (= (mau/vname a) (mau/vname b))
          (= (mau/vsort a) (mau/vsort b))))
      ((and (mau/app? a) (mau/app? b))
        (and
          (= (mau/op a) (mau/op b))
          (mau/args=? (mau/args a) (mau/args b))))
      (else false))))

(define
  mau/join-args
  (fn
    (args)
    (cond
      ((empty? args) "")
      ((empty? (rest args)) (mau/term->str (first args)))
      (else
        (str (mau/term->str (first args)) ", " (mau/join-args (rest args)))))))

(define
  mau/term->str
  (fn
    (t)
    (cond
      ((mau/var? t) (mau/vname t))
      ((mau/const? t) (mau/op t))
      ((mau/app? t) (str (mau/op t) "(" (mau/join-args (mau/args t)) ")"))
      (else "?"))))

(define
  mau/member?
  (fn
    (x xs)
    (cond
      ((empty? xs) false)
      ((= x (first xs)) true)
      (else (mau/member? x (rest xs))))))

(define
  mau/union
  (fn
    (xs ys)
    (cond
      ((empty? xs) ys)
      ((mau/member? (first xs) ys) (mau/union (rest xs) ys))
      (else (cons (first xs) (mau/union (rest xs) ys))))))

(define
  mau/term-vars
  (fn
    (t)
    (cond
      ((mau/var? t) (list (mau/vname t)))
      ((mau/app? t) (mau/term-vars-list (mau/args t)))
      (else (list)))))

(define
  mau/term-vars-list
  (fn
    (args)
    (if
      (empty? args)
      (list)
      (mau/union
        (mau/term-vars (first args))
        (mau/term-vars-list (rest args))))))