Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Haskell Turing Machine
{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
module Turing where
import Control.Applicative
import Data.Foldable(asum)
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Maybe
-- |State of the turing machine
type State
= Int
-- |Single cell on a tape
data Cell
= Blank
| Zero
| One
deriving ( Eq, Ord, Show )
-- |Tape consists of multiple cells
type Tape
= Map Int Cell
-- |Step taken by the turing machine
data Step
= SLeft
| SRight
| Still
deriving ( Eq, Ord, Show )
-- |Transition from a state to another
data Transition
= Transition { tInit :: State
, tFinal :: State
, tRead :: Cell
, tWrite :: Cell
, tMove :: Step
}
deriving ( Eq, Ord, Show )
-- |Turing machine
data Machine
= Machine { mInit :: State
, mFinal :: [ State ]
, mTrans :: [ Transition ]
}
deriving ( Eq, Ord, Show )
-- |Sample machine to increment a binary number
increment :: Machine
increment
= Machine { mInit = 0
, mFinal = [ 2 ]
, mTrans = [ Transition 0 0 Zero Zero SRight
, Transition 0 0 One One SRight
, Transition 0 1 Blank Blank SLeft
, Transition 1 1 One Zero SLeft
, Transition 1 2 Zero One Still
, Transition 1 2 Blank One Still
]
}
-- |Run a turing machine on a tape
run :: Int -> Tape -> Machine -> Maybe Tape
run pos tape m@Machine{..}
= run' mInit pos tape
where
run' state pos tape
| state `elem` mFinal = Just tape
| otherwise = asum $ map step trans
where
cell
= fromMaybe Blank (Map.lookup pos tape)
trans
= filter (\t -> tInit t == state && tRead t == cell) mTrans
step (Transition{..})
= run' tFinal pos' (Map.insert pos tWrite tape)
where
pos' = case tMove of
SLeft -> pos - 1
SRight -> pos + 1
Still -> pos
-- |Test case
test :: Maybe Tape
test
= run 0 tape increment
where
tape = Map.fromList
[ ( 0, One )
, ( 1, Zero )
, ( 2, One )
, ( 3, One )
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment