{- |
Module      :  ./CASL/CompositionTable/CompositionTable.hs
Description :  composition tables of qualitative calculi
Copyright   :  (c) Uni Bremen 2005
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  till@informatik.uni-bremen.de
Stability   :  provisional
Portability :  portable

composition tables
-}

module CASL.CompositionTable.CompositionTable where

data Table = Table Table_Attrs Compositiontable Conversetable
             Reflectiontable Models
             deriving (Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show)

data Table_Attrs = Table_Attrs
    { Table_Attrs -> String
tableName :: String
    , Table_Attrs -> Baserel
tableIdentity :: Baserel
    , Table_Attrs -> [Baserel]
baseRelations :: [Baserel]
    } deriving (Table_Attrs -> Table_Attrs -> Bool
(Table_Attrs -> Table_Attrs -> Bool)
-> (Table_Attrs -> Table_Attrs -> Bool) -> Eq Table_Attrs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table_Attrs -> Table_Attrs -> Bool
$c/= :: Table_Attrs -> Table_Attrs -> Bool
== :: Table_Attrs -> Table_Attrs -> Bool
$c== :: Table_Attrs -> Table_Attrs -> Bool
Eq, Int -> Table_Attrs -> ShowS
[Table_Attrs] -> ShowS
Table_Attrs -> String
(Int -> Table_Attrs -> ShowS)
-> (Table_Attrs -> String)
-> ([Table_Attrs] -> ShowS)
-> Show Table_Attrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table_Attrs] -> ShowS
$cshowList :: [Table_Attrs] -> ShowS
show :: Table_Attrs -> String
$cshow :: Table_Attrs -> String
showsPrec :: Int -> Table_Attrs -> ShowS
$cshowsPrec :: Int -> Table_Attrs -> ShowS
Show)

newtype Compositiontable = Compositiontable [Cmptabentry]
    deriving (Compositiontable -> Compositiontable -> Bool
(Compositiontable -> Compositiontable -> Bool)
-> (Compositiontable -> Compositiontable -> Bool)
-> Eq Compositiontable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compositiontable -> Compositiontable -> Bool
$c/= :: Compositiontable -> Compositiontable -> Bool
== :: Compositiontable -> Compositiontable -> Bool
$c== :: Compositiontable -> Compositiontable -> Bool
Eq, Int -> Compositiontable -> ShowS
[Compositiontable] -> ShowS
Compositiontable -> String
(Int -> Compositiontable -> ShowS)
-> (Compositiontable -> String)
-> ([Compositiontable] -> ShowS)
-> Show Compositiontable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compositiontable] -> ShowS
$cshowList :: [Compositiontable] -> ShowS
show :: Compositiontable -> String
$cshow :: Compositiontable -> String
showsPrec :: Int -> Compositiontable -> ShowS
$cshowsPrec :: Int -> Compositiontable -> ShowS
Show)

data Conversetable = Conversetable [Contabentry] |
        Conversetable_Ternary
        { Conversetable -> [Contabentry_Ternary]
inverse, Conversetable -> [Contabentry_Ternary]
shortcut, Conversetable -> [Contabentry_Ternary]
homing :: [Contabentry_Ternary] }
    deriving (Conversetable -> Conversetable -> Bool
(Conversetable -> Conversetable -> Bool)
-> (Conversetable -> Conversetable -> Bool) -> Eq Conversetable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conversetable -> Conversetable -> Bool
$c/= :: Conversetable -> Conversetable -> Bool
== :: Conversetable -> Conversetable -> Bool
$c== :: Conversetable -> Conversetable -> Bool
Eq, Int -> Conversetable -> ShowS
[Conversetable] -> ShowS
Conversetable -> String
(Int -> Conversetable -> ShowS)
-> (Conversetable -> String)
-> ([Conversetable] -> ShowS)
-> Show Conversetable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conversetable] -> ShowS
$cshowList :: [Conversetable] -> ShowS
show :: Conversetable -> String
$cshow :: Conversetable -> String
showsPrec :: Int -> Conversetable -> ShowS
$cshowsPrec :: Int -> Conversetable -> ShowS
Show)

data Reflectiontable = Reflectiontable [Reftabentry]
     deriving (Reflectiontable -> Reflectiontable -> Bool
(Reflectiontable -> Reflectiontable -> Bool)
-> (Reflectiontable -> Reflectiontable -> Bool)
-> Eq Reflectiontable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reflectiontable -> Reflectiontable -> Bool
$c/= :: Reflectiontable -> Reflectiontable -> Bool
== :: Reflectiontable -> Reflectiontable -> Bool
$c== :: Reflectiontable -> Reflectiontable -> Bool
Eq, Int -> Reflectiontable -> ShowS
[Reflectiontable] -> ShowS
Reflectiontable -> String
(Int -> Reflectiontable -> ShowS)
-> (Reflectiontable -> String)
-> ([Reflectiontable] -> ShowS)
-> Show Reflectiontable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reflectiontable] -> ShowS
$cshowList :: [Reflectiontable] -> ShowS
show :: Reflectiontable -> String
$cshow :: Reflectiontable -> String
showsPrec :: Int -> Reflectiontable -> ShowS
$cshowsPrec :: Int -> Reflectiontable -> ShowS
Show)

newtype Models = Models [Model]
    deriving (Models -> Models -> Bool
(Models -> Models -> Bool)
-> (Models -> Models -> Bool) -> Eq Models
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Models -> Models -> Bool
$c/= :: Models -> Models -> Bool
== :: Models -> Models -> Bool
$c== :: Models -> Models -> Bool
Eq, Int -> Models -> ShowS
[Models] -> ShowS
Models -> String
(Int -> Models -> ShowS)
-> (Models -> String) -> ([Models] -> ShowS) -> Show Models
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Models] -> ShowS
$cshowList :: [Models] -> ShowS
show :: Models -> String
$cshow :: Models -> String
showsPrec :: Int -> Models -> ShowS
$cshowsPrec :: Int -> Models -> ShowS
Show)

data Cmptabentry = Cmptabentry Cmptabentry_Attrs [Baserel]
                   deriving (Cmptabentry -> Cmptabentry -> Bool
(Cmptabentry -> Cmptabentry -> Bool)
-> (Cmptabentry -> Cmptabentry -> Bool) -> Eq Cmptabentry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cmptabentry -> Cmptabentry -> Bool
$c/= :: Cmptabentry -> Cmptabentry -> Bool
== :: Cmptabentry -> Cmptabentry -> Bool
$c== :: Cmptabentry -> Cmptabentry -> Bool
Eq, Int -> Cmptabentry -> ShowS
[Cmptabentry] -> ShowS
Cmptabentry -> String
(Int -> Cmptabentry -> ShowS)
-> (Cmptabentry -> String)
-> ([Cmptabentry] -> ShowS)
-> Show Cmptabentry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cmptabentry] -> ShowS
$cshowList :: [Cmptabentry] -> ShowS
show :: Cmptabentry -> String
$cshow :: Cmptabentry -> String
showsPrec :: Int -> Cmptabentry -> ShowS
$cshowsPrec :: Int -> Cmptabentry -> ShowS
Show)

data Cmptabentry_Attrs = Cmptabentry_Attrs
    { Cmptabentry_Attrs -> Baserel
cmptabentryArgBaserel1 :: Baserel
    , Cmptabentry_Attrs -> Baserel
cmptabentryArgBaserel2 :: Baserel
    } deriving (Cmptabentry_Attrs -> Cmptabentry_Attrs -> Bool
(Cmptabentry_Attrs -> Cmptabentry_Attrs -> Bool)
-> (Cmptabentry_Attrs -> Cmptabentry_Attrs -> Bool)
-> Eq Cmptabentry_Attrs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cmptabentry_Attrs -> Cmptabentry_Attrs -> Bool
$c/= :: Cmptabentry_Attrs -> Cmptabentry_Attrs -> Bool
== :: Cmptabentry_Attrs -> Cmptabentry_Attrs -> Bool
$c== :: Cmptabentry_Attrs -> Cmptabentry_Attrs -> Bool
Eq, Int -> Cmptabentry_Attrs -> ShowS
[Cmptabentry_Attrs] -> ShowS
Cmptabentry_Attrs -> String
(Int -> Cmptabentry_Attrs -> ShowS)
-> (Cmptabentry_Attrs -> String)
-> ([Cmptabentry_Attrs] -> ShowS)
-> Show Cmptabentry_Attrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cmptabentry_Attrs] -> ShowS
$cshowList :: [Cmptabentry_Attrs] -> ShowS
show :: Cmptabentry_Attrs -> String
$cshow :: Cmptabentry_Attrs -> String
showsPrec :: Int -> Cmptabentry_Attrs -> ShowS
$cshowsPrec :: Int -> Cmptabentry_Attrs -> ShowS
Show)

data Contabentry = Contabentry
    { Contabentry -> Baserel
contabentryArgBaseRel :: Baserel
    , Contabentry -> [Baserel]
contabentryConverseBaseRel :: [Baserel]
    } deriving (Contabentry -> Contabentry -> Bool
(Contabentry -> Contabentry -> Bool)
-> (Contabentry -> Contabentry -> Bool) -> Eq Contabentry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contabentry -> Contabentry -> Bool
$c/= :: Contabentry -> Contabentry -> Bool
== :: Contabentry -> Contabentry -> Bool
$c== :: Contabentry -> Contabentry -> Bool
Eq, Int -> Contabentry -> ShowS
[Contabentry] -> ShowS
Contabentry -> String
(Int -> Contabentry -> ShowS)
-> (Contabentry -> String)
-> ([Contabentry] -> ShowS)
-> Show Contabentry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contabentry] -> ShowS
$cshowList :: [Contabentry] -> ShowS
show :: Contabentry -> String
$cshow :: Contabentry -> String
showsPrec :: Int -> Contabentry -> ShowS
$cshowsPrec :: Int -> Contabentry -> ShowS
Show)

data Contabentry_Ternary = Contabentry_Ternary
    { Contabentry_Ternary -> Baserel
contabentry_TernaryArgBaseRel :: Baserel
    , Contabentry_Ternary -> [Baserel]
contabentry_TernaryConverseBaseRels :: [Baserel]
    } deriving (Contabentry_Ternary -> Contabentry_Ternary -> Bool
(Contabentry_Ternary -> Contabentry_Ternary -> Bool)
-> (Contabentry_Ternary -> Contabentry_Ternary -> Bool)
-> Eq Contabentry_Ternary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contabentry_Ternary -> Contabentry_Ternary -> Bool
$c/= :: Contabentry_Ternary -> Contabentry_Ternary -> Bool
== :: Contabentry_Ternary -> Contabentry_Ternary -> Bool
$c== :: Contabentry_Ternary -> Contabentry_Ternary -> Bool
Eq, Int -> Contabentry_Ternary -> ShowS
[Contabentry_Ternary] -> ShowS
Contabentry_Ternary -> String
(Int -> Contabentry_Ternary -> ShowS)
-> (Contabentry_Ternary -> String)
-> ([Contabentry_Ternary] -> ShowS)
-> Show Contabentry_Ternary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contabentry_Ternary] -> ShowS
$cshowList :: [Contabentry_Ternary] -> ShowS
show :: Contabentry_Ternary -> String
$cshow :: Contabentry_Ternary -> String
showsPrec :: Int -> Contabentry_Ternary -> ShowS
$cshowsPrec :: Int -> Contabentry_Ternary -> ShowS
Show)

data Reftabentry = Reftabentry
     { Reftabentry -> Baserel
reftabentryArgBaseRel :: Baserel
     , Reftabentry -> Baserel
reftabentryReflectiveBaseRel :: Baserel
     } deriving (Reftabentry -> Reftabentry -> Bool
(Reftabentry -> Reftabentry -> Bool)
-> (Reftabentry -> Reftabentry -> Bool) -> Eq Reftabentry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reftabentry -> Reftabentry -> Bool
$c/= :: Reftabentry -> Reftabentry -> Bool
== :: Reftabentry -> Reftabentry -> Bool
$c== :: Reftabentry -> Reftabentry -> Bool
Eq, Int -> Reftabentry -> ShowS
[Reftabentry] -> ShowS
Reftabentry -> String
(Int -> Reftabentry -> ShowS)
-> (Reftabentry -> String)
-> ([Reftabentry] -> ShowS)
-> Show Reftabentry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reftabentry] -> ShowS
$cshowList :: [Reftabentry] -> ShowS
show :: Reftabentry -> String
$cshow :: Reftabentry -> String
showsPrec :: Int -> Reftabentry -> ShowS
$cshowsPrec :: Int -> Reftabentry -> ShowS
Show)

data Model = Model
    { Model -> String
modelString1 :: String
    , Model -> String
modelString2 :: String
    } deriving (Model -> Model -> Bool
(Model -> Model -> Bool) -> (Model -> Model -> Bool) -> Eq Model
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Model -> Model -> Bool
$c/= :: Model -> Model -> Bool
== :: Model -> Model -> Bool
$c== :: Model -> Model -> Bool
Eq, Int -> Model -> ShowS
[Model] -> ShowS
Model -> String
(Int -> Model -> ShowS)
-> (Model -> String) -> ([Model] -> ShowS) -> Show Model
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Model] -> ShowS
$cshowList :: [Model] -> ShowS
show :: Model -> String
$cshow :: Model -> String
showsPrec :: Int -> Model -> ShowS
$cshowsPrec :: Int -> Model -> ShowS
Show)

newtype Baserel = Baserel
    { Baserel -> String
baserelBaserel :: String
    } deriving (Baserel -> Baserel -> Bool
(Baserel -> Baserel -> Bool)
-> (Baserel -> Baserel -> Bool) -> Eq Baserel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Baserel -> Baserel -> Bool
$c/= :: Baserel -> Baserel -> Bool
== :: Baserel -> Baserel -> Bool
$c== :: Baserel -> Baserel -> Bool
Eq, Eq Baserel
Eq Baserel =>
(Baserel -> Baserel -> Ordering)
-> (Baserel -> Baserel -> Bool)
-> (Baserel -> Baserel -> Bool)
-> (Baserel -> Baserel -> Bool)
-> (Baserel -> Baserel -> Bool)
-> (Baserel -> Baserel -> Baserel)
-> (Baserel -> Baserel -> Baserel)
-> Ord Baserel
Baserel -> Baserel -> Bool
Baserel -> Baserel -> Ordering
Baserel -> Baserel -> Baserel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Baserel -> Baserel -> Baserel
$cmin :: Baserel -> Baserel -> Baserel
max :: Baserel -> Baserel -> Baserel
$cmax :: Baserel -> Baserel -> Baserel
>= :: Baserel -> Baserel -> Bool
$c>= :: Baserel -> Baserel -> Bool
> :: Baserel -> Baserel -> Bool
$c> :: Baserel -> Baserel -> Bool
<= :: Baserel -> Baserel -> Bool
$c<= :: Baserel -> Baserel -> Bool
< :: Baserel -> Baserel -> Bool
$c< :: Baserel -> Baserel -> Bool
compare :: Baserel -> Baserel -> Ordering
$ccompare :: Baserel -> Baserel -> Ordering
$cp1Ord :: Eq Baserel
Ord)

instance Show Baserel where
 show :: Baserel -> String
show (Baserel b :: String
b) = "Baserel: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b