{- |
Module      :  ./Maude/Meta/AsSymbol.hs
Description :  Viewing Maude data types as Symbols
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

Viewing Maude data types as Symbols.

Defines a type class 'AsSymbol' that lets us treat Maude data types as
'Symbol's, converting back and forth between them as needed.

Consider importing "Maude.Meta" instead of this module.
-}

module Maude.Meta.AsSymbol (
    -- * The AsSymbol type class
    AsSymbol (..),
    -- * Auxiliary functions
    asSymbolSet,
    mapAsSymbol,
) where

import Maude.AS_Maude
import Maude.Symbol
import Maude.Meta.HasName
import Maude.Util

import Data.Maybe (fromJust)
import qualified Data.Set as Set

-- * The AsSymbol type class

{- | Represents something that can be converted into a 'Symbol'.
Instances should only override /one/ of its class methods: -}
--
{- * Use 'asSymbol' when every member of the instance type can be
represented as a 'Symbol'. -}
--
-- * Use 'asSymbolMaybe' otherwise.
--
-- Each function is defined in terms of the other one by default.

class AsSymbol a where
    -- | Convert the input into a 'Symbol'.
    asSymbol :: a -> Symbol
    asSymbol = Maybe Symbol -> Symbol
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Symbol -> Symbol) -> (a -> Maybe Symbol) -> a -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe Symbol
forall a. AsSymbol a => a -> Maybe Symbol
asSymbolMaybe
    -- | Convert the input into 'Maybe' a 'Symbol'
    asSymbolMaybe :: a -> Maybe Symbol
    asSymbolMaybe = Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just (Symbol -> Maybe Symbol) -> (a -> Symbol) -> a -> Maybe Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Symbol
forall a. AsSymbol a => a -> Symbol
asSymbol

-- * Auxiliary functions

-- | Instead of a single 'Symbol', convert the input into a 'SymbolSet'.
asSymbolSet :: (AsSymbol a) => a -> SymbolSet
asSymbolSet :: a -> SymbolSet
asSymbolSet = SymbolSet -> (Symbol -> SymbolSet) -> Maybe Symbol -> SymbolSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SymbolSet
forall a. Set a
Set.empty Symbol -> SymbolSet
forall a. a -> Set a
Set.singleton (Maybe Symbol -> SymbolSet)
-> (a -> Maybe Symbol) -> a -> SymbolSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe Symbol
forall a. AsSymbol a => a -> Maybe Symbol
asSymbolMaybe

{- | Apply a 'SymbolMap' to the input, then convert the result back to
the original type. -}
mapAsSymbol :: (AsSymbol a) => (Symbol -> a) -> SymbolMap -> a -> a
mapAsSymbol :: (Symbol -> a) -> SymbolMap -> a -> a
mapAsSymbol ctr :: Symbol -> a
ctr mp :: SymbolMap
mp item :: a
item = let extract :: Symbol -> a
extract = Symbol -> a
ctr (Symbol -> a) -> (Symbol -> Symbol) -> Symbol -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolMap -> Symbol -> Symbol
forall a. Ord a => Map a a -> a -> a
mapAsFunction SymbolMap
mp
    in a -> (Symbol -> a) -> Maybe Symbol -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
item Symbol -> a
extract (Maybe Symbol -> a) -> Maybe Symbol -> a
forall a b. (a -> b) -> a -> b
$ a -> Maybe Symbol
forall a. AsSymbol a => a -> Maybe Symbol
asSymbolMaybe a
item

-- * Predefined 'AsSymbol' instances

instance AsSymbol Symbol where
    asSymbol :: Symbol -> Symbol
asSymbol = Symbol -> Symbol
forall a. a -> a
id

instance AsSymbol Type where
    asSymbol :: Type -> Symbol
asSymbol typ :: Type
typ = case Type
typ of
        TypeSort sort :: Sort
sort -> Sort -> Symbol
forall a. AsSymbol a => a -> Symbol
asSymbol Sort
sort
        TypeKind kind :: Kind
kind -> Kind -> Symbol
forall a. AsSymbol a => a -> Symbol
asSymbol Kind
kind

instance AsSymbol Sort where
    asSymbol :: Sort -> Symbol
asSymbol = Qid -> Symbol
Sort (Qid -> Symbol) -> (Sort -> Qid) -> Sort -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sort -> Qid
forall a. HasName a => a -> Qid
getName

instance AsSymbol Kind where
    asSymbol :: Kind -> Symbol
asSymbol = Qid -> Symbol
Kind (Qid -> Symbol) -> (Kind -> Qid) -> Kind -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Qid
forall a. HasName a => a -> Qid
getName

instance AsSymbol LabelId where
    asSymbol :: LabelId -> Symbol
asSymbol = Qid -> Symbol
Labl (Qid -> Symbol) -> (LabelId -> Qid) -> LabelId -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelId -> Qid
forall a. HasName a => a -> Qid
getName

instance AsSymbol OpId where
    asSymbol :: OpId -> Symbol
asSymbol = Qid -> Symbol
OpWildcard (Qid -> Symbol) -> (OpId -> Qid) -> OpId -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpId -> Qid
forall a. HasName a => a -> Qid
getName

instance AsSymbol StmntAttr where
    asSymbolMaybe :: StmntAttr -> Maybe Symbol
asSymbolMaybe attr :: StmntAttr
attr = case StmntAttr
attr of
        Label name :: Qid
name -> Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just (Symbol -> Maybe Symbol) -> Symbol -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ Qid -> Symbol
Labl Qid
name
        _ -> Maybe Symbol
forall a. Maybe a
Nothing

instance AsSymbol Operator where
    asSymbol :: Operator -> Symbol
asSymbol (Op op :: OpId
op dom :: [Type]
dom cod :: Type
cod _) = let
            op' :: Qid
op' = OpId -> Qid
forall a. HasName a => a -> Qid
getName OpId
op
            dom' :: [Symbol]
dom' = (Type -> Symbol) -> [Type] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Symbol
forall a. AsSymbol a => a -> Symbol
asSymbol [Type]
dom
            cod' :: Symbol
cod' = Type -> Symbol
forall a. AsSymbol a => a -> Symbol
asSymbol Type
cod
        in Qid -> [Symbol] -> Symbol -> Symbol
Operator Qid
op' [Symbol]
dom' Symbol
cod'

instance AsSymbol Term where
    asSymbolMaybe :: Term -> Maybe Symbol
asSymbolMaybe term :: Term
term = case Term
term of
        Const _ _ -> Maybe Symbol
forall a. Maybe a
Nothing
        Var _ _ -> Maybe Symbol
forall a. Maybe a
Nothing
        Apply op :: Qid
op ts :: [Term]
ts tp :: Type
tp -> let
                dom :: [Symbol]
dom = (Term -> Symbol) -> [Term] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Type -> Symbol
forall a. AsSymbol a => a -> Symbol
asSymbol (Type -> Symbol) -> (Term -> Type) -> Term -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Type
getTermType) [Term]
ts
                cod :: Symbol
cod = Type -> Symbol
forall a. AsSymbol a => a -> Symbol
asSymbol Type
tp
            in Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just (Symbol -> Maybe Symbol) -> Symbol -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ Qid -> [Symbol] -> Symbol -> Symbol
Operator Qid
op [Symbol]
dom Symbol
cod