module TM2SMHelpers where

import SMType
import Data.Set (Set)
import qualified Data.Set as Set
import qualified TMType

eTag :: Set Tag
eTag :: Set Tag
eTag = [Tag] -> Set Tag
forall a. Ord a => [a] -> Set a
Set.fromList []
standardV :: Int -> Maybe StateVal
standardV :: Int -> Maybe StateVal
standardV Int
i = StateVal -> Maybe StateVal
forall a. a -> Maybe a
Just (StateVal -> Maybe StateVal) -> StateVal -> Maybe StateVal
forall a b. (a -> b) -> a -> b
$ Int -> Maybe TMCMD -> Maybe SMTag -> StateVal
StateVal Int
i Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eTagState :: StateName -> String -> State
eTagState :: StateName -> String -> State
eTagState StateName
name String
i = StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
name String
i Set Tag
eTag Maybe StateVal
forall a. Maybe a
Nothing
genRange :: Show a => StateName -> [a] -> [State]
genRange :: StateName -> [a] -> [State]
genRange StateName
name [a]
range = [StateName -> String -> State
eTagState StateName
name (a -> String
forall a. Show a => a -> String
show a
i) | a
i <- [a]
range]
gen :: StateName -> [State]
gen :: StateName -> [State]
gen StateName
name = StateName -> [Integer] -> [State]
forall a. Show a => StateName -> [a] -> [State]
genRange StateName
name [Integer
0..Integer
4]
addTag :: Tag -> State -> State
addTag :: Tag -> State -> State
addTag Tag
newTag State
q = State
q {s_tags :: Set Tag
s_tags = Tag -> Set Tag -> Set Tag
forall a. Ord a => a -> Set a -> Set a
Set.insert Tag
newTag (State -> Set Tag
s_tags State
q) }
addTags :: [Tag] -> [State] -> [State]
addTags :: [Tag] -> [State] -> [State]
addTags [Tag]
newTags [State]
qs = [Tag -> State -> State
addTag Tag
newTag State
p | State
p <- [State]
qs, Tag
newTag <- [Tag]
newTags]
getai :: [TMType.TapeCommand] -> (TMType.Square, Int)
getai :: [TapeCommand] -> (Square, Int)
getai [TapeCommand]
c =
    let get :: [TapeCommand] -> t -> (Square, t)
get [TapeCommand]
cmd t
i =
            case [TapeCommand]
cmd of
                TMType.PreSMCommand ((Square
a, StateOmega
_), (Square, StateOmega)
_) : [TapeCommand]
t
                    | Square
a Square -> Square -> Bool
forall a. Eq a => a -> a -> Bool
/= Square
TMType.ES -> (Square
a, t
i)
                    | Bool
otherwise -> [TapeCommand] -> t -> (Square, t)
get [TapeCommand]
t (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
                [TapeCommand]
_ -> String -> (Square, t)
forall a. HasCallStack => String -> a
error String
"Must be PreSMCommand"
    in
    [TapeCommand] -> Int -> (Square, Int)
forall t. Num t => [TapeCommand] -> t -> (Square, t)
get [TapeCommand]
c Int
1

addICmdSmTag :: TMCMD -> SMTag -> State -> State
addICmdSmTag :: TMCMD -> SMTag -> State -> State
addICmdSmTag TMCMD
cmd SMTag
tag State
q =
    let (Command [TapeCommand]
c) = TMCMD
cmd
        (Square
_, Int
j) = [TapeCommand] -> (Square, Int)
getai [TapeCommand]
c
    in
    case SMTag
tag of
        SMTag
T4 -> State
q {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
$ Int -> Maybe TMCMD -> Maybe SMTag -> StateVal
StateVal Int
j Maybe TMCMD
jcmd Maybe SMTag
jsmtag}
        SMTag
T9 -> State
q {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
$ Int -> Maybe TMCMD -> Maybe SMTag -> StateVal
StateVal Int
j Maybe TMCMD
jcmd Maybe SMTag
jsmtag}
        SMTag
TAlpha -> State
q {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
$ Int -> Maybe TMCMD -> Maybe SMTag -> StateVal
StateVal Int
0 Maybe TMCMD
jcmd Maybe SMTag
jsmtag}
        SMTag
TOmega -> State
q {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
$ Int -> Maybe TMCMD -> Maybe SMTag -> StateVal
StateVal (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe TMCMD
jcmd Maybe SMTag
jsmtag}
            where
                k :: Int
k = [TapeCommand] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TapeCommand]
c
    where   jcmd :: Maybe TMCMD
jcmd = TMCMD -> Maybe TMCMD
forall a. a -> Maybe a
Just TMCMD
cmd
            jsmtag :: Maybe SMTag
jsmtag = SMTag -> Maybe SMTag
forall a. a -> Maybe a
Just SMTag
tag

quoteTag :: Set Tag
quoteTag :: Set Tag
quoteTag = [Tag] -> Set Tag
forall a. Ord a => [a] -> Set a
Set.fromList [Tag
Quote]
dashTag :: Set Tag
dashTag :: Set Tag
dashTag = [Tag] -> Set Tag
forall a. Ord a => [a] -> Set a
Set.fromList [Tag
Dash]
hatTag :: Set Tag
hatTag :: Set Tag
hatTag = [Tag] -> Set Tag
forall a. Ord a => [a] -> Set a
Set.fromList [Tag
Hat]
hatdashTag :: Set Tag
hatdashTag :: Set Tag
hatdashTag = [Tag] -> Set Tag
forall a. Ord a => [a] -> Set a
Set.fromList [Tag
Hat, Tag
Dash]
newState :: StateName
                  -> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState :: StateName
-> String -> Set Tag -> Int -> Maybe TMCMD -> Maybe SMTag -> State
newState StateName
name String
idx Set Tag
tags Int
i Maybe TMCMD
cmd Maybe SMTag
tag = StateName -> String -> Set Tag -> Maybe StateVal -> State
State StateName
name String
idx Set Tag
tags (Maybe StateVal -> State) -> Maybe StateVal -> State
forall a b. (a -> b) -> a -> b
$ StateVal -> Maybe StateVal
forall a. a -> Maybe a
Just (StateVal -> Maybe StateVal) -> StateVal -> Maybe StateVal
forall a b. (a -> b) -> a -> b
$ Int -> Maybe TMCMD -> Maybe SMTag -> StateVal
StateVal Int
i Maybe TMCMD
cmd Maybe SMTag
tag
eX :: Int -> Smb
eX :: Int -> Smb
eX Int
j       = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eX' :: Int -> Smb
eX' :: Int -> Smb
eX' Int
j      = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eF :: String -> Int -> Smb
eF :: String -> Int -> Smb
eF String
idx Int
j   = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eF' :: String -> Int -> Smb
eF' :: String -> Int -> Smb
eF' String
idx Int
j  = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eE :: Int -> Smb
eE :: Int -> Smb
eE Int
j       = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eE' :: Int -> Smb
eE' :: Int -> Smb
eE' Int
j      = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eP :: Int -> Smb
eP :: Int -> Smb
eP Int
j       = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eQ :: Int -> Smb
eQ :: Int -> Smb
eQ Int
j       = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eR :: Int -> Smb
eR :: Int -> Smb
eR Int
j       = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eS :: Int -> Smb
eS :: Int -> Smb
eS Int
j       = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eT :: Int -> Smb
eT :: Int -> Smb
eT Int
j       = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eU :: Int -> Smb
eU :: Int -> Smb
eU Int
j       = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
ePd :: Int -> Smb
ePd :: Int -> Smb
ePd Int
j      = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eQd :: Int -> Smb
eQd :: Int -> Smb
eQd Int
j      = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eRd :: Int -> Smb
eRd :: Int -> Smb
eRd Int
j      = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eSd :: Int -> Smb
eSd :: Int -> Smb
eSd Int
j      = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eTd :: Int -> Smb
eTd :: Int -> Smb
eTd Int
j      = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing
eUd :: Int -> Smb
eUd :: Int -> Smb
eUd Int
j      = 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 Maybe TMCMD
forall a. Maybe a
Nothing Maybe SMTag
forall a. Maybe a
Nothing

getJIdx :: [TMType.TapeCommand] -> Int -> (String, String)
getJIdx :: [TapeCommand] -> Int -> (String, String)
getJIdx [TapeCommand]
c Int
j =
    let internal :: [TapeCommand] -> Int -> (String, String)
internal [TapeCommand]
cmd Int
i =
            case [TapeCommand]
cmd of
                TMType.PreSMCommand ((Square
_, TMType.StateOmega(TMType.State String
b)), (Square
_, TMType.StateOmega(TMType.State String
b1))) : [TapeCommand]
t
                    | Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i -> (String
b, String
b1)
                    | Bool
otherwise -> [TapeCommand] -> Int -> (String, String)
internal [TapeCommand]
t (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                [TapeCommand]
_ -> String -> (String, String)
forall a. HasCallStack => String -> a
error String
"Not found j"
    in
        [TapeCommand] -> Int -> (String, String)
internal [TapeCommand]
c Int
1