{-# LANGUAGE LambdaCase #-}

module TM2SM where

import SMType
import qualified Data.Set as Set
import qualified TMType
import TM2SMHelpers
import Data.List (transpose, groupBy, sortBy, length, zip4)
import Data.Maybe (fromJust, mapMaybe)
import Helpers
import Control.Arrow ((***))

splitPosNegCmds :: [[TMType.TapeCommand]] -> ([[TMType.TapeCommand]], [[TMType.TapeCommand]], [[TMType.TapeCommand]], [[TMType.TapeCommand]])
splitPosNegCmds :: [[TapeCommand]]
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
splitPosNegCmds [[TapeCommand]]
commands = do
    let check21 :: [TapeCommand] -> Bool
check21 [TapeCommand]
command =
            case [TapeCommand]
command of
                TMType.PreSMCommand((TMType.Value String
_ Int
_, StateOmega
_),(Square, StateOmega)
_) : [TapeCommand]
_ -> Bool
True
                TMType.PreSMCommand((Square
TMType.ES, StateOmega
_),(Square, StateOmega)
_) : [TapeCommand]
t -> [TapeCommand] -> Bool
check21 [TapeCommand]
t
                TMType.PreSMCommand((TMType.E Int
_, StateOmega
_),(Square, StateOmega)
_) : [TapeCommand]
_ -> Bool
False
                TMType.PreSMCommand((TMType.BCommand [TapeCommand]
_, StateOmega
_),(Square
_, StateOmega
_)) : [TapeCommand]
_ -> Bool
True
                TMType.PreSMCommand((TMType.PCommand [TapeCommand]
_, StateOmega
_),(Square
_, StateOmega
_)) : [TapeCommand]
_ -> Bool
True
                [] -> Bool
False
                [TapeCommand]
cmd -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Must be PreSMCommand: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TapeCommand] -> String
forall a. Show a => a -> String
show [TapeCommand]
cmd

    let reverseCommand :: TapeCommand -> TapeCommand
reverseCommand (TMType.PreSMCommand((Square
a, StateOmega
b),(Square
a1, StateOmega
b1))) =  ((Square, StateOmega), (Square, StateOmega)) -> TapeCommand
TMType.PreSMCommand((Square
a1, StateOmega
b1),(Square
a, StateOmega
b))
        reverseCommand TapeCommand
_ = String -> TapeCommand
forall a. HasCallStack => String -> a
error String
"Must be PreSMCommand"

    let splitPosNegCmdsInternal :: [[TapeCommand]]
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
splitPosNegCmdsInternal [[TapeCommand]]
cmds ([[TapeCommand]]
accP21, [[TapeCommand]]
accP22, [[TapeCommand]]
accN21, [[TapeCommand]]
accN22) =
            case [[TapeCommand]]
cmds of
                [TapeCommand]
h : [[TapeCommand]]
t
                    | [TapeCommand] -> Bool
check21 [TapeCommand]
h -> [[TapeCommand]]
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
splitPosNegCmdsInternal [[TapeCommand]]
t ([TapeCommand]
h [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]]
forall a. a -> [a] -> [a]
: [[TapeCommand]]
accP21, [[TapeCommand]]
accP22, [[TapeCommand]]
accN21, [[TapeCommand]]
accN22)
                    | [TapeCommand] -> Bool
check21 [TapeCommand]
reversedH -> [[TapeCommand]]
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
splitPosNegCmdsInternal [[TapeCommand]]
t ([[TapeCommand]]
accP21, [[TapeCommand]]
accP22, [TapeCommand]
h [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]]
forall a. a -> [a] -> [a]
: [[TapeCommand]]
accN21, [[TapeCommand]]
accN22)
                    | [TapeCommand]
reversedH [TapeCommand] -> [[TapeCommand]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[TapeCommand]]
accP22 -> [[TapeCommand]]
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
splitPosNegCmdsInternal [[TapeCommand]]
t ([[TapeCommand]]
accP21, [TapeCommand]
h [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]]
forall a. a -> [a] -> [a]
: [[TapeCommand]]
accP22, [[TapeCommand]]
accN21, [[TapeCommand]]
accN22)
                    | Bool
otherwise -> [[TapeCommand]]
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
splitPosNegCmdsInternal [[TapeCommand]]
t ([[TapeCommand]]
accP21, [[TapeCommand]]
accP22, [[TapeCommand]]
accN21, [TapeCommand]
h [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]]
forall a. a -> [a] -> [a]
: [[TapeCommand]]
accN22)
                    where reversedH :: [TapeCommand]
reversedH = (TapeCommand -> TapeCommand) -> [TapeCommand] -> [TapeCommand]
forall a b. (a -> b) -> [a] -> [b]
map TapeCommand -> TapeCommand
reverseCommand [TapeCommand]
h
                [] -> ([[TapeCommand]]
accP21, [[TapeCommand]]
accP22, [[TapeCommand]]
accN21, [[TapeCommand]]
accN22)
    [[TapeCommand]]
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
splitPosNegCmdsInternal [[TapeCommand]]
commands ([], [], [], [])


copySMForCommand :: SM -> SMTag -> TMCMD -> SM
copySMForCommand :: SM -> SMTag -> TMCMD -> SM
copySMForCommand SM
sm SMTag
tag TMCMD
cmd =
   let q :: [Set State]
q = (Set State -> Set State) -> [Set State] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map ((State -> State) -> Set State -> Set State
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (TMCMD -> SMTag -> State -> State
addICmdSmTag TMCMD
cmd SMTag
tag)) (SM -> [Set State]
qn SM
sm)
       filterWord :: Word -> Word
filterWord (Word [Smb]
w) = [Smb] -> Word
Word((Smb -> Smb) -> [Smb] -> [Smb]
forall a b. (a -> b) -> [a] -> [b]
map (\case SmbQ State
smb -> State -> Smb
SmbQ (TMCMD -> SMTag -> State -> State
addICmdSmTag TMCMD
cmd SMTag
tag State
smb) ; Smb
s -> Smb
s) [Smb]
w)
       prog :: [SRule]
prog = (SRule -> SRule) -> [SRule] -> [SRule]
forall a b. (a -> b) -> [a] -> [b]
map (\ (SRule [(Word, Word)]
l) -> [(Word, Word)] -> SRule
SRule(((Word, Word) -> (Word, Word)) -> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> [a] -> [b]
map (Word -> Word
filterWord (Word -> Word) -> (Word -> Word) -> (Word, Word) -> (Word, Word)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Word -> Word
filterWord) [(Word, Word)]
l)) (SM -> [SRule]
srs SM
sm)
   in
   [[Y]] -> [Set State] -> [SRule] -> SM
SM (SM -> [[Y]]
yn SM
sm) [Set State]
q [SRule]
prog

createSMs :: [Y] -> [SM]
createSMs :: [Y] -> [SM]
createSMs [Y]
y =
    let ps :: [State]
ps@[State
_,State
p1,State
p2,State
p3,State
p4] = StateName -> [State]
gen StateName
P
        p's :: [State]
p's@[State
p0',State
p1',State
p2',State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Quote] [State]
ps
        pds :: [State]
pds@[State
p0d,State
p1d,State
_,State
_,State
p4d] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
ps
        [State
p0'd,State
p1'd,State
p2'd,State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
p's

        qs :: [State]
qs@[State
_,State
q1,State
q2,State
q3,State
q4] = StateName -> [State]
gen StateName
Q
        q's :: [State]
q's@[State
q0',State
q1',State
q2',State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Quote] [State]
qs
        qds :: [State]
qds@[State
q0d,State
q1d,State
_,State
_,State
q4d] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
qs
        [State
q0'd,State
q1'd,State
q2'd,State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
q's

        rs :: [State]
rs@[State
_,State
r1,State
r2,State
r3,State
r4] = StateName -> [State]
gen StateName
R
        r's :: [State]
r's@[State
r0',State
r1',State
r2',State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Quote] [State]
rs
        rds :: [State]
rds@[State
r0d,State
r1d,State
_,State
_,State
r4d] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
rs
        [State
r0'd,State
r1'd,State
r2'd,State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
r's

        ss :: [State]
ss@[State
_,State
s1,State
s2,State
s3,State
s4] = StateName -> [State]
gen StateName
S
        s's :: [State]
s's@[State
s0',State
s1',State
s2',State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Quote] [State]
ss
        sds :: [State]
sds@[State
s0d,State
s1d,State
_,State
_,State
s4d] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
ss
        [State
s0'd,State
s1'd,State
s2'd,State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
s's

        ts :: [State]
ts@[State
_,State
t1,State
t2,State
t3,State
t4] = StateName -> [State]
gen StateName
T
        t's :: [State]
t's@[State
t0',State
t1',State
t2',State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Quote] [State]
ts
        tds :: [State]
tds@[State
t0d,State
t1d,State
_,State
_,State
t4d] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
ts
        [State
t0'd,State
t1'd,State
t2'd,State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
t's

        us :: [State]
us@[State
_,State
u1,State
u2,State
u3,State
u4] = StateName -> [State]
gen StateName
U
        u's :: [State]
u's@[State
u0',State
u1',State
u2',State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Quote] [State]
us
        uds :: [State]
uds@[State
u0d,State
u1d,State
_,State
_,State
u4d] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
us
        [State
u0'd,State
u1'd,State
u2'd,State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Dash] [State]
u's

        xs :: [State]
xs@[State
x0,State
x1,State
x2,State
_,State
x4] = StateName -> String -> State
eTagState StateName
X String
"" State -> [State] -> [State]
forall a. a -> [a] -> [a]
: StateName -> [Integer] -> [State]
forall a. Show a => StateName -> [a] -> [State]
genRange StateName
X [Integer
1..Integer
4]
        [State
x0',State
x1',State
x2',State
_,State
_] = [Tag] -> [State] -> [State]
addTags [Tag
Quote] [State]
xs

        e :: State
e = StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
E String
"" Set Tag
eTag Maybe StateVal
forall a. Maybe a
Nothing
        e' :: State
e' = StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
E String
"" ([Tag] -> Set Tag
forall a. Ord a => [a] -> Set a
Set.fromList [Tag
Quote]) Maybe StateVal
forall a. Maybe a
Nothing
        f :: State
f = StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
F String
"" Set Tag
eTag Maybe StateVal
forall a. Maybe a
Nothing
        f' :: State
f' = StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
F String
"" ([Tag] -> Set Tag
forall a. Ord a => [a] -> Set a
Set.fromList [Tag
Quote]) Maybe StateVal
forall a. Maybe a
Nothing

        copySM :: SM -> (State -> Bool) -> Tag -> SM
        copySM :: SM -> (State -> Bool) -> Tag -> SM
copySM SM
sm State -> Bool
qFilter Tag
newTag =
            let qss :: [Set State]
qss = (Set State -> Set State) -> [Set State] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map ((State -> State) -> Set State -> Set State
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\State
x -> if State -> Bool
qFilter State
x then Tag -> State -> State
addTag Tag
newTag State
x else State
x)) ([Set State] -> [Set State]) -> [Set State] -> [Set State]
forall a b. (a -> b) -> a -> b
$ SM -> [Set State]
qn SM
sm
                filterWord :: Word -> Word
filterWord (Word [Smb]
w) = [Smb] -> Word
Word((Smb -> Smb) -> [Smb] -> [Smb]
forall a b. (a -> b) -> [a] -> [b]
map (\Smb
s -> case Smb
s of SmbQ State
q | State -> Bool
qFilter State
q -> State -> Smb
SmbQ (Tag -> State -> State
addTag Tag
newTag State
q); Smb
_ -> Smb
s ) [Smb]
w)
                prog :: [SRule]
prog = (SRule -> SRule) -> [SRule] -> [SRule]
forall a b. (a -> b) -> [a] -> [b]
map (\ (SRule [(Word, Word)]
l) -> [(Word, Word)] -> SRule
SRule(((Word, Word) -> (Word, Word)) -> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> [a] -> [b]
map (Word -> Word
filterWord (Word -> Word) -> (Word -> Word) -> (Word, Word) -> (Word, Word)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Word -> Word
filterWord) [(Word, Word)]
l)) (SM -> [SRule]
srs SM
sm)
            in
                [[Y]] -> [Set State] -> [SRule] -> SM
SM (SM -> [[Y]]
yn SM
sm) [Set State]
qss [SRule]
prog

        sm1 :: SM
        sm1 :: SM
sm1 =
            let
               rl1 :: SRule
rl1 =
                  [(Word, Word)] -> SRule
SRule [
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
q1], [Smb] -> Word
Word [Y -> Smb
SmbY' Y
Delta, Y -> Smb
SmbY' Y
Delta, State -> Smb
SmbQ State
q1, Y -> Smb
SmbY Y
Delta, Y -> Smb
SmbY Y
Delta]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
r1], [Smb] -> Word
Word [Y -> Smb
SmbY' Y
Delta, State -> Smb
SmbQ State
r1, Y -> Smb
SmbY Y
Delta])
                  ]
               rl2 :: SRule
rl2 =
                  [(Word, Word)] -> SRule
SRule [
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
p1, State -> Smb
SmbQ State
q1], [Smb] -> Word
Word [State -> Smb
SmbQ State
p2, State -> Smb
SmbQ State
q2]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
r1], [Smb] -> Word
Word [State -> Smb
SmbQ State
r2]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
s1], [Smb] -> Word
Word [State -> Smb
SmbQ State
s2]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
t1], [Smb] -> Word
Word [State -> Smb
SmbQ State
t2]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
u1], [Smb] -> Word
Word [Y -> Smb
SmbY Y
Delta, State -> Smb
SmbQ State
u2])
                  ]
               rl3 :: SRule
rl3 =
                  [(Word, Word)] -> SRule
SRule [
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
p1, Y -> Smb
SmbY Y
Delta, State -> Smb
SmbQ State
q1], [Smb] -> Word
Word [State -> Smb
SmbQ State
p3, Y -> Smb
SmbY Y
Delta, State -> Smb
SmbQ State
q3]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
r1], [Smb] -> Word
Word [State -> Smb
SmbQ State
r3]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
s1], [Smb] -> Word
Word [State -> Smb
SmbQ State
s3]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
t1], [Smb] -> Word
Word [State -> Smb
SmbQ State
t3]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
u1], [Smb] -> Word
Word [State -> Smb
SmbQ State
u3])

                  ]
            in
            [[Y]] -> [Set State] -> [SRule] -> SM
SM [[Y
Delta],[Y
Delta],[Y
Delta],[Y
Delta]] (([State] -> Set State) -> [[State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [State] -> Set State
forall a. Ord a => [a] -> Set a
Set.fromList [[State
p1,State
p2,State
p3],[State
q1,State
q2,State
q3],[State
r1,State
r2,State
r3],[State
s1,State
s2,State
s3],[State
t1,State
t2,State
t3],[State
u1,State
u2,State
u3]]) [SRule
rl1,SRule
rl2,SRule
rl3]

        sm2 :: SM
        sm2 :: SM
sm2 =
            let
               rl1 :: SRule
rl1 =
                  [(Word, Word)] -> SRule
SRule [
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
q2], [Smb] -> Word
Word [Y -> Smb
SmbY Y
Delta, State -> Smb
SmbQ State
q2, Y -> Smb
SmbY' Y
Delta]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
s2], [Smb] -> Word
Word [Y -> Smb
SmbY' Y
Delta, State -> Smb
SmbQ State
s2, Y -> Smb
SmbY Y
Delta])
                  ]

               rl2 :: SRule
rl2 =
                  [(Word, Word)] -> SRule
SRule [
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
q2, State -> Smb
SmbQ State
r2, State -> Smb
SmbQ State
s2], [Smb] -> Word
Word [State -> Smb
SmbQ State
q1, State -> Smb
SmbQ State
r1, State -> Smb
SmbQ State
s1]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
p2], [Smb] -> Word
Word [State -> Smb
SmbQ State
p1]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
t2], [Smb] -> Word
Word [State -> Smb
SmbQ State
t1]),
                    ([Smb] -> Word
Word [State -> Smb
SmbQ State
u2], [Smb] -> Word
Word [State -> Smb
SmbQ State
u1])
                  ]

            in
            [[Y]] -> [Set State] -> [SRule] -> SM
SM [[Y
Delta],[Y
Delta],[Y
Delta],[Y
Delta]] (([State] -> Set State) -> [[State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [State] -> Set State
forall a. Ord a => [a] -> Set a
Set.fromList [[State
p1,State
p2],[State
q1,State
q2],[State
r1,State
r2],[State
s1,State
s2],[State
t1,State
t2],[State
u1,State
u2]]) [SRule
rl1,SRule
rl2]


        sm3 :: SM
        sm3 :: SM
sm3 = [[Y]] -> [Set State] -> [SRule] -> SM
SM (SM -> [[Y]]
yn SM
sm1) (SM -> [Set State]
qn SM
sm1) (SM -> [SRule]
srs SM
sm1 [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ SM -> [SRule]
srs SM
sm2)

        sm4 :: SM
        sm4 :: SM
sm4 =
            let sm3' :: SM
sm3' = SM -> (State -> Bool) -> Tag -> SM
copySM SM
sm3 (\State
q -> State -> String
s_idx State
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"3") Tag
Quote
            in
            [[Y]] -> [Set State] -> [SRule] -> SM
SM (SM -> [[Y]]
yn SM
sm1) (([Set State] -> Set State) -> [[Set State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [Set State] -> Set State
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([[Set State]] -> [Set State]) -> [[Set State]] -> [Set State]
forall a b. (a -> b) -> a -> b
$ [[Set State]] -> [[Set State]]
forall a. [[a]] -> [[a]]
transpose [SM -> [Set State]
qn SM
sm3, SM -> [Set State]
qn SM
sm3']) (SM -> [SRule]
srs SM
sm3 [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ SM -> [SRule]
srs SM
sm3')


        sm4d :: SM
        sm4d :: SM
sm4d = SM -> (State -> Bool) -> Tag -> SM
copySM SM
sm4 (Bool -> State -> Bool
forall a b. a -> b -> a
const Bool
True) Tag
Dash

        sm5 :: [Y] -> SM
        sm5 :: [Y] -> SM
sm5 [Y]
ys =
            let st :: [Set State]
st = ([State] -> Set State) -> [[State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [State] -> Set State
forall a. Ord a => [a] -> Set a
Set.fromList [[State
e], [State
x0,State
x4], [State
f], [State
e'],
                      [State]
ps [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
p0',State
p1',State
p2'],
                      [State]
qs [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
q0',State
q1',State
q2'],
                      [State]
rs [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
r0',State
r1',State
r2'],
                      [State]
ss [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
s0',State
s1',State
s2'],
                      [State]
ts [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
t0',State
t1',State
t2'],
                      [State]
us [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
u0',State
u1',State
u2'],
                      [State]
pds [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
p0'd,State
p1'd,State
p2'd],
                      [State]
qds [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
q0'd,State
q1'd,State
q2'd],
                      [State]
rds [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
r0'd,State
r1'd,State
r2'd],
                      [State]
sds [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
s0'd,State
s1'd,State
s2'd],
                      [State]
tds [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
t0'd,State
t1'd,State
t2'd],
                      [State]
uds [State] -> [State] -> [State]
forall a. [a] -> [a] -> [a]
++ [State
u0'd,State
u1'd,State
u2'd],
                      [State
f']]
                yss :: [[Y]]
yss = [[Y]
ys,[Y]
ys,[],[],[Y
Delta],[Y
Delta],[Y
Delta],[Y
Delta],[Y
Delta],[],[Y
Delta],[Y
Delta],[Y
Delta],[Y
Delta],[Y
Delta],[]]
                prg :: [SRule]
prg = (Y -> SRule) -> [Y] -> [SRule]
forall a b. (a -> b) -> [a] -> [b]
map (\Y
a -> [(Word, Word)] -> SRule
SRule[ ([Smb] -> Word
Word [State -> Smb
SmbQ State
x0], [Smb] -> Word
Word [Y -> Smb
SmbY' Y
a, State -> Smb
SmbQ State
x0, Y -> Smb
SmbY Y
a]),
                                        ([Smb] -> Word
Word [State -> Smb
SmbQ State
p1'], [Smb] -> Word
Word [State -> Smb
SmbQ State
p0']),
                                        ([Smb] -> Word
Word [State -> Smb
SmbQ State
q1', State -> Smb
SmbQ State
r1', State -> Smb
SmbQ State
s1', State -> Smb
SmbQ State
t1', State -> Smb
SmbQ State
u1', State -> Smb
SmbQ State
p0d],
                                         [Smb] -> Word
Word [Y -> Smb
SmbY' Y
Delta, State -> Smb
SmbQ State
q0', State -> Smb
SmbQ State
r0', State -> Smb
SmbQ State
s0', State -> Smb
SmbQ State
t0', State -> Smb
SmbQ State
u0', State -> Smb
SmbQ State
p1d, Y -> Smb
SmbY Y
Delta]),
                                        ([Smb] -> Word
Word [State -> Smb
SmbQ State
q0d, State -> Smb
SmbQ State
r0d, State -> Smb
SmbQ State
s0d, State -> Smb
SmbQ State
t0d, State -> Smb
SmbQ State
u0d],
                                         [Smb] -> Word
Word [State -> Smb
SmbQ State
q1d, State -> Smb
SmbQ State
r1d, State -> Smb
SmbQ State
s1d, State -> Smb
SmbQ State
t1d, State -> Smb
SmbQ State
u1d])
                                      ]) [Y]
y
            in
            [[Y]] -> [Set State] -> [SRule] -> SM
SM [[Y]]
yss [Set State]
st [SRule]
prg

        sm6 :: [Y] -> SM
        sm6 :: [Y] -> SM
sm6 [Y]
ys =
            let sm5' :: SM
sm5' = [Y] -> SM
sm5 [Y]
ys
                prg :: [SRule]
prg = [[(Word, Word)] -> SRule
SRule[ ([Smb] -> Word
Word [State -> Smb
SmbQ State
p0'], [Smb] -> Word
Word [State -> Smb
SmbQ State
p1]),
                              ([Smb] -> Word
Word [State -> Smb
SmbQ State
q0', State -> Smb
SmbQ State
r0', State -> Smb
SmbQ State
s0', State -> Smb
SmbQ State
t0', State -> Smb
SmbQ State
u0', State -> Smb
SmbQ State
p1'd],
                               [Smb] -> Word
Word [State -> Smb
SmbQ State
q1, State -> Smb
SmbQ State
r1, State -> Smb
SmbQ State
s1, State -> Smb
SmbQ State
t1, State -> Smb
SmbQ State
u1 ,State -> Smb
SmbQ State
p0d]),
                              ([Smb] -> Word
Word [State -> Smb
SmbQ State
q1'd, State -> Smb
SmbQ State
r1'd, State -> Smb
SmbQ State
s1'd, State -> Smb
SmbQ State
t1'd, State -> Smb
SmbQ State
u1'd],
                               [Smb] -> Word
Word [State -> Smb
SmbQ State
q0d, State -> Smb
SmbQ State
r0d, State -> Smb
SmbQ State
s0d, State -> Smb
SmbQ State
t0d, State -> Smb
SmbQ State
u0d]) ]]
            in
            [[Y]] -> [Set State] -> [SRule] -> SM
SM (SM -> [[Y]]
yn SM
sm5') (SM -> [Set State]
qn SM
sm5') [SRule]
prg

        sm7 :: [Y] -> SM
        sm7 :: [Y] -> SM
sm7 [Y]
ys =
            let sm5' :: SM
sm5' = [Y] -> SM
sm5 [Y]
ys
                prg :: [SRule]
prg = [[(Word, Word)] -> SRule
SRule[ ([Smb] -> Word
Word [State -> Smb
SmbQ State
e, State -> Smb
SmbQ State
x0], [Smb] -> Word
Word [State -> Smb
SmbQ State
e, State -> Smb
SmbQ State
x4]),
                              ([Smb] -> Word
Word [State -> Smb
SmbQ State
p1, State -> Smb
SmbQ State
q1, State -> Smb
SmbQ State
r1, State -> Smb
SmbQ State
s1, State -> Smb
SmbQ State
t1, State -> Smb
SmbQ State
u1, State -> Smb
SmbQ State
p0d],
                               [Smb] -> Word
Word [State -> Smb
SmbQ State
p4, State -> Smb
SmbQ State
q4, State -> Smb
SmbQ State
r4, State -> Smb
SmbQ State
s4, State -> Smb
SmbQ State
t4, State -> Smb
SmbQ State
u4, State -> Smb
SmbQ State
p4d]),
                              ([Smb] -> Word
Word [State -> Smb
SmbQ State
q0d, State -> Smb
SmbQ State
r0d, State -> Smb
SmbQ State
s0d, State -> Smb
SmbQ State
t0d, State -> Smb
SmbQ State
u0d],
                               [Smb] -> Word
Word [State -> Smb
SmbQ State
q4d, State -> Smb
SmbQ State
r4d, State -> Smb
SmbQ State
s4d, State -> Smb
SmbQ State
t4d, State -> Smb
SmbQ State
u4d]) ]]

            in
            [[Y]] -> [Set State] -> [SRule] -> SM
SM (SM -> [[Y]]
yn SM
sm5') (SM -> [Set State]
qn SM
sm5') [SRule]
prg

        sm8 :: [Y] -> SM
        sm8 :: [Y] -> SM
sm8 [Y]
ys =
            let sm5' :: SM
sm5' = [Y] -> SM
sm5 [Y]
ys
            in
            [[Y]] -> [Set State] -> [SRule] -> SM
SM (SM -> [[Y]]
yn SM
sm5') (SM -> [Set State]
qn SM
sm5') (SM -> [SRule]
srs SM
sm4 [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ SM -> [SRule]
srs SM
sm5' [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ SM -> [SRule]
srs SM
sm4d [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ SM -> [SRule]
srs ([Y] -> SM
sm6 [Y]
ys) [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ SM -> [SRule]
srs ([Y] -> SM
sm7 [Y]
ys))

        sm9 :: [Y] -> SM
        sm9 :: [Y] -> SM
sm9 [Y]
ys =
            let sm8' :: SM
sm8' = [Y] -> SM
sm8 [Y]
ys
                sm8c :: SM
sm8c = SM -> (State -> Bool) -> Tag -> SM
copySM SM
sm8' (\State
q -> StateName -> [StateName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem (State -> StateName
s_name State
q) [StateName
E, StateName
F] Bool -> Bool -> Bool
&& (State -> String
s_idx State
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"4")) Tag
Hat
            in
            [[Y]] -> [Set State] -> [SRule] -> SM
SM (SM -> [[Y]]
yn SM
sm1) (([Set State] -> Set State) -> [[Set State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [Set State] -> Set State
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([[Set State]] -> [Set State]) -> [[Set State]] -> [Set State]
forall a b. (a -> b) -> a -> b
$ [[Set State]] -> [[Set State]]
forall a. [[a]] -> [[a]]
transpose [SM -> [Set State]
qn SM
sm8', SM -> [Set State]
qn SM
sm8c]) (SM -> [SRule]
srs SM
sm8' [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ SM -> [SRule]
srs SM
sm8c)

        smAlpha :: SM
        smAlpha :: SM
smAlpha = [[Y]] -> [Set State] -> [SRule] -> SM
SM [[Y
Alpha],[Y
Alpha]] (([State] -> Set State) -> [[State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [State] -> Set State
forall a. Ord a => [a] -> Set a
Set.fromList [[State
e],[State
x0,State
x1,State
x2],[State
f]])
                                                                                [[(Word, Word)] -> SRule
SRule [([Smb] -> Word
Word [State -> Smb
SmbQ State
x0], [Smb] -> Word
Word [Y -> Smb
SmbY' Y
Alpha, State -> Smb
SmbQ State
x0, Y -> Smb
SmbY Y
Alpha])],
                                                                                [(Word, Word)] -> SRule
SRule [([Smb] -> Word
Word [State -> Smb
SmbQ State
e, State -> Smb
SmbQ State
x0], [Smb] -> Word
Word [State -> Smb
SmbQ State
e, State -> Smb
SmbQ State
x1])],
                                                                                [(Word, Word)] -> SRule
SRule [([Smb] -> Word
Word [State -> Smb
SmbQ State
x1], [Smb] -> Word
Word [Y -> Smb
SmbY Y
Alpha, State -> Smb
SmbQ State
x1, Y -> Smb
SmbY' Y
Alpha])],
                                                                                [(Word, Word)] -> SRule
SRule [([Smb] -> Word
Word [State -> Smb
SmbQ State
x1, State -> Smb
SmbQ State
f], [Smb] -> Word
Word [State -> Smb
SmbQ State
x2, State -> Smb
SmbQ State
f])]]

        smOmega :: SM
        smOmega :: SM
smOmega = [[Y]] -> [Set State] -> [SRule] -> SM
SM [[Y
Omega],[Y
Omega]] (([State] -> Set State) -> [[State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [State] -> Set State
forall a. Ord a => [a] -> Set a
Set.fromList [[State
e'],[State
x0',State
x1',State
x2'],[State
f']])
                                                                                [[(Word, Word)] -> SRule
SRule [([Smb] -> Word
Word [State -> Smb
SmbQ State
x0'], [Smb] -> Word
Word [Y -> Smb
SmbY Y
Omega, State -> Smb
SmbQ State
x0', Y -> Smb
SmbY' Y
Omega])],
                                                                                [(Word, Word)] -> SRule
SRule [([Smb] -> Word
Word [State -> Smb
SmbQ State
x0', State -> Smb
SmbQ State
f'], [Smb] -> Word
Word [State -> Smb
SmbQ State
x1', State -> Smb
SmbQ State
f'])],
                                                                                [(Word, Word)] -> SRule
SRule [([Smb] -> Word
Word [State -> Smb
SmbQ State
x1'], [Smb] -> Word
Word [Y -> Smb
SmbY' Y
Omega, State -> Smb
SmbQ State
x1', Y -> Smb
SmbY Y
Omega])],
                                                                                [(Word, Word)] -> SRule
SRule [([Smb] -> Word
Word [State -> Smb
SmbQ State
e', State -> Smb
SmbQ State
x1'], [Smb] -> Word
Word [State -> Smb
SmbQ State
e', State -> Smb
SmbQ State
x2'])]]

   in
      [SM
sm4, [Y] -> SM
sm9 [Y]
y, SM
smAlpha, SM
smOmega]

genConnectingRules :: TMCMD -> [SRule]
genConnectingRules :: TMCMD -> [SRule]
genConnectingRules TMCMD
cmd = do
    let (Command [TapeCommand]
command) = TMCMD
cmd
    let k :: Int
k = [TapeCommand] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TapeCommand]
command

    let eF0 :: Smb
eF0        = String -> Int -> Smb
eF String
"" Int
0
    let eFl' :: Smb
eFl'       = String -> Int -> Smb
eF' String
"" (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    let x :: Int -> SMTag -> Smb
x Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
X String
"" Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let x' :: Int -> SMTag -> Smb
x' Int
j SMTag
sm       = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
X String
"" Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let f' :: String -> Int -> SMTag -> Smb
f' String
idx Int
j SMTag
sm   = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
F String
idx Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let f :: String -> Int -> SMTag -> Smb
f String
idx Int
j SMTag
sm    = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
F String
idx Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let fl' :: SMTag -> Smb
fl' SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
F String
"" Set Tag
quoteTag (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let f0 :: SMTag -> Smb
f0 SMTag
sm         = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
F String
"" Set Tag
eTag Int
0 (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let e' :: Int -> SMTag -> Smb
e' Int
j SMTag
sm       = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
E String
"" Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let e :: Int -> SMTag -> Smb
e Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
E String
"" Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let p :: Int -> SMTag -> Smb
p Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
P String
"" Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let q :: Int -> SMTag -> Smb
q Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
Q String
"" Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let r :: Int -> SMTag -> Smb
r Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
R String
"" Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let s :: Int -> SMTag -> Smb
s Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
S String
"" Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let t :: Int -> SMTag -> Smb
t Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
T String
"" Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let u :: Int -> SMTag -> Smb
u Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
U String
"" Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let pd :: Int -> SMTag -> Smb
pd Int
j SMTag
sm       = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
P String
"" Set Tag
dashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let qd :: Int -> SMTag -> Smb
qd Int
j SMTag
sm       = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
Q String
"" Set Tag
dashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let rd :: Int -> SMTag -> Smb
rd Int
j SMTag
sm       = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
R String
"" Set Tag
dashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let sd :: Int -> SMTag -> Smb
sd Int
j SMTag
sm       = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
S String
"" Set Tag
dashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let td :: Int -> SMTag -> Smb
td Int
j SMTag
sm       = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
T String
"" Set Tag
dashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let ud :: Int -> SMTag -> Smb
ud Int
j SMTag
sm       = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
U String
"" Set Tag
dashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)

    let pIndex :: String -> Int -> SMTag -> Smb
pIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
P String
index Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let qIndex :: String -> Int -> SMTag -> Smb
qIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
Q String
index Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let rIndex :: String -> Int -> SMTag -> Smb
rIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
R String
index Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let sIndex :: String -> Int -> SMTag -> Smb
sIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
S String
index Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let tIndex :: String -> Int -> SMTag -> Smb
tIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
T String
index Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let uIndex :: String -> Int -> SMTag -> Smb
uIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
U String
index Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let xIndex :: String -> Int -> SMTag -> Smb
xIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
X String
index Set Tag
eTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)

    let pIndex' :: String -> Int -> SMTag -> Smb
pIndex' String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
P String
index Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let qIndex' :: String -> Int -> SMTag -> Smb
qIndex' String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
Q String
index Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let rIndex' :: String -> Int -> SMTag -> Smb
rIndex' String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
R String
index Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let sIndex' :: String -> Int -> SMTag -> Smb
sIndex' String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
S String
index Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let tIndex' :: String -> Int -> SMTag -> Smb
tIndex' String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
T String
index Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let uIndex' :: String -> Int -> SMTag -> Smb
uIndex' String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
U String
index Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let xIndex' :: String -> Int -> SMTag -> Smb
xIndex' String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
X String
index Set Tag
quoteTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)

    let phIndex :: String -> Int -> SMTag -> Smb
phIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
P String
index Set Tag
hatTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let qhIndex :: String -> Int -> SMTag -> Smb
qhIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
Q String
index Set Tag
hatTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let rhIndex :: String -> Int -> SMTag -> Smb
rhIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
R String
index Set Tag
hatTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let shIndex :: String -> Int -> SMTag -> Smb
shIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
S String
index Set Tag
hatTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let thIndex :: String -> Int -> SMTag -> Smb
thIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
T String
index Set Tag
hatTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let uhIndex :: String -> Int -> SMTag -> Smb
uhIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
U String
index Set Tag
hatTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let xh :: Int -> SMTag -> Smb
xh Int
j SMTag
sm                = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
X String
"" Set Tag
hatTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)

    let phdIndex :: String -> Int -> SMTag -> Smb
phdIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
P String
index Set Tag
hatdashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let qhdIndex :: String -> Int -> SMTag -> Smb
qhdIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
Q String
index Set Tag
hatdashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let rhdIndex :: String -> Int -> SMTag -> Smb
rhdIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
R String
index Set Tag
hatdashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let shdIndex :: String -> Int -> SMTag -> Smb
shdIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
S String
index Set Tag
hatdashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let thdIndex :: String -> Int -> SMTag -> Smb
thdIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
T String
index Set Tag
hatdashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let uhdIndex :: String -> Int -> SMTag -> Smb
uhdIndex String
index Int
j SMTag
sm        = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
U String
index Set Tag
hatdashTag Int
j (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)

    let (Square
a, Int
i) = [TapeCommand] -> (Square, Int)
getai [TapeCommand]
command
    let getFromJ :: Int -> String
getFromJ Int
j = String
state where (String
state, String
_) = [TapeCommand] -> Int -> (String, String)
getJIdx [TapeCommand]
command Int
j
    let getToJ :: Int -> String
getToJ Int
j = String
state where (String
_, String
state) = [TapeCommand] -> Int -> (String, String)
getJIdx [TapeCommand]
command Int
j

    let p4 :: SMTag -> Smb
p4         = String -> Int -> SMTag -> Smb
pIndex String
"1" Int
i
    let q4 :: SMTag -> Smb
q4         = String -> Int -> SMTag -> Smb
qIndex String
"1" Int
i
    let r4 :: SMTag -> Smb
r4         = String -> Int -> SMTag -> Smb
rIndex String
"1" Int
i
    let s4 :: SMTag -> Smb
s4         = String -> Int -> SMTag -> Smb
sIndex String
"1" Int
i
    let t4 :: SMTag -> Smb
t4         = String -> Int -> SMTag -> Smb
tIndex String
"1" Int
i
    let u4 :: SMTag -> Smb
u4         = String -> Int -> SMTag -> Smb
uIndex String
"1" Int
i
    let pd4 :: SMTag -> Smb
pd4 SMTag
sm     = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
P String
"0" Set Tag
dashTag Int
i (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let qd4 :: SMTag -> Smb
qd4 SMTag
sm     = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
Q String
"0" Set Tag
dashTag Int
i (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let rd4 :: SMTag -> Smb
rd4 SMTag
sm     = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
R String
"0" Set Tag
dashTag Int
i (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let sd4 :: SMTag -> Smb
sd4 SMTag
sm     = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
S String
"0" Set Tag
dashTag Int
i (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let td4 :: SMTag -> Smb
td4 SMTag
sm     = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
T String
"0" Set Tag
dashTag Int
i (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)
    let ud4 :: SMTag -> Smb
ud4 SMTag
sm     = State -> Smb
SmbQ (State -> Smb) -> State -> Smb
forall a b. (a -> b) -> a -> b
$ StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
U String
"0" Set Tag
dashTag Int
i (TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd) (SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
sm)

    let rule4 :: SRule
rule4 =
            [(Word, Word)] -> SRule
SRule ([(Word, Word)] -> SRule) -> [(Word, Word)] -> SRule
forall a b. (a -> b) -> a -> b
$ [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
(++)
            [([Smb] -> Word
Word [Int -> Smb
eE Int
0], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
0 SMTag
T4]),
            ([Smb] -> Word
Word [Smb
eFl'], [Smb] -> Word
Word [SMTag -> Smb
fl' SMTag
T4]),
            ([Smb] -> Word
Word [Int -> Smb
eX Int
0, Smb
eF0], [Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
0 SMTag
T4, SMTag -> Smb
f0 SMTag
T4]),
            ([Smb] -> Word
Word [Int -> Smb
eE' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Int -> Smb
eX' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)], [Smb] -> Word
Word [Int -> SMTag -> Smb
e' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
T4, Int -> SMTag -> Smb
x' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
T4]),
            ([Smb] -> Word
Word [Int -> Smb
eE Int
i], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
i SMTag
T4]),
            ([Smb] -> Word
Word [Int -> Smb
eX Int
i, String -> Int -> Smb
eF (Int -> String
getFromJ Int
i) Int
i, Int -> Smb
eE' Int
i, Int -> Smb
eP Int
i],
            [Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
i SMTag
T4, String -> Int -> SMTag -> Smb
f (Int -> String
getFromJ Int
i) Int
i SMTag
T4, Int -> SMTag -> Smb
e' Int
i SMTag
T4, SMTag -> Smb
p4 SMTag
T4]),
            ([Smb] -> Word
Word [Int -> Smb
eQ Int
i, Int -> Smb
eR Int
i, Int -> Smb
eS Int
i, Int -> Smb
eT Int
i, Int -> Smb
eU Int
i, Int -> Smb
ePd Int
i, Int -> Smb
eQd Int
i, Int -> Smb
eRd Int
i, Int -> Smb
eSd Int
i, Int -> Smb
eTd Int
i, Int -> Smb
eUd Int
i, String -> Int -> Smb
eF' (Int -> String
getFromJ Int
i) Int
i],
            [Smb] -> Word
Word [SMTag -> Smb
q4 SMTag
T4, SMTag -> Smb
r4 SMTag
T4, SMTag -> Smb
s4 SMTag
T4, SMTag -> Smb
t4 SMTag
T4, SMTag -> Smb
u4 SMTag
T4, SMTag -> Smb
pd4 SMTag
T4, SMTag -> Smb
qd4 SMTag
T4, SMTag -> Smb
rd4 SMTag
T4, SMTag -> Smb
sd4 SMTag
T4, SMTag -> Smb
td4 SMTag
T4, SMTag -> Smb
ud4 SMTag
T4, String -> Int -> SMTag -> Smb
f' (Int -> String
getFromJ Int
i) Int
i SMTag
T4])]
            ([(Word, Word)] -> [(Word, Word)])
-> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> a -> b
$ [[(Word, Word)]] -> [(Word, Word)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [[([Smb] -> Word
Word [Int -> Smb
eE Int
j], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
j SMTag
T4]),
            ([Smb] -> Word
Word [Int -> Smb
eX Int
j, String -> Int -> Smb
eF (Int -> String
getFromJ Int
j) Int
j, Int -> Smb
eE' Int
j, Int -> Smb
eP Int
j],
            [Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
j SMTag
T4, String -> Int -> SMTag -> Smb
f (Int -> String
getFromJ Int
j) Int
j SMTag
T4, Int -> SMTag -> Smb
e' Int
j SMTag
T4, Int -> SMTag -> Smb
p Int
j SMTag
T4]),
            ([Smb] -> Word
Word [Int -> Smb
eQ Int
j, Int -> Smb
eR Int
j, Int -> Smb
eS Int
j, Int -> Smb
eT Int
j, Int -> Smb
eU Int
j, Int -> Smb
ePd Int
j, Int -> Smb
eQd Int
j, Int -> Smb
eRd Int
j, Int -> Smb
eSd Int
j, Int -> Smb
eTd Int
j, Int -> Smb
eUd Int
j, String -> Int -> Smb
eF' (Int -> String
getFromJ Int
j) Int
j],
            [Smb] -> Word
Word [Int -> SMTag -> Smb
q Int
j SMTag
T4, Int -> SMTag -> Smb
r Int
j SMTag
T4, Int -> SMTag -> Smb
s Int
j SMTag
T4, Int -> SMTag -> Smb
t Int
j SMTag
T4, Int -> SMTag -> Smb
u Int
j SMTag
T4, Int -> SMTag -> Smb
pd Int
j SMTag
T4, Int -> SMTag -> Smb
qd Int
j SMTag
T4, Int -> SMTag -> Smb
rd Int
j SMTag
T4, Int -> SMTag -> Smb
sd Int
j SMTag
T4, Int -> SMTag -> Smb
td Int
j SMTag
T4, Int -> SMTag -> Smb
ud Int
j SMTag
T4, String -> Int -> SMTag -> Smb
f' (Int -> String
getFromJ Int
j) Int
j SMTag
T4])]
            | Int
j <- [Int
1 .. Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
k]]

    let rule4alpha :: SRule
rule4alpha =
            [(Word, Word)] -> SRule
SRule ([(Word, Word)] -> SRule) -> [(Word, Word)] -> SRule
forall a b. (a -> b) -> a -> b
$ [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
(++)
            [([Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
0 SMTag
T4, SMTag -> Smb
f0 SMTag
T4], [Smb] -> Word
Word [Y -> Smb
SmbY' Y
Alpha, Int -> SMTag -> Smb
x Int
0 SMTag
TAlpha, SMTag -> Smb
f0 SMTag
TAlpha]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
e' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
T4, Int -> SMTag -> Smb
x' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
T4], [Smb] -> Word
Word [Int -> SMTag -> Smb
e' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
TAlpha, Int -> SMTag -> Smb
x' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
TAlpha, Y -> Smb
SmbY' Y
Omega]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
i SMTag
T4], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
i SMTag
TAlpha]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
i SMTag
T4, String -> Int -> SMTag -> Smb
f (Int -> String
getFromJ Int
i) Int
i SMTag
T4, Int -> SMTag -> Smb
e' Int
i SMTag
T4, String -> Int -> SMTag -> Smb
pIndex' String
"1" Int
i SMTag
T4],
            [Smb] -> Word
Word [Y -> Smb
SmbY' (Y -> Smb) -> Y -> Smb
forall a b. (a -> b) -> a -> b
$ Square -> Y
Y Square
a, Int -> SMTag -> Smb
x Int
i SMTag
TAlpha, String -> Int -> SMTag -> Smb
f (Int -> String
getToJ Int
i) Int
i SMTag
TAlpha, Int -> SMTag -> Smb
e' Int
i SMTag
TAlpha, SMTag -> Smb
p4 SMTag
TAlpha, Y -> Smb
SmbY' Y
Delta]),
            ([Smb] -> Word
Word [String -> Int -> SMTag -> Smb
qIndex' String
"1" Int
i SMTag
T4, String -> Int -> SMTag -> Smb
rIndex' String
"1" Int
i SMTag
T4, String -> Int -> SMTag -> Smb
sIndex' String
"1" Int
i SMTag
T4, String -> Int -> SMTag -> Smb
tIndex' String
"1" Int
i SMTag
T4, String -> Int -> SMTag -> Smb
uIndex' String
"1" Int
i SMTag
T4],
            [Smb] -> Word
Word [SMTag -> Smb
q4 SMTag
TAlpha, SMTag -> Smb
r4 SMTag
TAlpha, SMTag -> Smb
s4 SMTag
TAlpha, SMTag -> Smb
t4 SMTag
TAlpha, SMTag -> Smb
u4 SMTag
TAlpha]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
0 SMTag
T4], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
0 SMTag
TAlpha]),
            ([Smb] -> Word
Word [SMTag -> Smb
fl' SMTag
T4], [Smb] -> Word
Word [SMTag -> Smb
fl' SMTag
TAlpha]),
            ([Smb] -> Word
Word [SMTag -> Smb
pd4 SMTag
T4, SMTag -> Smb
qd4 SMTag
T4, SMTag -> Smb
rd4 SMTag
T4, SMTag -> Smb
sd4 SMTag
T4, SMTag -> Smb
td4 SMTag
T4, SMTag -> Smb
ud4 SMTag
T4, String -> Int -> SMTag -> Smb
f' (Int -> String
getFromJ Int
i) Int
i SMTag
T4],
            [Smb] -> Word
Word [SMTag -> Smb
pd4 SMTag
TAlpha, SMTag -> Smb
qd4 SMTag
TAlpha, SMTag -> Smb
rd4 SMTag
TAlpha, SMTag -> Smb
sd4 SMTag
TAlpha, SMTag -> Smb
td4 SMTag
TAlpha, SMTag -> Smb
ud4 SMTag
TAlpha, String -> Int -> SMTag -> Smb
f' (Int -> String
getToJ Int
i) Int
i SMTag
TAlpha])]
            ([(Word, Word)] -> [(Word, Word)])
-> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> a -> b
$ [[(Word, Word)]] -> [(Word, Word)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [[([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
j SMTag
T4], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
j SMTag
TAlpha]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
j SMTag
T4, String -> Int -> SMTag -> Smb
f (Int -> String
getFromJ Int
j) Int
j SMTag
T4, Int -> SMTag -> Smb
e' Int
j SMTag
T4, Int -> SMTag -> Smb
p Int
j SMTag
T4],
            [Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
j SMTag
TAlpha, String -> Int -> SMTag -> Smb
f (Int -> String
getToJ Int
j) Int
j SMTag
TAlpha, Int -> SMTag -> Smb
e' Int
j SMTag
TAlpha, Int -> SMTag -> Smb
p Int
j SMTag
TAlpha]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
q Int
j SMTag
T4, Int -> SMTag -> Smb
r Int
j SMTag
T4, Int -> SMTag -> Smb
s Int
j SMTag
T4, Int -> SMTag -> Smb
t Int
j SMTag
T4, Int -> SMTag -> Smb
u Int
j SMTag
T4, Int -> SMTag -> Smb
pd Int
j SMTag
T4, Int -> SMTag -> Smb
qd Int
j SMTag
T4, Int -> SMTag -> Smb
rd Int
j SMTag
T4, Int -> SMTag -> Smb
sd Int
j SMTag
T4, Int -> SMTag -> Smb
td Int
j SMTag
T4, Int -> SMTag -> Smb
ud Int
j SMTag
T4, String -> Int -> SMTag -> Smb
f' (Int -> String
getFromJ Int
j) Int
j SMTag
T4],
            [Smb] -> Word
Word [Int -> SMTag -> Smb
q Int
j SMTag
TAlpha, Int -> SMTag -> Smb
r Int
j SMTag
TAlpha, Int -> SMTag -> Smb
s Int
j SMTag
TAlpha, Int -> SMTag -> Smb
t Int
j SMTag
TAlpha, Int -> SMTag -> Smb
u Int
j SMTag
TAlpha, Int -> SMTag -> Smb
pd Int
j SMTag
TAlpha, Int -> SMTag -> Smb
qd Int
j SMTag
TAlpha, Int -> SMTag -> Smb
rd Int
j SMTag
TAlpha, Int -> SMTag -> Smb
sd Int
j SMTag
TAlpha, Int -> SMTag -> Smb
td Int
j SMTag
TAlpha, Int -> SMTag -> Smb
ud Int
j SMTag
TAlpha, String -> Int -> SMTag -> Smb
f' (Int -> String
getToJ Int
j) Int
j SMTag
TAlpha])]
            | Int
j <- [Int
1 .. Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
k] ]

    let changeMachine :: SMTag -> SMTag -> [(Word, Word)]
changeMachine SMTag
from SMTag
to =
            [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
(++)
            [([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
i SMTag
from], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
i SMTag
to]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
i SMTag
from, String -> Int -> SMTag -> Smb
f (Int -> String
getToJ Int
i) Int
i SMTag
from, Int -> SMTag -> Smb
e' Int
i SMTag
from, SMTag -> Smb
p4 SMTag
from],
            [Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
i SMTag
to, String -> Int -> SMTag -> Smb
f (Int -> String
getToJ Int
i) Int
i SMTag
to, Int -> SMTag -> Smb
e' Int
i SMTag
to, SMTag -> Smb
p4 SMTag
to]),
            ([Smb] -> Word
Word [SMTag -> Smb
q4 SMTag
from, SMTag -> Smb
r4 SMTag
from, SMTag -> Smb
s4 SMTag
from, SMTag -> Smb
t4 SMTag
from, SMTag -> Smb
u4 SMTag
from, SMTag -> Smb
pd4 SMTag
from, SMTag -> Smb
qd4 SMTag
from, SMTag -> Smb
rd4 SMTag
from, SMTag -> Smb
sd4 SMTag
from, SMTag -> Smb
td4 SMTag
from, SMTag -> Smb
ud4 SMTag
from, String -> Int -> SMTag -> Smb
f' (Int -> String
getToJ Int
i) Int
i SMTag
from],
            [Smb] -> Word
Word [SMTag -> Smb
q4 SMTag
to, SMTag -> Smb
r4 SMTag
to, SMTag -> Smb
s4 SMTag
to, SMTag -> Smb
t4 SMTag
to, SMTag -> Smb
u4 SMTag
to, SMTag -> Smb
pd4 SMTag
to, SMTag -> Smb
qd4 SMTag
to, SMTag -> Smb
rd4 SMTag
to, SMTag -> Smb
sd4 SMTag
to, SMTag -> Smb
td4 SMTag
to, SMTag -> Smb
ud4 SMTag
to, String -> Int -> SMTag -> Smb
f' (Int -> String
getToJ Int
i) Int
i SMTag
to])]
            ([(Word, Word)] -> [(Word, Word)])
-> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> a -> b
$ [[(Word, Word)]] -> [(Word, Word)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [[([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
j SMTag
from], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
j SMTag
to]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
j SMTag
from, String -> Int -> SMTag -> Smb
f (Int -> String
getToJ Int
j) Int
j SMTag
from, Int -> SMTag -> Smb
e' Int
j SMTag
from, Int -> SMTag -> Smb
p Int
j SMTag
from],
            [Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
j SMTag
to, String -> Int -> SMTag -> Smb
f (Int -> String
getToJ Int
j) Int
j SMTag
to, Int -> SMTag -> Smb
e' Int
j SMTag
to, Int -> SMTag -> Smb
p Int
j SMTag
to]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
q Int
j SMTag
from, Int -> SMTag -> Smb
r Int
j SMTag
from, Int -> SMTag -> Smb
s Int
j SMTag
from, Int -> SMTag -> Smb
t Int
j SMTag
from, Int -> SMTag -> Smb
u Int
j SMTag
from, Int -> SMTag -> Smb
pd Int
j SMTag
from, Int -> SMTag -> Smb
qd Int
j SMTag
from, Int -> SMTag -> Smb
rd Int
j SMTag
from, Int -> SMTag -> Smb
sd Int
j SMTag
from, Int -> SMTag -> Smb
td Int
j SMTag
from, Int -> SMTag -> Smb
ud Int
j SMTag
from, String -> Int -> SMTag -> Smb
f' (Int -> String
getToJ Int
j) Int
j SMTag
from],
            [Smb] -> Word
Word [Int -> SMTag -> Smb
q Int
j SMTag
to, Int -> SMTag -> Smb
r Int
j SMTag
to, Int -> SMTag -> Smb
s Int
j SMTag
to, Int -> SMTag -> Smb
t Int
j SMTag
to, Int -> SMTag -> Smb
u Int
j SMTag
to, Int -> SMTag -> Smb
pd Int
j SMTag
to, Int -> SMTag -> Smb
qd Int
j SMTag
to, Int -> SMTag -> Smb
rd Int
j SMTag
to, Int -> SMTag -> Smb
sd Int
j SMTag
to, Int -> SMTag -> Smb
td Int
j SMTag
to, Int -> SMTag -> Smb
ud Int
j SMTag
to, String -> Int -> SMTag -> Smb
f' (Int -> String
getToJ Int
j) Int
j SMTag
to])]
            | Int
j <- [Int
1 .. Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
k]]

    let rulealphaomega :: SRule
rulealphaomega =
            [(Word, Word)] -> SRule
SRule ([(Word, Word)] -> SRule) -> [(Word, Word)] -> SRule
forall a b. (a -> b) -> a -> b
$ [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
(++)
            [([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
0 SMTag
TAlpha], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
0 SMTag
TOmega]),
            ([Smb] -> Word
Word [String -> Int -> SMTag -> Smb
xIndex String
"2" Int
0 SMTag
TAlpha, SMTag -> Smb
f0 SMTag
TAlpha], [Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
0 SMTag
TOmega, SMTag -> Smb
f0 SMTag
TOmega]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
e' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
TAlpha, Int -> SMTag -> Smb
x' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
TAlpha], [Smb] -> Word
Word [Int -> SMTag -> Smb
e' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
TOmega, Int -> SMTag -> Smb
x' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
TOmega]),
            ([Smb] -> Word
Word [SMTag -> Smb
fl' SMTag
TAlpha], [Smb] -> Word
Word [SMTag -> Smb
fl' SMTag
TOmega])]
            ([(Word, Word)] -> [(Word, Word)])
-> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> a -> b
$ SMTag -> SMTag -> [(Word, Word)]
changeMachine SMTag
TAlpha SMTag
TOmega

    let ruleomega9 :: SRule
ruleomega9 =
            [(Word, Word)] -> SRule
SRule ([(Word, Word)] -> SRule) -> [(Word, Word)] -> SRule
forall a b. (a -> b) -> a -> b
$ [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
(++)
            [([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
0 SMTag
TOmega], [Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
0 SMTag
T9]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
0 SMTag
TOmega, SMTag -> Smb
f0 SMTag
TOmega], [Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
0 SMTag
T9, SMTag -> Smb
f0 SMTag
T9]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
e' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
TOmega, String -> Int -> SMTag -> Smb
xIndex' String
"2" (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
TOmega], [Smb] -> Word
Word [Int -> SMTag -> Smb
e' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
T9, Int -> SMTag -> Smb
x' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
T9]),
            ([Smb] -> Word
Word [SMTag -> Smb
fl' SMTag
TOmega], [Smb] -> Word
Word [SMTag -> Smb
fl' SMTag
T9])]
            ([(Word, Word)] -> [(Word, Word)])
-> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> a -> b
$ SMTag -> SMTag -> [(Word, Word)]
changeMachine SMTag
TOmega SMTag
T9

    let rule9 :: SRule
rule9 =
            [(Word, Word)] -> SRule
SRule ([(Word, Word)] -> SRule) -> [(Word, Word)] -> SRule
forall a b. (a -> b) -> a -> b
$ [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
(++)
            [([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
0 SMTag
T9], [Smb] -> Word
Word [Int -> Smb
eE Int
0]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
0 SMTag
T9, SMTag -> Smb
f0 SMTag
T9], [Smb] -> Word
Word [Int -> Smb
eX Int
0,  Smb
eF0]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
e' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
T9, Int -> SMTag -> Smb
x' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SMTag
T9], [Smb] -> Word
Word [Int -> Smb
eE' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Int -> Smb
eX' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)]),
            ([Smb] -> Word
Word [SMTag -> Smb
fl' SMTag
T9], [Smb] -> Word
Word [ Smb
eFl']),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
i SMTag
T9], [Smb] -> Word
Word [Int -> Smb
eE Int
i]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
xh Int
i SMTag
T9, String -> Int -> SMTag -> Smb
f (Int -> String
getToJ Int
i) Int
i SMTag
T9, Int -> SMTag -> Smb
e' Int
i SMTag
T9, String -> Int -> SMTag -> Smb
phIndex String
"1" Int
i SMTag
T9],
            [Smb] -> Word
Word [Int -> Smb
eX Int
i, String -> Int -> Smb
eF (Int -> String
getToJ Int
i) Int
i, Int -> Smb
eE' Int
i, Int -> Smb
eP Int
i]),
            ([Smb] -> Word
Word [String -> Int -> SMTag -> Smb
qhIndex String
"1" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
rhIndex String
"1" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
shIndex String
"1" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
thIndex String
"1" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
uhIndex String
"1" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
phdIndex String
"0" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
qhdIndex String
"0" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
rhdIndex String
"0" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
shdIndex String
"0" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
thdIndex String
"0" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
uhdIndex String
"0" Int
i SMTag
T9, String -> Int -> SMTag -> Smb
f' (Int -> String
getToJ Int
i) Int
i SMTag
T9],
            [Smb] -> Word
Word [Int -> Smb
eQ Int
i, Int -> Smb
eR Int
i, Int -> Smb
eS Int
i, Int -> Smb
eT Int
i, Int -> Smb
eU Int
i, Int -> Smb
ePd Int
i, Int -> Smb
eQd Int
i, Int -> Smb
eRd Int
i, Int -> Smb
eSd Int
i, Int -> Smb
eTd Int
i, Int -> Smb
eUd Int
i, String -> Int -> Smb
eF' (Int -> String
getToJ Int
i) Int
i])]
            ([(Word, Word)] -> [(Word, Word)])
-> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> a -> b
$ [[(Word, Word)]] -> [(Word, Word)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [[([Smb] -> Word
Word [Int -> SMTag -> Smb
e Int
j SMTag
T9], [Smb] -> Word
Word [Int -> Smb
eE Int
j]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
x Int
j SMTag
T9, String -> Int -> SMTag -> Smb
f (Int -> String
getToJ Int
j) Int
j SMTag
T9, Int -> SMTag -> Smb
e' Int
j SMTag
T9, Int -> SMTag -> Smb
p Int
j SMTag
T9],
            [Smb] -> Word
Word [Int -> Smb
eX Int
j, String -> Int -> Smb
eF (Int -> String
getToJ Int
j) Int
j, Int -> Smb
eE' Int
j, Int -> Smb
eP Int
j]),
            ([Smb] -> Word
Word [Int -> SMTag -> Smb
q Int
j SMTag
T9, Int -> SMTag -> Smb
r Int
j SMTag
T9, Int -> SMTag -> Smb
s Int
j SMTag
T9, Int -> SMTag -> Smb
t Int
j SMTag
T9, Int -> SMTag -> Smb
u Int
j SMTag
T9, Int -> SMTag -> Smb
pd Int
j SMTag
T9, Int -> SMTag -> Smb
qd Int
j SMTag
T9, Int -> SMTag -> Smb
rd Int
j SMTag
T9, Int -> SMTag -> Smb
sd Int
j SMTag
T9, Int -> SMTag -> Smb
td Int
j SMTag
T9, Int -> SMTag -> Smb
ud Int
j SMTag
T9, String -> Int -> SMTag -> Smb
f' (Int -> String
getToJ Int
j) Int
j SMTag
T9],
            [Smb] -> Word
Word [Int -> Smb
eQ Int
j, Int -> Smb
eR Int
j, Int -> Smb
eS Int
j, Int -> Smb
eT Int
j, Int -> Smb
eU Int
j, Int -> Smb
ePd Int
j, Int -> Smb
eQd Int
j, Int -> Smb
eRd Int
j, Int -> Smb
eSd Int
j, Int -> Smb
eTd Int
j, Int -> Smb
eUd Int
j, String -> Int -> Smb
eF' (Int -> String
getToJ Int
j) Int
j])]
            | Int
j <- [Int
1 .. Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
k] ]

    [SRule
rule4, SRule
rule4alpha, SRule
rulealphaomega, SRule
ruleomega9, SRule
rule9]

genPos22Rule :: TMCMD -> SRule
genPos22Rule :: TMCMD -> SRule
genPos22Rule TMCMD
cmd = do
    let (Command [TapeCommand]
command) = TMCMD
cmd
    let k :: Int
k = [TapeCommand] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TapeCommand]
command
    let (Square
_, Int
i) = [TapeCommand] -> (Square, Int)
getai [TapeCommand]
command
    let getFromJ :: Int -> String
getFromJ Int
j = String
a where (String
a, String
_) = [TapeCommand] -> Int -> (String, String)
getJIdx [TapeCommand]
command Int
j
    let getToJ :: Int -> String
getToJ Int
j = String
a where (String
_, String
a) = [TapeCommand] -> Int -> (String, String)
getJIdx [TapeCommand]
command Int
j
    [(Word, Word)] -> SRule
SRule ([(Word, Word)] -> SRule) -> [(Word, Word)] -> SRule
forall a b. (a -> b) -> a -> b
$ [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
(++)
        [([Smb] -> Word
Word [Int -> Smb
eE Int
i, Int -> Smb
eX Int
i, String -> Int -> Smb
eF (Int -> String
getFromJ Int
i) Int
i, Int -> Smb
eE' Int
i, Int -> Smb
eP Int
i, Int -> Smb
eQ Int
i, Int -> Smb
eR Int
i, Int -> Smb
eS Int
i, Int -> Smb
eT Int
i, Int -> Smb
eU Int
i, Int -> Smb
ePd Int
i, Int -> Smb
eQd Int
i, Int -> Smb
eRd Int
i, Int -> Smb
eSd Int
i, Int -> Smb
eTd Int
i, Int -> Smb
eUd Int
i, String -> Int -> Smb
eF' (Int -> String
getFromJ Int
i) Int
i],
        [Smb] -> Word
Word [Int -> Smb
eE Int
i, Int -> Smb
eX Int
i, String -> Int -> Smb
eF (Int -> String
getToJ Int
i) Int
i, Int -> Smb
eE' Int
i, Int -> Smb
eP Int
i, Int -> Smb
eQ Int
i, Int -> Smb
eR Int
i, Int -> Smb
eS Int
i, Int -> Smb
eT Int
i, Int -> Smb
eU Int
i, Int -> Smb
ePd Int
i, Int -> Smb
eQd Int
i, Int -> Smb
eRd Int
i, Int -> Smb
eSd Int
i, Int -> Smb
eTd Int
i, Int -> Smb
eUd Int
i, String -> Int -> Smb
eF' (Int -> String
getToJ Int
i) Int
i])]
        ([(Word, Word)] -> [(Word, Word)])
-> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> a -> b
$ [[(Word, Word)]] -> [(Word, Word)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [[([Smb] -> Word
Word [String -> Int -> Smb
eF (Int -> String
getFromJ Int
j) Int
j], [Smb] -> Word
Word [String -> Int -> Smb
eF (Int -> String
getToJ Int
j) Int
j]),
        ([Smb] -> Word
Word [String -> Int -> Smb
eF' (Int -> String
getFromJ Int
j) Int
j], [Smb] -> Word
Word [String -> Int -> Smb
eF' (Int -> String
getToJ Int
j) Int
j])]
        | Int
j <- [Int
1 .. Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
k]]

symSM :: SRule -> SRule
symSM :: SRule -> SRule
symSM (SRule [(Word, Word)]
wordPairs) = do
    let groupByWord :: [Smb] -> ([Smb], b) -> ([Smb], [Smb])
groupByWord [Smb]
w ([Smb]
left, b
other) =
            case [Smb]
w of
                smb :: Smb
smb@(SmbY Y
_) : [Smb]
t -> [Smb] -> ([Smb], b) -> ([Smb], [Smb])
groupByWord [Smb]
t (Smb
smb Smb -> [Smb] -> [Smb]
forall a. a -> [a] -> [a]
: [Smb]
left, b
other)
                smb :: Smb
smb@(SmbY' Y
_) : [Smb]
t -> [Smb] -> ([Smb], b) -> ([Smb], [Smb])
groupByWord [Smb]
t (Smb
smb Smb -> [Smb] -> [Smb]
forall a. a -> [a] -> [a]
: [Smb]
left, b
other)
                Smb
smb : [Smb]
t -> ([Smb] -> [Smb]
forall a. [a] -> [a]
reverse [Smb]
left, Smb
smb Smb -> [Smb] -> [Smb]
forall a. a -> [a] -> [a]
: [Smb]
t)
                [] -> String -> ([Smb], [Smb])
forall a. HasCallStack => String -> a
error String
"There is no state in word"
    let reverseYs :: Smb -> Smb
reverseYs Smb
smb = case Smb
smb of
                            SmbY Y
y -> Y -> Smb
SmbY' Y
y
                            SmbY' Y
y -> Y -> Smb
SmbY Y
y
                            Smb
_ -> String -> Smb
forall a. HasCallStack => String -> a
error (Smb -> String
forall a. Show a => a -> String
show Smb
smb)
    let mapWords :: (Word, Word) -> (Word, Word)
mapWords (Word [Smb]
w1, Word [Smb]
w2) = ([Smb] -> Word
Word [Smb]
midle, [Smb] -> Word
Word ([Smb] -> Word) -> [Smb] -> Word
forall a b. (a -> b) -> a -> b
$ [Smb]
reversedLeftYs [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [Smb]
w1 [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [Smb]
reversedRightYs)
                                        where
                                            ([Smb]
left, [Smb]
other1) = [Smb] -> ([Smb], [Any]) -> ([Smb], [Smb])
forall b. [Smb] -> ([Smb], b) -> ([Smb], [Smb])
groupByWord [Smb]
w2 ([], [])
                                            ([Smb]
right, [Smb]
midle) = ([Smb] -> [Smb]) -> ([Smb], [Smb]) -> ([Smb], [Smb])
forall a b. (a -> b) -> (a, a) -> (b, b)
mapTuple [Smb] -> [Smb]
forall a. [a] -> [a]
reverse (([Smb], [Smb]) -> ([Smb], [Smb]))
-> ([Smb], [Smb]) -> ([Smb], [Smb])
forall a b. (a -> b) -> a -> b
$ [Smb] -> ([Smb], [Any]) -> ([Smb], [Smb])
forall b. [Smb] -> ([Smb], b) -> ([Smb], [Smb])
groupByWord ([Smb] -> [Smb]
forall a. [a] -> [a]
reverse [Smb]
other1) ([], [])
                                            reversedLeftYs :: [Smb]
reversedLeftYs = (Smb -> Smb) -> [Smb] -> [Smb]
forall a b. (a -> b) -> [a] -> [b]
map Smb -> Smb
reverseYs [Smb]
left
                                            reversedRightYs :: [Smb]
reversedRightYs = (Smb -> Smb) -> [Smb] -> [Smb]
forall a b. (a -> b) -> [a] -> [b]
map Smb -> Smb
reverseYs [Smb]
right

    [(Word, Word)] -> SRule
SRule ([(Word, Word)] -> SRule) -> [(Word, Word)] -> SRule
forall a b. (a -> b) -> a -> b
$ ((Word, Word) -> (Word, Word)) -> [(Word, Word)] -> [(Word, Word)]
forall a b. (a -> b) -> [a] -> [b]
map (Word, Word) -> (Word, Word)
mapWords [(Word, Word)]
wordPairs

sigmaFunc :: [TMType.State] -> [[Smb]] -> SMType.Word
sigmaFunc :: [State] -> [[Smb]] -> Word
sigmaFunc [State]
states [[Smb]]
u =
    [Smb] -> Word
Word ([Smb] -> Word) -> [Smb] -> Word
forall a b. (a -> b) -> a -> b
$
    Int -> Smb
eE Int
0 Smb -> [Smb] -> [Smb]
forall a. a -> [a] -> [a]
: [Smb]
alphan [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [Int -> Smb
eX Int
0, String -> Int -> Smb
eF String
"" Int
0] [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++
    ((Int, State, [Smb], [Smb]) -> [Smb])
-> [(Int, State, [Smb], [Smb])] -> [Smb]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
    (\(Int
i, TMType.State String
q, [Smb]
d, [Smb]
w) ->
        Int -> Smb
eE Int
i Smb -> [Smb] -> [Smb]
forall a. a -> [a] -> [a]
: [Smb]
w [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [Int -> Smb
eX Int
i, String -> Int -> Smb
eF String
q Int
i, Int -> Smb
eE' Int
i, Int -> Smb
eP Int
i] [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [Smb]
d
                  [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [Int -> Smb
eQ Int
i, Int -> Smb
eR Int
i, Int -> Smb
eS Int
i, Int -> Smb
eT Int
i, Int -> Smb
eU Int
i, Int -> Smb
ePd Int
i, Int -> Smb
eQd Int
i, Int -> Smb
eRd Int
i, Int -> Smb
eSd Int
i, Int -> Smb
eTd Int
i, Int -> Smb
eUd Int
i, String -> Int -> Smb
eF' String
q Int
i]) ([Int]
-> [State] -> [[Smb]] -> [[Smb]] -> [(Int, State, [Smb], [Smb])]
forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 [Int
1..] [State]
states [[Smb]]
deltan [[Smb]]
u) [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++
    [Int -> Smb
eE' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Int -> Smb
eX' (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)] [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [Smb]
omegan [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [String -> Int -> Smb
eF' String
"" (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)]
    where
            un :: [Int]
un = ([Smb] -> Int) -> [[Smb]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Smb] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Smb]]
u
            k :: Int
k = [State] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [State]
states
            n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
un
            alphan :: [Smb]
alphan = Int -> Smb -> [Smb]
forall a. Int -> a -> [a]
replicate Int
n (Smb -> [Smb]) -> Smb -> [Smb]
forall a b. (a -> b) -> a -> b
$ Y -> Smb
SmbY Y
Alpha
            omegan :: [Smb]
omegan = Int -> Smb -> [Smb]
forall a. Int -> a -> [a]
replicate Int
n (Smb -> [Smb]) -> Smb -> [Smb]
forall a b. (a -> b) -> a -> b
$ Y -> Smb
SmbY Y
Omega
            deltan :: [[Smb]]
deltan = (Int -> [Smb]) -> [Int] -> [[Smb]]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Smb -> [Smb]
forall a. Int -> a -> [a]
replicate Int
i (Smb -> [Smb]) -> Smb -> [Smb]
forall a b. (a -> b) -> a -> b
$ Y -> Smb
SmbY Y
Delta) [Int]
un

renameRightLeftBoundings :: [[TMType.TapeCommand]] -> [[TMType.TapeCommand]]
renameRightLeftBoundings :: [[TapeCommand]] -> [[TapeCommand]]
renameRightLeftBoundings = ([TapeCommand] -> [TapeCommand])
-> [[TapeCommand]] -> [[TapeCommand]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [TapeCommand] -> [TapeCommand] -> [TapeCommand]
renameRightLeftBoundingsInternal Int
1 [])
    where
        f :: State -> StateOmega
f State
q = State -> StateOmega
TMType.StateOmega State
q
        renameRightLeftBoundingsInternal :: Int -> [TapeCommand] -> [TapeCommand] -> [TapeCommand]
renameRightLeftBoundingsInternal Int
i [TapeCommand]
acc [TapeCommand]
command =
            case [TapeCommand]
command of
                TMType.SingleTapeCommand ((Square
l1, State
s1, Square
_), (Square
l2, State
s2, Square
_)) : [TapeCommand]
t
                    | Square
l1 Square -> Square -> Bool
forall a. Eq a => a -> a -> Bool
== Square
TMType.LBS -> Int -> [TapeCommand] -> [TapeCommand] -> [TapeCommand]
renameRightLeftBoundingsInternal (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (((Square, StateOmega), (Square, StateOmega)) -> TapeCommand
TMType.PreSMCommand ((Square
newRight, StateOmega
newS1), (Square
newRight, StateOmega
newS2)) TapeCommand -> [TapeCommand] -> [TapeCommand]
forall a. a -> [a] -> [a]
: [TapeCommand]
acc) [TapeCommand]
t
                    | Bool
otherwise -> Int -> [TapeCommand] -> [TapeCommand] -> [TapeCommand]
renameRightLeftBoundingsInternal (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (((Square, StateOmega), (Square, StateOmega)) -> TapeCommand
TMType.PreSMCommand ((Square
l1, StateOmega
newS1), (Square
l2, StateOmega
newS2)) TapeCommand -> [TapeCommand] -> [TapeCommand]
forall a. a -> [a] -> [a]
: [TapeCommand]
acc) [TapeCommand]
t
                        where   newRight :: Square
newRight = Int -> Square
TMType.E Int
i
                                newS1 :: StateOmega
newS1 = State -> StateOmega
f State
s1
                                newS2 :: StateOmega
newS2 = State -> StateOmega
f State
s2
                [] -> [TapeCommand] -> [TapeCommand]
forall a. [a] -> [a]
reverse [TapeCommand]
acc
                TMType.PreSMCommand ((Square, StateOmega), (Square, StateOmega))
_ : [TapeCommand]
_ -> String -> [TapeCommand]
forall a. HasCallStack => String -> a
error String
"PreSMCommand found"

tm2sm :: TMType.TM -> (SM, SMType.Word, [TMType.State])
tm2sm :: TM -> (SM, Word, [State])
tm2sm (TMType.TM (InputAlphabet
_,
        [TapeAlphabet]
tapeAlphabets,
        TMType.MultiTapeStates [Set State]
tapesStates,
        TMType.Commands Set [TapeCommand]
commandsSet,
        TMType.StartStates [State]
startStates,
        TMType.AccessStates [State]
accessStates)
        ) =
    let numOfTapes :: Int
numOfTapes = [TapeAlphabet] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TapeAlphabet]
tapeAlphabets
        gamma :: [SMTag]
gamma = [SMTag
T4, SMTag
T9, SMTag
TAlpha, SMTag
TOmega]
        y :: [[Y]]
y = (TapeAlphabet -> [Y]) -> [TapeAlphabet] -> [[Y]]
forall a b. (a -> b) -> [a] -> [b]
map (\(TMType.TapeAlphabet Set Square
a) -> (Square -> Y) -> [Square] -> [Y]
forall a b. (a -> b) -> [a] -> [b]
map Square -> Y
Y ([Square] -> [Y]) -> [Square] -> [Y]
forall a b. (a -> b) -> a -> b
$ Set Square -> [Square]
forall a. Set a -> [a]
Set.toList Set Square
a) [TapeAlphabet]
tapeAlphabets
        getFinalForTape :: Set Tag -> [[State]]
getFinalForTape Set Tag
tag = (Int -> [State] -> [State]) -> [Int] -> [[State]] -> [[State]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i [State]
idxs -> (State -> State) -> [State] -> [State]
forall a b. (a -> b) -> [a] -> [b]
map (\(TMType.State String
idx) -> StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
F String
idx Set Tag
tag (Maybe StateVal -> State) -> Maybe StateVal -> State
forall a b. (a -> b) -> a -> b
$ Int -> Maybe StateVal
standardV Int
i) [State]
idxs) [Int
1 .. Int
numOfTapes] ([[State]] -> [[State]]) -> [[State]] -> [[State]]
forall a b. (a -> b) -> a -> b
$ (Set State -> [State]) -> [Set State] -> [[State]]
forall a b. (a -> b) -> [a] -> [b]
map Set State -> [State]
forall a. Set a -> [a]
Set.toList [Set State]
tapesStates
        standatdState :: StateName -> Set Tag -> [[State]]
standatdState StateName
name Set Tag
tags = [[StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
name String
"" Set Tag
tags (Int -> Maybe StateVal
standardV Int
i)]  | Int
i <- [Int
1..Int
numOfTapes]]
        es :: [[State]]
es = (:) [StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
E String
"" Set Tag
eTag (Maybe StateVal -> State) -> Maybe StateVal -> State
forall a b. (a -> b) -> a -> b
$ Int -> Maybe StateVal
standardV Int
0] ([[State]] -> [[State]]) -> [[State]] -> [[State]]
forall a b. (a -> b) -> a -> b
$ StateName -> Set Tag -> [[State]]
standatdState StateName
E Set Tag
eTag
        e's :: [[State]]
e's = StateName -> Set Tag -> [[State]]
standatdState StateName
E Set Tag
quoteTag [[State]] -> [[State]] -> [[State]]
forall a. [a] -> [a] -> [a]
++ [[StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
E String
"" Set Tag
quoteTag (Maybe StateVal -> State)
-> (Int -> Maybe StateVal) -> Int -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe StateVal
standardV (Int -> State) -> Int -> State
forall a b. (a -> b) -> a -> b
$ Int
numOfTapes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]]
        fs :: [[State]]
fs = (:) [StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
F String
"" Set Tag
eTag (Maybe StateVal -> State) -> Maybe StateVal -> State
forall a b. (a -> b) -> a -> b
$ Int -> Maybe StateVal
standardV Int
0] ([[State]] -> [[State]]) -> [[State]] -> [[State]]
forall a b. (a -> b) -> a -> b
$ Set Tag -> [[State]]
getFinalForTape Set Tag
eTag
        f's :: [[State]]
f's = Set Tag -> [[State]]
getFinalForTape Set Tag
quoteTag [[State]] -> [[State]] -> [[State]]
forall a. [a] -> [a] -> [a]
++ [[StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
F String
"" Set Tag
quoteTag (Maybe StateVal -> State)
-> (Int -> Maybe StateVal) -> Int -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe StateVal
standardV (Int -> State) -> Int -> State
forall a b. (a -> b) -> a -> b
$ Int
numOfTapes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]]
        xs :: [[State]]
xs = [[StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
X String
"" Set Tag
eTag (Int -> Maybe StateVal
standardV Int
i)]  | Int
i <- [Int
0 .. Int
numOfTapes]] [[State]] -> [[State]] -> [[State]]
forall a. [a] -> [a] -> [a]
++ [[StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
X String
"" Set Tag
quoteTag (Maybe StateVal -> State)
-> (Int -> Maybe StateVal) -> Int -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe StateVal
standardV (Int -> State) -> Int -> State
forall a b. (a -> b) -> a -> b
$ Int
numOfTapes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]]
        [[[State]]
ps,[[State]]
qs,[[State]]
rs,[[State]]
ss,[[State]]
ts,[[State]]
us,[[State]]
pds,[[State]]
qds,[[State]]
rds,[[State]]
sds,[[State]]
tds,[[State]]
uds] = [StateName -> Set Tag -> [[State]]
standatdState StateName
name Set Tag
tag | StateName
name <- [StateName
P, StateName
Q, StateName
R, StateName
S, StateName
T, StateName
U], Set Tag
tag <- [Set Tag
eTag, Set Tag
dashTag]]
        standardStates :: [[State]]
standardStates = [[[State]]] -> [[State]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[State]]
es, [[State]]
e's, [[State]]
fs, [[State]]
f's, [[State]]
xs, [[State]]
ps, [[State]]
qs, [[State]]
rs, [[State]]
ss, [[State]]
ts, [[State]]
us, [[State]]
pds, [[State]]
qds, [[State]]
rds, [[State]]
sds, [[State]]
tds, [[State]]
uds]

        commands :: [[TapeCommand]]
commands = [[TapeCommand]] -> [[TapeCommand]]
renameRightLeftBoundings ([[TapeCommand]] -> [[TapeCommand]])
-> [[TapeCommand]] -> [[TapeCommand]]
forall a b. (a -> b) -> a -> b
$ Set [TapeCommand] -> [[TapeCommand]]
forall a. Set a -> [a]
Set.toList Set [TapeCommand]
commandsSet
        ([[TapeCommand]]
pos21, [[TapeCommand]]
pos22, [[TapeCommand]]
_, [[TapeCommand]]
_) = [[TapeCommand]]
-> ([[TapeCommand]], [[TapeCommand]], [[TapeCommand]],
    [[TapeCommand]])
splitPosNegCmds [[TapeCommand]]
commands
        sms :: [[SM]]
sms = [[TMCMD -> SM
f (TMCMD -> SM) -> TMCMD -> SM
forall a b. (a -> b) -> a -> b
$ [TapeCommand] -> TMCMD
Command [TapeCommand]
c | TMCMD -> SM
f <- (SM -> SMTag -> TMCMD -> SM) -> [SM] -> [SMTag] -> [TMCMD -> SM]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith SM -> SMTag -> TMCMD -> SM
copySMForCommand ([Y] -> [SM]
createSMs ([Y] -> [SM]) -> [Y] -> [SM]
forall a b. (a -> b) -> a -> b
$ [[Y]] -> Int -> [Y]
forall a. [a] -> Int -> a
(!!) [[Y]]
y (Int -> [Y]) -> Int -> [Y]
forall a b. (a -> b) -> a -> b
$ (Square, Int) -> Int
forall a b. (a, b) -> b
snd ([TapeCommand] -> (Square, Int)
getai [TapeCommand]
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [SMTag]
gamma] | [TapeCommand]
c <- [[TapeCommand]]
pos21 ]
        smsRules :: [SRule]
smsRules = (SM -> [SRule]) -> [SM] -> [SRule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SM -> [SRule]
srs ([SM] -> [SRule]) -> [SM] -> [SRule]
forall a b. (a -> b) -> a -> b
$ [[SM]] -> [SM]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[SM]]
sms
        groupByStates :: Set State -> Set State -> Bool
groupByStates Set State
s1 Set State
s2 = State -> StateName
s_name State
e1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== State -> StateName
s_name State
e2
                                Bool -> Bool -> Bool
&& Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
Dash Set Tag
tag1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
Dash Set Tag
tag2
                                Bool -> Bool -> Bool
&& Int
id1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
id2
                                Bool -> Bool -> Bool
&& (State -> StateName
s_name State
e1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
/= StateName
E Bool -> Bool -> Bool
|| Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag2)
                                Bool -> Bool -> Bool
&& (State -> StateName
s_name State
e1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
/= StateName
F Bool -> Bool -> Bool
|| Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag2)
                                where   e1 :: State
e1 = Int -> Set State -> State
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set State
s1
                                        e2 :: State
e2 = Int -> Set State -> State
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set State
s2
                                        tag1 :: Set Tag
tag1 = State -> Set Tag
s_tags State
e1
                                        tag2 :: Set Tag
tag2 = State -> Set Tag
s_tags State
e2
                                        id1 :: Int
id1 = StateVal -> Int
tape (StateVal -> Int)
-> (Maybe StateVal -> StateVal) -> Maybe StateVal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> Int) -> Maybe StateVal -> Int
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
e1
                                        id2 :: Int
id2 = StateVal -> Int
tape (StateVal -> Int)
-> (Maybe StateVal -> StateVal) -> Maybe StateVal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> Int) -> Maybe StateVal -> Int
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
e2
        sortByNames :: Set State -> Set State -> Ordering
sortByNames Set State
s1 Set State
s2 = (StateName, Int, Bool, Bool, Bool)
-> (StateName, Int, Bool, Bool, Bool) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (State -> StateName
s_name State
e1, Int
id1, Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
Dash Set Tag
tag1, Bool
be1, Bool
bf1) (State -> StateName
s_name State
e2, Int
id2, Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
Dash Set Tag
tag2, Bool
be2, Bool
bf2)
                                where   e1 :: State
e1 = Int -> Set State -> State
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set State
s1
                                        e2 :: State
e2 = Int -> Set State -> State
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set State
s2
                                        tag1 :: Set Tag
tag1 = State -> Set Tag
s_tags State
e1
                                        tag2 :: Set Tag
tag2 = State -> Set Tag
s_tags State
e2
                                        id1 :: Int
id1 = StateVal -> Int
tape (StateVal -> Int)
-> (Maybe StateVal -> StateVal) -> Maybe StateVal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> Int) -> Maybe StateVal -> Int
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
e1
                                        id2 :: Int
id2 = StateVal -> Int
tape (StateVal -> Int)
-> (Maybe StateVal -> StateVal) -> Maybe StateVal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> Int) -> Maybe StateVal -> Int
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
e2
                                        be1 :: Bool
be1 = State -> StateName
s_name State
e1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== StateName
E Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag1
                                        be2 :: Bool
be2 = State -> StateName
s_name State
e2 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== StateName
E Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag2
                                        bf1 :: Bool
bf1 = State -> StateName
s_name State
e1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== StateName
F Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag1
                                        bf2 :: Bool
bf2 = State -> StateName
s_name State
e2 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== StateName
F Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag2
        filterSmsStates :: Set State -> Bool
filterSmsStates Set State
s = State -> StateName
s_name State
e StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
/= StateName
F
                                where   e :: State
e = Int -> Set State -> State
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set State
s
        smsStates :: [Set State]
smsStates = (Set State -> Bool) -> [Set State] -> [Set State]
forall a. (a -> Bool) -> [a] -> [a]
filter Set State -> Bool
filterSmsStates ([Set State] -> [Set State])
-> ([[SM]] -> [Set State]) -> [[SM]] -> [Set State]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SM] -> [Set State]) -> [[SM]] -> [Set State]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([Set State] -> Set State) -> [[Set State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [Set State] -> Set State
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([[Set State]] -> [Set State])
-> ([SM] -> [[Set State]]) -> [SM] -> [Set State]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Set State]] -> [[Set State]]
forall a. [[a]] -> [[a]]
transpose ([[Set State]] -> [[Set State]])
-> ([SM] -> [[Set State]]) -> [SM] -> [[Set State]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SM -> [Set State]) -> [SM] -> [[Set State]]
forall a b. (a -> b) -> [a] -> [b]
map SM -> [Set State]
qn) ([[SM]] -> [Set State]) -> [[SM]] -> [Set State]
forall a b. (a -> b) -> a -> b
$ [[SM]] -> [[SM]]
forall a. [[a]] -> [[a]]
transpose [[SM]]
sms
        otherStates :: [[State]]
otherStates = [[State
s {s_val :: Maybe StateVal
s_val = StateVal -> Maybe StateVal
forall a. a -> Maybe a
Just (StateVal -> Maybe StateVal) -> StateVal -> Maybe StateVal
forall a b. (a -> b) -> a -> b
$ (Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> StateVal) -> Maybe StateVal -> StateVal
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
s) {tmCommand :: Maybe TMCMD
tmCommand = TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just (TMCMD -> Maybe TMCMD) -> TMCMD -> Maybe TMCMD
forall a b. (a -> b) -> a -> b
$ [TapeCommand] -> TMCMD
Command [TapeCommand]
c, smTag :: Maybe SMTag
smTag = SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
g}} | State
s <- [State]
state ] | SMTag
g <- [SMTag]
gamma, [TapeCommand]
c <- [[TapeCommand]]
pos21, [State]
state <- [[State]]
standardStates]
        smsConnectingRules :: [SRule]
smsConnectingRules = ([TapeCommand] -> [SRule]) -> [[TapeCommand]] -> [SRule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TMCMD -> [SRule]
genConnectingRules (TMCMD -> [SRule])
-> ([TapeCommand] -> TMCMD) -> [TapeCommand] -> [SRule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TapeCommand] -> TMCMD
Command) [[TapeCommand]]
pos21
        crStates :: [[State]]
crStates = (State -> State -> Bool) -> [State] -> [[State]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy State -> State -> Bool
groupByStatesFunc ([State] -> [[State]])
-> ([SRule] -> [State]) -> [SRule] -> [[State]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State -> State -> Ordering) -> [State] -> [State]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy State -> State -> Ordering
sortByNamesStates ([State] -> [State]) -> ([SRule] -> [State]) -> [SRule] -> [State]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SRule -> [State]) -> [SRule] -> [State]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SRule -> [State]
getStatesFromRule ([SRule] -> [[State]]) -> [SRule] -> [[State]]
forall a b. (a -> b) -> a -> b
$ [SRule]
smsConnectingRules
                where
                        getStatesFromWord :: Smb -> Maybe State
getStatesFromWord (SmbQ State
q) = State -> Maybe State
forall a. a -> Maybe a
Just State
q
                        getStatesFromWord Smb
_ = Maybe State
forall a. Maybe a
Nothing
                        getStatesFromWords :: (Word, Word) -> [State]
getStatesFromWords (Word [Smb]
l, Word [Smb]
r) = (Smb -> Maybe State) -> [Smb] -> [State]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Smb -> Maybe State
getStatesFromWord ([Smb]
l [Smb] -> [Smb] -> [Smb]
forall a. [a] -> [a] -> [a]
++ [Smb]
r)
                        getStatesFromRule :: SRule -> [State]
getStatesFromRule (SRule [(Word, Word)]
r) = ((Word, Word) -> [State]) -> [(Word, Word)] -> [State]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Word, Word) -> [State]
getStatesFromWords [(Word, Word)]
r
                        groupByStatesFunc :: State -> State -> Bool
groupByStatesFunc State
s1 State
s2 = State -> StateName
s_name State
s1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== State -> StateName
s_name State
s2
                                            Bool -> Bool -> Bool
&& Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
Dash Set Tag
tag1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
Dash Set Tag
tag2
                                            Bool -> Bool -> Bool
&& Int
id1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
id2
                                            Bool -> Bool -> Bool
&& (State -> StateName
s_name State
s1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
/= StateName
E Bool -> Bool -> Bool
|| Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag2)
                                            Bool -> Bool -> Bool
&& (State -> StateName
s_name State
s1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
/= StateName
F Bool -> Bool -> Bool
|| Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag2)
                                            where   tag1 :: Set Tag
tag1 = State -> Set Tag
s_tags State
s1
                                                    tag2 :: Set Tag
tag2 = State -> Set Tag
s_tags State
s2
                                                    id1 :: Int
id1 = StateVal -> Int
tape (StateVal -> Int)
-> (Maybe StateVal -> StateVal) -> Maybe StateVal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> Int) -> Maybe StateVal -> Int
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
s1
                                                    id2 :: Int
id2 = StateVal -> Int
tape (StateVal -> Int)
-> (Maybe StateVal -> StateVal) -> Maybe StateVal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> Int) -> Maybe StateVal -> Int
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
s2
                        sortByNamesStates :: State -> State -> Ordering
sortByNamesStates State
s1 State
s2 = (StateName, Int, Bool, Bool, Bool)
-> (StateName, Int, Bool, Bool, Bool) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (State -> StateName
s_name State
s1, Int
id1, Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
Dash Set Tag
tag1, Bool
be1, Bool
bf1) (State -> StateName
s_name State
s2, Int
id2, Tag -> Set Tag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Tag
Dash Set Tag
tag2, Bool
be2, Bool
bf2)
                                            where   tag1 :: Set Tag
tag1 = State -> Set Tag
s_tags State
s1
                                                    tag2 :: Set Tag
tag2 = State -> Set Tag
s_tags State
s2
                                                    id1 :: Int
id1 = StateVal -> Int
tape (StateVal -> Int)
-> (Maybe StateVal -> StateVal) -> Maybe StateVal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> Int) -> Maybe StateVal -> Int
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
s1
                                                    id2 :: Int
id2 = StateVal -> Int
tape (StateVal -> Int)
-> (Maybe StateVal -> StateVal) -> Maybe StateVal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe StateVal -> StateVal
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StateVal -> Int) -> Maybe StateVal -> Int
forall a b. (a -> b) -> a -> b
$ State -> Maybe StateVal
s_val State
s2
                                                    be1 :: Bool
be1 = State -> StateName
s_name State
s1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== StateName
E Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag1
                                                    be2 :: Bool
be2 = State -> StateName
s_name State
s2 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== StateName
E Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag2
                                                    bf1 :: Bool
bf1 = State -> StateName
s_name State
s1 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== StateName
F Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag1
                                                    bf2 :: Bool
bf2 = State -> StateName
s_name State
s2 StateName -> StateName -> Bool
forall a. Eq a => a -> a -> Bool
== StateName
F Bool -> Bool -> Bool
&& Set Tag -> Bool
forall a. Set a -> Bool
Set.null Set Tag
tag2
        finalSmStates :: [Set State]
finalSmStates = ([Set State] -> Set State) -> [[Set State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [Set State] -> Set State
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([[Set State]] -> [Set State])
-> ([Set State] -> [[Set State]]) -> [Set State] -> [Set State]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set State -> Set State -> Bool) -> [Set State] -> [[Set State]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Set State -> Set State -> Bool
groupByStates ([Set State] -> [[Set State]])
-> ([Set State] -> [Set State]) -> [Set State] -> [[Set State]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set State -> Set State -> Ordering) -> [Set State] -> [Set State]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Set State -> Set State -> Ordering
sortByNames ([Set State] -> [Set State]) -> [Set State] -> [Set State]
forall a b. (a -> b) -> a -> b
$ ([State] -> Set State) -> [[State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [State] -> Set State
forall a. Ord a => [a] -> Set a
Set.fromList [[State]]
standardStates [Set State] -> [Set State] -> [Set State]
forall a. [a] -> [a] -> [a]
++ ([State] -> Set State) -> [[State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [State] -> Set State
forall a. Ord a => [a] -> Set a
Set.fromList [[State]]
otherStates [Set State] -> [Set State] -> [Set State]
forall a. [a] -> [a] -> [a]
++ [Set State]
smsStates [Set State] -> [Set State] -> [Set State]
forall a. [a] -> [a] -> [a]
++ ([State] -> Set State) -> [[State]] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map [State] -> Set State
forall a. Ord a => [a] -> Set a
Set.fromList [[State]]
crStates
        smsPos22Rules :: [SRule]
smsPos22Rules = ([TapeCommand] -> SRule) -> [[TapeCommand]] -> [SRule]
forall a b. (a -> b) -> [a] -> [b]
map (TMCMD -> SRule
genPos22Rule (TMCMD -> SRule)
-> ([TapeCommand] -> TMCMD) -> [TapeCommand] -> SRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TapeCommand] -> TMCMD
Command) [[TapeCommand]]
pos22

        finalSmRules :: [SRule]
finalSmRules = [SRule]
smsRules [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ [SRule]
smsConnectingRules [SRule] -> [SRule] -> [SRule]
forall a. [a] -> [a] -> [a]
++ [SRule]
smsPos22Rules
        --symmFinalSmRules = (++) finalSmRules $ map symSM finalSmRules

    in
        ([[Y]] -> [Set State] -> [SRule] -> SM
SM [[Y]]
y [Set State]
finalSmStates [SRule]
finalSmRules, [State] -> [[Smb]] -> Word
sigmaFunc [State]
accessStates ([[Smb]] -> Word) -> [[Smb]] -> Word
forall a b. (a -> b) -> a -> b
$ Int -> [Smb] -> [[Smb]]
forall a. Int -> a -> [a]
replicate Int
numOfTapes [], [State]
startStates)