Two programs to run an unlimited register machine.

Posted on 27.09.2013

This year, I am taking a mathematical logic course and as part of my study we are looking at Unlimited Register Machines and Turing Machines.

The course features a number of programs for the URM it describes - as you would expect, simple ones are easy to compute by hand. However, I found myself wanting to try URMs with larger inputs than given, and repeatedly trying different URMs with different values is tedious and not something I have time for.

Finally, I knew I could, so I just did - I wrote a quick python program to execute a URM code file. The code file takes an initial line of comma separated inputs matching all the registers you wish to refer to, and subsequent lines are of the form:

J(1,2,3)
C(3,1)

and so on. The type of bracket used is unimportant, but the lack of spacing is essential. I could of course fix this, but it wasn't really an exercise in writing a parser. Cautious use of .strip("" "") would fix this, but again, I am the only user of this to my knowledge.

So, the python code looks like this:

import sys

class URM(object):
    initial_registers = []
    registers = []
    program = []
    ip = 0
    result = 0

    def parse(self, line):
        instruction_list = []
        instruction = line[0]
        args = [int(x) for x in line[2:-1].split("","")]
        instruction_list.append(instruction)
        instruction_list.append(args)
        self.program.append(instruction_list)

    def J(self, *args):
        ref1 = args[0]
        ref2 = args[1]
        set_ip = args[2]
        if set_ip-1 > len(self.program):
            return -1

        if self.registers[ref1-1] == self.registers[ref2-1]:
            self.ip = set_ip-1
            return 0
        else:
            return 1

    def S(self, *args):
        ref1 = args[0]
        self.registers[ref1-1] = self.registers[ref1-1] + 1
        return 1

    def Z(self, *args):
        ref1 = args[0]
        self.registers[ref1-1] = 0
        return 1

    def C(self, *args):
        ref1 = args[0]
        ref2 = args[1]
        self.registers[ref2-1] = self.registers[ref1-1]
        return 1

    def execute(self, trace=True):
        try:
            while True:
                if self.ip > len(self.program)-1:
                    print("""")
                    break

                if trace:
                    print(""%d : %s"" % (self.ip+1, 
                                   "" "".join([str(i) for i in self.registers])),
                          end="" "")

                current_instruction_pair = self.program[self.ip]
                instruction, args = current_instruction_pair
                if trace:
                    print(""\t%s %s"" % (instruction, "" "".join(""%d""%(d) for d in args)))
                f = self.instruction_map[instruction]
                result = f(self, *args)
                if result == -1:
                    break
                else:
                    self.ip = self.ip + result
        except KeyboardInterrupt as e:
            print(""Execution interrupted."")
        else:
            print(""Execution complete."")
            print(""Result = %s"" % ("" "".join(""%d"" % d for d in self.registers)))

    instruction_map = {'C':C,
                       'J':J,
                       'Z':Z,
                       'S':S
                      }

    def __init__(self, code, inputs):
        for line in code.split(""\n""):
            if len(line) > 0:
             self.parse(line)

        for initial_value in inputs:
            self.registers.append(initial_value)
            self.initial_registers.append(initial_value)

if __name__=='__main__':

    code_file = sys.argv[1]
    code_contents = """"
    code = """"

    with open(code_file, ""r"") as f:
        code_contents = f.read()

    initial_line = code_contents.split(""\n"")[0]
    code = ""\n"".join(code_contents.split(""\n"")[1:])
    initial_values = [int(x) for x in initial_line.strip("" "").split("","")]

    u = URM(code, initial_values)
    u.execute()

I've been learning Haskell on and off for a while and felt that the goal of writing something like this ought to be possible in Haskell too. This task felt particularly suited for functional programming, particularly pattern matching of instructions. So without further ado:

import System.Environment
import System.FilePath

data Jump =        Jump { comparereg1 :: Int,
                          comparereg2 :: Int,
                          jumpip :: Int
                        } deriving(Eq, Show)
data Successor =   Successor { increg :: Int } deriving(Eq, Show)
data Zero =        Zero { zeroreg :: Int } deriving(Eq, Show)
data Copy =        Copy { srcreg :: Int , 
                          dstreg :: Int } deriving(Eq, Show)
data Instruction = JumpInstruction Jump | 
                   SuccessorInstruction Successor | 
                   ZeroInstruction Zero | 
                   CopyInstruction Copy 
                   deriving(Eq, Show)
data ProgramState = ProgramState { registers :: [Int],
                         ip :: Int,
                         code :: [Instruction] } deriving(Eq)

instance Show ProgramState where
    show (ProgramState registers ip code) = ""IP="" ++ (show (ip+1)) 
        ++ ""\tRegs="" ++ show registers

wordsOn :: (Char -> Bool) -> String -> [String]
wordsOn p s =  case dropWhile p s of
                      """" -> []
                      s' -> w : wordsOn p s''
                            where (w, s'') = break p s'

stringToIntArgs :: [String] -> [Int]
stringToIntArgs (x:xs) = [read x :: Int] ++ stringToIntArgs(xs)
stringToIntArgs []     = []

replaceListEntry :: [Int] -> Int -> Int -> [Int]
replaceListEntry (x:xs) n val 
    | n == 0    = val:xs
    | otherwise = x:replaceListEntry xs (n-1) val
replaceListEntry [] n val = []

parseCodeInstructions :: [String] -> [Instruction]
parseCodeInstructions (x:xs) = do
    let args = stringToIntArgs (wordsOn (==',') ((wordsOn (==')') 
                                    ((wordsOn (=='(') x)!!1))!!0))
    let inst = (wordsOn (=='(') x)!!0
    case inst of
        ""J"" -> [JumpInstruction (Jump {comparereg1=args!!0, 
                    comparereg2=args!!1, 
                    jumpip=args!!2})] 
                ++ parseCodeInstructions xs
        ""C"" -> [CopyInstruction (Copy {srcreg=args!!0, 
                    dstreg=args!!1})] 
                ++ parseCodeInstructions xs
        ""S"" -> [SuccessorInstruction (Successor {increg=args!!0})] 
                ++ parseCodeInstructions xs
        ""Z"" -> [ZeroInstruction (Zero {zeroreg=args!!0})] 
                ++ parseCodeInstructions xs
parseCodeInstructions [] = []

parseCode :: [String] -> ProgramState
parseCode (x:xs) = ProgramState {
                       registers = (stringToIntArgs (wordsOn (==',') x)), 
                       ip = 0,
                       code=parseCodeInstructions xs}


getreg :: ProgramState -> Int -> Int
getreg state n = ((registers state))!!(n-1) - 1

setreg :: ProgramState -> Int -> Int -> [Int]
setreg state n v = do
    let regs = registers state
    replaceListEntry regs n v

jump :: ProgramState -> Int -> Int -> Int -> ProgramState
jump state cr1 cr2 jumpip 
     | getreg state cr1 == getreg state cr2 =  
         ProgramState{registers=(registers state),
                      ip=jumpip-1,
                      code=(code state)}
     | otherwise                            =  
         ProgramState{registers=(registers state),
                      ip=(ip state) + 1,
                      code=(code state)}

zero :: ProgramState -> Int -> ProgramState
zero state zeroreg = ProgramState{registers=(setreg state (zeroreg-1) 0), 
                                  ip=(ip state)+1, 
                                  code=(code state)}

successor :: ProgramState -> Int -> ProgramState
successor state increg = 
    ProgramState{registers=(setreg state (increg-1) 
            ((registers state)!!(increg-1) + 1)), 
        ip=(ip state)+1, 
        code=(code state)}

copy :: ProgramState -> Int -> Int -> ProgramState
copy state srcreg dstreg = 
    ProgramState{registers=(setreg state (dstreg-1) 
            ((registers state)!!(srcreg-1))), 
        ip=(ip state)+1, 
        code=(code state)}

execInstructionOnURM :: ProgramState -> ProgramState
execInstructionOnURM state = do 
    let i = (code state)!!(ip state)
    case i of
        JumpInstruction (Jump comparereg1 comparereg2 jumpip) -> 
            jump state comparereg1 comparereg2 jumpip
        SuccessorInstruction (Successor increg) -> 
            successor state increg
        ZeroInstruction (Zero zeroreg) -> 
            zero state zeroreg
        CopyInstruction (Copy srcreg dstreg) -> 
            copy state srcreg dstreg

executeURM :: ProgramState -> ProgramState
executeURM state 
    | (ip state) >= length (code state) = state
    | (ip state) < 0 = state
    | otherwise = executeURM (execInstructionOnURM state)

main :: IO ()
main = do
    args <- getArgs
    program_code <- readFile (args !! 0)
    let program_lines = lines program_code
    let finalstate = executeURM (parseCode program_lines)
    putStrLn ""URM in Haskell by Antony Vennard""
    print finalstate

This code is probably not optimal - I am still quite new to Haskell, but there's a few handy tricks in there I really like. One main pattern is that each execution of the program creates a new ProgramState. Like many functional languages, the state variable coming in is immutable. I felt that returning a value like this was a better way to increment the IP than in a procedural way.

Anyway, if these interest you by all means feel free to use them. There are a few other implementations out there on the internet that I was able to find after a quick search, including one online simulator and this generator-based python example.