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.