{- |
Module : ./CASL/CompositionTable/ModelTable.hs
Description : intermediate calculus table
Copyright : (c) Uni Bremen 2005
License : GPLv2 or higher, see LICENSE.txt
Maintainer : Christian.Maeder@dfki.de
Stability : provisional
Portability : portable
-}
module CASL.CompositionTable.ModelTable where
import Common.Utils
import qualified Data.IntSet as IntSet
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Data.List
data Table2 = Table2 String Int (IntMap.IntMap Baserel) BSet CmpTbl ConTables
type BSet = IntSet.IntSet
type ConTable = IntMap.IntMap IntSet.IntSet
type ConTables = (ConTable, ConTable, ConTable, ConTable)
lkup :: (Show a, Ord a) => a -> Map.Map a Int -> Int
lkup i = Map.findWithDefault
(error $ "CASL.CompositionTable.ModelTable.lkup" ++ show i) i
toTable2 :: Table -> Table2
toTable2 (Table (Table_Attrs name id_ baserels)
(Compositiontable comptbl) convtbl _ _) =
let ns = number baserels
m = Map.fromList ns
in Table2 name (lkup id_ m)
(IntMap.fromList $ map (\ (a, b) -> (b, a)) ns)
(IntSet.fromAscList [1 .. Map.size m])
(toCmpTbl m comptbl)
$ toConTables m convtbl
toCmpTbl :: Map.Map Baserel Int -> [Cmptabentry] -> CmpTbl
toCmpTbl m =
foldl' (\ t (Cmptabentry (Cmptabentry_Attrs rel1 rel2) bs)
-> IntMap.insertWith IntMap.union (lkup rel1 m)
(IntMap.insertWith IntSet.union (lkup rel2 m)
(IntSet.fromList $ map (`lkup` m) bs) IntMap.empty) t)
toConTab :: Map.Map Baserel Int -> (a -> Baserel) -> (a -> [Baserel]) -> [a]
-> ConTable
toConTab m s1 s2 = foldl' (\ t a ->
IntMap.insertWith IntSet.union (lkup (s1 a) m)
(IntSet.fromList $ map (`lkup` m) $ s2 a) t) IntMap.empty
toConTab2 :: Map.Map Baserel Int -> [Contabentry_Ternary] -> ConTable
toConTab2 m =
toConTab m contabentry_TernaryArgBaseRel contabentry_TernaryConverseBaseRels
toConTables :: Map.Map Baserel Int -> Conversetable -> ConTables
toConTables m c = case c of
Conversetable l ->
(toConTab m contabentryArgBaseRel contabentryConverseBaseRel l
Conversetable_Ternary l1 l2 l3 ->
(IntMap.empty, toConTab2 m l1, toConTab2 m l2, toConTab2 m l3)