4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maeder{- |
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederModule : ./CASL/CompositionTable/ModelTable.hs
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederDescription : intermediate calculus table
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederCopyright : (c) Uni Bremen 2005
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian MaederLicense : GPLv2 or higher, see LICENSE.txt
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maeder
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederMaintainer : Christian.Maeder@dfki.de
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederStability : provisional
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederPortability : portable
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maeder
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian Maeder-}
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian Maeder
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maedermodule CASL.CompositionTable.ModelTable where
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian Maeder
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport CASL.CompositionTable.CompositionTable
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maederimport Common.Utils
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian Maeder
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maederimport qualified Data.IntSet as IntSet
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maederimport qualified Data.IntMap as IntMap
7c554e9d4a39b8eb3b0881f20807c95dd8e793aeChristian Maederimport qualified Data.Map as Map
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maederimport Data.List
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maeder
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maederdata Table2 = Table2 String Int (IntMap.IntMap Baserel) BSet CmpTbl ConTables
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maeder
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maedertype BSet = IntSet.IntSet
7c554e9d4a39b8eb3b0881f20807c95dd8e793aeChristian Maeder
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maedertype CmpTbl = IntMap.IntMap (IntMap.IntMap IntSet.IntSet)
53301de22afd7190981b363b57c48df86fcb50f7Christian Maeder
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maedertype ConTable = IntMap.IntMap IntSet.IntSet
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maedertype ConTables = (ConTable, ConTable, ConTable, ConTable)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maederlkup :: (Show a, Ord a) => a -> Map.Map a Int -> Int
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maederlkup i = Map.findWithDefault
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder (error $ "CASL.CompositionTable.ModelTable.lkup" ++ show i) i
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoTable2 :: Table -> Table2
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoTable2 (Table (Table_Attrs name id_ baserels)
986e0e9cf8c2358f455460b3fc75ce7c5dcf0973Christian Maeder (Compositiontable comptbl) convtbl _ _) =
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder let ns = number baserels
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder m = Map.fromList ns
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder in Table2 name (lkup id_ m)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder (IntMap.fromList $ map (\ (a, b) -> (b, a)) ns)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder (IntSet.fromAscList [1 .. Map.size m])
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder (toCmpTbl m comptbl)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder $ toConTables m convtbl
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoCmpTbl :: Map.Map Baserel Int -> [Cmptabentry] -> CmpTbl
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoCmpTbl m =
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder foldl' (\ t (Cmptabentry (Cmptabentry_Attrs rel1 rel2) bs)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder -> IntMap.insertWith IntMap.union (lkup rel1 m)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder (IntMap.insertWith IntSet.union (lkup rel2 m)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder (IntSet.fromList $ map (`lkup` m) bs) IntMap.empty) t)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder IntMap.empty
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoConTab :: Map.Map Baserel Int -> (a -> Baserel) -> (a -> [Baserel]) -> [a]
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder -> ConTable
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoConTab m s1 s2 = foldl' (\ t a ->
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder IntMap.insertWith IntSet.union (lkup (s1 a) m)
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder (IntSet.fromList $ map (`lkup` m) $ s2 a) t) IntMap.empty
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoConTab2 :: Map.Map Baserel Int -> [Contabentry_Ternary] -> ConTable
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoConTab2 m =
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder toConTab m contabentry_TernaryArgBaseRel contabentry_TernaryConverseBaseRels
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoConTables :: Map.Map Baserel Int -> Conversetable -> ConTables
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedertoConTables m c = case c of
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder Conversetable l ->
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder (toConTab m contabentryArgBaseRel contabentryConverseBaseRel l
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder , IntMap.empty, IntMap.empty, IntMap.empty)
ff9a53595208f532c25ac5168f772f48fd80fdb5Christian Maeder Conversetable_Ternary l1 l2 l3 ->
53301de22afd7190981b363b57c48df86fcb50f7Christian Maeder (IntMap.empty, toConTab2 m l1, toConTab2 m l2, toConTab2 m l3)
53301de22afd7190981b363b57c48df86fcb50f7Christian Maeder