{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./Adl/As.hs
Description :  abstract ADL syntax
Copyright   :  (c) Stef Joosten, Christian Maeder DFKI GmbH 2010
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

-}

module Adl.As where

import Data.Char
import Data.Data
import Data.List (sortBy)

import Common.Id
import Common.Keywords

data Concept
  = C Token -- ^ The name of this Concept
  | Anything -- ^ Really anything as introduced by I and V
    deriving (Concept -> Concept -> Bool
(Concept -> Concept -> Bool)
-> (Concept -> Concept -> Bool) -> Eq Concept
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Concept -> Concept -> Bool
$c/= :: Concept -> Concept -> Bool
== :: Concept -> Concept -> Bool
$c== :: Concept -> Concept -> Bool
Eq, Eq Concept
Eq Concept =>
(Concept -> Concept -> Ordering)
-> (Concept -> Concept -> Bool)
-> (Concept -> Concept -> Bool)
-> (Concept -> Concept -> Bool)
-> (Concept -> Concept -> Bool)
-> (Concept -> Concept -> Concept)
-> (Concept -> Concept -> Concept)
-> Ord Concept
Concept -> Concept -> Bool
Concept -> Concept -> Ordering
Concept -> Concept -> Concept
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 :: Concept -> Concept -> Concept
$cmin :: Concept -> Concept -> Concept
max :: Concept -> Concept -> Concept
$cmax :: Concept -> Concept -> Concept
>= :: Concept -> Concept -> Bool
$c>= :: Concept -> Concept -> Bool
> :: Concept -> Concept -> Bool
$c> :: Concept -> Concept -> Bool
<= :: Concept -> Concept -> Bool
$c<= :: Concept -> Concept -> Bool
< :: Concept -> Concept -> Bool
$c< :: Concept -> Concept -> Bool
compare :: Concept -> Concept -> Ordering
$ccompare :: Concept -> Concept -> Ordering
$cp1Ord :: Eq Concept
Ord, Int -> Concept -> ShowS
[Concept] -> ShowS
Concept -> String
(Int -> Concept -> ShowS)
-> (Concept -> String) -> ([Concept] -> ShowS) -> Show Concept
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Concept] -> ShowS
$cshowList :: [Concept] -> ShowS
show :: Concept -> String
$cshow :: Concept -> String
showsPrec :: Int -> Concept -> ShowS
$cshowsPrec :: Int -> Concept -> ShowS
Show, Typeable, Typeable Concept
Constr
DataType
Typeable Concept =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Concept -> c Concept)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Concept)
-> (Concept -> Constr)
-> (Concept -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Concept))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Concept))
-> ((forall b. Data b => b -> b) -> Concept -> Concept)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Concept -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Concept -> r)
-> (forall u. (forall d. Data d => d -> u) -> Concept -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Concept -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Concept -> m Concept)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Concept -> m Concept)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Concept -> m Concept)
-> Data Concept
Concept -> Constr
Concept -> DataType
(forall b. Data b => b -> b) -> Concept -> Concept
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Concept -> c Concept
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Concept
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Concept -> u
forall u. (forall d. Data d => d -> u) -> Concept -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Concept -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Concept -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Concept -> m Concept
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Concept -> m Concept
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Concept
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Concept -> c Concept
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Concept)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Concept)
$cAnything :: Constr
$cC :: Constr
$tConcept :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Concept -> m Concept
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Concept -> m Concept
gmapMp :: (forall d. Data d => d -> m d) -> Concept -> m Concept
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Concept -> m Concept
gmapM :: (forall d. Data d => d -> m d) -> Concept -> m Concept
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Concept -> m Concept
gmapQi :: Int -> (forall d. Data d => d -> u) -> Concept -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Concept -> u
gmapQ :: (forall d. Data d => d -> u) -> Concept -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Concept -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Concept -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Concept -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Concept -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Concept -> r
gmapT :: (forall b. Data b => b -> b) -> Concept -> Concept
$cgmapT :: (forall b. Data b => b -> b) -> Concept -> Concept
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Concept)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Concept)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Concept)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Concept)
dataTypeOf :: Concept -> DataType
$cdataTypeOf :: Concept -> DataType
toConstr :: Concept -> Constr
$ctoConstr :: Concept -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Concept
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Concept
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Concept -> c Concept
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Concept -> c Concept
$cp1Data :: Typeable Concept
Data)

instance GetRange Concept where
    getRange :: Concept -> Range
getRange c :: Concept
c = case Concept
c of
      C t :: Token
t -> Token -> Range
forall a. GetRange a => a -> Range
getRange Token
t
      Anything -> Range
nullRange
    rangeSpan :: Concept -> [Pos]
rangeSpan c :: Concept
c = case Concept
c of
      C t :: Token
t -> Token -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Token
t
      Anything -> []

data RelType = RelType
  { RelType -> Concept
relSrc :: Concept -- ^ the source concept
  , RelType -> Concept
relTrg :: Concept -- ^ the target concept
  } deriving (RelType -> RelType -> Bool
(RelType -> RelType -> Bool)
-> (RelType -> RelType -> Bool) -> Eq RelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelType -> RelType -> Bool
$c/= :: RelType -> RelType -> Bool
== :: RelType -> RelType -> Bool
$c== :: RelType -> RelType -> Bool
Eq, Eq RelType
Eq RelType =>
(RelType -> RelType -> Ordering)
-> (RelType -> RelType -> Bool)
-> (RelType -> RelType -> Bool)
-> (RelType -> RelType -> Bool)
-> (RelType -> RelType -> Bool)
-> (RelType -> RelType -> RelType)
-> (RelType -> RelType -> RelType)
-> Ord RelType
RelType -> RelType -> Bool
RelType -> RelType -> Ordering
RelType -> RelType -> RelType
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 :: RelType -> RelType -> RelType
$cmin :: RelType -> RelType -> RelType
max :: RelType -> RelType -> RelType
$cmax :: RelType -> RelType -> RelType
>= :: RelType -> RelType -> Bool
$c>= :: RelType -> RelType -> Bool
> :: RelType -> RelType -> Bool
$c> :: RelType -> RelType -> Bool
<= :: RelType -> RelType -> Bool
$c<= :: RelType -> RelType -> Bool
< :: RelType -> RelType -> Bool
$c< :: RelType -> RelType -> Bool
compare :: RelType -> RelType -> Ordering
$ccompare :: RelType -> RelType -> Ordering
$cp1Ord :: Eq RelType
Ord, Int -> RelType -> ShowS
[RelType] -> ShowS
RelType -> String
(Int -> RelType -> ShowS)
-> (RelType -> String) -> ([RelType] -> ShowS) -> Show RelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelType] -> ShowS
$cshowList :: [RelType] -> ShowS
show :: RelType -> String
$cshow :: RelType -> String
showsPrec :: Int -> RelType -> ShowS
$cshowsPrec :: Int -> RelType -> ShowS
Show, Typeable, Typeable RelType
Constr
DataType
Typeable RelType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RelType -> c RelType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RelType)
-> (RelType -> Constr)
-> (RelType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RelType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RelType))
-> ((forall b. Data b => b -> b) -> RelType -> RelType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RelType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RelType -> r)
-> (forall u. (forall d. Data d => d -> u) -> RelType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RelType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RelType -> m RelType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RelType -> m RelType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RelType -> m RelType)
-> Data RelType
RelType -> Constr
RelType -> DataType
(forall b. Data b => b -> b) -> RelType -> RelType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelType -> c RelType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RelType -> u
forall u. (forall d. Data d => d -> u) -> RelType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelType -> c RelType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RelType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RelType)
$cRelType :: Constr
$tRelType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RelType -> m RelType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
gmapMp :: (forall d. Data d => d -> m d) -> RelType -> m RelType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
gmapM :: (forall d. Data d => d -> m d) -> RelType -> m RelType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RelType -> m RelType
gmapQi :: Int -> (forall d. Data d => d -> u) -> RelType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RelType -> u
gmapQ :: (forall d. Data d => d -> u) -> RelType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RelType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelType -> r
gmapT :: (forall b. Data b => b -> b) -> RelType -> RelType
$cgmapT :: (forall b. Data b => b -> b) -> RelType -> RelType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RelType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RelType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RelType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RelType)
dataTypeOf :: RelType -> DataType
$cdataTypeOf :: RelType -> DataType
toConstr :: RelType -> Constr
$ctoConstr :: RelType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelType -> c RelType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelType -> c RelType
$cp1Data :: Typeable RelType
Data)

instance GetRange RelType where
    getRange :: RelType -> Range
getRange = Concept -> Range
forall a. GetRange a => a -> Range
getRange (Concept -> Range) -> (RelType -> Concept) -> RelType -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelType -> Concept
relSrc
    rangeSpan :: RelType -> [Pos]
rangeSpan (RelType c1 :: Concept
c1 c2 :: Concept
c2) =
      [[Pos]] -> [Pos]
joinRanges [Concept -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Concept
c1, Concept -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Concept
c2]

data Relation = Sgn
  { Relation -> Token
decnm :: Token  -- ^ the name
  , Relation -> RelType
relType :: RelType
  } deriving (Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, Eq Relation
Eq Relation =>
(Relation -> Relation -> Ordering)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Relation)
-> (Relation -> Relation -> Relation)
-> Ord Relation
Relation -> Relation -> Bool
Relation -> Relation -> Ordering
Relation -> Relation -> Relation
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 :: Relation -> Relation -> Relation
$cmin :: Relation -> Relation -> Relation
max :: Relation -> Relation -> Relation
$cmax :: Relation -> Relation -> Relation
>= :: Relation -> Relation -> Bool
$c>= :: Relation -> Relation -> Bool
> :: Relation -> Relation -> Bool
$c> :: Relation -> Relation -> Bool
<= :: Relation -> Relation -> Bool
$c<= :: Relation -> Relation -> Bool
< :: Relation -> Relation -> Bool
$c< :: Relation -> Relation -> Bool
compare :: Relation -> Relation -> Ordering
$ccompare :: Relation -> Relation -> Ordering
$cp1Ord :: Eq Relation
Ord, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
(Int -> Relation -> ShowS)
-> (Relation -> String) -> ([Relation] -> ShowS) -> Show Relation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relation] -> ShowS
$cshowList :: [Relation] -> ShowS
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: Int -> Relation -> ShowS
$cshowsPrec :: Int -> Relation -> ShowS
Show, Typeable, Typeable Relation
Constr
DataType
Typeable Relation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Relation -> c Relation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Relation)
-> (Relation -> Constr)
-> (Relation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Relation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relation))
-> ((forall b. Data b => b -> b) -> Relation -> Relation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Relation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Relation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Relation -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Relation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Relation -> m Relation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Relation -> m Relation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Relation -> m Relation)
-> Data Relation
Relation -> Constr
Relation -> DataType
(forall b. Data b => b -> b) -> Relation -> Relation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Relation -> c Relation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Relation
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Relation -> u
forall u. (forall d. Data d => d -> u) -> Relation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Relation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Relation -> c Relation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Relation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relation)
$cSgn :: Constr
$tRelation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Relation -> m Relation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
gmapMp :: (forall d. Data d => d -> m d) -> Relation -> m Relation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
gmapM :: (forall d. Data d => d -> m d) -> Relation -> m Relation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Relation -> m Relation
gmapQi :: Int -> (forall d. Data d => d -> u) -> Relation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Relation -> u
gmapQ :: (forall d. Data d => d -> u) -> Relation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Relation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Relation -> r
gmapT :: (forall b. Data b => b -> b) -> Relation -> Relation
$cgmapT :: (forall b. Data b => b -> b) -> Relation -> Relation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Relation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Relation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Relation)
dataTypeOf :: Relation -> DataType
$cdataTypeOf :: Relation -> DataType
toConstr :: Relation -> Constr
$ctoConstr :: Relation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Relation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Relation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Relation -> c Relation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Relation -> c Relation
$cp1Data :: Typeable Relation
Data)

instance GetRange Relation where
    getRange :: Relation -> Range
getRange = Token -> Range
forall a. GetRange a => a -> Range
getRange (Token -> Range) -> (Relation -> Token) -> Relation -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation -> Token
decnm
    rangeSpan :: Relation -> [Pos]
rangeSpan (Sgn n :: Token
n t :: RelType
t) =
      [[Pos]] -> [Pos]
joinRanges [Token -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Token
n, RelType -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan RelType
t]

-- | builtin relation over Anything
bRels :: [String]
bRels :: [String]
bRels = ["I", "V"]

isBRel :: String -> Bool
isBRel :: String -> Bool
isBRel s :: String
s = String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
s [String]
bRels

data UnOp
  = K0 -- ^ Reflexive and transitive closure *
  | K1 -- ^ Transitive closure +
  | Cp -- ^ Complement -
  | Co -- ^ Converse ~
    deriving (UnOp -> UnOp -> Bool
(UnOp -> UnOp -> Bool) -> (UnOp -> UnOp -> Bool) -> Eq UnOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnOp -> UnOp -> Bool
$c/= :: UnOp -> UnOp -> Bool
== :: UnOp -> UnOp -> Bool
$c== :: UnOp -> UnOp -> Bool
Eq, Eq UnOp
Eq UnOp =>
(UnOp -> UnOp -> Ordering)
-> (UnOp -> UnOp -> Bool)
-> (UnOp -> UnOp -> Bool)
-> (UnOp -> UnOp -> Bool)
-> (UnOp -> UnOp -> Bool)
-> (UnOp -> UnOp -> UnOp)
-> (UnOp -> UnOp -> UnOp)
-> Ord UnOp
UnOp -> UnOp -> Bool
UnOp -> UnOp -> Ordering
UnOp -> UnOp -> UnOp
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 :: UnOp -> UnOp -> UnOp
$cmin :: UnOp -> UnOp -> UnOp
max :: UnOp -> UnOp -> UnOp
$cmax :: UnOp -> UnOp -> UnOp
>= :: UnOp -> UnOp -> Bool
$c>= :: UnOp -> UnOp -> Bool
> :: UnOp -> UnOp -> Bool
$c> :: UnOp -> UnOp -> Bool
<= :: UnOp -> UnOp -> Bool
$c<= :: UnOp -> UnOp -> Bool
< :: UnOp -> UnOp -> Bool
$c< :: UnOp -> UnOp -> Bool
compare :: UnOp -> UnOp -> Ordering
$ccompare :: UnOp -> UnOp -> Ordering
$cp1Ord :: Eq UnOp
Ord, Typeable, Typeable UnOp
Constr
DataType
Typeable UnOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> UnOp -> c UnOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnOp)
-> (UnOp -> Constr)
-> (UnOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnOp))
-> ((forall b. Data b => b -> b) -> UnOp -> UnOp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnOp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UnOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UnOp -> m UnOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnOp -> m UnOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnOp -> m UnOp)
-> Data UnOp
UnOp -> Constr
UnOp -> DataType
(forall b. Data b => b -> b) -> UnOp -> UnOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnOp -> c UnOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnOp
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UnOp -> u
forall u. (forall d. Data d => d -> u) -> UnOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnOp -> m UnOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnOp -> m UnOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnOp -> c UnOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnOp)
$cCo :: Constr
$cCp :: Constr
$cK1 :: Constr
$cK0 :: Constr
$tUnOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UnOp -> m UnOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnOp -> m UnOp
gmapMp :: (forall d. Data d => d -> m d) -> UnOp -> m UnOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnOp -> m UnOp
gmapM :: (forall d. Data d => d -> m d) -> UnOp -> m UnOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnOp -> m UnOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> UnOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnOp -> u
gmapQ :: (forall d. Data d => d -> u) -> UnOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnOp -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnOp -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnOp -> r
gmapT :: (forall b. Data b => b -> b) -> UnOp -> UnOp
$cgmapT :: (forall b. Data b => b -> b) -> UnOp -> UnOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UnOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnOp)
dataTypeOf :: UnOp -> DataType
$cdataTypeOf :: UnOp -> DataType
toConstr :: UnOp -> Constr
$ctoConstr :: UnOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnOp -> c UnOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnOp -> c UnOp
$cp1Data :: Typeable UnOp
Data)

instance Show UnOp where
  show :: UnOp -> String
show o :: UnOp
o = case UnOp
o of
    K0 -> "*"
    K1 -> "+"
    Cp -> "-" -- prefix!
    Co -> "~"

data MulOp
  = Fc -- ^ composition ;
  | Fd -- ^ relative addition !
  | Fi -- ^ intersection /\.
  | Fu -- ^ union \/
  | Ri -- ^ Rule implication |-
  | Rr -- ^ Rule reverse implication -|
  | Re -- ^ Rule equivalence
    deriving (MulOp -> MulOp -> Bool
(MulOp -> MulOp -> Bool) -> (MulOp -> MulOp -> Bool) -> Eq MulOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MulOp -> MulOp -> Bool
$c/= :: MulOp -> MulOp -> Bool
== :: MulOp -> MulOp -> Bool
$c== :: MulOp -> MulOp -> Bool
Eq, Eq MulOp
Eq MulOp =>
(MulOp -> MulOp -> Ordering)
-> (MulOp -> MulOp -> Bool)
-> (MulOp -> MulOp -> Bool)
-> (MulOp -> MulOp -> Bool)
-> (MulOp -> MulOp -> Bool)
-> (MulOp -> MulOp -> MulOp)
-> (MulOp -> MulOp -> MulOp)
-> Ord MulOp
MulOp -> MulOp -> Bool
MulOp -> MulOp -> Ordering
MulOp -> MulOp -> MulOp
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 :: MulOp -> MulOp -> MulOp
$cmin :: MulOp -> MulOp -> MulOp
max :: MulOp -> MulOp -> MulOp
$cmax :: MulOp -> MulOp -> MulOp
>= :: MulOp -> MulOp -> Bool
$c>= :: MulOp -> MulOp -> Bool
> :: MulOp -> MulOp -> Bool
$c> :: MulOp -> MulOp -> Bool
<= :: MulOp -> MulOp -> Bool
$c<= :: MulOp -> MulOp -> Bool
< :: MulOp -> MulOp -> Bool
$c< :: MulOp -> MulOp -> Bool
compare :: MulOp -> MulOp -> Ordering
$ccompare :: MulOp -> MulOp -> Ordering
$cp1Ord :: Eq MulOp
Ord, Typeable, Typeable MulOp
Constr
DataType
Typeable MulOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MulOp -> c MulOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MulOp)
-> (MulOp -> Constr)
-> (MulOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MulOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MulOp))
-> ((forall b. Data b => b -> b) -> MulOp -> MulOp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MulOp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MulOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> MulOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> MulOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MulOp -> m MulOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MulOp -> m MulOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MulOp -> m MulOp)
-> Data MulOp
MulOp -> Constr
MulOp -> DataType
(forall b. Data b => b -> b) -> MulOp -> MulOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MulOp -> c MulOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MulOp
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MulOp -> u
forall u. (forall d. Data d => d -> u) -> MulOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MulOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MulOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MulOp -> m MulOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MulOp -> m MulOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MulOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MulOp -> c MulOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MulOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MulOp)
$cRe :: Constr
$cRr :: Constr
$cRi :: Constr
$cFu :: Constr
$cFi :: Constr
$cFd :: Constr
$cFc :: Constr
$tMulOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MulOp -> m MulOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MulOp -> m MulOp
gmapMp :: (forall d. Data d => d -> m d) -> MulOp -> m MulOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MulOp -> m MulOp
gmapM :: (forall d. Data d => d -> m d) -> MulOp -> m MulOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MulOp -> m MulOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> MulOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MulOp -> u
gmapQ :: (forall d. Data d => d -> u) -> MulOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MulOp -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MulOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MulOp -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MulOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MulOp -> r
gmapT :: (forall b. Data b => b -> b) -> MulOp -> MulOp
$cgmapT :: (forall b. Data b => b -> b) -> MulOp -> MulOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MulOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MulOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MulOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MulOp)
dataTypeOf :: MulOp -> DataType
$cdataTypeOf :: MulOp -> DataType
toConstr :: MulOp -> Constr
$ctoConstr :: MulOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MulOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MulOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MulOp -> c MulOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MulOp -> c MulOp
$cp1Data :: Typeable MulOp
Data)

instance Show MulOp where
  show :: MulOp -> String
show o :: MulOp
o = case MulOp
o of
    Fc -> ";"
    Fd -> "!"
    Fi -> String
lAnd
    Fu -> String
lOr
    Ri -> "|-"
    Rr -> "-|"
    Re -> "="

data Rule
  = Tm Relation
  | MulExp MulOp [Rule]
  | UnExp UnOp Rule
    deriving (Rule -> Rule -> Bool
(Rule -> Rule -> Bool) -> (Rule -> Rule -> Bool) -> Eq Rule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rule -> Rule -> Bool
$c/= :: Rule -> Rule -> Bool
== :: Rule -> Rule -> Bool
$c== :: Rule -> Rule -> Bool
Eq, Eq Rule
Eq Rule =>
(Rule -> Rule -> Ordering)
-> (Rule -> Rule -> Bool)
-> (Rule -> Rule -> Bool)
-> (Rule -> Rule -> Bool)
-> (Rule -> Rule -> Bool)
-> (Rule -> Rule -> Rule)
-> (Rule -> Rule -> Rule)
-> Ord Rule
Rule -> Rule -> Bool
Rule -> Rule -> Ordering
Rule -> Rule -> Rule
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 :: Rule -> Rule -> Rule
$cmin :: Rule -> Rule -> Rule
max :: Rule -> Rule -> Rule
$cmax :: Rule -> Rule -> Rule
>= :: Rule -> Rule -> Bool
$c>= :: Rule -> Rule -> Bool
> :: Rule -> Rule -> Bool
$c> :: Rule -> Rule -> Bool
<= :: Rule -> Rule -> Bool
$c<= :: Rule -> Rule -> Bool
< :: Rule -> Rule -> Bool
$c< :: Rule -> Rule -> Bool
compare :: Rule -> Rule -> Ordering
$ccompare :: Rule -> Rule -> Ordering
$cp1Ord :: Eq Rule
Ord, Int -> Rule -> ShowS
[Rule] -> ShowS
Rule -> String
(Int -> Rule -> ShowS)
-> (Rule -> String) -> ([Rule] -> ShowS) -> Show Rule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rule] -> ShowS
$cshowList :: [Rule] -> ShowS
show :: Rule -> String
$cshow :: Rule -> String
showsPrec :: Int -> Rule -> ShowS
$cshowsPrec :: Int -> Rule -> ShowS
Show, Typeable, Typeable Rule
Constr
DataType
Typeable Rule =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Rule -> c Rule)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Rule)
-> (Rule -> Constr)
-> (Rule -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Rule))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rule))
-> ((forall b. Data b => b -> b) -> Rule -> Rule)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r)
-> (forall u. (forall d. Data d => d -> u) -> Rule -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Rule -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Rule -> m Rule)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rule -> m Rule)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rule -> m Rule)
-> Data Rule
Rule -> Constr
Rule -> DataType
(forall b. Data b => b -> b) -> Rule -> Rule
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rule -> c Rule
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rule
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Rule -> u
forall u. (forall d. Data d => d -> u) -> Rule -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rule
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rule -> c Rule
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rule)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rule)
$cUnExp :: Constr
$cMulExp :: Constr
$cTm :: Constr
$tRule :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Rule -> m Rule
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
gmapMp :: (forall d. Data d => d -> m d) -> Rule -> m Rule
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
gmapM :: (forall d. Data d => d -> m d) -> Rule -> m Rule
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rule -> m Rule
gmapQi :: Int -> (forall d. Data d => d -> u) -> Rule -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rule -> u
gmapQ :: (forall d. Data d => d -> u) -> Rule -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Rule -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rule -> r
gmapT :: (forall b. Data b => b -> b) -> Rule -> Rule
$cgmapT :: (forall b. Data b => b -> b) -> Rule -> Rule
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rule)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rule)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Rule)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rule)
dataTypeOf :: Rule -> DataType
$cdataTypeOf :: Rule -> DataType
toConstr :: Rule -> Constr
$ctoConstr :: Rule -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rule
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rule
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rule -> c Rule
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rule -> c Rule
$cp1Data :: Typeable Rule
Data)

instance GetRange Rule where
  getRange :: Rule -> Range
getRange e :: Rule
e = case Rule
e of
    Tm r :: Relation
r -> Relation -> Range
forall a. GetRange a => a -> Range
getRange Relation
r
    UnExp _ f :: Rule
f -> Rule -> Range
forall a. GetRange a => a -> Range
getRange Rule
f
    MulExp _ es :: [Rule]
es -> (Rule -> Range) -> [Rule] -> Range
forall a. (a -> Range) -> [a] -> Range
concatMapRange Rule -> Range
forall a. GetRange a => a -> Range
getRange [Rule]
es
  rangeSpan :: Rule -> [Pos]
rangeSpan e :: Rule
e = case Rule
e of
    Tm r :: Relation
r -> Relation -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Relation
r
    UnExp _ f :: Rule
f -> Rule -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Rule
f
    MulExp _ es :: [Rule]
es -> [[Pos]] -> [Pos]
joinRanges ([[Pos]] -> [Pos]) -> [[Pos]] -> [Pos]
forall a b. (a -> b) -> a -> b
$ (Rule -> [Pos]) -> [Rule] -> [[Pos]]
forall a b. (a -> b) -> [a] -> [b]
map Rule -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [Rule]
es

data Prop
  = Uni          -- ^ univalent
  | Inj          -- ^ injective
  | Sur          -- ^ surjective
  | Tot          -- ^ total
  | Sym          -- ^ symmetric
  | Asy          -- ^ antisymmetric
  | Trn          -- ^ transitive
  | Rfx          -- ^ reflexive
  | Prop         -- ^ meta property
    deriving (Int -> Prop
Prop -> Int
Prop -> [Prop]
Prop -> Prop
Prop -> Prop -> [Prop]
Prop -> Prop -> Prop -> [Prop]
(Prop -> Prop)
-> (Prop -> Prop)
-> (Int -> Prop)
-> (Prop -> Int)
-> (Prop -> [Prop])
-> (Prop -> Prop -> [Prop])
-> (Prop -> Prop -> [Prop])
-> (Prop -> Prop -> Prop -> [Prop])
-> Enum Prop
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Prop -> Prop -> Prop -> [Prop]
$cenumFromThenTo :: Prop -> Prop -> Prop -> [Prop]
enumFromTo :: Prop -> Prop -> [Prop]
$cenumFromTo :: Prop -> Prop -> [Prop]
enumFromThen :: Prop -> Prop -> [Prop]
$cenumFromThen :: Prop -> Prop -> [Prop]
enumFrom :: Prop -> [Prop]
$cenumFrom :: Prop -> [Prop]
fromEnum :: Prop -> Int
$cfromEnum :: Prop -> Int
toEnum :: Int -> Prop
$ctoEnum :: Int -> Prop
pred :: Prop -> Prop
$cpred :: Prop -> Prop
succ :: Prop -> Prop
$csucc :: Prop -> Prop
Enum, Prop -> Prop -> Bool
(Prop -> Prop -> Bool) -> (Prop -> Prop -> Bool) -> Eq Prop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prop -> Prop -> Bool
$c/= :: Prop -> Prop -> Bool
== :: Prop -> Prop -> Bool
$c== :: Prop -> Prop -> Bool
Eq, Eq Prop
Eq Prop =>
(Prop -> Prop -> Ordering)
-> (Prop -> Prop -> Bool)
-> (Prop -> Prop -> Bool)
-> (Prop -> Prop -> Bool)
-> (Prop -> Prop -> Bool)
-> (Prop -> Prop -> Prop)
-> (Prop -> Prop -> Prop)
-> Ord Prop
Prop -> Prop -> Bool
Prop -> Prop -> Ordering
Prop -> Prop -> Prop
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 :: Prop -> Prop -> Prop
$cmin :: Prop -> Prop -> Prop
max :: Prop -> Prop -> Prop
$cmax :: Prop -> Prop -> Prop
>= :: Prop -> Prop -> Bool
$c>= :: Prop -> Prop -> Bool
> :: Prop -> Prop -> Bool
$c> :: Prop -> Prop -> Bool
<= :: Prop -> Prop -> Bool
$c<= :: Prop -> Prop -> Bool
< :: Prop -> Prop -> Bool
$c< :: Prop -> Prop -> Bool
compare :: Prop -> Prop -> Ordering
$ccompare :: Prop -> Prop -> Ordering
$cp1Ord :: Eq Prop
Ord, Int -> Prop -> ShowS
[Prop] -> ShowS
Prop -> String
(Int -> Prop -> ShowS)
-> (Prop -> String) -> ([Prop] -> ShowS) -> Show Prop
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prop] -> ShowS
$cshowList :: [Prop] -> ShowS
show :: Prop -> String
$cshow :: Prop -> String
showsPrec :: Int -> Prop -> ShowS
$cshowsPrec :: Int -> Prop -> ShowS
Show, Typeable, Typeable Prop
Constr
DataType
Typeable Prop =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Prop -> c Prop)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Prop)
-> (Prop -> Constr)
-> (Prop -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Prop))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prop))
-> ((forall b. Data b => b -> b) -> Prop -> Prop)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prop -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prop -> r)
-> (forall u. (forall d. Data d => d -> u) -> Prop -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Prop -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Prop -> m Prop)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Prop -> m Prop)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Prop -> m Prop)
-> Data Prop
Prop -> Constr
Prop -> DataType
(forall b. Data b => b -> b) -> Prop -> Prop
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prop -> c Prop
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prop
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Prop -> u
forall u. (forall d. Data d => d -> u) -> Prop -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prop -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prop -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Prop -> m Prop
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prop -> m Prop
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prop
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prop -> c Prop
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prop)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prop)
$cProp :: Constr
$cRfx :: Constr
$cTrn :: Constr
$cAsy :: Constr
$cSym :: Constr
$cTot :: Constr
$cSur :: Constr
$cInj :: Constr
$cUni :: Constr
$tProp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Prop -> m Prop
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prop -> m Prop
gmapMp :: (forall d. Data d => d -> m d) -> Prop -> m Prop
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prop -> m Prop
gmapM :: (forall d. Data d => d -> m d) -> Prop -> m Prop
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Prop -> m Prop
gmapQi :: Int -> (forall d. Data d => d -> u) -> Prop -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Prop -> u
gmapQ :: (forall d. Data d => d -> u) -> Prop -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Prop -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prop -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prop -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prop -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prop -> r
gmapT :: (forall b. Data b => b -> b) -> Prop -> Prop
$cgmapT :: (forall b. Data b => b -> b) -> Prop -> Prop
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prop)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prop)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Prop)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prop)
dataTypeOf :: Prop -> DataType
$cdataTypeOf :: Prop -> DataType
toConstr :: Prop -> Constr
$ctoConstr :: Prop -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prop
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prop
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prop -> c Prop
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prop -> c Prop
$cp1Data :: Typeable Prop
Data)

showUp :: Show a => a -> String
showUp :: a -> String
showUp = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

allProps :: [Prop]
allProps :: [Prop]
allProps = [Prop
Uni .. Prop
Rfx]

data RangedProp = RangedProp
  { RangedProp -> Prop
propProp :: Prop
  , RangedProp -> Range
propRange :: Range }
    deriving (RangedProp -> RangedProp -> Bool
(RangedProp -> RangedProp -> Bool)
-> (RangedProp -> RangedProp -> Bool) -> Eq RangedProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RangedProp -> RangedProp -> Bool
$c/= :: RangedProp -> RangedProp -> Bool
== :: RangedProp -> RangedProp -> Bool
$c== :: RangedProp -> RangedProp -> Bool
Eq, Eq RangedProp
Eq RangedProp =>
(RangedProp -> RangedProp -> Ordering)
-> (RangedProp -> RangedProp -> Bool)
-> (RangedProp -> RangedProp -> Bool)
-> (RangedProp -> RangedProp -> Bool)
-> (RangedProp -> RangedProp -> Bool)
-> (RangedProp -> RangedProp -> RangedProp)
-> (RangedProp -> RangedProp -> RangedProp)
-> Ord RangedProp
RangedProp -> RangedProp -> Bool
RangedProp -> RangedProp -> Ordering
RangedProp -> RangedProp -> RangedProp
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 :: RangedProp -> RangedProp -> RangedProp
$cmin :: RangedProp -> RangedProp -> RangedProp
max :: RangedProp -> RangedProp -> RangedProp
$cmax :: RangedProp -> RangedProp -> RangedProp
>= :: RangedProp -> RangedProp -> Bool
$c>= :: RangedProp -> RangedProp -> Bool
> :: RangedProp -> RangedProp -> Bool
$c> :: RangedProp -> RangedProp -> Bool
<= :: RangedProp -> RangedProp -> Bool
$c<= :: RangedProp -> RangedProp -> Bool
< :: RangedProp -> RangedProp -> Bool
$c< :: RangedProp -> RangedProp -> Bool
compare :: RangedProp -> RangedProp -> Ordering
$ccompare :: RangedProp -> RangedProp -> Ordering
$cp1Ord :: Eq RangedProp
Ord, Int -> RangedProp -> ShowS
[RangedProp] -> ShowS
RangedProp -> String
(Int -> RangedProp -> ShowS)
-> (RangedProp -> String)
-> ([RangedProp] -> ShowS)
-> Show RangedProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RangedProp] -> ShowS
$cshowList :: [RangedProp] -> ShowS
show :: RangedProp -> String
$cshow :: RangedProp -> String
showsPrec :: Int -> RangedProp -> ShowS
$cshowsPrec :: Int -> RangedProp -> ShowS
Show, Typeable, Typeable RangedProp
Constr
DataType
Typeable RangedProp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RangedProp -> c RangedProp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RangedProp)
-> (RangedProp -> Constr)
-> (RangedProp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RangedProp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RangedProp))
-> ((forall b. Data b => b -> b) -> RangedProp -> RangedProp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RangedProp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RangedProp -> r)
-> (forall u. (forall d. Data d => d -> u) -> RangedProp -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RangedProp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RangedProp -> m RangedProp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RangedProp -> m RangedProp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RangedProp -> m RangedProp)
-> Data RangedProp
RangedProp -> Constr
RangedProp -> DataType
(forall b. Data b => b -> b) -> RangedProp -> RangedProp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RangedProp -> c RangedProp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RangedProp
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RangedProp -> u
forall u. (forall d. Data d => d -> u) -> RangedProp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RangedProp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RangedProp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RangedProp -> m RangedProp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RangedProp -> m RangedProp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RangedProp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RangedProp -> c RangedProp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RangedProp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RangedProp)
$cRangedProp :: Constr
$tRangedProp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RangedProp -> m RangedProp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RangedProp -> m RangedProp
gmapMp :: (forall d. Data d => d -> m d) -> RangedProp -> m RangedProp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RangedProp -> m RangedProp
gmapM :: (forall d. Data d => d -> m d) -> RangedProp -> m RangedProp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RangedProp -> m RangedProp
gmapQi :: Int -> (forall d. Data d => d -> u) -> RangedProp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RangedProp -> u
gmapQ :: (forall d. Data d => d -> u) -> RangedProp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RangedProp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RangedProp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RangedProp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RangedProp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RangedProp -> r
gmapT :: (forall b. Data b => b -> b) -> RangedProp -> RangedProp
$cgmapT :: (forall b. Data b => b -> b) -> RangedProp -> RangedProp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RangedProp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RangedProp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RangedProp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RangedProp)
dataTypeOf :: RangedProp -> DataType
$cdataTypeOf :: RangedProp -> DataType
toConstr :: RangedProp -> Constr
$ctoConstr :: RangedProp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RangedProp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RangedProp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RangedProp -> c RangedProp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RangedProp -> c RangedProp
$cp1Data :: Typeable RangedProp
Data)
  -- should be fine since ranges are always equal

instance GetRange RangedProp where
   getRange :: RangedProp -> Range
getRange = RangedProp -> Range
propRange
   rangeSpan :: RangedProp -> [Pos]
rangeSpan (RangedProp p :: Prop
p r :: Range
r) = Token -> [Pos]
tokenRange (String -> Range -> Token
Token (Prop -> String
forall a. Show a => a -> String
show Prop
p) Range
r)

-- | create a ranged property
rProp :: Prop -> RangedProp
rProp :: Prop -> RangedProp
rProp p :: Prop
p = Prop -> Range -> RangedProp
RangedProp Prop
p Range
nullRange

data Object = Object
  { Object -> Token
label :: Token
  , Object -> Rule
expr :: Rule
  , Object -> [RangedProp]
props :: [RangedProp]
  , Object -> [Object]
subobjs :: [Object]
  } deriving (Int -> Object -> ShowS
[Object] -> ShowS
Object -> String
(Int -> Object -> ShowS)
-> (Object -> String) -> ([Object] -> ShowS) -> Show Object
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Object] -> ShowS
$cshowList :: [Object] -> ShowS
show :: Object -> String
$cshow :: Object -> String
showsPrec :: Int -> Object -> ShowS
$cshowsPrec :: Int -> Object -> ShowS
Show, Typeable, Typeable Object
Constr
DataType
Typeable Object =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Object -> c Object)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Object)
-> (Object -> Constr)
-> (Object -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Object))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Object))
-> ((forall b. Data b => b -> b) -> Object -> Object)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Object -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Object -> r)
-> (forall u. (forall d. Data d => d -> u) -> Object -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Object -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Object -> m Object)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Object -> m Object)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Object -> m Object)
-> Data Object
Object -> Constr
Object -> DataType
(forall b. Data b => b -> b) -> Object -> Object
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Object -> c Object
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Object
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Object -> u
forall u. (forall d. Data d => d -> u) -> Object -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Object -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Object -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Object -> m Object
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Object -> m Object
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Object
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Object -> c Object
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Object)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Object)
$cObject :: Constr
$tObject :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Object -> m Object
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Object -> m Object
gmapMp :: (forall d. Data d => d -> m d) -> Object -> m Object
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Object -> m Object
gmapM :: (forall d. Data d => d -> m d) -> Object -> m Object
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Object -> m Object
gmapQi :: Int -> (forall d. Data d => d -> u) -> Object -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Object -> u
gmapQ :: (forall d. Data d => d -> u) -> Object -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Object -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Object -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Object -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Object -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Object -> r
gmapT :: (forall b. Data b => b -> b) -> Object -> Object
$cgmapT :: (forall b. Data b => b -> b) -> Object -> Object
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Object)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Object)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Object)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Object)
dataTypeOf :: Object -> DataType
$cdataTypeOf :: Object -> DataType
toConstr :: Object -> Constr
$ctoConstr :: Object -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Object
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Object
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Object -> c Object
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Object -> c Object
$cp1Data :: Typeable Object
Data)

data KeyAtt = KeyAtt (Maybe Token) Rule deriving (Int -> KeyAtt -> ShowS
[KeyAtt] -> ShowS
KeyAtt -> String
(Int -> KeyAtt -> ShowS)
-> (KeyAtt -> String) -> ([KeyAtt] -> ShowS) -> Show KeyAtt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyAtt] -> ShowS
$cshowList :: [KeyAtt] -> ShowS
show :: KeyAtt -> String
$cshow :: KeyAtt -> String
showsPrec :: Int -> KeyAtt -> ShowS
$cshowsPrec :: Int -> KeyAtt -> ShowS
Show, Typeable, Typeable KeyAtt
Constr
DataType
Typeable KeyAtt =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> KeyAtt -> c KeyAtt)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c KeyAtt)
-> (KeyAtt -> Constr)
-> (KeyAtt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c KeyAtt))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyAtt))
-> ((forall b. Data b => b -> b) -> KeyAtt -> KeyAtt)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> KeyAtt -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> KeyAtt -> r)
-> (forall u. (forall d. Data d => d -> u) -> KeyAtt -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> KeyAtt -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt)
-> Data KeyAtt
KeyAtt -> Constr
KeyAtt -> DataType
(forall b. Data b => b -> b) -> KeyAtt -> KeyAtt
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyAtt -> c KeyAtt
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyAtt
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> KeyAtt -> u
forall u. (forall d. Data d => d -> u) -> KeyAtt -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KeyAtt -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KeyAtt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyAtt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyAtt -> c KeyAtt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeyAtt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyAtt)
$cKeyAtt :: Constr
$tKeyAtt :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt
gmapMp :: (forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt
gmapM :: (forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeyAtt -> m KeyAtt
gmapQi :: Int -> (forall d. Data d => d -> u) -> KeyAtt -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> KeyAtt -> u
gmapQ :: (forall d. Data d => d -> u) -> KeyAtt -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> KeyAtt -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KeyAtt -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KeyAtt -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KeyAtt -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KeyAtt -> r
gmapT :: (forall b. Data b => b -> b) -> KeyAtt -> KeyAtt
$cgmapT :: (forall b. Data b => b -> b) -> KeyAtt -> KeyAtt
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyAtt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyAtt)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c KeyAtt)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeyAtt)
dataTypeOf :: KeyAtt -> DataType
$cdataTypeOf :: KeyAtt -> DataType
toConstr :: KeyAtt -> Constr
$ctoConstr :: KeyAtt -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyAtt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyAtt
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyAtt -> c KeyAtt
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyAtt -> c KeyAtt
$cp1Data :: Typeable KeyAtt
Data)

instance GetRange KeyAtt where
  getRange :: KeyAtt -> Range
getRange (KeyAtt _ e :: Rule
e) = Rule -> Range
forall a. GetRange a => a -> Range
getRange Rule
e
  rangeSpan :: KeyAtt -> [Pos]
rangeSpan (KeyAtt _ e :: Rule
e) = Rule -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Rule
e

data KeyDef = KeyDef
  { KeyDef -> Token
kdlbl :: Token
  , KeyDef -> Concept
kdcpt :: Concept
  , KeyDef -> [KeyAtt]
kdats :: [KeyAtt]
  } deriving (Int -> KeyDef -> ShowS
[KeyDef] -> ShowS
KeyDef -> String
(Int -> KeyDef -> ShowS)
-> (KeyDef -> String) -> ([KeyDef] -> ShowS) -> Show KeyDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyDef] -> ShowS
$cshowList :: [KeyDef] -> ShowS
show :: KeyDef -> String
$cshow :: KeyDef -> String
showsPrec :: Int -> KeyDef -> ShowS
$cshowsPrec :: Int -> KeyDef -> ShowS
Show, Typeable, Typeable KeyDef
Constr
DataType
Typeable KeyDef =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> KeyDef -> c KeyDef)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c KeyDef)
-> (KeyDef -> Constr)
-> (KeyDef -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c KeyDef))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyDef))
-> ((forall b. Data b => b -> b) -> KeyDef -> KeyDef)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> KeyDef -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> KeyDef -> r)
-> (forall u. (forall d. Data d => d -> u) -> KeyDef -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> KeyDef -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> KeyDef -> m KeyDef)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KeyDef -> m KeyDef)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KeyDef -> m KeyDef)
-> Data KeyDef
KeyDef -> Constr
KeyDef -> DataType
(forall b. Data b => b -> b) -> KeyDef -> KeyDef
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyDef -> c KeyDef
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyDef
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> KeyDef -> u
forall u. (forall d. Data d => d -> u) -> KeyDef -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KeyDef -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KeyDef -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeyDef -> m KeyDef
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyDef -> m KeyDef
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyDef
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyDef -> c KeyDef
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeyDef)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyDef)
$cKeyDef :: Constr
$tKeyDef :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> KeyDef -> m KeyDef
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyDef -> m KeyDef
gmapMp :: (forall d. Data d => d -> m d) -> KeyDef -> m KeyDef
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeyDef -> m KeyDef
gmapM :: (forall d. Data d => d -> m d) -> KeyDef -> m KeyDef
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeyDef -> m KeyDef
gmapQi :: Int -> (forall d. Data d => d -> u) -> KeyDef -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> KeyDef -> u
gmapQ :: (forall d. Data d => d -> u) -> KeyDef -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> KeyDef -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KeyDef -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KeyDef -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KeyDef -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KeyDef -> r
gmapT :: (forall b. Data b => b -> b) -> KeyDef -> KeyDef
$cgmapT :: (forall b. Data b => b -> b) -> KeyDef -> KeyDef
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyDef)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeyDef)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c KeyDef)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeyDef)
dataTypeOf :: KeyDef -> DataType
$cdataTypeOf :: KeyDef -> DataType
toConstr :: KeyDef -> Constr
$ctoConstr :: KeyDef -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyDef
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeyDef
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyDef -> c KeyDef
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeyDef -> c KeyDef
$cp1Data :: Typeable KeyDef
Data)

instance GetRange KeyDef where
  getRange :: KeyDef -> Range
getRange (KeyDef _ c :: Concept
c _) = Concept -> Range
forall a. GetRange a => a -> Range
getRange Concept
c
  rangeSpan :: KeyDef -> [Pos]
rangeSpan (KeyDef _ c :: Concept
c as :: [KeyAtt]
as) = [[Pos]] -> [Pos]
joinRanges [Concept -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan Concept
c, [KeyAtt] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan [KeyAtt]
as]

data RuleKind = SignalOn | Signals | Maintains
  deriving (RuleKind -> RuleKind -> Bool
(RuleKind -> RuleKind -> Bool)
-> (RuleKind -> RuleKind -> Bool) -> Eq RuleKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleKind -> RuleKind -> Bool
$c/= :: RuleKind -> RuleKind -> Bool
== :: RuleKind -> RuleKind -> Bool
$c== :: RuleKind -> RuleKind -> Bool
Eq, Eq RuleKind
Eq RuleKind =>
(RuleKind -> RuleKind -> Ordering)
-> (RuleKind -> RuleKind -> Bool)
-> (RuleKind -> RuleKind -> Bool)
-> (RuleKind -> RuleKind -> Bool)
-> (RuleKind -> RuleKind -> Bool)
-> (RuleKind -> RuleKind -> RuleKind)
-> (RuleKind -> RuleKind -> RuleKind)
-> Ord RuleKind
RuleKind -> RuleKind -> Bool
RuleKind -> RuleKind -> Ordering
RuleKind -> RuleKind -> RuleKind
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 :: RuleKind -> RuleKind -> RuleKind
$cmin :: RuleKind -> RuleKind -> RuleKind
max :: RuleKind -> RuleKind -> RuleKind
$cmax :: RuleKind -> RuleKind -> RuleKind
>= :: RuleKind -> RuleKind -> Bool
$c>= :: RuleKind -> RuleKind -> Bool
> :: RuleKind -> RuleKind -> Bool
$c> :: RuleKind -> RuleKind -> Bool
<= :: RuleKind -> RuleKind -> Bool
$c<= :: RuleKind -> RuleKind -> Bool
< :: RuleKind -> RuleKind -> Bool
$c< :: RuleKind -> RuleKind -> Bool
compare :: RuleKind -> RuleKind -> Ordering
$ccompare :: RuleKind -> RuleKind -> Ordering
$cp1Ord :: Eq RuleKind
Ord, Int -> RuleKind -> ShowS
[RuleKind] -> ShowS
RuleKind -> String
(Int -> RuleKind -> ShowS)
-> (RuleKind -> String) -> ([RuleKind] -> ShowS) -> Show RuleKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleKind] -> ShowS
$cshowList :: [RuleKind] -> ShowS
show :: RuleKind -> String
$cshow :: RuleKind -> String
showsPrec :: Int -> RuleKind -> ShowS
$cshowsPrec :: Int -> RuleKind -> ShowS
Show, Typeable, Typeable RuleKind
Constr
DataType
Typeable RuleKind =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RuleKind -> c RuleKind)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RuleKind)
-> (RuleKind -> Constr)
-> (RuleKind -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RuleKind))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RuleKind))
-> ((forall b. Data b => b -> b) -> RuleKind -> RuleKind)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RuleKind -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RuleKind -> r)
-> (forall u. (forall d. Data d => d -> u) -> RuleKind -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RuleKind -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RuleKind -> m RuleKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RuleKind -> m RuleKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RuleKind -> m RuleKind)
-> Data RuleKind
RuleKind -> Constr
RuleKind -> DataType
(forall b. Data b => b -> b) -> RuleKind -> RuleKind
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleKind -> c RuleKind
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleKind
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RuleKind -> u
forall u. (forall d. Data d => d -> u) -> RuleKind -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleKind -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleKind -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RuleKind -> m RuleKind
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleKind -> m RuleKind
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleKind
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleKind -> c RuleKind
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RuleKind)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RuleKind)
$cMaintains :: Constr
$cSignals :: Constr
$cSignalOn :: Constr
$tRuleKind :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RuleKind -> m RuleKind
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleKind -> m RuleKind
gmapMp :: (forall d. Data d => d -> m d) -> RuleKind -> m RuleKind
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleKind -> m RuleKind
gmapM :: (forall d. Data d => d -> m d) -> RuleKind -> m RuleKind
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RuleKind -> m RuleKind
gmapQi :: Int -> (forall d. Data d => d -> u) -> RuleKind -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RuleKind -> u
gmapQ :: (forall d. Data d => d -> u) -> RuleKind -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RuleKind -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleKind -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleKind -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleKind -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleKind -> r
gmapT :: (forall b. Data b => b -> b) -> RuleKind -> RuleKind
$cgmapT :: (forall b. Data b => b -> b) -> RuleKind -> RuleKind
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RuleKind)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RuleKind)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RuleKind)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RuleKind)
dataTypeOf :: RuleKind -> DataType
$cdataTypeOf :: RuleKind -> DataType
toConstr :: RuleKind -> Constr
$ctoConstr :: RuleKind -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleKind
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleKind
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleKind -> c RuleKind
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleKind -> c RuleKind
$cp1Data :: Typeable RuleKind
Data)

showRuleKind :: RuleKind -> String
showRuleKind :: RuleKind -> String
showRuleKind k :: RuleKind
k = if RuleKind
k RuleKind -> RuleKind -> Bool
forall a. Eq a => a -> a -> Bool
== RuleKind
SignalOn then "ON"
             else RuleKind -> String
forall a. Show a => a -> String
showUp RuleKind
k

data RuleHeader = Always | RuleHeader RuleKind Token
  deriving (RuleHeader -> RuleHeader -> Bool
(RuleHeader -> RuleHeader -> Bool)
-> (RuleHeader -> RuleHeader -> Bool) -> Eq RuleHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleHeader -> RuleHeader -> Bool
$c/= :: RuleHeader -> RuleHeader -> Bool
== :: RuleHeader -> RuleHeader -> Bool
$c== :: RuleHeader -> RuleHeader -> Bool
Eq, Int -> RuleHeader -> ShowS
[RuleHeader] -> ShowS
RuleHeader -> String
(Int -> RuleHeader -> ShowS)
-> (RuleHeader -> String)
-> ([RuleHeader] -> ShowS)
-> Show RuleHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleHeader] -> ShowS
$cshowList :: [RuleHeader] -> ShowS
show :: RuleHeader -> String
$cshow :: RuleHeader -> String
showsPrec :: Int -> RuleHeader -> ShowS
$cshowsPrec :: Int -> RuleHeader -> ShowS
Show, Typeable, Typeable RuleHeader
Constr
DataType
Typeable RuleHeader =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RuleHeader -> c RuleHeader)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RuleHeader)
-> (RuleHeader -> Constr)
-> (RuleHeader -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RuleHeader))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RuleHeader))
-> ((forall b. Data b => b -> b) -> RuleHeader -> RuleHeader)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RuleHeader -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RuleHeader -> r)
-> (forall u. (forall d. Data d => d -> u) -> RuleHeader -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RuleHeader -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader)
-> Data RuleHeader
RuleHeader -> Constr
RuleHeader -> DataType
(forall b. Data b => b -> b) -> RuleHeader -> RuleHeader
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleHeader -> c RuleHeader
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleHeader
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RuleHeader -> u
forall u. (forall d. Data d => d -> u) -> RuleHeader -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleHeader -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleHeader -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleHeader
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleHeader -> c RuleHeader
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RuleHeader)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RuleHeader)
$cRuleHeader :: Constr
$cAlways :: Constr
$tRuleHeader :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader
gmapMp :: (forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader
gmapM :: (forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RuleHeader -> m RuleHeader
gmapQi :: Int -> (forall d. Data d => d -> u) -> RuleHeader -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RuleHeader -> u
gmapQ :: (forall d. Data d => d -> u) -> RuleHeader -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RuleHeader -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleHeader -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleHeader -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleHeader -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleHeader -> r
gmapT :: (forall b. Data b => b -> b) -> RuleHeader -> RuleHeader
$cgmapT :: (forall b. Data b => b -> b) -> RuleHeader -> RuleHeader
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RuleHeader)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RuleHeader)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RuleHeader)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RuleHeader)
dataTypeOf :: RuleHeader -> DataType
$cdataTypeOf :: RuleHeader -> DataType
toConstr :: RuleHeader -> Constr
$ctoConstr :: RuleHeader -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleHeader
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleHeader
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleHeader -> c RuleHeader
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleHeader -> c RuleHeader
$cp1Data :: Typeable RuleHeader
Data)

data Pair = Pair Token Token deriving (Int -> Pair -> ShowS
[Pair] -> ShowS
Pair -> String
(Int -> Pair -> ShowS)
-> (Pair -> String) -> ([Pair] -> ShowS) -> Show Pair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pair] -> ShowS
$cshowList :: [Pair] -> ShowS
show :: Pair -> String
$cshow :: Pair -> String
showsPrec :: Int -> Pair -> ShowS
$cshowsPrec :: Int -> Pair -> ShowS
Show, Typeable, Typeable Pair
Constr
DataType
Typeable Pair =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Pair -> c Pair)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pair)
-> (Pair -> Constr)
-> (Pair -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pair))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pair))
-> ((forall b. Data b => b -> b) -> Pair -> Pair)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pair -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pair -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pair -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pair -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pair -> m Pair)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pair -> m Pair)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pair -> m Pair)
-> Data Pair
Pair -> Constr
Pair -> DataType
(forall b. Data b => b -> b) -> Pair -> Pair
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pair -> c Pair
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pair
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Pair -> u
forall u. (forall d. Data d => d -> u) -> Pair -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pair -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pair -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pair -> m Pair
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pair -> m Pair
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pair
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pair -> c Pair
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pair)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pair)
$cPair :: Constr
$tPair :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pair -> m Pair
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pair -> m Pair
gmapMp :: (forall d. Data d => d -> m d) -> Pair -> m Pair
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pair -> m Pair
gmapM :: (forall d. Data d => d -> m d) -> Pair -> m Pair
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pair -> m Pair
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pair -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pair -> u
gmapQ :: (forall d. Data d => d -> u) -> Pair -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pair -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pair -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pair -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pair -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pair -> r
gmapT :: (forall b. Data b => b -> b) -> Pair -> Pair
$cgmapT :: (forall b. Data b => b -> b) -> Pair -> Pair
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pair)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pair)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pair)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pair)
dataTypeOf :: Pair -> DataType
$cdataTypeOf :: Pair -> DataType
toConstr :: Pair -> Constr
$ctoConstr :: Pair -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pair
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pair
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pair -> c Pair
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pair -> c Pair
$cp1Data :: Typeable Pair
Data)

data Plugin = Service | Sqlplug | Phpplug deriving (Int -> Plugin -> ShowS
[Plugin] -> ShowS
Plugin -> String
(Int -> Plugin -> ShowS)
-> (Plugin -> String) -> ([Plugin] -> ShowS) -> Show Plugin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Plugin] -> ShowS
$cshowList :: [Plugin] -> ShowS
show :: Plugin -> String
$cshow :: Plugin -> String
showsPrec :: Int -> Plugin -> ShowS
$cshowsPrec :: Int -> Plugin -> ShowS
Show, Typeable, Typeable Plugin
Constr
DataType
Typeable Plugin =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Plugin -> c Plugin)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Plugin)
-> (Plugin -> Constr)
-> (Plugin -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Plugin))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Plugin))
-> ((forall b. Data b => b -> b) -> Plugin -> Plugin)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Plugin -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Plugin -> r)
-> (forall u. (forall d. Data d => d -> u) -> Plugin -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Plugin -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Plugin -> m Plugin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Plugin -> m Plugin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Plugin -> m Plugin)
-> Data Plugin
Plugin -> Constr
Plugin -> DataType
(forall b. Data b => b -> b) -> Plugin -> Plugin
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Plugin -> c Plugin
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Plugin
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Plugin -> u
forall u. (forall d. Data d => d -> u) -> Plugin -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Plugin -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Plugin -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Plugin -> m Plugin
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Plugin -> m Plugin
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Plugin
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Plugin -> c Plugin
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Plugin)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Plugin)
$cPhpplug :: Constr
$cSqlplug :: Constr
$cService :: Constr
$tPlugin :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Plugin -> m Plugin
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Plugin -> m Plugin
gmapMp :: (forall d. Data d => d -> m d) -> Plugin -> m Plugin
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Plugin -> m Plugin
gmapM :: (forall d. Data d => d -> m d) -> Plugin -> m Plugin
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Plugin -> m Plugin
gmapQi :: Int -> (forall d. Data d => d -> u) -> Plugin -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Plugin -> u
gmapQ :: (forall d. Data d => d -> u) -> Plugin -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Plugin -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Plugin -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Plugin -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Plugin -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Plugin -> r
gmapT :: (forall b. Data b => b -> b) -> Plugin -> Plugin
$cgmapT :: (forall b. Data b => b -> b) -> Plugin -> Plugin
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Plugin)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Plugin)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Plugin)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Plugin)
dataTypeOf :: Plugin -> DataType
$cdataTypeOf :: Plugin -> DataType
toConstr :: Plugin -> Constr
$ctoConstr :: Plugin -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Plugin
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Plugin
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Plugin -> c Plugin
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Plugin -> c Plugin
$cp1Data :: Typeable Plugin
Data)

data PatElem
  = Pr RuleHeader Rule
  | Pg Concept Concept -- specific and generic concept
  | Pk KeyDef
  | Pm [RangedProp] Relation Bool -- True indicates population
  | Plug Plugin Object
  | Population Bool Relation [Pair] -- True indicates declaration
    deriving (Int -> PatElem -> ShowS
[PatElem] -> ShowS
PatElem -> String
(Int -> PatElem -> ShowS)
-> (PatElem -> String) -> ([PatElem] -> ShowS) -> Show PatElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatElem] -> ShowS
$cshowList :: [PatElem] -> ShowS
show :: PatElem -> String
$cshow :: PatElem -> String
showsPrec :: Int -> PatElem -> ShowS
$cshowsPrec :: Int -> PatElem -> ShowS
Show, Typeable, Typeable PatElem
Constr
DataType
Typeable PatElem =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PatElem -> c PatElem)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PatElem)
-> (PatElem -> Constr)
-> (PatElem -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PatElem))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PatElem))
-> ((forall b. Data b => b -> b) -> PatElem -> PatElem)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PatElem -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PatElem -> r)
-> (forall u. (forall d. Data d => d -> u) -> PatElem -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PatElem -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PatElem -> m PatElem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PatElem -> m PatElem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PatElem -> m PatElem)
-> Data PatElem
PatElem -> Constr
PatElem -> DataType
(forall b. Data b => b -> b) -> PatElem -> PatElem
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PatElem -> c PatElem
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PatElem
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PatElem -> u
forall u. (forall d. Data d => d -> u) -> PatElem -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PatElem -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PatElem -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PatElem -> m PatElem
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PatElem -> m PatElem
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PatElem
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PatElem -> c PatElem
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PatElem)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PatElem)
$cPopulation :: Constr
$cPlug :: Constr
$cPm :: Constr
$cPk :: Constr
$cPg :: Constr
$cPr :: Constr
$tPatElem :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PatElem -> m PatElem
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PatElem -> m PatElem
gmapMp :: (forall d. Data d => d -> m d) -> PatElem -> m PatElem
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PatElem -> m PatElem
gmapM :: (forall d. Data d => d -> m d) -> PatElem -> m PatElem
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PatElem -> m PatElem
gmapQi :: Int -> (forall d. Data d => d -> u) -> PatElem -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PatElem -> u
gmapQ :: (forall d. Data d => d -> u) -> PatElem -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PatElem -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PatElem -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PatElem -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PatElem -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PatElem -> r
gmapT :: (forall b. Data b => b -> b) -> PatElem -> PatElem
$cgmapT :: (forall b. Data b => b -> b) -> PatElem -> PatElem
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PatElem)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PatElem)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PatElem)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PatElem)
dataTypeOf :: PatElem -> DataType
$cdataTypeOf :: PatElem -> DataType
toConstr :: PatElem -> Constr
$ctoConstr :: PatElem -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PatElem
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PatElem
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PatElem -> c PatElem
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PatElem -> c PatElem
$cp1Data :: Typeable PatElem
Data)

data Context = Context (Maybe Token) [PatElem] deriving (Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show, Typeable, Typeable Context
Constr
DataType
Typeable Context =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Context -> c Context)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Context)
-> (Context -> Constr)
-> (Context -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Context))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Context))
-> ((forall b. Data b => b -> b) -> Context -> Context)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Context -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Context -> r)
-> (forall u. (forall d. Data d => d -> u) -> Context -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Context -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Context -> m Context)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Context -> m Context)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Context -> m Context)
-> Data Context
Context -> Constr
Context -> DataType
(forall b. Data b => b -> b) -> Context -> Context
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Context -> c Context
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Context
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Context -> u
forall u. (forall d. Data d => d -> u) -> Context -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Context -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Context -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Context -> m Context
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Context -> m Context
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Context
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Context -> c Context
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Context)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Context)
$cContext :: Constr
$tContext :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Context -> m Context
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Context -> m Context
gmapMp :: (forall d. Data d => d -> m d) -> Context -> m Context
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Context -> m Context
gmapM :: (forall d. Data d => d -> m d) -> Context -> m Context
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Context -> m Context
gmapQi :: Int -> (forall d. Data d => d -> u) -> Context -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Context -> u
gmapQ :: (forall d. Data d => d -> u) -> Context -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Context -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Context -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Context -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Context -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Context -> r
gmapT :: (forall b. Data b => b -> b) -> Context -> Context
$cgmapT :: (forall b. Data b => b -> b) -> Context -> Context
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Context)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Context)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Context)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Context)
dataTypeOf :: Context -> DataType
$cdataTypeOf :: Context -> DataType
toConstr :: Context -> Constr
$ctoConstr :: Context -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Context
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Context
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Context -> c Context
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Context -> c Context
$cp1Data :: Typeable Context
Data)

instance GetRange Context where
  getRange :: Context -> Range
getRange (Context mt :: Maybe Token
mt _) = Maybe Token -> Range
forall a. GetRange a => a -> Range
getRange Maybe Token
mt

comparePatElem :: PatElem -> PatElem -> Ordering
comparePatElem :: PatElem -> PatElem -> Ordering
comparePatElem p1 :: PatElem
p1 p2 :: PatElem
p2 = case (PatElem
p1, PatElem
p2) of
  (Pm {}, Pm {}) -> Ordering
EQ
  (Pm _ _ True, Population True _ _) -> Ordering
EQ
  (Pm {}, _) -> Ordering
LT
  (Population True _ _, Pm _ _ True) -> Ordering
EQ
  (Population True _ _, _) -> Ordering
LT
  (_, Pm {}) -> Ordering
GT
  (_, Population True _ _) -> Ordering
GT
  (Pg {}, Pg {}) -> Ordering
EQ
  (Pg {}, _) -> Ordering
LT
  (_, Pg {}) -> Ordering
GT
  _ -> Ordering
EQ

mkContext :: Maybe Token -> [PatElem] -> Context
mkContext :: Maybe Token -> [PatElem] -> Context
mkContext m :: Maybe Token
m = Maybe Token -> [PatElem] -> Context
Context Maybe Token
m ([PatElem] -> Context)
-> ([PatElem] -> [PatElem]) -> [PatElem] -> Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatElem -> PatElem -> Ordering) -> [PatElem] -> [PatElem]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy PatElem -> PatElem -> Ordering
comparePatElem