Oxi allh perl

[Giorgos Keramidas]

On 2006-07-11 14:12, Christos Ricudis <ricudis at komodino.itc.auth.gr> wrote:
> SIGA mwre :
>
> #!perl
> #
> # Disclaimer : I have only proved this code correct (*), not acutally
> tested it.
> # (*) for simplicity, I have ommited some minor irrelevant issues
> involving infinity
> #
> # I/O tape
> $tape="00101001110101010010H";
> # transitions table
> # "$transitions[]="state,read,write,movement,new state";
> $transitions[0]="0,0,1,r,0";
> $transitions[1]="0,1,0,r,0";
> $transitions[2]="0,H,H,l,1";
> #
> $halt=0;
> $curstate=0;
> $curpos=0;
> while ($halt==0) {
>    $match=0;
>    foreach $i (@transitions) {
>       ($state,$read,$write,$movement,$newstate)=split(/,/,$i);
>       if (($state==$curstate) && ($read eq substr($tape,$curpos,1))) {
>          $match=1;
>          $curstate=$newstate;
>          substr($tape,$curpos,1)=$write;
>          if ($movement=="r") {
>                $curpos++;
>          } elsif ($movement=="l") {
>                $curpos--;
>          }
>          break;                                                }
>    }
>    if ($match==0) {
>        print "$tape\n";
>        $halt=1;
>    }
> }
>
> Twra to mono pou exeis na kaneis einai na ry8miseis swsta to $tape kai
> to $transitions[], kai na ftiakseis enan TCL interpreter.

On 2006-07-11 14:13, Dimitris Mexis <m65 at vivodinet.gr> wrote:
> Pare Pare kosme....
> Lisp uber alles! Perl pf!

Your wish is granted:

| CL-USER> (let ((tape #(0 0 1 0 1 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 H))
|                (transitions #(#(0 0 1 r 0)
|                               #(0 1 0 r 0)
|                               #(0 H H l 1))))
|            (let (halt (curstate 0) (curpos 0))
|              (loop while (not halt)
|                   do (let (match)
|                        (loop for x across transitions
|                           do (destructuring-bind (s r w m ns) (loop for v across x collect v)
|                                (when (and (equal s curstate) (equal r (aref tape curpos)))
|                                  (setq match t
|                                        curstate ns)
|                                  (setf (aref tape curpos) w)
|                                  (setq curpos
|                                        (+ curpos (cond ((equal 'R m) +1)
|                                                        ((equal 'L m) -1)
|                                                        (t 0))))
|                                    (return t))))
|                        (when (not match)
|                            (format t "~&~A" tape)
|                            (setq halt t))))))
| #(1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 0 1 1 0 1 H)
| NIL
| CL-USER>

Na perimenw ena TCL interpreter?