Oxi allh perl

[Dimitris Mexis]

On Tue, 11 Jul 2006 15:32:56 +0300, Giorgos Keramidas wrote:

> 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?

Respect!