Машина Тюрінга для опису алгоритмів

_ -> error "Ambiguous transition"

where transitionMatches state c (Transition from to on move write) =

(from == state) && (elem c on)

runTransition :: TuringMachine -> [Char] -> Char -> [Char] -> String -> Transition -> MachineState

runTransition m (l:left) c right state (Transition from tostate on MoveLeft write) =

TMState left l (write:right) tostate

runTransition m left c [] state (Transition from tostate on MoveRight write) =

TMState (write:left) (getBlankSym m) [] tostate

runTransition m left c (r:right) state (Transition from tostate on MoveRight write) =

TMState (write:left) r right tostate

stepMachine :: TuringMachine -> MachineState -> MachineState

stepMachine machine@(Machine _ _ _ _ translist) st@(TMState tapeleft c taperight state) =

let trans = findMatchingTransition translist state c

in case trans of

(Just t) -> runTransition machine tapeleft c taperight state t

Nothing -> error "No applicable transition from state"

getMachineStateString (TMState left c right state) =

(state ++ ":[" ++ (reverse left) ++ "{" ++ [c] ++ "}" ++ right ++ "]")

runTracedMachine :: TuringMachine -> [Char] -> [String]

runTracedMachine tm@(Machine states initial alphabet blank transitions) (t:tape) =

runTracedMachineSteps tm (TMState [] t tape initial) where

runTracedMachineSteps machine state =

let newstate@(TMState left c right st) = stepMachine machine state

in if st == "Halt"

then [getMachineStateString newstate]

else let trace=runTracedMachineSteps machine newstate

in ((getMachineStateString newstate):trace)

runMachine :: TuringMachine -> [Char] -> [Char]

runMachine tm@(Machine states initial alphabet blank transitions) (t:tape) =

runMachineSteps tm (TMState [] t tape initial) where

runMachineSteps machine state =

let newstate@(TMState left c right st) = stepMachine machine state

in if st == "Halt"

then (concat [(reverse left), [c], right])

else runMachineSteps machine newstate

-- Parsing code - implemented using the Parsec monadic parser library.

-- Basic setup stuff - use a standard haskell style lexer; set up the reserved words

-- and symbols in the lexer.

lexer :: P.TokenParser ()

lexer = P.makeTokenParser (haskellDef

{ P.reservedNames = ["states","alphabet","trans","from","to","on","write","move","left","right","initial","blank"] })

reserved = P.reserved lexer

symbol = P.symbol lexer

braces = P.braces lexer

parens = P.parens lexer

charlit = P.charLiteral lexer

strlit = P.stringLiteral lexer

ident = P.identifier lexer

whitespace = P.whiteSpace lexer

states = reserved "states"

alphabet = reserved "alphabet"

trans = reserved "trans"

from = reserved "from"

to = reserved "to"

on = reserved "on"

write = reserved "write"

move = reserved "move"

initial = reserved "initial"

blank = reserved "blank"

left = do { reserved "left"

; return MoveLeft

}

right = do { reserved "right"

; return MoveRight

}

-- statesDecl ::= "states" "{" strlit+ "}" "initial" strlit

statesDecl = do { states

; strlst <- braces (many1 strlit)

; initial

; i <- strlit

; return (i,strlst)

}

-- alphaDecl ::= "alphabet" "{" charlit+ "}" "blank" charlit

alphaDecl = do { alphabet

; charlst <- braces (many1 charlit)

; blank

; bl <- charlit

; return (bl, charlst)

}

-- transDecl ::= "trans" "from" strlit "to" strlit "on" "(" charlit+ ")" "write" charlit "move" ("left" | "right")

transDecl = do { trans

; from

; fromState <- strlit

; to

; targetState <- strlit

; on

; chrs <- parens (many1 charlit)

; write

; wrchar <- charlit

; move

; dir <- ( left <|> right)

; return (Transition fromState targetState chrs dir wrchar)

}

-- machine ::= statesDecl alphaDecl transDecl+

machine = do { (i,sts) <- statesDecl

; (bl,alpha) <- alphaDecl

; trans <- many1 transDecl

; return (Machine sts i alpha bl trans)

}

run :: (Show a) => Parser a -> String -> IO a

run p input

= case (parse p "" input) of

Left err -> do{ putStr "parse error at "

; print err

; error "Parse error"

}

Right x -> return x

runTParser :: String -> IO TuringMachine

runTParser input =

run (do { whitespace

; x <- machine

; eof

; return x }) input

-- A sample Turing program - first in the comment, and then coded into

-- a string literal, to make it easy to run tests. This sample program

-- is a basic Turing subtract - it takes a unary equation "111111-111=",

-- and leaves the result of subtracting the second from the first.

--

-- states { "one" "two" "three" "four" } initial "one"

-- alphabet { '1' ' ' '=' '-' } blank ' '

-- trans from "one" to "one" on (' ') write ' ' move right

-- trans from "one" to "one" on ('1') write '1' move right

-- trans from "one" to "one" on ('-') write '-' move right

-- trans from "one" to "two" on ('=') write ' ' move left

-- trans from "two" to "three" on ('1') write '=' move left

-- trans from "two" to "Halt" on ('-') write '-' move left

-- trans from "three" to "three" on ('1') write '1' move left

-- trans from "three" to "four" on ('-') write '-' move left

-- trans from "four" to "four" on (' ') write ' ' move left

-- trans from "four" to "one" on ('1') write ' ' move right

sampleMachine = concat ["states { \"one\" \"two\" \"three\" \"four\" } initial \"one\"\n ",

" alphabet { '1' ' ' '=' '-' } blank ' '\n ",

"trans from \"one\" to \"one\" on (' ') write ' ' move right\n ",

"trans from \"one\" to \"one\" on ('1') write '1' move right\n ",

"trans from \"one\" to \"one\" on ('-') write '-' move right\n ",

"trans from \"one\" to \"two\" on ('=') write ' ' move left\n ",

"trans from \"two\" to \"three\" on ('1') write '=' move left\n ",

"trans from \"two\" to \"Halt\" on ('-') write '-' move left\n ",

"trans from \"three\" to \"three\" on ('1') write '1' move left\n ",

"trans from \"three\" to \"four\" on ('-') write '-' move left\n ",

"trans from \"four\" to \"four\" on (' ') write ' ' move left\n ",

"trans from \"four\" to \"one\" on ('1') write ' ' move right" ]

runTracedMachineOnString :: String -> String -> IO ([String])

runTracedMachineOnString m str =

do

tm <- runTParser m

return (runTracedMachine tm str)

runMachineOnString :: String -> String -> IO String

runMachineOnString m str =

do

tm <- runTParser m

return (runMachine tm str)

sampleInput = " 11111111-111= "

-- Main program execution scaffolding

-- main still needs a bit of work so that ghci will link correctly;

-- runs fine in GHCI, but linkage errors in GHC. For now, just load

-- this file, and then execute "runFromFile" from the command line.

main =

do

[file] <- getArgs

m <- parseFromFile (do { whitespace

; x <- machine

; eof

; return x }) file

case m of

Right machine -> do

print "Enter input for parser:"

s <- getLine

result <- return (runMachine machine s)

print (concat ["Result:[", result, "]"])

Left x -> do

print (concat ["Parse error"])

runFromFile :: String -> IO ()

runFromFile filename =

do

m <- parseFromFile (do { whitespace

; x <- machine

; eof

; return x }) filename

case m of

Right machine -> do

print "Enter input for parser:"

s <- getLine

result <- return (runMachine machine s)

print (concat ["Result:[", result, "]"])

Left x -> do

print (concat ["Parse error"])

Размещено на Allbest.ru