Simuler une machine de registre Minsky (I)


26

Il existe de nombreux formalismes, alors même si vous pouvez trouver d'autres sources utiles, j'espère le préciser suffisamment pour qu'elles ne soient pas nécessaires.

Un RM se compose d'une machine à états finis et d'un nombre fini de registres nommés, dont chacun contient un entier non négatif. Pour faciliter la saisie textuelle, cette tâche nécessite que les états soient également nommés.

Il existe trois types d'état: incrément et décrément, qui font tous deux référence à un registre spécifique; et terminer. Un état d'incrémentation incrémente son registre et passe le contrôle à son seul successeur. Un état de décrémentation a deux successeurs: si son registre est différent de zéro, il le décrémente et passe le contrôle au premier successeur; sinon (c'est-à-dire que le registre est nul), il passe simplement le contrôle au deuxième successeur.

Pour la "gentillesse" en tant que langage de programmation, les états de terminaison prennent une chaîne codée en dur à imprimer (vous pouvez donc indiquer une terminaison exceptionnelle).

L'entrée provient de stdin. Le format d'entrée se compose d'une ligne par état, suivie du contenu du registre initial. La première ligne est l'état initial. BNF pour les lignes d'état est:

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

Il y a une certaine flexibilité dans la définition de l'identifiant et du message. Votre programme doit accepter une chaîne alphanumérique non vide comme identifiant, mais il peut accepter des chaînes plus générales si vous préférez (par exemple, si votre langue prend en charge les identificateurs avec des traits de soulignement et c'est plus facile pour vous de travailler avec). De même, pour le message, vous devez accepter une chaîne non vide d'alpha et d'espaces, mais vous pouvez accepter des chaînes plus complexes qui autorisent les sauts de ligne et les guillemets doubles si vous le souhaitez.

La dernière ligne d'entrée, qui donne les valeurs initiales du registre, est une liste séparée des espaces d'affectations identificateur = int, qui doit être non vide. Il n'est pas nécessaire d'initialiser tous les registres nommés dans le programme: tous ceux qui ne sont pas initialisés sont supposés être 0.

Votre programme doit lire l'entrée et simuler la RM. Lorsqu'il atteint un état de fin, il doit émettre le message, une nouvelle ligne, puis les valeurs de tous les registres (dans n'importe quel format pratique, lisible par l'homme, et dans n'importe quel ordre).

Remarque: formellement, les registres doivent contenir des entiers non bornés. Cependant, vous pouvez, si vous le souhaitez, supposer qu'aucune valeur de registre ne dépassera jamais 2 ^ 30.

Quelques exemples simples

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

Résultats attendus:

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

Résultats attendus:

Ok
a=3 b=7 t=0
Cas de test pour des machines plus difficiles à analyser
s0 : t - s0 s1
s1 : t + "t is 1"
t=17

Résultats attendus:

t is 1
t=1

et

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

Résultats attendus:

t is nonzero
t=0

Un exemple plus compliqué

Tiré du défi de code de problème Josephus du DailyWTF. L'entrée est n (nombre de soldats) et k (avance) et la sortie en r est la position (indexée zéro) de la personne qui survit.

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

Résultats attendus:

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

Ce programme comme une image, pour ceux qui pensent visuellement et trouveraient utile de saisir la syntaxe: Problème de Josephus RM

Si vous avez aimé ce golf, regardez la suite .


L'entrée provient-elle de stdin, d'un fichier ou d'un autre endroit?
Kevin Brown

@Bass, de stdin.
Peter Taylor

Vous devez ajouter des cas de test avec les problèmes suivants difficiles à gérer: 1) messages avec des espaces, 2) messages avec des signes égaux, 3) messages dans inc_line, 4) messages dans le premier état d'une dec_line, 5) messages dans des espaces dans cas 3 et 4.
MtnViewMark

La grammaire contient une erreur: il doit y avoir un espace littéral entre les deux entrées state_name dans dec_line. Il n'est pas clair non plus si vous voulez obliger les utilisateurs à accepter plusieurs espaces entre les jetons dans l'entrée.
MtnViewMark

2
@Peter: +1 pour un golf de code vraiment charnu avec un bon équilibre de spécifications et une marge de manœuvre! La plupart des questions ici ont été beaucoup trop fines.
MtnViewMark

Réponses:


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

Courez avec perl -M5.010 file.

Cela a commencé très différemment, mais je crains qu'elle ne converge avec la solution Ruby dans de nombreux domaines vers la fin. On dirait que l'avantage de Ruby est «pas de sceaux» et «une meilleure intégration regex» de Perl.

Un petit détail des entrailles, si vous ne lisez pas Perl:

  • @p=<>: lire la description complète de la machine pour @p
  • /=/,$_{$`}=$' for split$",pop@p: pour chaque ( for) affectation ( split$") dans la dernière ligne de description de la machine ( @p), recherchez le signe égal ( /=/) puis affectez une valeur $'à la %_clé de hachage$`
  • $o='\w+': l'état initial serait le premier à correspondre aux «caractères de mots» de l'expression rationnelle de Perl
  • until/"/: boucle jusqu'à ce que nous atteignions un état de terminaison:
    • map{($r,$o,$,,$b)=$'=~/".*?"|\S+/g if/^$o :/}@p: boucle sur la description de la machine @p: lorsque nous sommes sur la ligne correspondant à l'état actuel ( if/^$o :/), jetons ( /".*?"|\S+/g) le reste de la ligne $'aux variables ($r,$o,$,,$b). Astuce: la même variable $osi elle est utilisée initialement pour le nom de l'étiquette et ensuite pour l'opérateur. Dès que l'étiquette correspond, l'opérateur la remplace et comme une étiquette ne peut pas (raisonnablement) être nommée + ou -, elle ne correspond plus.
    • $_=$o=($_{$r}+=','cmp$o)<0?do{$_{$r}=0;$b}:$,:
      - ajustez le registre cible $_{$r}vers le haut ou vers le bas (magie ASCII: ','cmp'+'vaut 1 alors que ','cmp'-'-1);
      - si le résultat est négatif ( <0?, ne peut se produire que pour -)
      - alors restez à 0 ( $_{$r}=0) et retournez la deuxième étiquette $b;
      - sinon retourner la première (éventuellement la seule) étiquette$,
    • BTW, c'est au $,lieu de $adonc il peut être collé au jeton suivant untilsans espace blanc entre les deux.
  • say for eval,%_: vidage du rapport ( eval) et du contenu des registres dans%_

Vous n'avez pas vraiment besoin des deux points /^$o :/. Le simple signe d'insertion suffit à garantir que vous ne regardez que les étiquettes.
Lowjacker

@Lowjacker Je n'en ai pas besoin pour déterminer que je suis sur la bonne étiquette, mais j'ai besoin de le garder à l'écart $'. C'est un personnage dans l'expression régulière, ce serait trois $c,à rendre compte de l'extérieur. Alternativement, certains plus gros encore changent en expression rationnelle symbolique.
JB

10

Python + C, 466 caractères

Juste pour le plaisir, un programme python qui compile le programme RM en C, puis compile et exécute le 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')

3
Cela ne fonctionnera pas si les registres ont des noms comme ' main', ' if', etc.
Nabb

1
@Nabb: Buzzkill. Je laisse au lecteur le soin d'ajouter des préfixes de soulignement aux bons endroits.
Keith Randall

6

Haskell, 444 caractères

(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

C'était dur! La bonne gestion des messages contenant des espaces coûte plus de 70 caractères. Le formatage de sortie doit être plus "lisible par l'homme" et correspondre aux exemples coûte encore 25.


  • Edit: (498 -> 482) diverses petites doublures, et quelques suggestions de @ FUZxxl
  • Modifier: (482 -> 453) revenir en arrière en utilisant les nombres réels pour les registres; de nombreuses astuces de golf appliquées
  • Modifier: (453 -> 444) formatage de sortie en ligne et analyse de la valeur initiale

Je ne connais pas Haskell, donc je ne peux pas déchiffrer toute la syntaxe, mais je peux assez déchiffrer pour voir que vous utilisez des listes pour le contenu du registre. Je dois dire que je suis surpris que ce soit plus court que d'utiliser des pouces.
Peter Taylor

Mettre les liaisons locales après wheresur une seule ligne séparée par des points-virgules pourrait vous faire économiser 6 caractères. Et je suppose que vous pouvez enregistrer certains caractères dans la définition de qen changeant le si-alors-sinon verbeux en garde de modèle.
FUZxxl

Et aussi: Supposez simplement aveuglément que la troisième valeur est "-"dans la définition qet utilisez un trait de soulignement à la place.
FUZxxl

Je suppose que vous pouvez enregistrer un autre caractère en remplaçant la ligne 8 par q[_,_,r,_,s,z]d|maybe t(==0)$lookup r d=n z d|t=n s$r%(-1)$d. Mais de toute façon, ce programme est extrêmement bien joué.
FUZxxl

Vous pouvez raccourcir considérablement le code d'analyse en tirant parti du lexPrélude. Par exemple, quelque chose comme f[]=[];f s=lex s>>= \(t,r)->t:f rdivisera une ligne en jetons tout en gérant correctement les chaînes entre guillemets.
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} /}

Je m'attendrais à ce que cela échoue sur les préfixes des étiquettes les uns des autres. Pensées?
JB

Je n'arrive pas à le faire fonctionner avec un autre cas que les exemples. Quel est le problème avec ça?
JB

Je pense que c'est réparé maintenant.
Lowjacker

Ah, beaucoup mieux. Merci.
JB

3

Delphi, 646

Delphi n'offre pas grand-chose en ce qui concerne le fractionnement de chaînes et d'autres choses. Heureusement, nous avons des collections génériques, ce qui aide un peu, mais c'est toujours une solution assez large:

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.

Voici la version échancrée et commentée:

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.

1

PHP, 446 441 402 398 395 389 371 370 366 caractères

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

Non golfé


<?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 : Prend en charge les chaînes pour le premier état, et une légère compression
441 -> 402 : Compression if / else et instructions d'affectation autant que possible
402 -> 398 : Les noms de fonction peuvent être utilisés comme constantes pouvant être utilisées comme chaînes
398 -> 395 : Utilise des opérateurs de court-circuit
395 -> 389 : Pas besoin de la partie else
389 -> 371 : Pas besoin d'utiliser array_key_exists ()
371 -> 370 : Suppression de l'espace inutile
370 -> 366 : Suppression de deux espaces inutiles dans le foreach


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
}

1
J'ai testé cela mais il ne semble rien produire sur stdout . Que dois-je ajouter pour voir les résultats? (PS, la spécification indique que l'ordre des registres dans la sortie n'est pas pertinent, vous pouvez donc enregistrer 7 caractères .sort())
Peter Taylor

@Peter merci pour l'astuce - je vais devoir ajouter 8 caractères pour println- ah bien!
Armand

1

Clojure (344 caractères)

Avec quelques sauts de ligne pour la "lisibilité":

(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)))))))

1

Postscript () () (852) (718)

Pour des vrais cette fois. Exécute tous les cas de test. Il nécessite toujours que le programme RM suive immédiatement le flux du programme.

Edit: plus d'affacturage, noms de procédures réduits.

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

Indenté et commenté avec programme annexé.

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

Cela fait un moment que je n'ai pas écrit de PostScript, mais définissez-vous des fonctions avec des noms comme regline? Tu ne peux pas économiser beaucoup en les appelant des choses comme R?
Peter Taylor

Oui définitivement. Mais il y a aussi un problème potentiel car toutes ces définitions coexistent avec les noms d'état et de registre dans le même dictionnaire. J'ai donc essayé de trouver des caractères de ponctuation avec une valeur mnémonique (donc je peux toujours le lire :). J'espère aussi trouver plus de réductions algorithmiques, donc je ne voulais pas dépenser trop d'énergie avant de pouvoir le regarder avec des yeux neufs.
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]}

Voici la sortie du premier test:

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

1

Stax , 115 100 bytes

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

Exécuter et déboguer

En utilisant notre site, vous reconnaissez avoir lu et compris notre politique liée aux cookies et notre politique de confidentialité.
Licensed under cc by-sa 3.0 with attribution required.