Symuluj maszynę rejestrującą Minsky'ego (I)

26

Istnieje wiele formalizmów, więc chociaż mogą okazać się przydatne inne źródła, mam nadzieję, że sprecyzuję to na tyle jasno, że nie będą one konieczne.

RM składa się ze skończonej maszyny stanów i skończonej liczby nazwanych rejestrów, z których każdy zawiera nieujemną liczbę całkowitą. Aby ułatwić wprowadzanie tekstu, zadanie to wymaga również nazwania stanów.

Istnieją trzy rodzaje stanów: inkrementacja i dekrementacja, które odnoszą się do określonego rejestru; i zakończyć. Stan przyrostowy zwiększa rejestr i przekazuje kontrolę jednemu następcy. Stan dekrementacji ma dwóch następców: jeśli jego rejestr jest różny od zera, to dekrementuje go i przekazuje kontrolę pierwszemu następcy; w przeciwnym razie (tzn. rejestr ma wartość zero), po prostu przekazuje kontrolę drugiemu następcy.

W przypadku „niceness” jako języka programowania, stany zakończenia wymagają wydrukowania na stałe łańcucha (abyś mógł wskazać wyjątkowe zakończenie).

Dane wejściowe pochodzą ze standardowego wejścia. Format wejściowy składa się z jednej linii na stan, po której następuje początkowa zawartość rejestru. Pierwszy wiersz to stan początkowy. BNF dla linii stanu to:

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

Istnieje pewna elastyczność w definicji identyfikatora i komunikatu. Twój program musi zaakceptować niepusty łańcuch znaków alfanumerycznych jako identyfikator, ale jeśli wolisz, może zaakceptować bardziej ogólne ciągi znaków (np. Jeśli Twój język obsługuje identyfikatory z podkreślnikami i jest to łatwiejsze w pracy). Podobnie do wiadomości, którą musi zaakceptować niepusty ciąg znaków alfanumerycznych i przestrzeni, ale mogą przyjąć bardziej skomplikowanych ciągów znaków, które pozwalają uciekły nowe linie i znaki cudzysłowu, jeśli chcesz.

Ostatni wiersz danych wejściowych, który podaje początkowe wartości rejestru, to oddzielona spacjami lista przypisań identyfikator = int, które muszą być niepuste. Nie jest wymagane, aby inicjalizowało wszystkie rejestry nazwane w programie: zakłada się, że każdy, który nie został zainicjowany, ma wartość 0.

Twój program powinien odczytać dane wejściowe i zasymulować RM. Kiedy osiągnie stan końcowy, powinien wyemitować komunikat, nowy wiersz, a następnie wartości wszystkich rejestrów (w dowolnym dogodnym, czytelnym dla człowieka formacie i dowolnej kolejności).

Uwaga: formalnie rejestry powinny zawierać nieograniczone liczby całkowite. Możesz jednak założyć, że wartość rejestru nigdy nie przekroczy 2 ^ 30.

Kilka prostych przykładów

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

Oczekiwane rezultaty:

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

Oczekiwane rezultaty:

Ok
a=3 b=7 t=0
Przypadki testowe dla maszyn trudniejszych do analizy
s0 : t - s0 s1
s1 : t + "t is 1"
t=17

Oczekiwane rezultaty:

t is 1
t=1

i

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

Oczekiwane rezultaty:

t is nonzero
t=0

Bardziej skomplikowany przykład

Zaczerpnięte z wyzwania DailyWTF z kodem problemu Josephusa. Dane wejściowe to n (liczba żołnierzy) ik (postęp), a dane wyjściowe w r to pozycja (o indeksie zerowym) osoby, która przeżyła.

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

Oczekiwane rezultaty:

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

Ten program jako obraz dla tych, którzy myślą wizualnie i uznaliby, że pomocne byłoby uchwycenie składni: Problem Józefa RM

Jeśli podobał ci się ten golf, spójrz na kontynuację .

Peter Taylor
źródło
Czy dane wejściowe pochodzą ze standardowego wejścia, pliku lub z innego miejsca?
Kevin Brown
@Bass, od standardowego.
Peter Taylor
Powinieneś dodać kilka przypadków testowych z następującymi trudnymi do rozwiązania problemami: 1) wiadomości ze spacjami, 2) wiadomości ze znakami równości, 3) wiadomości w inc_line, 4) wiadomości w pierwszym stanie dec_line, 5) wiadomości w spacjach w przypadki 3 i 4.
MtnViewMark
W gramatyce występuje błąd: między dwoma wpisami nazwa_stanu w dec_line musi znajdować się literalna spacja. Nie jest również jasne, czy chcesz, aby ludzie akceptowali wiele spacji między tokenami na wejściu.
MtnViewMark
2
@Peter: +1 za naprawdę mięsisty golf z dobrą równowagą specyfikacji i przestrzenią do manewru! Większość pytań tutaj była zbyt cienka.
MtnViewMark

Odpowiedzi:

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

Uruchom z perl -M5.010 file.

Zaczęło się zupełnie inaczej, ale obawiam się, że pod koniec zbiegło się z rozwiązaniem Ruby w wielu obszarach. Wydaje się, że zaletą Ruby jest „brak pieczęci”, a „lepsza integracja wyrażeń regularnych Perla”.

Trochę szczegółów z wnętrza, jeśli nie czytasz Perla:

  • @p=<>: przeczytaj cały opis maszyny do @p
  • /=/,$_{$`}=$' for split$",pop@p: dla każdego forprzypisania ( split$") w ostatnim wierszu opisu maszyny ( @p) zlokalizuj znak równości ( /=/), a następnie przypisz wartość $'do %_klucza skrótu$`
  • $o='\w+': stan początkowy byłby pierwszym, który będzie pasował do wyrażenia regularnego Perla „wyrażenie słowne”
  • until/"/: pętla, aż osiągniemy stan zakończenia:
    • map{($r,$o,$,,$b)=$'=~/".*?"|\S+/g if/^$o :/}@p: zapętlenie opisu maszyny @p: gdy jesteśmy w linii dopasowującej aktualny stan ( if/^$o :/), tokenize ( /".*?"|\S+/g) resztę linii $'do zmiennych ($r,$o,$,,$b). Sztuczka: ta sama zmienna, $ojeśli początkowo jest używana dla nazwy etykiety, a następnie dla operatora. Gdy tylko etykieta się zgadza, operator ją zastępuje, a ponieważ etykieta nie może (rozsądnie) nazywać się + lub -, nigdy więcej nie pasuje.
    • $_=$o=($_{$r}+=','cmp$o)<0?do{$_{$r}=0;$b}:$,:
      - dostosuj rejestr docelowy w $_{$r}górę lub w dół (magia ASCII: ','cmp'+'wynosi 1, a ','cmp'-'-1);
      - jeśli wynik jest ujemny ( <0?, może się zdarzyć tylko dla -)
      - to pozostań na 0 ( $_{$r}=0) i zwróć drugą etykietę $b;
      - w przeciwnym razie zwróć pierwszą (prawdopodobnie jedyną) etykietę$,
    • BTW, $,zamiast $atego można go przykleić do następnego tokena untilbez odstępów między nimi.
  • say for eval,%_: zrzut raportu ( eval) i zawartość rejestrów w%_
JB
źródło
Tak naprawdę nie potrzebujesz dwukropka /^$o :/. Samo daszek wystarczy, abyś patrzył tylko na etykiety.
Lowjacker 30.03.11
@Lowjacker Nie potrzebuję tego, aby stwierdzić, że jestem na dobrej etykiecie, ale potrzebuję tego z dala $'. Jest jedną postacią w wyrażeniu regularnym, którą można przypisać $c,do trzech z zewnątrz. Na przemian niektóre większe, ale jeszcze zmienione wyrażenia regularne.
JB
10

Python + C, 466 znaków

Dla zabawy program w języku Python, który kompiluje program RM do C, a następnie kompiluje i uruchamia 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
źródło
3
To nie zadziała, jeśli rejestry mają nazwy takie jak „ main”, „ if” itp.
Nabb
1
@Nabb: Buzzkill. Pozostawiam to czytelnikowi, aby dodać prefiksy podkreślenia w odpowiednich miejscach.
Keith Randall
6

Haskell, 444 znaki

(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

Człowieku, to było trudne! Prawidłowa obsługa wiadomości ze spacjami kosztuje ponad 70 znaków. Formatowanie wyjściowe, aby było bardziej „czytelne dla człowieka”, i pasujące do przykładów kosztowało kolejne 25.


  • Edytuj: (498 -> 482) różne małe wstawki i niektóre sugestie @ FUZxxl
  • Edycja: (482 -> 453) przełącz z powrotem, używając rzeczywistych numerów rejestrów; zastosowano wiele sztuczek golfowych
  • Edycja: (453 -> 444) wbudowane formatowanie wyjściowe i parsowanie wartości początkowej
MtnViewMark
źródło
Nie znam Haskella, więc nie mogę odszyfrować całej składni, ale mogę odczytać wystarczająco dużo, aby zobaczyć, że używasz list do zawartości rejestru. Muszę powiedzieć, że jestem zaskoczony, że jest to krótsze niż używanie ints.
Peter Taylor
Umieszczenie lokalnych powiązań wherew jednym wierszu oddzielonym średnikami może zaoszczędzić 6 znaków. I myślę, że możesz zaoszczędzić trochę znaków w definicji q, zmieniając pełne słowo „jeśli-to-jeszcze” na strażnika wzorów.
FUZxxl
A także: Po prostu ślepo załóżmy, że trzecia wartość jest "-"w definicji qi użyj zamiast tego podkreślenia.
FUZxxl
Myślę, że możesz uratować inny znak, zmieniając wiersz 8 na q[_,_,r,_,s,z]d|maybe t(==0)$lookup r d=n z d|t=n s$r%(-1)$d. Ale tak czy inaczej, ten program jest bardzo dobry w golfa.
FUZxxl
Możesz znacznie skrócić kod parsujący, korzystając lexz Preludium. Na przykład coś podobnego f[]=[];f s=lex s>>= \(t,r)->t:f rpodzieli linię na tokeny, poprawnie obsługując cytowane ciągi.
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
źródło
Spodziewałbym się, że to się nie powiedzie w przypadku prefiksów etykiet. Myśli?
JB
Wydaje mi się, że nie mogę sprawić, aby działał z innym przypadkiem niż w przykładach. Co jest z tym
JB
Myślę, że teraz jest to naprawione.
Lowjacker 30.03.11
Ach, o wiele lepiej. Dziękuję Ci.
JB
3

Delphi, 646

Delphi nie oferuje wiele w odniesieniu do dzielenia ciągów znaków i innych rzeczy. Na szczęście mamy kolekcje ogólne, co trochę pomaga, ale wciąż jest to dość duże rozwiązanie:

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.

Tutaj wersja z wcięciem i komentarzem:

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
źródło
1

PHP, 446 441 402 398 395 389 371 370 366 znaków

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

Nie golfił


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

Dziennik zmian


446 -> 441 : Obsługuje ciągi znaków dla pierwszego stanu i niewielką kompresję
441 -> 402 : Skompresowane jeśli / else i instrukcje przypisania w jak największym stopniu
402 -> 398 : Nazwy funkcji mogą być użyte jako stałe, które mogą być użyte jako ciągi
398 -> 395 : Wykorzystuje operatory zwarć
395 -> 389 : Nie ma potrzeby korzystania z drugiej części
389 -> 371 : Nie trzeba używać array_key_exists ()
371 -> 370 : Usunięto niepotrzebne miejsce
370 -> 366 : Usunięto dwa niepotrzebne spacje w foreach

Kevin Brown
źródło
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
źródło
1
Przetestowałem to, ale wydaje się, że nie wydaje niczego na standardowe wyjście . Co muszę dodać, aby zobaczyć wyniki? (PS specyfikacja mówi, że kolejność rejestrów na wyjściu jest nieistotna, więc można zapisać 7 znaków .sort())
Peter Taylor
@ Peter dziękuje za podpowiedź - będę musiał dodać 8 znaków dla println- no cóż!
Armand
1

Clojure (344 znaków)

Z kilkoma liniami podziału dla „czytelności”:

(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
źródło
1

Postscript () () (852) (718)

Tym razem dla reali. Wykonuje wszystkie przypadki testowe. Nadal wymaga, aby program RM natychmiast podążał za strumieniem programu.

Edycja: Więcej faktoringu, skrócone nazwy procedur.

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

Wcięte i skomentowane dołączonym programem.

%!
%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
źródło
Minęło trochę czasu, odkąd napisałem jakiś PostScript, ale czy definiujesz funkcje o nazwach takich jak regline? Czy nie możesz dużo zaoszczędzić, nazywając je takimi rzeczami R?
Peter Taylor,
Tak, zdecydowanie. Istnieje jednak również potencjalny problem, ponieważ wszystkie te definicje współistnieją ze stanem i rejestrują nazwy w tym samym słowniku. Próbowałem więc znaleźć znaki interpunkcyjne o pewnej wartości mnemonicznej (więc wciąż mogę to odczytać :). Mam również nadzieję, że znajdę więcej algorytmicznych redukcji, więc nie chciałem wydawać zbyt dużo energii, zanim mogłem na to spojrzeć świeżymi oczami.
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]}

To jest wynik pierwszego testu:

% cat | awk -f mrm1.awk
s0 : a - s1 "Ok"
s1 : b + s0
a=3 b=4
^D
Ok
a=0
b=7
Dan Andreatta
źródło
1

Stax , 115 100 bajtów

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

Uruchom i debuguj

rekurencyjny
źródło