-- |This module represents a types of Turing machine.
module TMType where

import Data.Set (Set)

-- |This type represents a state of the Turing machine 'TM'.
newtype State = State String
    deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Eq State
Eq State
-> (State -> State -> Ordering)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> State)
-> (State -> State -> State)
-> Ord State
State -> State -> Bool
State -> State -> Ordering
State -> State -> State
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 :: State -> State -> State
$cmin :: State -> State -> State
max :: State -> State -> State
$cmax :: State -> State -> State
>= :: State -> State -> Bool
$c>= :: State -> State -> Bool
> :: State -> State -> Bool
$c> :: State -> State -> Bool
<= :: State -> State -> Bool
$c<= :: State -> State -> Bool
< :: State -> State -> Bool
$c< :: State -> State -> Bool
compare :: State -> State -> Ordering
$ccompare :: State -> State -> Ordering
$cp1Ord :: Eq State
Ord, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)

-- |Type of a k-vector of tapes states, where k is a count of tapes. 
--
-- Type represents all states of the Turing machine 'TM'.
newtype MultiTapeStates = MultiTapeStates [Set State]
    deriving (MultiTapeStates -> MultiTapeStates -> Bool
(MultiTapeStates -> MultiTapeStates -> Bool)
-> (MultiTapeStates -> MultiTapeStates -> Bool)
-> Eq MultiTapeStates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiTapeStates -> MultiTapeStates -> Bool
$c/= :: MultiTapeStates -> MultiTapeStates -> Bool
== :: MultiTapeStates -> MultiTapeStates -> Bool
$c== :: MultiTapeStates -> MultiTapeStates -> Bool
Eq, Eq MultiTapeStates
Eq MultiTapeStates
-> (MultiTapeStates -> MultiTapeStates -> Ordering)
-> (MultiTapeStates -> MultiTapeStates -> Bool)
-> (MultiTapeStates -> MultiTapeStates -> Bool)
-> (MultiTapeStates -> MultiTapeStates -> Bool)
-> (MultiTapeStates -> MultiTapeStates -> Bool)
-> (MultiTapeStates -> MultiTapeStates -> MultiTapeStates)
-> (MultiTapeStates -> MultiTapeStates -> MultiTapeStates)
-> Ord MultiTapeStates
MultiTapeStates -> MultiTapeStates -> Bool
MultiTapeStates -> MultiTapeStates -> Ordering
MultiTapeStates -> MultiTapeStates -> MultiTapeStates
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 :: MultiTapeStates -> MultiTapeStates -> MultiTapeStates
$cmin :: MultiTapeStates -> MultiTapeStates -> MultiTapeStates
max :: MultiTapeStates -> MultiTapeStates -> MultiTapeStates
$cmax :: MultiTapeStates -> MultiTapeStates -> MultiTapeStates
>= :: MultiTapeStates -> MultiTapeStates -> Bool
$c>= :: MultiTapeStates -> MultiTapeStates -> Bool
> :: MultiTapeStates -> MultiTapeStates -> Bool
$c> :: MultiTapeStates -> MultiTapeStates -> Bool
<= :: MultiTapeStates -> MultiTapeStates -> Bool
$c<= :: MultiTapeStates -> MultiTapeStates -> Bool
< :: MultiTapeStates -> MultiTapeStates -> Bool
$c< :: MultiTapeStates -> MultiTapeStates -> Bool
compare :: MultiTapeStates -> MultiTapeStates -> Ordering
$ccompare :: MultiTapeStates -> MultiTapeStates -> Ordering
$cp1Ord :: Eq MultiTapeStates
Ord, Int -> MultiTapeStates -> ShowS
[MultiTapeStates] -> ShowS
MultiTapeStates -> String
(Int -> MultiTapeStates -> ShowS)
-> (MultiTapeStates -> String)
-> ([MultiTapeStates] -> ShowS)
-> Show MultiTapeStates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiTapeStates] -> ShowS
$cshowList :: [MultiTapeStates] -> ShowS
show :: MultiTapeStates -> String
$cshow :: MultiTapeStates -> String
showsPrec :: Int -> MultiTapeStates -> ShowS
$cshowsPrec :: Int -> MultiTapeStates -> ShowS
Show)

-- |Type of a k-vector of a start states of the Turing machine 'TM'.
newtype StartStates = StartStates [State]
    deriving (StartStates -> StartStates -> Bool
(StartStates -> StartStates -> Bool)
-> (StartStates -> StartStates -> Bool) -> Eq StartStates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartStates -> StartStates -> Bool
$c/= :: StartStates -> StartStates -> Bool
== :: StartStates -> StartStates -> Bool
$c== :: StartStates -> StartStates -> Bool
Eq, Eq StartStates
Eq StartStates
-> (StartStates -> StartStates -> Ordering)
-> (StartStates -> StartStates -> Bool)
-> (StartStates -> StartStates -> Bool)
-> (StartStates -> StartStates -> Bool)
-> (StartStates -> StartStates -> Bool)
-> (StartStates -> StartStates -> StartStates)
-> (StartStates -> StartStates -> StartStates)
-> Ord StartStates
StartStates -> StartStates -> Bool
StartStates -> StartStates -> Ordering
StartStates -> StartStates -> StartStates
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 :: StartStates -> StartStates -> StartStates
$cmin :: StartStates -> StartStates -> StartStates
max :: StartStates -> StartStates -> StartStates
$cmax :: StartStates -> StartStates -> StartStates
>= :: StartStates -> StartStates -> Bool
$c>= :: StartStates -> StartStates -> Bool
> :: StartStates -> StartStates -> Bool
$c> :: StartStates -> StartStates -> Bool
<= :: StartStates -> StartStates -> Bool
$c<= :: StartStates -> StartStates -> Bool
< :: StartStates -> StartStates -> Bool
$c< :: StartStates -> StartStates -> Bool
compare :: StartStates -> StartStates -> Ordering
$ccompare :: StartStates -> StartStates -> Ordering
$cp1Ord :: Eq StartStates
Ord, Int -> StartStates -> ShowS
[StartStates] -> ShowS
StartStates -> String
(Int -> StartStates -> ShowS)
-> (StartStates -> String)
-> ([StartStates] -> ShowS)
-> Show StartStates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartStates] -> ShowS
$cshowList :: [StartStates] -> ShowS
show :: StartStates -> String
$cshow :: StartStates -> String
showsPrec :: Int -> StartStates -> ShowS
$cshowsPrec :: Int -> StartStates -> ShowS
Show)

-- |Type of a k-vector of a final states of the Turing machine 'TM'.
newtype AccessStates = AccessStates [State]
    deriving (AccessStates -> AccessStates -> Bool
(AccessStates -> AccessStates -> Bool)
-> (AccessStates -> AccessStates -> Bool) -> Eq AccessStates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessStates -> AccessStates -> Bool
$c/= :: AccessStates -> AccessStates -> Bool
== :: AccessStates -> AccessStates -> Bool
$c== :: AccessStates -> AccessStates -> Bool
Eq, Eq AccessStates
Eq AccessStates
-> (AccessStates -> AccessStates -> Ordering)
-> (AccessStates -> AccessStates -> Bool)
-> (AccessStates -> AccessStates -> Bool)
-> (AccessStates -> AccessStates -> Bool)
-> (AccessStates -> AccessStates -> Bool)
-> (AccessStates -> AccessStates -> AccessStates)
-> (AccessStates -> AccessStates -> AccessStates)
-> Ord AccessStates
AccessStates -> AccessStates -> Bool
AccessStates -> AccessStates -> Ordering
AccessStates -> AccessStates -> AccessStates
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 :: AccessStates -> AccessStates -> AccessStates
$cmin :: AccessStates -> AccessStates -> AccessStates
max :: AccessStates -> AccessStates -> AccessStates
$cmax :: AccessStates -> AccessStates -> AccessStates
>= :: AccessStates -> AccessStates -> Bool
$c>= :: AccessStates -> AccessStates -> Bool
> :: AccessStates -> AccessStates -> Bool
$c> :: AccessStates -> AccessStates -> Bool
<= :: AccessStates -> AccessStates -> Bool
$c<= :: AccessStates -> AccessStates -> Bool
< :: AccessStates -> AccessStates -> Bool
$c< :: AccessStates -> AccessStates -> Bool
compare :: AccessStates -> AccessStates -> Ordering
$ccompare :: AccessStates -> AccessStates -> Ordering
$cp1Ord :: Eq AccessStates
Ord, Int -> AccessStates -> ShowS
[AccessStates] -> ShowS
AccessStates -> String
(Int -> AccessStates -> ShowS)
-> (AccessStates -> String)
-> ([AccessStates] -> ShowS)
-> Show AccessStates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessStates] -> ShowS
$cshowList :: [AccessStates] -> ShowS
show :: AccessStates -> String
$cshow :: AccessStates -> String
showsPrec :: Int -> AccessStates -> ShowS
$cshowsPrec :: Int -> AccessStates -> ShowS
Show)

-- |Type of a state in a changed Turing machine, which has a form F_q, where q is a 'State'.
newtype StateOmega = StateOmega {StateOmega -> State
state :: State}
    deriving (StateOmega -> StateOmega -> Bool
(StateOmega -> StateOmega -> Bool)
-> (StateOmega -> StateOmega -> Bool) -> Eq StateOmega
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateOmega -> StateOmega -> Bool
$c/= :: StateOmega -> StateOmega -> Bool
== :: StateOmega -> StateOmega -> Bool
$c== :: StateOmega -> StateOmega -> Bool
Eq, Eq StateOmega
Eq StateOmega
-> (StateOmega -> StateOmega -> Ordering)
-> (StateOmega -> StateOmega -> Bool)
-> (StateOmega -> StateOmega -> Bool)
-> (StateOmega -> StateOmega -> Bool)
-> (StateOmega -> StateOmega -> Bool)
-> (StateOmega -> StateOmega -> StateOmega)
-> (StateOmega -> StateOmega -> StateOmega)
-> Ord StateOmega
StateOmega -> StateOmega -> Bool
StateOmega -> StateOmega -> Ordering
StateOmega -> StateOmega -> StateOmega
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 :: StateOmega -> StateOmega -> StateOmega
$cmin :: StateOmega -> StateOmega -> StateOmega
max :: StateOmega -> StateOmega -> StateOmega
$cmax :: StateOmega -> StateOmega -> StateOmega
>= :: StateOmega -> StateOmega -> Bool
$c>= :: StateOmega -> StateOmega -> Bool
> :: StateOmega -> StateOmega -> Bool
$c> :: StateOmega -> StateOmega -> Bool
<= :: StateOmega -> StateOmega -> Bool
$c<= :: StateOmega -> StateOmega -> Bool
< :: StateOmega -> StateOmega -> Bool
$c< :: StateOmega -> StateOmega -> Bool
compare :: StateOmega -> StateOmega -> Ordering
$ccompare :: StateOmega -> StateOmega -> Ordering
$cp1Ord :: Eq StateOmega
Ord)
instance Show StateOmega where
    show :: StateOmega -> String
show StateOmega
s = String
"F_{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
q String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
        where (State String
q) = StateOmega -> State
state StateOmega
s

-- |Type of a command of the Turing machine 'TM', which applicable on a single tape.
--
-- 'SingleTapeCommand' is a command for normal Turing machine.
--
-- 'PreSMCommand' is a command for Turing machine after change.
data TapeCommand = SingleTapeCommand ((Square, State, Square), (Square, State, Square)) | PreSMCommand ((Square, StateOmega), (Square, StateOmega))
    deriving (TapeCommand -> TapeCommand -> Bool
(TapeCommand -> TapeCommand -> Bool)
-> (TapeCommand -> TapeCommand -> Bool) -> Eq TapeCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TapeCommand -> TapeCommand -> Bool
$c/= :: TapeCommand -> TapeCommand -> Bool
== :: TapeCommand -> TapeCommand -> Bool
$c== :: TapeCommand -> TapeCommand -> Bool
Eq, Eq TapeCommand
Eq TapeCommand
-> (TapeCommand -> TapeCommand -> Ordering)
-> (TapeCommand -> TapeCommand -> Bool)
-> (TapeCommand -> TapeCommand -> Bool)
-> (TapeCommand -> TapeCommand -> Bool)
-> (TapeCommand -> TapeCommand -> Bool)
-> (TapeCommand -> TapeCommand -> TapeCommand)
-> (TapeCommand -> TapeCommand -> TapeCommand)
-> Ord TapeCommand
TapeCommand -> TapeCommand -> Bool
TapeCommand -> TapeCommand -> Ordering
TapeCommand -> TapeCommand -> TapeCommand
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 :: TapeCommand -> TapeCommand -> TapeCommand
$cmin :: TapeCommand -> TapeCommand -> TapeCommand
max :: TapeCommand -> TapeCommand -> TapeCommand
$cmax :: TapeCommand -> TapeCommand -> TapeCommand
>= :: TapeCommand -> TapeCommand -> Bool
$c>= :: TapeCommand -> TapeCommand -> Bool
> :: TapeCommand -> TapeCommand -> Bool
$c> :: TapeCommand -> TapeCommand -> Bool
<= :: TapeCommand -> TapeCommand -> Bool
$c<= :: TapeCommand -> TapeCommand -> Bool
< :: TapeCommand -> TapeCommand -> Bool
$c< :: TapeCommand -> TapeCommand -> Bool
compare :: TapeCommand -> TapeCommand -> Ordering
$ccompare :: TapeCommand -> TapeCommand -> Ordering
$cp1Ord :: Eq TapeCommand
Ord, Int -> TapeCommand -> ShowS
[TapeCommand] -> ShowS
TapeCommand -> String
(Int -> TapeCommand -> ShowS)
-> (TapeCommand -> String)
-> ([TapeCommand] -> ShowS)
-> Show TapeCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TapeCommand] -> ShowS
$cshowList :: [TapeCommand] -> ShowS
show :: TapeCommand -> String
$cshow :: TapeCommand -> String
showsPrec :: Int -> TapeCommand -> ShowS
$cshowsPrec :: Int -> TapeCommand -> ShowS
Show)

-- |This is a data type of square of the Turing machine 'TM'. 
--
-- 'Value' is a square of string.
--
-- 'E' is a square, which we use after change of Turing machine, for representing empties of a tape, and its argument marks the tape number. 
--
-- 'RBS' is a right bounding square. 
--
-- 'LBS' is a left bounding square.
--
-- 'ES' is a empty square.
--
-- 'PCommand' is a square of command with parentheses surroundings.
--
-- 'BCommand' is a square of command with brackets surroundings.
data Square = Value {Square -> String
val_name :: String, Square -> Int
val_quote_cnt :: Int} | E Int | RBS | LBS | ES | PCommand [TapeCommand] | BCommand [TapeCommand]
    deriving (Square -> Square -> Bool
(Square -> Square -> Bool)
-> (Square -> Square -> Bool) -> Eq Square
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Square -> Square -> Bool
$c/= :: Square -> Square -> Bool
== :: Square -> Square -> Bool
$c== :: Square -> Square -> Bool
Eq, Eq Square
Eq Square
-> (Square -> Square -> Ordering)
-> (Square -> Square -> Bool)
-> (Square -> Square -> Bool)
-> (Square -> Square -> Bool)
-> (Square -> Square -> Bool)
-> (Square -> Square -> Square)
-> (Square -> Square -> Square)
-> Ord Square
Square -> Square -> Bool
Square -> Square -> Ordering
Square -> Square -> Square
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 :: Square -> Square -> Square
$cmin :: Square -> Square -> Square
max :: Square -> Square -> Square
$cmax :: Square -> Square -> Square
>= :: Square -> Square -> Bool
$c>= :: Square -> Square -> Bool
> :: Square -> Square -> Bool
$c> :: Square -> Square -> Bool
<= :: Square -> Square -> Bool
$c<= :: Square -> Square -> Bool
< :: Square -> Square -> Bool
$c< :: Square -> Square -> Bool
compare :: Square -> Square -> Ordering
$ccompare :: Square -> Square -> Ordering
$cp1Ord :: Eq Square
Ord, Int -> Square -> ShowS
[Square] -> ShowS
Square -> String
(Int -> Square -> ShowS)
-> (Square -> String) -> ([Square] -> ShowS) -> Show Square
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Square] -> ShowS
$cshowList :: [Square] -> ShowS
show :: Square -> String
$cshow :: Square -> String
showsPrec :: Int -> Square -> ShowS
$cshowsPrec :: Int -> Square -> ShowS
Show)

-- |Type of input alphabet of the Turing machine 'TM'.
newtype InputAlphabet = InputAlphabet (Set Square)
    deriving (InputAlphabet -> InputAlphabet -> Bool
(InputAlphabet -> InputAlphabet -> Bool)
-> (InputAlphabet -> InputAlphabet -> Bool) -> Eq InputAlphabet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputAlphabet -> InputAlphabet -> Bool
$c/= :: InputAlphabet -> InputAlphabet -> Bool
== :: InputAlphabet -> InputAlphabet -> Bool
$c== :: InputAlphabet -> InputAlphabet -> Bool
Eq, Eq InputAlphabet
Eq InputAlphabet
-> (InputAlphabet -> InputAlphabet -> Ordering)
-> (InputAlphabet -> InputAlphabet -> Bool)
-> (InputAlphabet -> InputAlphabet -> Bool)
-> (InputAlphabet -> InputAlphabet -> Bool)
-> (InputAlphabet -> InputAlphabet -> Bool)
-> (InputAlphabet -> InputAlphabet -> InputAlphabet)
-> (InputAlphabet -> InputAlphabet -> InputAlphabet)
-> Ord InputAlphabet
InputAlphabet -> InputAlphabet -> Bool
InputAlphabet -> InputAlphabet -> Ordering
InputAlphabet -> InputAlphabet -> InputAlphabet
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 :: InputAlphabet -> InputAlphabet -> InputAlphabet
$cmin :: InputAlphabet -> InputAlphabet -> InputAlphabet
max :: InputAlphabet -> InputAlphabet -> InputAlphabet
$cmax :: InputAlphabet -> InputAlphabet -> InputAlphabet
>= :: InputAlphabet -> InputAlphabet -> Bool
$c>= :: InputAlphabet -> InputAlphabet -> Bool
> :: InputAlphabet -> InputAlphabet -> Bool
$c> :: InputAlphabet -> InputAlphabet -> Bool
<= :: InputAlphabet -> InputAlphabet -> Bool
$c<= :: InputAlphabet -> InputAlphabet -> Bool
< :: InputAlphabet -> InputAlphabet -> Bool
$c< :: InputAlphabet -> InputAlphabet -> Bool
compare :: InputAlphabet -> InputAlphabet -> Ordering
$ccompare :: InputAlphabet -> InputAlphabet -> Ordering
$cp1Ord :: Eq InputAlphabet
Ord, Int -> InputAlphabet -> ShowS
[InputAlphabet] -> ShowS
InputAlphabet -> String
(Int -> InputAlphabet -> ShowS)
-> (InputAlphabet -> String)
-> ([InputAlphabet] -> ShowS)
-> Show InputAlphabet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputAlphabet] -> ShowS
$cshowList :: [InputAlphabet] -> ShowS
show :: InputAlphabet -> String
$cshow :: InputAlphabet -> String
showsPrec :: Int -> InputAlphabet -> ShowS
$cshowsPrec :: Int -> InputAlphabet -> ShowS
Show)

-- |Type of tape alphabet of the Turing machine 'TM'.
newtype TapeAlphabet = TapeAlphabet (Set Square)
    deriving (TapeAlphabet -> TapeAlphabet -> Bool
(TapeAlphabet -> TapeAlphabet -> Bool)
-> (TapeAlphabet -> TapeAlphabet -> Bool) -> Eq TapeAlphabet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TapeAlphabet -> TapeAlphabet -> Bool
$c/= :: TapeAlphabet -> TapeAlphabet -> Bool
== :: TapeAlphabet -> TapeAlphabet -> Bool
$c== :: TapeAlphabet -> TapeAlphabet -> Bool
Eq, Eq TapeAlphabet
Eq TapeAlphabet
-> (TapeAlphabet -> TapeAlphabet -> Ordering)
-> (TapeAlphabet -> TapeAlphabet -> Bool)
-> (TapeAlphabet -> TapeAlphabet -> Bool)
-> (TapeAlphabet -> TapeAlphabet -> Bool)
-> (TapeAlphabet -> TapeAlphabet -> Bool)
-> (TapeAlphabet -> TapeAlphabet -> TapeAlphabet)
-> (TapeAlphabet -> TapeAlphabet -> TapeAlphabet)
-> Ord TapeAlphabet
TapeAlphabet -> TapeAlphabet -> Bool
TapeAlphabet -> TapeAlphabet -> Ordering
TapeAlphabet -> TapeAlphabet -> TapeAlphabet
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 :: TapeAlphabet -> TapeAlphabet -> TapeAlphabet
$cmin :: TapeAlphabet -> TapeAlphabet -> TapeAlphabet
max :: TapeAlphabet -> TapeAlphabet -> TapeAlphabet
$cmax :: TapeAlphabet -> TapeAlphabet -> TapeAlphabet
>= :: TapeAlphabet -> TapeAlphabet -> Bool
$c>= :: TapeAlphabet -> TapeAlphabet -> Bool
> :: TapeAlphabet -> TapeAlphabet -> Bool
$c> :: TapeAlphabet -> TapeAlphabet -> Bool
<= :: TapeAlphabet -> TapeAlphabet -> Bool
$c<= :: TapeAlphabet -> TapeAlphabet -> Bool
< :: TapeAlphabet -> TapeAlphabet -> Bool
$c< :: TapeAlphabet -> TapeAlphabet -> Bool
compare :: TapeAlphabet -> TapeAlphabet -> Ordering
$ccompare :: TapeAlphabet -> TapeAlphabet -> Ordering
$cp1Ord :: Eq TapeAlphabet
Ord, Int -> TapeAlphabet -> ShowS
[TapeAlphabet] -> ShowS
TapeAlphabet -> String
(Int -> TapeAlphabet -> ShowS)
-> (TapeAlphabet -> String)
-> ([TapeAlphabet] -> ShowS)
-> Show TapeAlphabet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TapeAlphabet] -> ShowS
$cshowList :: [TapeAlphabet] -> ShowS
show :: TapeAlphabet -> String
$cshow :: TapeAlphabet -> String
showsPrec :: Int -> TapeAlphabet -> ShowS
$cshowsPrec :: Int -> TapeAlphabet -> ShowS
Show)

-- |Type of commands of a Turing machine 'TM'.
newtype Commands = Commands (Set [TapeCommand])
    deriving (Commands -> Commands -> Bool
(Commands -> Commands -> Bool)
-> (Commands -> Commands -> Bool) -> Eq Commands
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Commands -> Commands -> Bool
$c/= :: Commands -> Commands -> Bool
== :: Commands -> Commands -> Bool
$c== :: Commands -> Commands -> Bool
Eq, Eq Commands
Eq Commands
-> (Commands -> Commands -> Ordering)
-> (Commands -> Commands -> Bool)
-> (Commands -> Commands -> Bool)
-> (Commands -> Commands -> Bool)
-> (Commands -> Commands -> Bool)
-> (Commands -> Commands -> Commands)
-> (Commands -> Commands -> Commands)
-> Ord Commands
Commands -> Commands -> Bool
Commands -> Commands -> Ordering
Commands -> Commands -> Commands
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 :: Commands -> Commands -> Commands
$cmin :: Commands -> Commands -> Commands
max :: Commands -> Commands -> Commands
$cmax :: Commands -> Commands -> Commands
>= :: Commands -> Commands -> Bool
$c>= :: Commands -> Commands -> Bool
> :: Commands -> Commands -> Bool
$c> :: Commands -> Commands -> Bool
<= :: Commands -> Commands -> Bool
$c<= :: Commands -> Commands -> Bool
< :: Commands -> Commands -> Bool
$c< :: Commands -> Commands -> Bool
compare :: Commands -> Commands -> Ordering
$ccompare :: Commands -> Commands -> Ordering
$cp1Ord :: Eq Commands
Ord, Int -> Commands -> ShowS
[Commands] -> ShowS
Commands -> String
(Int -> Commands -> ShowS)
-> (Commands -> String) -> ([Commands] -> ShowS) -> Show Commands
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Commands] -> ShowS
$cshowList :: [Commands] -> ShowS
show :: Commands -> String
$cshow :: Commands -> String
showsPrec :: Int -> Commands -> ShowS
$cshowsPrec :: Int -> Commands -> ShowS
Show)

-- |This type represents a Turing macine. 
newtype TM = TM (InputAlphabet, [TapeAlphabet], MultiTapeStates, Commands, StartStates, AccessStates)
    deriving (TM -> TM -> Bool
(TM -> TM -> Bool) -> (TM -> TM -> Bool) -> Eq TM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TM -> TM -> Bool
$c/= :: TM -> TM -> Bool
== :: TM -> TM -> Bool
$c== :: TM -> TM -> Bool
Eq, Eq TM
Eq TM
-> (TM -> TM -> Ordering)
-> (TM -> TM -> Bool)
-> (TM -> TM -> Bool)
-> (TM -> TM -> Bool)
-> (TM -> TM -> Bool)
-> (TM -> TM -> TM)
-> (TM -> TM -> TM)
-> Ord TM
TM -> TM -> Bool
TM -> TM -> Ordering
TM -> TM -> TM
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 :: TM -> TM -> TM
$cmin :: TM -> TM -> TM
max :: TM -> TM -> TM
$cmax :: TM -> TM -> TM
>= :: TM -> TM -> Bool
$c>= :: TM -> TM -> Bool
> :: TM -> TM -> Bool
$c> :: TM -> TM -> Bool
<= :: TM -> TM -> Bool
$c<= :: TM -> TM -> Bool
< :: TM -> TM -> Bool
$c< :: TM -> TM -> Bool
compare :: TM -> TM -> Ordering
$ccompare :: TM -> TM -> Ordering
$cp1Ord :: Eq TM
Ord, Int -> TM -> ShowS
[TM] -> ShowS
TM -> String
(Int -> TM -> ShowS)
-> (TM -> String) -> ([TM] -> ShowS) -> Show TM
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TM] -> ShowS
$cshowList :: [TM] -> ShowS
show :: TM -> String
$cshow :: TM -> String
showsPrec :: Int -> TM -> ShowS
$cshowsPrec :: Int -> TM -> ShowS
Show)