module TRS where
    
import Data.List
import Term
import Rule

type TRS = [Rule]

type Overlap   = (Rule, Position, Rule, Subst)

-- pretty printers

show_trs :: TRS -> String
show_trs []  = unlines ["  (empty system)"]
show_trs trs = unlines [ "  " ++ show_rule rule | rule <- trs ]

print_trs :: TRS -> IO ()
print_trs trs = putStr (show_trs trs)

-- manupilating functions

diff :: TRS -> TRS -> TRS
diff trs1 trs2 = [ rule | rule <- trs1, notElem rule trs2 ]

signature_of :: TRS -> [(String, Int)]
signature_of trs = nub [ fn | rule <- trs, fn <- Rule.signature_of rule ]

substitute :: TRS -> Subst -> TRS
substitute trs sigma = [ Rule.substitute rule sigma | rule <- trs ]

variables :: TRS -> [String]
variables trs = nub [ x | rule <- trs, x <- Rule.variables rule ]

-- Fun(R)

functions :: TRS -> [String]
functions trs = nub [ f | rule <- trs, f <- Rule.functions rule ]

left_linear :: TRS -> Bool
left_linear trs = all Rule.left_linear trs

subsume :: TRS -> TRS -> Bool
subsume trs1 trs2 =
  all
    (\lr2 -> any (\lr1 -> Rule.subsume lr1 lr2) trs1)
    trs2

unique :: TRS -> TRS
unique trs = nubBy Rule.variant trs

-- Rewriting

-- [ u | t ->_R u ]
reducts :: TRS -> Term -> [Term]
reducts trs t =
  [ replace t (Term.substitute r sigma) p
  | p <- positions t,
    (l, r) <- trs,
    Just sigma <- [match l (subterm_at t p)] ]

reductsRules :: TRS -> Term -> [(Term, Rule)]
reductsRules trs t =
  [ (replace t (Term.substitute r sigma) p, (l, r))
  | p <- positions t,
    (l, r) <- trs,
    Just sigma <- [match l (subterm_at t p)] ]

-- A term u if t ->_R u.
rewrite :: TRS -> Term -> Maybe Term
rewrite trs t =
  case sortOn Term.size (reducts trs t) of
    []    -> Nothing
    u : _ -> Just u

rename :: String -> Int -> TRS -> TRS
rename x k trs = [ Rule.rename x k rule | rule <- trs ]
