Simulasikan Mesin Registrasi Minsky (I)

26

Ada banyak formalisme, jadi sementara Anda mungkin menemukan sumber-sumber lain yang berguna, saya berharap untuk menentukan ini dengan cukup jelas sehingga tidak perlu.

RM terdiri dari mesin keadaan terbatas dan sejumlah register bernama, yang masing-masing memegang bilangan bulat non-negatif. Untuk memudahkan input teks, tugas ini mengharuskan status yang disebutkan juga.

Ada tiga jenis negara: kenaikan dan penurunan, yang keduanya merujuk pada register tertentu; dan mengakhiri. Status kenaikan menambah registernya dan memberikan kendali kepada satu penggantinya. Negara penurunan memiliki dua penerus: jika registernya bukan nol maka ia menurunkannya dan memberikan kendali kepada penerus pertama; jika tidak (mis. register adalah nol) itu hanya melewati kontrol ke penerus kedua.

Untuk "kebaikan" sebagai bahasa pemrograman, status terminate mengambil string hard-coded untuk dicetak (sehingga Anda dapat mengindikasikan terminasi yang luar biasa).

Masukan dari stdin. Format input terdiri dari satu baris per negara, diikuti oleh konten register awal. Baris pertama adalah kondisi awal. BNF untuk jalur negara adalah:

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

Ada beberapa fleksibilitas dalam definisi pengidentifikasi dan pesan. Program Anda harus menerima string alfanumerik yang tidak kosong sebagai pengidentifikasi, tetapi mungkin menerima string yang lebih umum jika Anda lebih suka (misalnya jika bahasa Anda mendukung pengidentifikasi dengan garis bawah dan itu lebih mudah bagi Anda untuk bekerja dengannya). Demikian pula, untuk pesan Anda harus menerima string alfanumerik dan spasi yang tidak kosong, tetapi Anda dapat menerima string yang lebih kompleks yang memungkinkan baris baru dan karakter kutip ganda lolos jika Anda mau.

Baris input terakhir, yang memberikan nilai register awal, adalah daftar pengidentifikasi = int penugasan yang dipisahkan spasi, yang harus non-kosong. Tidak perlu menginisialisasi semua register yang disebutkan dalam program: semua yang tidak diinisialisasi diasumsikan 0.

Program Anda harus membaca input dan mensimulasikan RM. Ketika mencapai kondisi terminasi, ia harus memancarkan pesan, baris baru, dan kemudian nilai-nilai semua register (dalam format apa pun yang mudah dibaca oleh manusia, dalam format apa pun).

Catatan: secara formal register harus memegang bilangan bulat tidak terikat. Namun, Anda dapat jika Anda berasumsi bahwa nilai register tidak akan melebihi 2 ^ 30.

Beberapa contoh sederhana

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

Hasil yang diharapkan:

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

Hasil yang diharapkan:

Ok
a=3 b=7 t=0
Uji kasus untuk mesin rumit untuk parse
s0 : t - s0 s1
s1 : t + "t is 1"
t=17

Hasil yang diharapkan:

t is 1
t=1

dan

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

Hasil yang diharapkan:

t is nonzero
t=0

Contoh yang lebih rumit

Diambil dari tantangan kode masalah DailyWTF Josephus. Input adalah n (jumlah tentara) dan k (muka) dan output dalam r adalah posisi (diindeks nol) dari orang yang selamat.

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

Hasil yang diharapkan:

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

Program itu sebagai gambar, bagi mereka yang berpikir secara visual dan akan sangat membantu untuk memahami sintaksis: Masalah Josephus RM

Jika Anda menikmati golf ini, lihat sekuelnya .

Peter Taylor
sumber
Apakah input berasal dari stdin, dari file, atau dari tempat lain?
Kevin Brown
@Bass, dari stdin.
Peter Taylor
Anda harus menambahkan beberapa kasus uji dengan hal-hal berikut yang sulit ditangani: 1) pesan dengan spasi, 2) pesan dengan tanda sama dengan, 3) pesan dalam inc_line, 4) pesan dalam keadaan pertama dari dec_line, 5) pesan dalam spasi di case 3 & 4.
MtnViewMark
Tata bahasa memiliki kesalahan: Perlu ada ruang literal antara dua entri state_name di dec_line. Juga tidak jelas apakah Anda meminta orang untuk menerima beberapa spasi di antara token dalam input.
MtnViewMark
2
@ Peter: +1 untuk kode-golf yang benar-benar gemuk dengan keseimbangan spesifikasi yang baik dan ruang untuk bermanuver! Sebagian besar pertanyaan di sini terlalu tipis.
MtnViewMark

Jawaban:

10

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,%_

Jalankan dengan perl -M5.010 file.

Itu mulai sangat berbeda, tapi saya khawatir itu menyatu dengan solusi Ruby di banyak daerah menjelang akhir. Sepertinya keuntungan Ruby adalah "no sigils", dan Perl "integrasi regex yang lebih baik".

Sedikit detail dari jeroan, jika Anda tidak membaca Perl:

  • @p=<>: baca seluruh deskripsi mesin ke @p
  • /=/,$_{$`}=$' for split$",pop@p: untuk setiap forpenugasan ( split$") pada baris deskripsi mesin terakhir ( @p), cari tanda sama dengan ( /=/) lalu tetapkan nilai $'ke %_kunci hask$`
  • $o='\w+': keadaan awal akan menjadi yang pertama untuk mencocokkan Perl regex "karakter kata"
  • until/"/: loop sampai kami mencapai status terminasi:
    • map{($r,$o,$,,$b)=$'=~/".*?"|\S+/g if/^$o :/}@p: loop pada deskripsi mesin @p: ketika kita berada di baris yang sesuai dengan keadaan saat ini ( if/^$o :/), tokenize ( /".*?"|\S+/g) sisa baris $'ke variabel ($r,$o,$,,$b). Trik: variabel yang sama $ojika awalnya digunakan untuk nama label dan selanjutnya untuk operator. Segera setelah label cocok, operator menimpanya, dan karena label tidak dapat (secara wajar) dinamai + atau -, label tidak akan cocok lagi.
    • $_=$o=($_{$r}+=','cmp$o)<0?do{$_{$r}=0;$b}:$,:
      - sesuaikan register target $_{$r}naik atau turun (ASCII magic: ','cmp'+'adalah 1 sedangkan ','cmp'-'-1);
      - jika hasilnya negatif ( <0?, hanya bisa terjadi untuk -)
      - maka tetap pada 0 ( $_{$r}=0) dan kembalikan label kedua $b;
      - lain kembalikan label pertama (mungkin satu-satunya)$,
    • BTW, itu $,bukan $ajadi itu bisa menempel token berikutnya untiltanpa spasi putih di antaranya.
  • say for eval,%_: dump report ( eval) dan isi register di%_
JB
sumber
Anda tidak benar-benar membutuhkan usus besar /^$o :/. Tanda sisipan saja sudah cukup untuk memastikan Anda hanya melihat label.
Lowjacker
@ Lowjacker Saya tidak membutuhkannya untuk menentukan saya berada di label yang tepat, tapi saya perlu itu dijauhkan $'. Itu satu karakter di regex, itu akan menjadi tiga $c,untuk menjelaskan dari luar. Secara bergantian beberapa yang lebih besar namun berubah menjadi regen tokenizing.
JB
10

Python + C, 466 karakter

Hanya untuk bersenang-senang, program python yang mengkompilasi program RM ke C, lalu mengkompilasi & menjalankan C.

import sys,os,shlex
G=shlex.shlex(sys.stdin).get_token
A=B=''
C='_:'
V={}
J=lambda x:'goto '+x+';'if'"'!=x[0]else'{puts('+x+');goto _;}'
while 1:
 L,c=G(),G()
 if''==c:break
 if':'==c:
  v,d=G(),G()
  V[v]=1;B+=L+c+v+d+d+';'
  if'+'==d:B+=J(G())
  else:B+='if('+v+'>=0)'+J(G())+'else{'+v+'=0;'+J(G())+'}'
 else:A+=L+c+G()+';'
for v in V:C+='printf("'+v+'=%d\\n",'+v+');'
open('C.c','w').write('int '+','.join(V)+';main(){'+A+B+C+'}')
os.system('gcc -w C.c;./a.out')
Keith Randall
sumber
3
Ini tidak akan berfungsi jika register memiliki nama seperti ' main', ' if', dll.
Nabb
1
@Nabb: Buzzkill. Saya serahkan kepada pembaca untuk menambahkan awalan garis bawah di tempat yang tepat.
Keith Randall
6

Haskell, 444 karakter

(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" ")]
 n s d=q(filter((==s).head)m!!0)d
main=interact$c.lines
t=1<3;j='"';w=words

Astaga, itu sulit! Penanganan pesan yang benar dengan spasi di dalamnya membutuhkan biaya lebih dari 70 karakter. Format pemformatan menjadi lebih "terbaca oleh manusia", dan sesuai dengan contoh, biayanya 25 lainnya.


  • Sunting: (498 -> 482) berbagai in-linings kecil, dan beberapa saran @ FUZxxl
  • Sunting: (482 -> 453) kembali menggunakan nomor aktual untuk register; banyak trik golf diterapkan
  • Sunting: (453 -> 444) format output inline dan parsing nilai awal
MtnViewMark
sumber
Saya tidak tahu Haskell, jadi saya tidak bisa menguraikan semua sintaks, tetapi saya bisa menguraikan cukup untuk melihat bahwa Anda menggunakan daftar untuk konten register. Saya harus mengatakan saya terkejut bahwa itu lebih pendek daripada menggunakan int.
Peter Taylor
Menempatkan binding lokal setelah wheremenjadi satu baris yang dipisahkan oleh titik koma dapat menghemat 6 karakter. Dan saya kira Anda bisa menyimpan beberapa karakter dalam definisi qdengan mengubah verbose jika-maka-lagi menjadi penjaga pola.
FUZxxl
Dan juga: Anggap saja secara membuta, bahwa nilai ketiga ada "-"dalam definisi qdan gunakan garis bawah sebagai gantinya.
FUZxxl
Saya kira, Anda dapat menyimpan char lain dengan mengubah baris 8 menjadi q[_,_,r,_,s,z]d|maybe t(==0)$lookup r d=n z d|t=n s$r%(-1)$d. Tapi bagaimanapun, program ini golf sangat bagus.
FUZxxl
Anda dapat mempersingkat kode parsing dengan mengambil keuntungan dari lexPrelude. Misalnya sesuatu seperti f[]=[];f s=lex s>>= \(t,r)->t:f rakan membagi garis menjadi token sambil menangani string yang dikutip dengan benar.
hammar
6

Ruby 1.9, 214 212 211 198 195 192 181 175 173 175

*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} /}
Lowjacker
sumber
Saya berharap ini gagal pada label awalan satu sama lain. Pikiran?
JB
Sepertinya saya tidak bisa membuatnya bekerja dengan kasus lain selain contoh. Ada apa dengan ini?
JB
Saya pikir itu sudah diperbaiki sekarang.
Lowjacker
Ah, jauh lebih baik. Terima kasih.
JB
3

Delphi, 646

Delphi tidak menawarkan banyak hal berkaitan dengan string dan hal-hal yang membelah. Untungnya, kami memiliki koleksi generik, yang memang sedikit membantu, tetapi ini masih merupakan solusi yang agak besar:

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.

Di sini versi indentasi dan komentar:

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.
PatrickvL
sumber
1

PHP, 446 441 402 398 395 389 371 370 366 karakter

<?$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]);}

Tidak disatukan


<?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 : Mendukung string untuk status pertama, dan sedikit kompresi
441 -> 402 : Terkompresi jika / lain dan pernyataan penugasan sebanyak mungkin
402 -> 398 : Nama fungsi dapat digunakan sebagai konstanta yang dapat digunakan sebagai string
398 -> 395 : Menggunakan operator hubung singkat
395 -> 389 : Tidak perlu untuk bagian lain
389 -> 371 : Tidak perlu menggunakan array_key_exists ()
371 -> 370 : Menghapus ruang yang tidak dibutuhkan
370 -> 366 : Menghapus dua ruang yang tidak dibutuhkan di pendahuluan

Kevin Brown
sumber
1

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
}
Armand
sumber
1
Saya menguji ini tetapi tampaknya tidak menghasilkan apa pun untuk stdout . Apa yang perlu saya tambahkan untuk melihat hasilnya? (PS spec mengatakan bahwa urutan register dalam output tidak relevan, sehingga Anda dapat menyimpan 7 karakter dari .sort())
Peter Taylor
@ Peter terima kasih atas tipnya - saya harus menambahkan 8 karakter untuk println- ah well!
Armand
1

Clojure (344 karakter)

Dengan beberapa linebreak untuk "keterbacaan":

(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)))))))
Omar
sumber
1

Postscript () () (852) (718)

Untuk real kali ini. Menjalankan semua test case. Masih membutuhkan program RM untuk segera mengikuti aliran program.

Sunting: Lebih banyak anjak piutang, nama prosedur yang dikurangi.

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

Diindentasi dan dikomentari dengan program terlampir.

%!
%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

{
    currentfile =string readline ^
    ( : )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
luser droog
sumber
Sudah lama sejak saya menulis PostScript, tetapi apakah Anda mendefinisikan fungsi dengan nama seperti regline? Tidak bisakah Anda menghemat banyak dengan menyebut mereka hal-hal seperti R?
Peter Taylor
Iya tentu saja. Tetapi ada juga masalah potensial karena semua definisi ini hidup berdampingan dengan negara dan mendaftarkan nama dalam kamus yang sama. Jadi saya sudah mencoba mencari tanda baca dengan beberapa nilai mnemonik (jadi saya masih bisa membacanya :). Saya juga berharap menemukan lebih banyak pengurangan algoritmik, jadi saya tidak ingin menghabiskan terlalu banyak energi sebelum saya bisa melihatnya dengan mata segar.
luser droog
1

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]}

Ini adalah output untuk tes pertama:

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

Stax , 115 100 byte

╥áípßNtP~£G±☼ΩtHô⌐╒╡~·7╝su9êq7h50Z`╩ë&ñ╝←j╞.½5└∩√I|ù┤╧Åτ╘8┼ç╕╒Æ►^█₧♫÷?²H½$IG☺S╚]«♀_≥å∩A+∩╣Δ└▐♫!}♥swα

Jalankan dan debug itu

rekursif
sumber