content: {- |
  Module      :  ./Maude/Meta/HasOps.hs
  Description :  Accessing the Operators of Maude data types
  Copyright   :  (c) Martin Kuehl, Uni Bremen 2008-2009
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  mkhl@informatik.uni-bremen.de
  Stability   :  experimental
  Portability :  portable
  
  Accessing the Operators of Maude data types.
  
  Defines a type class 'HasOps' that lets us access the 'Operator's of
  Maude data types as 'SymbolSet's.
  
  Consider importing "Maude.Meta" instead of this module.
  -}
  
  module Maude.Meta.HasOps (
      -- * The HasOps type class
      HasOps (..)
  ) where
  
  import Maude.AS_Maude
  import Maude.Symbol
  import Maude.Meta.AsSymbol
  import Maude.Meta.HasName
  
  import Data.Set (Set)
  import qualified Data.Set as Set
  
  -- * The HasOps type class
  
  -- | Represents something that contains a 'Set' of 'Operator's (as 'Symbol's).
  class HasOps a where
      -- | Extract the 'Operator's contained in the input.
      getOps :: a -> SymbolSet
      -- | Map the 'Operator's contained in the input.
      mapOps :: SymbolMap -> a -> a
  
  -- * Predefined instances
  
  instance HasOps Symbol where
      getOps sym = case sym of
          Operator {} -> Set.singleton sym
          OpWildcard _ -> Set.singleton sym
          _ -> Set.empty
      mapOps mp sym = case sym of
          Operator {} -> mapAsSymbol id mp sym
          OpWildcard _ -> mapAsSymbol id mp sym
          _ -> sym
  
  instance (HasOps a) => HasOps [a] where
      getOps = Set.unions . map getOps
      mapOps = map . mapOps
  
  instance (HasOps a, HasOps b) => HasOps (a, b) where
      getOps (a, b) = Set.union (getOps a) (getOps b)
      mapOps mp (a, b) = (mapOps mp a, mapOps mp b)
  
  instance (HasOps a, HasOps b, HasOps c) => HasOps (a, b, c) where
      getOps (a, b, c) = Set.union (getOps a) (getOps (b, c))
      mapOps mp (a, b, c) = (mapOps mp a, mapOps mp b, mapOps mp c)
  
  instance (Ord a, HasOps a) => HasOps (Set a) where
      getOps = Set.fold (Set.union . getOps) Set.empty
      mapOps = Set.map . mapOps
  
  instance HasOps Operator where
      getOps = asSymbolSet
      mapOps mp op@(Op _ _ _ as) = let
              swapAttrs (Op qid dom cod _) = Op qid dom cod as
          in mapAsSymbol (swapAttrs . toOperator) mp op
  
  instance HasOps Attr where
      getOps attr = case attr of
          Id term -> getOps term
          LeftId term -> getOps term
          RightId term -> getOps term
          _ -> Set.empty
      mapOps mp attr = case attr of
          Id term -> Id $ mapOps mp term
          LeftId term -> LeftId $ mapOps mp term
          RightId term -> RightId $ mapOps mp term
          _ -> attr
  
  instance HasOps Term where
      getOps term = case term of
          Apply _ ts _ -> Set.insert (asSymbol term) (getOps ts)
          _ -> Set.empty
      mapOps mp term = case term of
          Apply _ ts tp -> let
                  op = getName $ mapOps mp $ asSymbol term
              in Apply op (mapOps mp ts) tp
          _ -> term
  
  instance HasOps Condition where
      getOps cond = case cond of
          EqCond t1 t2 -> getOps (t1, t2)
          MbCond t _ -> getOps t
          MatchCond t1 t2 -> getOps (t1, t2)
          RwCond t1 t2 -> getOps (t1, t2)
      mapOps mp cond = case cond of
          EqCond t1 t2 -> EqCond (mapOps mp t1) (mapOps mp t2)
          MbCond t s -> MbCond (mapOps mp t) s
          MatchCond t1 t2 -> MatchCond (mapOps mp t1) (mapOps mp t2)
          RwCond t1 t2 -> RwCond (mapOps mp t1) (mapOps mp t2)
  
  instance HasOps Membership where
      getOps (Mb t _ cs _) = getOps (t, cs)
      mapOps mp (Mb t s cs as) = let
              t' = mapOps mp t
              cs' = mapOps mp cs
          in Mb t' s cs' as
  
  instance HasOps Equation where
      getOps (Eq t1 t2 cs _) = getOps (t1, t2, cs)
      mapOps mp (Eq t1 t2 cs as) = let
              t1' = mapOps mp t1
              t2' = mapOps mp t2
              cs' = mapOps mp cs
          in Eq t1' t2' cs' as
  
  instance HasOps Rule where
      getOps (Rl t1 t2 cs _) = getOps (t1, t2, cs)
      mapOps mp (Rl t1 t2 cs as) = let
              t1' = mapOps mp t1
              t2' = mapOps mp t2
              cs' = mapOps mp cs
          in Rl t1' t2' cs' as
  