{-# LANGUAGE TemplateHaskell, TupleSections, RankNTypes, TypeApplications, OverloadedStrings #-}
module TuringMachine (
LabeledStates,
Alphabet,
TuringMachine,
turingMachine,
quadruples,
labeledStates,
alphabet,
TMGetter,
TMSetter,
states,
symbols,
allStates,
allSymbols,
strQuadruples,
strLabeledStates,
strSymbols,
strNumStates,
strNumSymbols,
maxNumState,
maxNumSymbol,
module TuringMachine.Quadruple,
module Containers,
module Lens,
) where
import TuringMachine.Quadruple
import Containers hiding (Quadruple)
import Lens
import Control.Applicative (liftA2, liftA3)
import Data.Maybe (catMaybes)
import GHC.Generics ((:.:)(Comp1, unComp1))
type LabeledStates = PrismMap String State
type Alphabet = IsoMap ShowedSymbol Symbol
data TuringMachine = TM
{ TuringMachine -> Quadruples
_quadruples :: Quadruples
, TuringMachine -> LabeledStates
_labeledStates :: LabeledStates
, TuringMachine -> Alphabet
_alphabet :: Alphabet
} deriving (TuringMachine -> TuringMachine -> Bool
(TuringMachine -> TuringMachine -> Bool)
-> (TuringMachine -> TuringMachine -> Bool) -> Eq TuringMachine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TuringMachine -> TuringMachine -> Bool
$c/= :: TuringMachine -> TuringMachine -> Bool
== :: TuringMachine -> TuringMachine -> Bool
$c== :: TuringMachine -> TuringMachine -> Bool
Eq)
turingMachine :: Quadruples -> LabeledStates -> Alphabet -> TuringMachine
turingMachine :: Quadruples -> LabeledStates -> Alphabet -> TuringMachine
turingMachine = Quadruples -> LabeledStates -> Alphabet -> TuringMachine
TM
makeLenses ''TuringMachine
maybe' :: (a -> Maybe b) -> (a -> b) -> a -> b
maybe' :: (a -> Maybe b) -> (a -> b) -> a -> b
maybe' a -> Maybe b
f a -> b
g a
x =
case a -> Maybe b
f a
x of
Maybe b
Nothing -> a -> b
g a
x
Just b
y -> b
y
instance Show TuringMachine where
show :: TuringMachine -> String
show TuringMachine
tm =
((((State, Symbol), (SymbolOrMove, State)) -> String)
-> [((State, Symbol), (SymbolOrMove, State))] -> String)
-> [((State, Symbol), (SymbolOrMove, State))]
-> (((State, Symbol), (SymbolOrMove, State)) -> String)
-> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((State, Symbol), (SymbolOrMove, State)) -> String)
-> [((State, Symbol), (SymbolOrMove, State))] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TuringMachine
tmTuringMachine
-> Getting
[((State, Symbol), (SymbolOrMove, State))]
TuringMachine
[((State, Symbol), (SymbolOrMove, State))]
-> [((State, Symbol), (SymbolOrMove, State))]
forall s a. s -> Getting a s a -> a
^.(Quadruples
-> Const [((State, Symbol), (SymbolOrMove, State))] Quadruples)
-> TuringMachine
-> Const [((State, Symbol), (SymbolOrMove, State))] TuringMachine
Lens' TuringMachine Quadruples
quadruples((Quadruples
-> Const [((State, Symbol), (SymbolOrMove, State))] Quadruples)
-> TuringMachine
-> Const [((State, Symbol), (SymbolOrMove, State))] TuringMachine)
-> (([((State, Symbol), (SymbolOrMove, State))]
-> Const
[((State, Symbol), (SymbolOrMove, State))]
[((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> Const [((State, Symbol), (SymbolOrMove, State))] Quadruples)
-> Getting
[((State, Symbol), (SymbolOrMove, State))]
TuringMachine
[((State, Symbol), (SymbolOrMove, State))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> ([((State, Symbol), (SymbolOrMove, State))]
-> Const
[((State, Symbol), (SymbolOrMove, State))]
[((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> Const [((State, Symbol), (SymbolOrMove, State))] Quadruples
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList) ((((State, Symbol), (SymbolOrMove, State)) -> String) -> String)
-> (((State, Symbol), (SymbolOrMove, State)) -> String) -> String
forall a b. (a -> b) -> a -> b
$
\((State
q1, Symbol
s), (SymbolOrMove
sm, State
q2)) ->
let q1' :: String
q1' =
(State -> Maybe String) -> (State -> String) -> State -> String
forall a b. (a -> Maybe b) -> (a -> b) -> a -> b
maybe'
((TuringMachine
tmTuringMachine
-> Getting LabeledStates TuringMachine LabeledStates
-> LabeledStates
forall s a. s -> Getting a s a -> a
^.Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates) LabeledStates -> State -> Maybe String
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)
(Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (State -> Int) -> State -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
numState)
State
q1
s' :: String
s' = ShowedSymbol -> String
forall a. Show a => a -> String
show (ShowedSymbol -> String) -> ShowedSymbol -> String
forall a b. (a -> b) -> a -> b
$
(Symbol -> Maybe ShowedSymbol)
-> (Symbol -> ShowedSymbol) -> Symbol -> ShowedSymbol
forall a b. (a -> Maybe b) -> (a -> b) -> a -> b
maybe'
((TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet) Alphabet -> Symbol -> Maybe ShowedSymbol
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)
(ShowedSymbol -> Symbol -> ShowedSymbol
forall a b. a -> b -> a
const ShowedSymbol
"?")
Symbol
s
sm' :: String
sm' = case SymbolOrMove
sm of
S s_ -> ShowedSymbol -> String
forall a. Show a => a -> String
show (ShowedSymbol -> String) -> ShowedSymbol -> String
forall a b. (a -> b) -> a -> b
$
(Symbol -> Maybe ShowedSymbol)
-> (Symbol -> ShowedSymbol) -> Symbol -> ShowedSymbol
forall a b. (a -> Maybe b) -> (a -> b) -> a -> b
maybe'
((TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet) Alphabet -> Symbol -> Maybe ShowedSymbol
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)
(ShowedSymbol -> Symbol -> ShowedSymbol
forall a b. a -> b -> a
const ShowedSymbol
"?")
Symbol
s_
M m -> Move -> String
forall a. Show a => a -> String
show Move
m
q2' :: String
q2' =
(State -> Maybe String) -> (State -> String) -> State -> String
forall a b. (a -> Maybe b) -> (a -> b) -> a -> b
maybe'
((TuringMachine
tmTuringMachine
-> Getting LabeledStates TuringMachine LabeledStates
-> LabeledStates
forall s a. s -> Getting a s a -> a
^.Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates) LabeledStates -> State -> Maybe String
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)
(Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (State -> Int) -> State -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
numState)
State
q2
in Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
q1') Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
q1' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
s' String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s') Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
sm' String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sm') Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
q2' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
type TMGetter a = Getter TuringMachine a
type TMSetter a b = Setter TuringMachine TuringMachine a b
traverseMaybe :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe :: (a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe a -> f (Maybe b)
f = ([Maybe b] -> [b]) -> f [Maybe b] -> f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe b] -> [b]
forall a. [Maybe a] -> [a]
catMaybes (f [Maybe b] -> f [b]) -> ([a] -> f [Maybe b]) -> [a] -> f [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Maybe b)) -> [a] -> f [Maybe b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f (Maybe b)
f
states :: TMSetter State (Maybe State)
states :: (State -> f (Maybe State)) -> TuringMachine -> f TuringMachine
states State -> f (Maybe State)
f TuringMachine
tm =
(Quadruples -> LabeledStates -> Alphabet -> TuringMachine)
-> f Quadruples -> f LabeledStates -> f Alphabet -> f TuringMachine
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Quadruples -> LabeledStates -> Alphabet -> TuringMachine
turingMachine
(TuringMachine
tmTuringMachine
-> Getting Quadruples TuringMachine Quadruples -> Quadruples
forall s a. s -> Getting a s a -> a
^.Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples Quadruples -> (Quadruples -> f Quadruples) -> f Quadruples
forall a b. a -> (a -> b) -> b
& ([((State, Symbol), (SymbolOrMove, State))] -> Quadruples)
-> f [((State, Symbol), (SymbolOrMove, State))] -> f Quadruples
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((State, Symbol), (SymbolOrMove, State))] -> Quadruples
forall c v. UnsafeListable c v => [v] -> c
fromList (f [((State, Symbol), (SymbolOrMove, State))] -> f Quadruples)
-> (Quadruples -> f [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> f Quadruples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State))
-> f (Maybe ((State, Symbol), (SymbolOrMove, State))))
-> [((State, Symbol), (SymbolOrMove, State))]
-> f [((State, Symbol), (SymbolOrMove, State))]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe ((State, Symbol), (SymbolOrMove, State))
-> f (Maybe ((State, Symbol), (SymbolOrMove, State)))
forall t t.
((State, t), (t, State)) -> f (Maybe ((State, t), (t, State)))
updQ ([((State, Symbol), (SymbolOrMove, State))]
-> f [((State, Symbol), (SymbolOrMove, State))])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> f [((State, Symbol), (SymbolOrMove, State))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList)
(TuringMachine
tmTuringMachine
-> Getting LabeledStates TuringMachine LabeledStates
-> LabeledStates
forall s a. s -> Getting a s a -> a
^.Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates LabeledStates
-> (LabeledStates -> f LabeledStates) -> f LabeledStates
forall a b. a -> (a -> b) -> b
& ([(String, State)] -> LabeledStates)
-> f [(String, State)] -> f LabeledStates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, State)] -> LabeledStates
forall c v. UnsafeListable c v => [v] -> c
fromList (f [(String, State)] -> f LabeledStates)
-> (LabeledStates -> f [(String, State)])
-> LabeledStates
-> f LabeledStates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, State) -> f (Maybe (String, State)))
-> [(String, State)] -> f [(String, State)]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe (String, State) -> f (Maybe (String, State))
updLS ([(String, State)] -> f [(String, State)])
-> (LabeledStates -> [(String, State)])
-> LabeledStates
-> f [(String, State)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabeledStates -> [(String, State)]
forall c v. Listable c v => c -> [v]
toList)
(TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet Alphabet -> (Alphabet -> f Alphabet) -> f Alphabet
forall a b. a -> (a -> b) -> b
& Alphabet -> f Alphabet
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
where
f' :: State -> (:.:) f Maybe State
f' = f (Maybe State) -> (:.:) f Maybe State
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (Maybe State) -> (:.:) f Maybe State)
-> (State -> f (Maybe State)) -> State -> (:.:) f Maybe State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> f (Maybe State)
f
updQ :: ((State, t), (t, State)) -> f (Maybe ((State, t), (t, State)))
updQ ((State
qf, t
s), (t
sm, State
qt)) =
(:.:) f Maybe ((State, t), (t, State))
-> f (Maybe ((State, t), (t, State)))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe ((State, t), (t, State))
-> f (Maybe ((State, t), (t, State))))
-> (:.:) f Maybe ((State, t), (t, State))
-> f (Maybe ((State, t), (t, State)))
forall a b. (a -> b) -> a -> b
$ ((State, t) -> (t, State) -> ((State, t), (t, State)))
-> (:.:) f Maybe (State, t)
-> (:.:) f Maybe (t, State)
-> (:.:) f Maybe ((State, t), (t, State))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ((,t
s) (State -> (State, t))
-> (:.:) f Maybe State -> (:.:) f Maybe (State, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> (:.:) f Maybe State
f' State
qf) ((t
sm,) (State -> (t, State))
-> (:.:) f Maybe State -> (:.:) f Maybe (t, State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> (:.:) f Maybe State
f' State
qt)
updLS :: (String, State) -> f (Maybe (String, State))
updLS = (:.:) f Maybe (String, State) -> f (Maybe (String, State))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe (String, State) -> f (Maybe (String, State)))
-> ((String, State) -> (:.:) f Maybe (String, State))
-> (String, State)
-> f (Maybe (String, State))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State -> (:.:) f Maybe State)
-> (String, State) -> (:.:) f Maybe (String, State)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse State -> (:.:) f Maybe State
f'
symbols :: TMSetter Symbol (Maybe Symbol)
symbols :: (Symbol -> f (Maybe Symbol)) -> TuringMachine -> f TuringMachine
symbols Symbol -> f (Maybe Symbol)
f TuringMachine
tm =
(Quadruples -> LabeledStates -> Alphabet -> TuringMachine)
-> f Quadruples -> f LabeledStates -> f Alphabet -> f TuringMachine
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Quadruples -> LabeledStates -> Alphabet -> TuringMachine
turingMachine
(TuringMachine
tmTuringMachine
-> Getting Quadruples TuringMachine Quadruples -> Quadruples
forall s a. s -> Getting a s a -> a
^.Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples Quadruples -> (Quadruples -> f Quadruples) -> f Quadruples
forall a b. a -> (a -> b) -> b
& ([((State, Symbol), (SymbolOrMove, State))] -> Quadruples)
-> f [((State, Symbol), (SymbolOrMove, State))] -> f Quadruples
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((State, Symbol), (SymbolOrMove, State))] -> Quadruples
forall c v. UnsafeListable c v => [v] -> c
fromList (f [((State, Symbol), (SymbolOrMove, State))] -> f Quadruples)
-> (Quadruples -> f [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> f Quadruples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State))
-> f (Maybe ((State, Symbol), (SymbolOrMove, State))))
-> [((State, Symbol), (SymbolOrMove, State))]
-> f [((State, Symbol), (SymbolOrMove, State))]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe ((State, Symbol), (SymbolOrMove, State))
-> f (Maybe ((State, Symbol), (SymbolOrMove, State)))
forall t t.
((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
updQ ([((State, Symbol), (SymbolOrMove, State))]
-> f [((State, Symbol), (SymbolOrMove, State))])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> f [((State, Symbol), (SymbolOrMove, State))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList)
(TuringMachine
tmTuringMachine
-> Getting LabeledStates TuringMachine LabeledStates
-> LabeledStates
forall s a. s -> Getting a s a -> a
^.Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates LabeledStates
-> (LabeledStates -> f LabeledStates) -> f LabeledStates
forall a b. a -> (a -> b) -> b
& LabeledStates -> f LabeledStates
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
(TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet Alphabet -> (Alphabet -> f Alphabet) -> f Alphabet
forall a b. a -> (a -> b) -> b
& ([(ShowedSymbol, Symbol)] -> Alphabet)
-> f [(ShowedSymbol, Symbol)] -> f Alphabet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ShowedSymbol, Symbol)] -> Alphabet
forall c v. UnsafeListable c v => [v] -> c
fromList (f [(ShowedSymbol, Symbol)] -> f Alphabet)
-> (Alphabet -> f [(ShowedSymbol, Symbol)])
-> Alphabet
-> f Alphabet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ShowedSymbol, Symbol) -> f (Maybe (ShowedSymbol, Symbol)))
-> [(ShowedSymbol, Symbol)] -> f [(ShowedSymbol, Symbol)]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe (ShowedSymbol, Symbol) -> f (Maybe (ShowedSymbol, Symbol))
updA ([(ShowedSymbol, Symbol)] -> f [(ShowedSymbol, Symbol)])
-> (Alphabet -> [(ShowedSymbol, Symbol)])
-> Alphabet
-> f [(ShowedSymbol, Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> [(ShowedSymbol, Symbol)]
forall c v. Listable c v => c -> [v]
toList)
where
f' :: Symbol -> (:.:) f Maybe Symbol
f' = f (Maybe Symbol) -> (:.:) f Maybe Symbol
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (Maybe Symbol) -> (:.:) f Maybe Symbol)
-> (Symbol -> f (Maybe Symbol)) -> Symbol -> (:.:) f Maybe Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> f (Maybe Symbol)
f
updQ :: ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
updQ ((t
qf, Symbol
s), (m :: SymbolOrMove
m@(M Move
_), t
qt)) =
(:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t))))
-> (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
forall a b. (a -> b) -> a -> b
$ (,(SymbolOrMove
m, t
qt)) ((t, Symbol) -> ((t, Symbol), (SymbolOrMove, t)))
-> (Symbol -> (t, Symbol))
-> Symbol
-> ((t, Symbol), (SymbolOrMove, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t
qf,) (Symbol -> ((t, Symbol), (SymbolOrMove, t)))
-> (:.:) f Maybe Symbol
-> (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> (:.:) f Maybe Symbol
f' Symbol
s
updQ ((t
qf, Symbol
s), (S Symbol
s', t
qt)) =
(:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t))))
-> (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
forall a b. (a -> b) -> a -> b
$ ((t, Symbol)
-> (SymbolOrMove, t) -> ((t, Symbol), (SymbolOrMove, t)))
-> (:.:) f Maybe (t, Symbol)
-> (:.:) f Maybe (SymbolOrMove, t)
-> (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ((t
qf,) (Symbol -> (t, Symbol))
-> (:.:) f Maybe Symbol -> (:.:) f Maybe (t, Symbol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> (:.:) f Maybe Symbol
f' Symbol
s) ((,t
qt) (SymbolOrMove -> (SymbolOrMove, t))
-> (Symbol -> SymbolOrMove) -> Symbol -> (SymbolOrMove, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> SymbolOrMove
forall s. s -> MoveOr s
S (Symbol -> (SymbolOrMove, t))
-> (:.:) f Maybe Symbol -> (:.:) f Maybe (SymbolOrMove, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> (:.:) f Maybe Symbol
f' Symbol
s')
updA :: (ShowedSymbol, Symbol) -> f (Maybe (ShowedSymbol, Symbol))
updA = (:.:) f Maybe (ShowedSymbol, Symbol)
-> f (Maybe (ShowedSymbol, Symbol))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe (ShowedSymbol, Symbol)
-> f (Maybe (ShowedSymbol, Symbol)))
-> ((ShowedSymbol, Symbol) -> (:.:) f Maybe (ShowedSymbol, Symbol))
-> (ShowedSymbol, Symbol)
-> f (Maybe (ShowedSymbol, Symbol))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> (:.:) f Maybe Symbol)
-> (ShowedSymbol, Symbol) -> (:.:) f Maybe (ShowedSymbol, Symbol)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Symbol -> (:.:) f Maybe Symbol
f'
allStates :: TMGetter (Set State)
allStates :: (Set State -> f (Set State)) -> TuringMachine -> f TuringMachine
allStates = (TuringMachine -> Set State)
-> (Set State -> f (Set State)) -> TuringMachine -> f TuringMachine
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((TuringMachine -> Set State)
-> (Set State -> f (Set State))
-> TuringMachine
-> f TuringMachine)
-> (TuringMachine -> Set State)
-> (Set State -> f (Set State))
-> TuringMachine
-> f TuringMachine
forall a b. (a -> b) -> a -> b
$ do
Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> TuringMachine -> Quadruples
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
LabeledStates
ls <- Getting LabeledStates TuringMachine LabeledStates
-> TuringMachine -> LabeledStates
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates
let statesFromLS :: Set State
statesFromLS = LabeledStates -> Set State
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet LabeledStates
ls
statesFromQ :: ((v, b), (a, v)) -> c
statesFromQ ((v
qf, b
_), (a
_, v
qt)) = [v] -> c
forall c v. UnsafeListable c v => [v] -> c
fromList [v
qf, v
qt]
Set State -> TuringMachine -> Set State
forall (m :: * -> *) a. Monad m => a -> m a
return (Set State -> TuringMachine -> Set State)
-> Set State -> TuringMachine -> Set State
forall a b. (a -> b) -> a -> b
$ (Set State -> Set State -> Set State)
-> Set State -> [Set State] -> Set State
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
(\/) Set State
statesFromLS ([Set State] -> Set State) -> [Set State] -> Set State
forall a b. (a -> b) -> a -> b
$ ((State, Symbol), (SymbolOrMove, State)) -> Set State
forall c v b a. UnsafeListable c v => ((v, b), (a, v)) -> c
statesFromQ (((State, Symbol), (SymbolOrMove, State)) -> Set State)
-> [((State, Symbol), (SymbolOrMove, State))] -> [Set State]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs
allSymbols :: TMGetter (Set Symbol)
allSymbols :: (Set Symbol -> f (Set Symbol)) -> TuringMachine -> f TuringMachine
allSymbols = (TuringMachine -> Set Symbol)
-> (Set Symbol -> f (Set Symbol))
-> TuringMachine
-> f TuringMachine
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((TuringMachine -> Set Symbol)
-> (Set Symbol -> f (Set Symbol))
-> TuringMachine
-> f TuringMachine)
-> (TuringMachine -> Set Symbol)
-> (Set Symbol -> f (Set Symbol))
-> TuringMachine
-> f TuringMachine
forall a b. (a -> b) -> a -> b
$ do
Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> TuringMachine -> Quadruples
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
Alphabet
a <- Getting Alphabet TuringMachine Alphabet
-> TuringMachine -> Alphabet
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet
let symbolsFromA :: Set Symbol
symbolsFromA = Alphabet -> Set Symbol
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet Alphabet
a
symbolsFromQ :: ((a, Symbol), (SymbolOrMove, b)) -> Set Symbol
symbolsFromQ ((a
_, Symbol
s), (SymbolOrMove
sm, b
_)) =
forall v. UnsafeListable (Set Symbol) v => [v] -> Set Symbol
forall c v. UnsafeListable c v => [v] -> c
fromList @(Set Symbol) ([Symbol] -> Set Symbol) -> [Symbol] -> Set Symbol
forall a b. (a -> b) -> a -> b
$
case SymbolOrMove
sm of
M Move
_ -> [Symbol
s]
S Symbol
s' -> [Symbol
s, Symbol
s']
Set Symbol -> TuringMachine -> Set Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Symbol -> TuringMachine -> Set Symbol)
-> Set Symbol -> TuringMachine -> Set Symbol
forall a b. (a -> b) -> a -> b
$ (Set Symbol -> Set Symbol -> Set Symbol)
-> Set Symbol -> [Set Symbol] -> Set Symbol
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set Symbol -> Set Symbol -> Set Symbol
forall c. Operable c => c -> c -> c
(\/) Set Symbol
symbolsFromA ([Set Symbol] -> Set Symbol) -> [Set Symbol] -> Set Symbol
forall a b. (a -> b) -> a -> b
$ ((State, Symbol), (SymbolOrMove, State)) -> Set Symbol
forall a b. ((a, Symbol), (SymbolOrMove, b)) -> Set Symbol
symbolsFromQ (((State, Symbol), (SymbolOrMove, State)) -> Set Symbol)
-> [((State, Symbol), (SymbolOrMove, State))] -> [Set Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs
strQuadruples :: TMGetter (Set StrQuadruple)
strQuadruples :: (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
strQuadruples = (Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
-> Quadruples -> f Quadruples)
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quadruples -> Set StrQuadruple)
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> Quadruples
-> f Quadruples
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ([StrQuadruple] -> Set StrQuadruple
forall c v. UnsafeListable c v => [v] -> c
fromList ([StrQuadruple] -> Set StrQuadruple)
-> (Quadruples -> [StrQuadruple]) -> Quadruples -> Set StrQuadruple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State)) -> StrQuadruple)
-> [((State, Symbol), (SymbolOrMove, State))] -> [StrQuadruple]
forall a b. (a -> b) -> [a] -> [b]
map ((State, Symbol), (SymbolOrMove, State)) -> StrQuadruple
toStrQ ([((State, Symbol), (SymbolOrMove, State))] -> [StrQuadruple])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> [StrQuadruple]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList)
strLabeledStates :: TMGetter (Set String)
strLabeledStates :: (Set String -> f (Set String)) -> TuringMachine -> f TuringMachine
strLabeledStates = (LabeledStates -> f LabeledStates)
-> TuringMachine -> f TuringMachine
Lens' TuringMachine LabeledStates
labeledStates ((LabeledStates -> f LabeledStates)
-> TuringMachine -> f TuringMachine)
-> ((Set String -> f (Set String))
-> LabeledStates -> f LabeledStates)
-> (Set String -> f (Set String))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LabeledStates -> Set String)
-> (Set String -> f (Set String))
-> LabeledStates
-> f LabeledStates
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to LabeledStates -> Set String
forall c k. (Keyable c k, Ord k) => c -> Set k
keysSet
strSymbols :: TMGetter (Set String)
strSymbols :: (Set String -> f (Set String)) -> TuringMachine -> f TuringMachine
strSymbols = (Alphabet -> f Alphabet) -> TuringMachine -> f TuringMachine
Lens' TuringMachine Alphabet
alphabet ((Alphabet -> f Alphabet) -> TuringMachine -> f TuringMachine)
-> ((Set String -> f (Set String)) -> Alphabet -> f Alphabet)
-> (Set String -> f (Set String))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alphabet -> Set String)
-> (Set String -> f (Set String)) -> Alphabet -> f Alphabet
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((ShowedSymbol -> String) -> Set ShowedSymbol -> Set String
forall c1 c2 v1 v2. Gunctor c1 c2 v1 v2 => (v1 -> v2) -> c1 -> c2
gmap (ShowedSymbol -> String
forall a. Show a => a -> String
show :: ShowedSymbol -> String) (Set ShowedSymbol -> Set String)
-> (Alphabet -> Set ShowedSymbol) -> Alphabet -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> Set ShowedSymbol
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet)
strNumStates :: TMGetter (Set String)
strNumStates :: (Set String -> f (Set String)) -> TuringMachine -> f TuringMachine
strNumStates = (Set State -> f (Set State)) -> TuringMachine -> f TuringMachine
TMGetter (Set State)
allStates ((Set State -> f (Set State)) -> TuringMachine -> f TuringMachine)
-> ((Set String -> f (Set String)) -> Set State -> f (Set State))
-> (Set String -> f (Set String))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set State -> Set String)
-> (Set String -> f (Set String)) -> Set State -> f (Set State)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((State -> String) -> Set State -> Set String
forall c1 c2 v1 v2. Gunctor c1 c2 v1 v2 => (v1 -> v2) -> c1 -> c2
gmap (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (State -> Int) -> State -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
numState))
strNumSymbols :: TMGetter (Set String)
strNumSymbols :: (Set String -> f (Set String)) -> TuringMachine -> f TuringMachine
strNumSymbols = (Set Symbol -> f (Set Symbol)) -> TuringMachine -> f TuringMachine
TMGetter (Set Symbol)
allSymbols ((Set Symbol -> f (Set Symbol))
-> TuringMachine -> f TuringMachine)
-> ((Set String -> f (Set String)) -> Set Symbol -> f (Set Symbol))
-> (Set String -> f (Set String))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Symbol -> Set String)
-> (Set String -> f (Set String)) -> Set Symbol -> f (Set Symbol)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Symbol -> String) -> Set Symbol -> Set String
forall c1 c2 v1 v2. Gunctor c1 c2 v1 v2 => (v1 -> v2) -> c1 -> c2
gmap (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Symbol -> Int) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Int
numSymbol))
maxNumState :: TMGetter Int
maxNumState :: (Int -> f Int) -> TuringMachine -> f TuringMachine
maxNumState = (Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine)
-> ((Int -> f Int) -> Quadruples -> f Quadruples)
-> (Int -> f Int)
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quadruples -> Int) -> (Int -> f Int) -> Quadruples -> f Quadruples
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (Quadruples -> [Int]) -> Quadruples -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State)) -> Int)
-> [((State, Symbol), (SymbolOrMove, State))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((State, Symbol), (SymbolOrMove, State)) -> Int
forall b a. ((State, b), (a, State)) -> Int
maxN ([((State, Symbol), (SymbolOrMove, State))] -> [Int])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList) where
maxN :: ((State, b), (a, State)) -> Int
maxN ((State
qs, b
_), (a
_, State
qf)) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int) -> (State -> Int) -> State -> State -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` State -> Int
numState) State
qs State
qf
maxNumSymbol :: TMGetter Int
maxNumSymbol :: (Int -> f Int) -> TuringMachine -> f TuringMachine
maxNumSymbol = (Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine)
-> ((Int -> f Int) -> Quadruples -> f Quadruples)
-> (Int -> f Int)
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quadruples -> Int) -> (Int -> f Int) -> Quadruples -> f Quadruples
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (Quadruples -> [Int]) -> Quadruples -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State)) -> Int)
-> [((State, Symbol), (SymbolOrMove, State))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((State, Symbol), (SymbolOrMove, State)) -> Int
forall a b. ((a, Symbol), (SymbolOrMove, b)) -> Int
maxM ([((State, Symbol), (SymbolOrMove, State))] -> [Int])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList) where
maxM :: ((a, Symbol), (SymbolOrMove, b)) -> Int
maxM ((a
_, Symbol
s), (M Move
_, b
_)) = Symbol -> Int
numSymbol Symbol
s
maxM ((a
_, Symbol
s), (S Symbol
s', b
_)) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int) -> (Symbol -> Int) -> Symbol -> Symbol -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Symbol -> Int
numSymbol) Symbol
s Symbol
s'