Renaming.hs

----------------------------------------------------------------------------
-- |
-- Module      :  CSPM.Interpreter.Renaming
-- Copyright   :  (c) Fontaine 2009
-- License     :  BSD
-- 
-- Maintainer  :  Fontaine@cs.uni-duesseldorf.de
-- Stability   :  experimental
-- Portability :  GHC-only
--
-- Utility functions dealing with renaming relations.
----------------------------------------------------------------------------
{-
naive implementation of a renaming relation.
todo: mode efficent implementation
-}
module CSPM.Interpreter.Renaming
where

import CSPM.Interpreter.Types as Types
import CSPM.Interpreter.Hash as Hash
import CSPM.Interpreter.ClosureSet

import qualified Data.List as List
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Map as Map

{- todo speedup using hashing -}
toRenaming :: [(Value,Value)]-> RenamingRelation
toRenaming s = RenamingRelation {
    renamingPairs = pairs
   ,renamingDigest = renameDigest pairs
   ,renamingDomain = Set.map fst pairs
   ,renamingRange = Set.map snd pairs
  } where
  pairs = Set.unions $ map pairToRel s
  pairToRel :: (Value,Value) -> Set (Event,Event)
  pairToRel (a,b) = Set.fromList $ do
   (VDotTuple p1) <- Set.toList $ prefixTrieToSet $ valueToPT a
   return (p1, newPrefix ++ drop plen p1)
   where
     plen = prefixLen a    
     newPrefix = valueToPrefix b

  valueToPrefix :: Value -> [Value]
  valueToPrefix v = case v of
    VChannel _ -> [v]
    VDotTuple l@(VChannel _ : _) -> l
    VDotTuple [] -> throwScriptError "toRenaming1 : empty dot-tuple" Nothing Nothing
    VDotTuple _ -> throwScriptError "toRenaming1 : dot-tuple does not start with a channel"
                     Nothing (Just v)
    _ -> throwScriptError "toRenaming1 : cannot make renaming"
           Nothing $ Just v

  prefixLen :: Value -> Int
  prefixLen v = case v of
    VChannel _ -> 1
    VDotTuple l@(VChannel _ : _) -> length l
    VDotTuple [] -> throwScriptError "toRenaming2 : empty dot-tuple" Nothing Nothing
    VDotTuple _ -> throwScriptError "toRenaming2 : dot-tuple does not start with a channel"
                     Nothing (Just v)
    _ -> throwScriptError "toRenaming2 : cannot make renaming"
           Nothing $ Just v

renameDigest :: Set (Event,Event) -> Digest
renameDigest pairs
  = mix3 (hs "RenamingRelation")
     (hash $ map fst $ Set.toList pairs)
     (hash $ map snd $ Set.toList pairs)

{-
inverseRenaming :: RenamingRelation -> RenamingRelation
inverseRenaming r
  = RenamingRelation {
    renamingPairs = pairs
   ,renamingDigest = renameDigest pairs
   ,renamingDomain = renamingRange r
   ,renamingRange = renamingDomain r } 
  where
    pairs = Set.map (\(a,b) -> (b,a)) $ renamingPairs r
-}

{- sets have actually no advantage because we convert to lists anyway -} 

imageRenaming :: RenamingRelation -> Event -> [Event]
imageRenaming relation prefix
  = List.map snd $ List.filter (\(x,_) -> x == prefix) $ Set.toList $ renamingPairs relation

preImageRenaming :: RenamingRelation -> Event -> [Event]
preImageRenaming relation prefix
  = List.map fst $ List.filter (\(_,x) -> x == prefix) $ Set.toList $ renamingPairs relation

isInRelation :: RenamingRelation -> Event -> Event -> Bool
isInRelation rel a b = (a,b) `Set.member` renamingPairs rel