{- |
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 CASL.CompositionTable.CompositionTable
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 CmpTbl = IntMap.IntMap (IntMap.IntMap 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 :: a -> Map a Int -> Int
lkup i :: a
i = Int -> a -> Map a Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
  ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ "CASL.CompositionTable.ModelTable.lkup" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
i) a
i

toTable2 :: Table -> Table2
toTable2 :: Table -> Table2
toTable2 (Table (Table_Attrs name :: [Char]
name id_ :: Baserel
id_ baserels :: [Baserel]
baserels)
  (Compositiontable comptbl :: [Cmptabentry]
comptbl) convtbl :: Conversetable
convtbl _ _) =
  let ns :: [(Baserel, Int)]
ns = [Baserel] -> [(Baserel, Int)]
forall a. [a] -> [(a, Int)]
number [Baserel]
baserels
      m :: Map Baserel Int
m = [(Baserel, Int)] -> Map Baserel Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Baserel, Int)]
ns
  in [Char]
-> Int -> IntMap Baserel -> BSet -> CmpTbl -> ConTables -> Table2
Table2 [Char]
name (Baserel -> Map Baserel Int -> Int
forall a. (Show a, Ord a) => a -> Map a Int -> Int
lkup Baserel
id_ Map Baserel Int
m)
    ([(Int, Baserel)] -> IntMap Baserel
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Baserel)] -> IntMap Baserel)
-> [(Int, Baserel)] -> IntMap Baserel
forall a b. (a -> b) -> a -> b
$ ((Baserel, Int) -> (Int, Baserel))
-> [(Baserel, Int)] -> [(Int, Baserel)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (a :: Baserel
a, b :: Int
b) -> (Int
b, Baserel
a)) [(Baserel, Int)]
ns)
    ([Int] -> BSet
IntSet.fromAscList [1 .. Map Baserel Int -> Int
forall k a. Map k a -> Int
Map.size Map Baserel Int
m])
    (Map Baserel Int -> [Cmptabentry] -> CmpTbl
toCmpTbl Map Baserel Int
m [Cmptabentry]
comptbl)
    (ConTables -> Table2) -> ConTables -> Table2
forall a b. (a -> b) -> a -> b
$ Map Baserel Int -> Conversetable -> ConTables
toConTables Map Baserel Int
m Conversetable
convtbl

toCmpTbl :: Map.Map Baserel Int -> [Cmptabentry] -> CmpTbl
toCmpTbl :: Map Baserel Int -> [Cmptabentry] -> CmpTbl
toCmpTbl m :: Map Baserel Int
m =
  (CmpTbl -> Cmptabentry -> CmpTbl)
-> CmpTbl -> [Cmptabentry] -> CmpTbl
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ t :: CmpTbl
t (Cmptabentry (Cmptabentry_Attrs rel1 :: Baserel
rel1 rel2 :: Baserel
rel2) bs :: [Baserel]
bs)
              -> (IntMap BSet -> IntMap BSet -> IntMap BSet)
-> Int -> IntMap BSet -> CmpTbl -> CmpTbl
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith IntMap BSet -> IntMap BSet -> IntMap BSet
forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union (Baserel -> Map Baserel Int -> Int
forall a. (Show a, Ord a) => a -> Map a Int -> Int
lkup Baserel
rel1 Map Baserel Int
m)
                 ((BSet -> BSet -> BSet) -> Int -> BSet -> IntMap BSet -> IntMap BSet
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith BSet -> BSet -> BSet
IntSet.union (Baserel -> Map Baserel Int -> Int
forall a. (Show a, Ord a) => a -> Map a Int -> Int
lkup Baserel
rel2 Map Baserel Int
m)
                 ([Int] -> BSet
IntSet.fromList ([Int] -> BSet) -> [Int] -> BSet
forall a b. (a -> b) -> a -> b
$ (Baserel -> Int) -> [Baserel] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Baserel -> Map Baserel Int -> Int
forall a. (Show a, Ord a) => a -> Map a Int -> Int
`lkup` Map Baserel Int
m) [Baserel]
bs) IntMap BSet
forall a. IntMap a
IntMap.empty) CmpTbl
t)
  CmpTbl
forall a. IntMap a
IntMap.empty

toConTab :: Map.Map Baserel Int -> (a -> Baserel) -> (a -> [Baserel]) -> [a]
  -> ConTable
toConTab :: Map Baserel Int
-> (a -> Baserel) -> (a -> [Baserel]) -> [a] -> IntMap BSet
toConTab m :: Map Baserel Int
m s1 :: a -> Baserel
s1 s2 :: a -> [Baserel]
s2 = (IntMap BSet -> a -> IntMap BSet)
-> IntMap BSet -> [a] -> IntMap BSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ t :: IntMap BSet
t a :: a
a ->
    (BSet -> BSet -> BSet) -> Int -> BSet -> IntMap BSet -> IntMap BSet
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith BSet -> BSet -> BSet
IntSet.union (Baserel -> Map Baserel Int -> Int
forall a. (Show a, Ord a) => a -> Map a Int -> Int
lkup (a -> Baserel
s1 a
a) Map Baserel Int
m)
           ([Int] -> BSet
IntSet.fromList ([Int] -> BSet) -> [Int] -> BSet
forall a b. (a -> b) -> a -> b
$ (Baserel -> Int) -> [Baserel] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Baserel -> Map Baserel Int -> Int
forall a. (Show a, Ord a) => a -> Map a Int -> Int
`lkup` Map Baserel Int
m) ([Baserel] -> [Int]) -> [Baserel] -> [Int]
forall a b. (a -> b) -> a -> b
$ a -> [Baserel]
s2 a
a) IntMap BSet
t) IntMap BSet
forall a. IntMap a
IntMap.empty

toConTab2 :: Map.Map Baserel Int -> [Contabentry_Ternary] -> ConTable
toConTab2 :: Map Baserel Int -> [Contabentry_Ternary] -> IntMap BSet
toConTab2 m :: Map Baserel Int
m =
  Map Baserel Int
-> (Contabentry_Ternary -> Baserel)
-> (Contabentry_Ternary -> [Baserel])
-> [Contabentry_Ternary]
-> IntMap BSet
forall a.
Map Baserel Int
-> (a -> Baserel) -> (a -> [Baserel]) -> [a] -> IntMap BSet
toConTab Map Baserel Int
m Contabentry_Ternary -> Baserel
contabentry_TernaryArgBaseRel Contabentry_Ternary -> [Baserel]
contabentry_TernaryConverseBaseRels

toConTables :: Map.Map Baserel Int -> Conversetable -> ConTables
toConTables :: Map Baserel Int -> Conversetable -> ConTables
toConTables m :: Map Baserel Int
m c :: Conversetable
c = case Conversetable
c of
  Conversetable l :: [Contabentry]
l ->
    (Map Baserel Int
-> (Contabentry -> Baserel)
-> (Contabentry -> [Baserel])
-> [Contabentry]
-> IntMap BSet
forall a.
Map Baserel Int
-> (a -> Baserel) -> (a -> [Baserel]) -> [a] -> IntMap BSet
toConTab Map Baserel Int
m Contabentry -> Baserel
contabentryArgBaseRel Contabentry -> [Baserel]
contabentryConverseBaseRel [Contabentry]
l
    , IntMap BSet
forall a. IntMap a
IntMap.empty, IntMap BSet
forall a. IntMap a
IntMap.empty, IntMap BSet
forall a. IntMap a
IntMap.empty)
  Conversetable_Ternary l1 :: [Contabentry_Ternary]
l1 l2 :: [Contabentry_Ternary]
l2 l3 :: [Contabentry_Ternary]
l3 ->
    (IntMap BSet
forall a. IntMap a
IntMap.empty, Map Baserel Int -> [Contabentry_Ternary] -> IntMap BSet
toConTab2 Map Baserel Int
m [Contabentry_Ternary]
l1, Map Baserel Int -> [Contabentry_Ternary] -> IntMap BSet
toConTab2 Map Baserel Int
m [Contabentry_Ternary]
l2, Map Baserel Int -> [Contabentry_Ternary] -> IntMap BSet
toConTab2 Map Baserel Int
m [Contabentry_Ternary]
l3)