User:Ian/LARSA Interpreter

My LARSA interpreter in Perl

our %DATA, $datstr="", $cmdstr, $state="", @i;
our $ivalence, $ovalence, $var;
@{$DATA{'0'}}=@{$DATA{'1'}}=(0,1);

sub do_step {
	$_=shift;
	if (/^[01]$/) { $datstr.=$_;
	} elsif (length($datstr)<($_[0]||1)&&defined($_[5])) {
		$cmdstr=$_[5].$cmdstr; $state=$_[6]//$state;
	} else {
		$state=substr($_[4], ((1<<$_[3])-1-oct '0b' . substr $datstr, -$_[3], $_[3]), 1) if defined $_[4];
		$cmdstr=(substr $_[2], ((1<<$_[0])-1-oct '0b' . substr $datstr, -$_[0], $_[0], '')*$_[1], $_[1]).$cmdstr;
	}
}

sub process {
	my $_;
	while (length $cmdstr) {
		$_=substr $cmdstr, 0, 1, '';
		$_.=$state if defined $DATA{$_.$state};
		do_step $_, @{$DATA{$_}};
		print $state,'@',$datstr,'$',$cmdstr,"\n"; #stack trace
	}
}

while (<>) {
	while (/\\$/) {chomp; chop; $_.=<>}
	next if /^\$[01]=[^=]/; #Comment
	if (/^\$(..?)=(\d+)?(?:(?:@([^|]?))?\|(.*?))?(?:,(\d+)?(?:,(.*?)(?:(?:,(\d+))?,(.*))?)?)?$/) { #Assignment
		@i=@{$DATA{$1}}=($2//0,$5//int(length($6)/(1<<$2))//0,$6,$7//$2//0,$8,$4,$3);
		print $1,' (',$i[0],'--',$i[1],')=',$i[2],"\t@(",$i[3],')',
			defined($i[4])?'!':'','=',$i[4],defined($i[5])?"\t|".
			(defined($i[6])?'@!='.$i[6]:'').'|':'',$i[5],"\n";
	} elsif (/^#(.(.)?)?(?:,(\d+))?=(.*)$/) { #Table Composition
		my $var = $1;
		chomp $4; $cmdbak=$4; my $istate=$2;
		my @output=(),@ostate=(),$output="";
		my $datbak=$datstr, my $statebak=$state;
		my @vtrace=(), $ovalence=0;
		for (split //, $cmdbak) {
			$vtrace[++$#vtrace]=$DATA{$_}->[1]-$DATA{$_}->[0]+$vtrace[-1]//-1;
			$ovalence=$vtrace[-1]>0?$vtrace[-1]:$DATA{$_}->[1]>$ovalence?$DATA{$_}->[1]:$ovalence;
		}
		{local $,=", ";print @vtrace,"\n"};
		$ivalence = -(sort {$a <=> $b} @vtrace)[0]+1;
		$ivalence = 0 if $ivalence<0;
		$ivalence = $3 if defined $3;
		print 'Examining function: valence (',$ivalence,',',$ovalence,")...\n";
		for my $i (reverse 0..(1<<$ivalence)-1) {
			print 'Processing given ',$i," on the stack...\n";
			$datstr=substr sprintf('%0'.$ivalence.'b', $i), 0, $ivalence;
			($_, $state, $cmdstr)=($i, $istate, $cmdbak);
			process;
			print $var,"(",$i,"):(",$ivalence,",",length $datstr,")@",$state,"=",$datstr,"\n";
			push @output, $datstr;
			push @ostate, $state;
		}
		($datstr, $state)=($datbak, $statebak);
		$ovalence=(sort {$b <=> $a} map {length $_} @output)[0];
		$output=join '', map {sprintf '%'.$ovalence.'s',$_} @output;
		$istate=join '', map {$_ eq ''?"\x7F":$_} @ostate;
		$istate =~ s/\x7F*$//;
		undef $istate unless length $istate;
		print "*",$var,"=",$ivalence,",",$ovalence,",",$output,$istate?(",".$istate):'',"\n";
		@{$DATA{$var}}=($ivalence,$ovalence,$output,$ivalence,$istate);
	} else {chomp; $cmdstr=$_; process} #Evaluation
}

About the Interpreter

In addition to accepting LARSA assignments and evaluations, it also has a "composition" or "currying" feature (#[var][state]=[...]) that takes a group of commands and optionally assigns them to a new command. For example, if the stack was pqrs, #a=&|> would do p>(q|(r&s)) to the number (note the RPN ordering). It accepts an input bit count, so, if there was a "+" command that incremented the stack as a single binary number, #p,8=+++++ will generate a command p for all values from 0 to 255 that adds 5 to the input. It also does constant folding, so #o=1| would generate a table that takes one value and replaces it with 1 (unary tautology). If you don't want to assign it to a new command, use #=[...] to just test it and output a table. If a state is given, that will determine the initial state for the commands. The composition assignment, like a regular assignment, does not interfere with the current stack or state.