module FST.RRegTypes (
module FST.RegTypes,
RReg(..),
(<*>), (<.>),
idR, r,
) where
#if MIN_VERSION_base(4,8,0)
import Prelude hiding ((<*>))
#endif
import FST.RegTypes
import FST.TransducerTypes (Symbol(..))
import Data.List (nub)
data RReg a =
Cross (Reg a) (Reg a)
| Comp (RReg a) (RReg a)
| ProductR (RReg a) (RReg a)
| UnionR (RReg a) (RReg a)
| StarR (RReg a)
| Identity (Reg a)
| Relation (Symbol a) (Symbol a)
| EmptyR
deriving (Eq)
instance Eq a => Combinators (RReg a) where
EmptyR <|> r2 = r2
r1 <|> EmptyR = r1
r1 <|> r2 = if r1 == r2 then r1 else UnionR r1 r2
EmptyR |> _ = EmptyR
_ |> EmptyR = EmptyR
r1 |> r2 = ProductR r1 r2
star (StarR r1) = star r1
star r1 = StarR r1
plus r1 = r1 |> star r1
empty = EmptyR
infixl 2 <*>
infixl 1 <.>
(<*>) :: Eq a => Reg a -> Reg a -> RReg a
(<*>) = Cross
(<.>) :: Eq a => RReg a -> RReg a -> RReg a
(<.>) = Comp
idR :: Eq a => Reg a -> RReg a
idR = Identity
r :: Eq a => a -> a -> RReg a
r a b = Relation (S a) (S b)
instance Symbols RReg where
symbols (Cross r1 r2) = nub $ symbols r1 ++ symbols r2
symbols (Comp r1 r2) = nub $ symbols r1 ++ symbols r2
symbols (ProductR r1 r2) = nub $ symbols r1 ++ symbols r2
symbols (UnionR r1 r2) = nub $ symbols r1 ++ symbols r2
symbols (StarR r1) = symbols r1
symbols (Identity r1) = symbols r1
symbols (Relation a b) = let sym (S c) = [c]
sym _ = []
in nub $ sym a ++ sym b
symbols _ = []
instance Show a => Show (RReg a) where
show (Cross r1 r2) = "[ " ++ show r1 ++ " .x. " ++ show r2 ++ " ]"
show (Comp r1 r2) = "[ " ++ show r1 ++ " .o. " ++ show r2 ++ " ]"
show (UnionR r1 r2) = "[ " ++ show r1 ++ " | " ++ show r2 ++ " ]"
show (ProductR r1 r2) = "[ " ++ show r1 ++ " " ++ show r2 ++ " ]"
show (Identity r) = show r
show (StarR r) = "[ " ++ show r ++ " ]*"
show (Relation a b) = "[ " ++ show a ++":"++show b ++" ]"
show EmptyR = "[]"