# Simulate a Minsky Register Machine (I)

There are many formalisms, so while you may find other sources useful I hope to specify this clearly enough that they're not necessary.

A RM consists of a finite state machine and a finite number of named registers, each of which holds a non-negative integer. For ease of textual input this task requires that the states also be named.

There are three types of state: increment and decrement, which both reference a specific register; and terminate. An increment state increments its register and passes control to its one successor. A decrement state has two successors: if its register is non-zero then it decrements it and passes control to the first successor; otherwise (i.e. register is zero) it simply passes control to the second successor.

For "niceness" as a programming language, the terminate states take a hard-coded string to print (so you can indicate exceptional termination).

Input is from stdin. The input format consists of one line per state, followed by the initial register contents. The first line is the initial state. BNF for the state lines is:

line       ::= inc_line
| dec_line
inc_line   ::= label ' : ' reg_name ' + ' state_name
dec_line   ::= label ' : ' reg_name ' - ' state_name ' ' state_name
state_name ::= label
| '"' message '"'
label      ::= identifier
reg_name   ::= identifier


There is some flexibility in the definition of identifier and message. Your program must accept a non-empty alphanumeric string as an identifier, but it may accept more general strings if you prefer (e.g. if your language supports identifiers with underscores and that's easier for you to work with). Similarly, for message you must accept a non-empty string of alphanumerics and spaces, but you may accept more complex strings which allow escaped newlines and double-quote characters if you want.

The final line of input, which gives the initial register values, is a space-separated list of identifier=int assignments, which must be non-empty. It is not required that it initialise all registers named in the program: any which aren't initialised are assumed to be 0.

Your program should read the input and simulate the RM. When it reaches a terminate state it should emit the message, a newline, and then the values of all the registers (in any convenient, human-readable, format, and any order).

Note: formally the registers should hold unbounded integers. However, you may if you wish assume that no register's value will ever exceed 2^30.

### Some simple examples

a+=b, a=0
s0 : a - s1 "Ok"
s1 : b + s0
a=3 b=4


Expected results:

Ok
a=0 b=7

b+=a, t=0
init : t - init d0
d0 : a - d1 a0
d1 : b + d2
d2 : t + d0
a0 : t - a1 "Ok"
a1 : a + a0
a=3 b=4


Expected results:

Ok
a=3 b=7 t=0

Test cases for trickier-to-parse machines
s0 : t - s0 s1
s1 : t + "t is 1"
t=17


Expected results:

t is 1
t=1


and

s0 : t - "t is nonzero" "t is zero"
t=1


Expected results:

t is nonzero
t=0


### A more complicated example

Taken from the DailyWTF's Josephus problem code challenge. Input is n (number of soldiers) and k (advance) and output in r is the (zero-indexed) position of the person who survives.

init0 : k - init1 init3
init1 : r + init2
init2 : t + init0
init3 : t - init4 init5
init4 : k + init3
init5 : r - init6 "ERROR k is 0"
init6 : i + init7
init7 : n - loop0 "ERROR n is 0"
loop0 : n - loop1 "Ok"
loop1 : i + loop2
loop2 : k - loop3 loop5
loop3 : r + loop4
loop4 : t + loop2
loop5 : t - loop6 loop7
loop6 : k + loop5
loop7 : i - loop8 loopa
loop8 : r - loop9 loopc
loop9 : t + loop7
loopa : t - loopb loop7
loopb : i + loopa
loopc : t - loopd loopf
loopd : i + loope
loope : r + loopc
loopf : i + loop0
n=40 k=3


Expected results:

Ok
i=40 k=3 n=0 r=27 t=0


That program as a picture, for those who think visually and would find it helpful to grasp the syntax:

If you enjoyed this golf, have a look at the sequel.

• Does input come from stdin, from a file, or from some other place? Mar 27 '11 at 21:04
• @Bass, from stdin. Mar 27 '11 at 21:35
• You should add some test cases with the following difficult to handle issues: 1) messages with spaces, 2) messages with equal signs, 3) messages in inc_line, 4) messages in the first state of a dec_line, 5) messages in spaces in cases 3 & 4. Mar 28 '11 at 3:22
• The grammar has an error: There needs to be a literal space between the two state_name entries in dec_line. It is also unclear if you mean to require people to accept multiple spaces between tokens in the input. Mar 28 '11 at 3:37
• @Peter: +1 for a really meaty code-golf with good balance of specification and room to maneuver! Most questions here have been far too thin. Mar 28 '11 at 20:50

## Perl, 166

@p=<>;/=/,$_{$}=$' for split$",pop@p;$o='\w+';(map{($r
,$o,$,,$b)=$'=~/".*?"|\S+/g if/^$o :/}@p),$_=$o=($_{$r} +=','cmp$o)<0?do{$_{$r}=0;$b}:$,until/"/;say for eval,%_


Run with perl -M5.010 file.

It started wildly different, but I'm afraid it converged with the Ruby solution in many areas towards the end. Seems like Ruby's advantage is "no sigils", and Perl's "better regex integration".

A bit of detail from the innards, if you don't read Perl:

• @p=<>: read the whole machine description to @p
• /=/,$_{$}=$' for split$",pop@p: for each (for) assignment (split$") in the last machine description line (@p), locate equal sign (/=/) then assign value $' to hask %_ key $ • $o='\w+': initial state would be first one to match Perl regex "word characters"
• until/"/: loop until we reach a termination state:
• map{($r,$o,$,,$b)=$'=~/".*?"|\S+/g if/^$o :/}@p: loop on machine description @p: when we're on the line matching current state (if/^$o :/), tokenize (/".*?"|\S+/g) the rest of the line $' to variables ($r,$o,$,,$b). Trick: the same variable $o if used initially for label name and subsequently for operator. As soon as the label matches, the operator overrides it, and as a label can't (reasonably) be named + or -, it never matches again. • $_=$o=($_{$r}+=','cmp$o)<0?do{$_{$r}=0;$b}:$,:
- adjust target register $_{$r} up or down (ASCII magic: ','cmp'+' is 1 whereas ','cmp'-' is -1);
- if the result is negative (<0?, can only happens for -)
- then stay at 0 ($_{$r}=0) and return second label $b; - else return first (possibly sole) label $,
• BTW, it's $, instead of $a so it can be glued to next token until with no whitespace in between.
• say for eval,%_: dump report (eval) and contents of registers in %_
• You don't really need the colon in /^$o :/. The caret alone is enough to ensure you're only looking at labels. Mar 30 '11 at 23:17 • @Lowjacker I don't need it to determine I'm on the right label, but I need it to be kept out of $'. It's one character in the regex, it would be three $c, to account for from outside. Alternately some bigger yet change to the tokenizing regex. – J B Mar 31 '11 at 6:51 ## Haskell, 444 characters (w%f)(u@(s,v):z)|s==w=(s,f+v):z|t=u:(w%f)z (w%f)[]=[(w,f)] p#(a:z)|j==a=w p++[j]&z|t=(p++[a])#z;p#[]=w p p&(a:z)|j==a=p:""#z|t=(p++[a])&z c x=q(m!!0)$map((\(s,_:n)->(s,read n)).break(=='=')).w$last x where m=map(""#)$init x
q[_,_,r,"+",s]d=n s$r%1$d
q[_,_,r,_,s,z]d|maybe t(==0)(lookup r d)=n z d|t=n s$r%(-1)$d
n('"':s)d=unlines[s,d>>=(\(r,v)->r++'=':shows v" ")]
main=interact$c.lines t=1<3;j='"';w=words  Man, that was hard! Proper handling of messages with spaces in them cost over 70 characters. Output formatting to be more "human readable", and match the examples cost another 25. • Edit: (498 -> 482) various small in-linings, and some of @FUZxxl's suggestions • Edit: (482 -> 453) switch back using actual numbers for the registers; many golf tricks applied • Edit: (453 -> 444) inlined output formatting and initial value parsing • I don't know Haskell, so I can't decipher all the syntax, but I can decipher enough to see that you're using lists for the register contents. I must say I'm surprised that that's shorter than using ints. Mar 28 '11 at 12:24 • Putting the local bindings after where into a single line seperated by semicolons could save you 6 characters. And I guess you could save some chars in the definition of q by changing the verbose if-then-else to a pattern guard. Mar 28 '11 at 18:13 • And also: Just blindly assume, that the third value is "-" in the definition of q and use an underscore instead. Mar 28 '11 at 18:20 • I guess, you could save another char by changing line 8 to q[_,_,r,_,s,z]d|maybe t(==0)$lookup r d=n z d|t=n s$r%(-1)$d. But anyway, this program is golfed extremely good. Mar 29 '11 at 19:09
• You can shorten the parsing code considerably by taking advantage of lex from the Prelude. For example something like f[]=[];f s=lex s>>= \(t,r)->t:f r will split a line into tokens while handling quoted strings correctly. Nov 7 '11 at 1:53

*s,k=*$< a,=s b=Hash.new 0 eval k.gsub /(\w+)=/,';b["\1"]=' loop{x,y,r,o,t,f=a.scan /".*?"|\S+/ l=(b[r]-=o<=>?,)<0?(b[r]=0;f):t l[?"]&&puts(eval(l),b)&exit a,=s.grep /^#{l} /}  • I'd expect this to fail on labels prefixes of one another. Thoughts? – J B Mar 30 '11 at 11:57 • I can't seem to make it work with any other case than the examples. What's wrong with this? – J B Mar 30 '11 at 14:46 • I think it's fixed now. Mar 30 '11 at 15:59 • Ah, much better. Thank you. – J B Mar 30 '11 at 21:56 ## Delphi, 646 Delphi does not offer very much with regard to splitting strings and stuff. Luckily, we do have generic collections, which does help a bit, but this is still a rather largish solution : uses SysUtils,Generics.Collections;type P=array[0..99]of string;Y=TDictionary<string,P>;Z=TDictionary<string,Int32>;var t:Y;l,i:string;j,k:Int32;q:P;u:Z;v:TPair<string,Int32>;begin t:=Y.Create;repeat if i=''then i:=q[0];t.Add(q[0],q);ReadLn(l);for j:=0to 6do begin k:=Pos(' ',l+' ');q[j]:=Copy(l,1,k-1);Delete(l,1,k)end;until q[1]<>':';u:=Z.Create;j:=0;repeat k:=Pos('=',q[j]);u.Add(Copy(q[j],1,k-1),StrToInt(Copy(q[j],k+1,99)));Inc(j)until q[j]='';repeat q:=t[i];i:=q[4];u.TryGetValue(q[2],j);if q[3]='+'then Inc(j)else if j=0then i:=q[5]else Dec(j);u.AddOrSetValue(q[2],j)until i[1]='"';WriteLn(i);for v in u do Write(v.Key,'=',v.Value,' ')end.  Here the indented and commented version : uses SysUtils,Generics.Collections; type // P is a declaration line, offsets: // 0 = label // 1 = ':' // 2 = register // 3 = operation ('-' or '+') // 4 = 1st state (or message) // 5 = 2nd state (or message) P=array[0..99]of string; // T is a dictionary of all state lines : Y=TDictionary<string,P>; // Z is a dictionary of all registers : Z=TDictionary<string,Int32>; var t:Y; l, i:string; j, k:Int32; q:P; u:Z; v:TPair<string,Int32>; begin // Read all input lines : t:=Y.Create; repeat // Put all lines into a record if i=''then i:=q[0]; t.Add(q[0],q); // Split up each input line on spaces : ReadLn(l); for j:=0to 6do begin k:=Pos(' ',l+' '); q[j]:=Copy(l,1,k-1); Delete(l,1,k) end; // Stop when there are no more state transitions : until q[1]<>':'; // Scan initial registers : u:=Z.Create; j:=0; repeat k:=Pos('=',q[j]); // Add each name=value pair to a dictionary : u.Add(Copy(q[j],1,k-1),StrToInt(Copy(q[j],k+1,99))); Inc(j) until q[j]=''; // Execute the state machine : repeat q:=t[i]; i:=q[4]; u.TryGetValue(q[2],j); if q[3]='+'then Inc(j) else if j=0then i:=q[5] else Dec(j); u.AddOrSetValue(q[2],j) until i[1]='"'; WriteLn(i); for v in u do Write(v.Key,'=',v.Value,' ') end.  # Stax, 115 100 bytes ╥áípßNtP~£G±☼ΩtHô⌐╒╡~·7╝su9êq7h50Z╩ë&ñ╝←j╞.½5└∩√I|ù┤╧Åτ╘8┼ç╕╒Æ►^█₧♫÷?²H½$IG☺S╚]«♀_≥å∩A+∩╣Δ└▐♫!}♥swα


Run and debug it

# JavaScript (V8), 300 bytes

p=>{g=p.split
;r=g[g.length-1].split .map(R=>R.split=);g.pop();l=g.map(L=>L.match(/\w+|[+-]|"[ \w]+"/g));t=l[0][0];for(;;){c=l.find(L=>L[0]==t);(e=r.find(R=>R[0]==c[1]))||r.push(e=[c[1],0]);t=eval(c[2]+c[2]+"e[1]")<0?e[1]++&&c[4]:c[3];if(t[0]==")return t.slice(1,-1)+
+r.map(R=>R.join=)}}


Try it online!

I used a trick with eval to choose between ++e[1] and --e[1]... it only saved a few bytes but it's fun.

• What's it like, coding in a refridgerator? Feb 13 at 6:54
• @Razetime Cold. But lots of food! Feb 13 at 15:28

## PHP, 446441402398395389371370 366 characters

<?$t=trim;$e=explode;while($l=$t(fgets(STDIN))){if(strpos($l,"=")){foreach($e(" ",$l)as$b){list($k,$c)=$e("=",$b);$v[$k]=$c;}break;}list($k,$d)=$e(":",$l);$r[$z=$t($k)]=$t($d);$c=$c?:$z;}while($d=$e(" ",$r[$c],4)){$c=$v[$a=$d[0]]||!$d[3]?$d[2]:$d[3];if(!$r[$c]){eval("echo$c.'\n';");foreach($v as$k=>$c)echo$k."=".$c." ";die;}if(!$d[3]&&++$v[$a]||$v[$a]&&--$v[$a]);}


## Ungolfed

<?php

$register = array();$values = array();

while($line = trim(fgets(STDIN))){ if(strpos($line, "=")){

// Set each value and then continue to the calculations

foreach(explode(" ", $line) as$var){
list($key,$val) = explode("=", $var);$values[$key] =$val;
}

break;
}

list($key,$data) = explode(":", $line); // Add data to the register$register[$z = trim($key)] = trim($data); // Set the first register$current = $current?:$z;
}

while($data = explode(" ",$register[$current], 4)){ // Determine next register and current register$current = $values[$target = $data[0]] || !$data[3]? $data[2] :$data[3];

// Will return true if the register does not exist (Messages wont have a register)

if(!$register[$current]){

// No need to strip the quotes this way

eval("echo$current.'\n';"); // Print all values in the right formatting foreach($values as $key =>$val)
echo $key."=".$val." ";

die();
}

// Only subtraction has a third index
// Only positive values return true

// If there is no third index, then increase the value
// If there is a third index, increment the decrease the value if it is positive

// Uses PHP's short-circuit operators

if(!$data[3] && ++$values[$target] ||$values[$target] && --$values[$target]); }  ## Changelog 446 -> 441: Supports strings for the first state, and some slight compression 441 -> 402: Compressed if/else and assignment statements as much as possible 402 -> 398: Function names can be used as constants which can be used as strings 398 -> 395: Uses short circuit operators 395 -> 389: No need for the else part 389 -> 371: No need to use array_key_exists() 371 -> 370: Removed unneeded space 370 -> 366: Removed two unneeded spaces in the foreach # Groovy , 338 m={s=r=[:];z=[:] it.eachLine{e->((e==~/\w+=.*/)?{(e=~/((\w+)=(\d+))+/).each{r[it[2]]=it[3] as int}}:{f=(e=~/(\w+) : (.*)/)[0];s=s?:f[1];z[f[1]]=f[2];})()} while(s[0]!='"'){p=(z[s]=~/(\w+) (.) (\w+|(?:".*?")) ?(.*)?/)[0];s=p[3];a=r[p[1]]?:0;r[p[1]]=p[2]=='-'?a?a-1:{s=p[4];0}():a+1} println s[1..-2]+"\n"+r.collect{k,v->"$k=$v"}.join(' ')} ['''s0 : a - s1 "Ok" s1 : b + s0 a=3 b=4''':'''Ok a=0 b=7''', '''init : t - init d0 d0 : a - d1 a0 d1 : b + d2 d2 : t + d0 a0 : t - a1 "Ok" a1 : a + a0 a=3 b=4''':'''Ok a=3 b=7 t=0''', '''s0 : t - s0 s1 s1 : t + "t is 1" t=17''':'''t is 1 t=1''', '''s0 : t - "t is nonzero" "t is zero" t=1''':'''t is nonzero t=0''', '''init0 : k - init1 init3 init1 : r + init2 init2 : t + init0 init3 : t - init4 init5 init4 : k + init3 init5 : r - init6 "ERROR k is 0" init6 : i + init7 init7 : n - loop0 "ERROR n is 0" loop0 : n - loop1 "Ok" loop1 : i + loop2 loop2 : k - loop3 loop5 loop3 : r + loop4 loop4 : t + loop2 loop5 : t - loop6 loop7 loop6 : k + loop5 loop7 : i - loop8 loopa loop8 : r - loop9 loopc loop9 : t + loop7 loopa : t - loopb loop7 loopb : i + loopa loopc : t - loopd loopf loopd : i + loope loope : r + loopc loopf : i + loop0 n=40 k=3''':'''Ok i=40 k=3 n=0 r=27 t=0'''].collect {input,expectedOutput-> def actualOutput = m(input) actualOutput == expectedOutput }  • I tested this but it doesn't seem to output anything to stdout. What do I need to add to see the results? (PS the spec says that the order of the registers in the output is irrelevant, so you can save 7 chars from .sort()) Nov 21 '11 at 12:22 • @Peter thanks for the tip - I'll have to add 8 chars for println - ah well! Nov 21 '11 at 13:48 # Clojure (344 chars) With a few linebreaks for "readability": (let[i(apply str(butlast(slurp *in*)))] (loop[s(read-string i)p(->> i(replace(zipmap":\n=""[] "))(apply str)(format"{%s}")read-string)] (let[c(p s)](cond(string? s)(println s"\n"(filter #(number?(% 1))p)) (=(c 1)'-)(let[z(=(get p(c 0)0)0)](recur(c(if z 3 2))(if z p(update-in p[(c 0)]dec)))) 1(recur(c 2)(update-in p[(c 0)]#(if %(inc %)1)))))))  ## Postscript () () (852) (718) For reals this time. Executes all the test cases. It still requires the RM program to immediately follow in the program stream. Edit: More factoring, reduced procedure names. errordict/undefined{& " * 34 eq{.()= !{& " .(=). load " .( ).}forall ^()= stop}{^ ^ " 0 @ : 0}ifelse}put<</^{pop}/&{dup}/:{def}/#{exch}/*{& 0 get}/.{print}/~{1 index}/"{=string cvs}/{cvn # ^ #}/+={~ load add :}/++{1 ~ length 1 sub getinterval}/S{/I where{^}{/I ~ cvx :}ifelse}/D{/? # :/_ # cvlit :}/+{D S({//_ 1 +=//?})$ ^ :}/-{/| # : D S({//_ load 0 ne{//_ -1
+=//?}{//|}ifelse})$^ :}/![]/@{~/! #[# cvn ! aload length & 1 add # roll]:}/;{(=)search ^ # ^ # cvi @ :}/${* 32 eq{++}if * 34 eq{& ++(")search
^ length 2 add 4 3 roll # 0 # getinterval cvx }{token ^
#}ifelse}>>begin{currentfile =string readline ^( : )search{( + )search{
$^ +}{( - )search ^ $ $^ -}ifelse}{( ){search{;}{; I}ifelse}loop}ifelse}loop  Indented and commented with appended program. %! %Minsky Register Machine Simulation errordict/undefined{ %replace the handler for the /undefined error & " * 34 eq{ % if, after conversion to string, it begins with '"', .()= !{ % print it, print newline, iterate through the register list & " .(=). load " .( ). % print regname=value }forall ^()= stop % print newline, END PROGRAM }{ % if it doesn't begin with '"', it's an uninitialized register ^ ^ " 0 @ : 0 %initialize register to zero, return zero }ifelse }put << /^{pop} /&{dup} /:{def} % cf FORTH /#{exch} /*{& 0 get} % cf C /.{print} % cf BF % these fragments were repeated several times /~{1 index} /"{=string cvs} % convert to string /{cvn # ^ #} % convert to name, exch, pop, exch /+={~ load add :} % add a value to a variable /++{1 ~ length 1 sub getinterval} % increment a "string pointer" /S{/I where{^}{/I ~ cvx :}ifelse} %setINIT define initial state unless already done /D{/? # :/_ # cvlit :} %sr define state and register for generated procedure /+{D S({//_ 1 +=//?})$ ^ :} % generate an increment state and define
/-{/| # : D S({//_ load 0 ne{//_ -1 +=//?}{//|}ifelse})$^ :} % decrement state /![] %REGS list of registers /@{~/! #[# cvn ! aload length & 1 add # roll]:} %addreg append to REGS /;{(=)search ^ # ^ # cvi @ :} %regline process a register assignment /${ %tpe extract the next token or "string"
* 32 eq{++}if %skip ahead if space
* 34 eq{ %if quote, find the end-quote and snag both
& ++(")search ^ length 2 add 4 3 roll # 0 # getinterval cvx 
}{
token ^ # %not a quote: pull a token, exch, pop
}ifelse
}
>>begin

{
( : )search{ % if it's a state line
( + )search{ % if it's an increment
 $^ + %parse it }{ ( - )search ^ $ $^ - %it's a decrement. Parse it }ifelse }{ % not a state, do register assignments, and call initial state ( ){search{;}{; I}ifelse}loop %Look Ma, no exit! }ifelse }loop init0 : k - init1 init3 init1 : r + init2 init2 : t + init0 init3 : t - init4 init5 init4 : k + init3 init5 : r - init6 "ERROR k is 0" init6 : i + init7 init7 : n - loop0 "ERROR n is 0" loop0 : n - loop1 "Ok" loop1 : i + loop2 loop2 : k - loop3 loop5 loop3 : r + loop4 loop4 : t + loop2 loop5 : t - loop6 loop7 loop6 : k + loop5 loop7 : i - loop8 loopa loop8 : r - loop9 loopc loop9 : t + loop7 loopa : t - loopb loop7 loopb : i + loopa loopc : t - loopd loopf loopd : i + loope loope : r + loopc loopf : i + loop0 n=40 k=3  • It's a while since I wrote any PostScript, but are you defining functions with names like regline? Can't you save a lot by calling them things like R? Nov 4 '12 at 17:08 • Yes, definitely. But there's also a potential problem since all these definitions coexist with the state and register names in the same dictionary. So I've been trying to find punctuation chars with some mnemonic value (so I can still read it :). I'm also hoping to find more algorithmic reductions, so I didn't want to spend too much energy before I could look at it with fresh eyes. Nov 4 '12 at 18:30 # AWK - 447 BEGIN{FS=":"}NF<2{split($1,x," ");for(y in x){split(x[y],q,"=");
g[q[1]]=int(q[2])}}NF>1{w=$1;l=$2;gsub(/ /,"",w);if(!a)a=w;for(i=0;;)
{sub(/^ +/,"",l);if(l=="")break;if(substr(l,1,1)=="\""){l=substr(l,2);
z=index(l,"\"")}else{z=index(l," ");z||z=length(l)+1}d[w,i++]=
substr(l,1,z-1);l=substr(l,z+1)}}END{for(;;){if(!((a,0)in d))break;h=d[a,0];
if(d[a,1]~/+/){g[h]++;a=d[a,2]}else{a=g[h]?d[a,2]:d[a,3];g[h]&&g[h]--}}
print a;for(r in g)print r"="g[r]}


This is the output for the first test:

% cat | awk -f mrm1.awk
s0 : a - s1 "Ok"
s1 : b + s0
a=3 b=4
^D
Ok
a=0
b=7