aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

117
Task/Universal-Turing-machine/Perl-6/universal-turing-machine.pl6
View file

@ -2,73 +2,82 @@ sub run_utm(:$state! is copy, :$blank!, :@rules!, :@tape = [$blank], :$halt, :$p
$pos += @tape if $pos < 0;
die "Bad initial position" unless $pos ~~ ^@tape;
step:
print "$state\t";
for ^@tape {
my $v = @tape[$_];
print $_ == $pos ?? "[$v]" !! " $v ";
}
print "\n";
STEP: loop {
print "$state\t";
for ^@tape {
my $v = @tape[$_];
print $_ == $pos ?? "[$v]" !! " $v ";
}
print "\n";
return if $state eq $halt;
for @rules -> @rule {
my ($s0, $v0, $v1, $dir, $s1) = @rule;
next unless $s0 eq $state and @tape[$pos] eq $v0;
last if $state eq $halt;
@tape[$pos] = $v1;
for @rules -> @rule {
my ($s0, $v0, $v1, $dir, $s1) = @rule;
next unless $s0 eq $state and @tape[$pos] eq $v0;
given $dir {
when 'left' {
if $pos == 0 { unshift @tape, $blank }
else { $pos-- }
}
when 'right' {
push @tape, $blank if ++$pos >= @tape;
}
}
@tape[$pos] = $v1;
$state = $s1;
goto step;
given $dir {
when 'left' {
if $pos == 0 { unshift @tape, $blank }
else { $pos-- }
}
when 'right' {
push @tape, $blank if ++$pos >= @tape;
}
}
$state = $s1;
next STEP;
}
die 'No matching rules';
}
die "No matching rules";
}
say "incr machine";
run_utm :halt<qf>,
:state<q0>,
:tape[1,1,1],
:blank<B>,
:rules[ [< q0 1 1 right q0 >],]
[< q0 B 1 stay qf >] ];
:state<q0>,
:tape[1,1,1],
:blank<B>,
:rules[]
[< q0 1 1 right q0 >],
[< q0 B 1 stay qf >]
];
say "\nbusy beaver";
run_utm :halt<halt>,
:state<a>,
:blank<0>,
:rules[ [< a 0 1 right b >],]
[< a 1 1 left c >],
[< b 0 1 left a >],
[< b 1 1 right b >],
[< c 0 1 left b >],
[< c 1 1 stay halt >] ];
:state<a>,
:blank<0>,
:rules[]
[< a 0 1 right b >],
[< a 1 1 left c >],
[< b 0 1 left a >],
[< b 1 1 right b >],
[< c 0 1 left b >],
[< c 1 1 stay halt >]
];
say "\nsorting test";
run_utm :halt<STOP>,
:state<A>,
:blank<0>,
:tape[< 2 2 2 1 2 2 1 2 1 2 1 2 1 2 >],
:rules[ [< A 1 1 right A >],]
[< A 2 3 right B >],
[< A 0 0 left E >],
[< B 1 1 right B >],
[< B 2 2 right B >],
[< B 0 0 left C >],
[< C 1 2 left D >],
[< C 2 2 left C >],
[< C 3 2 left E >],
[< D 1 1 left D >],
[< D 2 2 left D >],
[< D 3 1 right A >],
[< E 1 1 left E >],
[< E 0 0 right STOP >] ];
:state<A>,
:blank<0>,
:tape[< 2 2 2 1 2 2 1 2 1 2 1 2 1 2 >],
:rules[]
[< A 1 1 right A >],
[< A 2 3 right B >],
[< A 0 0 left E >],
[< B 1 1 right B >],
[< B 2 2 right B >],
[< B 0 0 left C >],
[< C 1 2 left D >],
[< C 2 2 left C >],
[< C 3 2 left E >],
[< D 1 1 left D >],
[< D 2 2 left D >],
[< D 3 1 right A >],
[< E 1 1 left E >],
[< E 0 0 right STOP >]
];