base10-slow-add.tm

"Michael C. Toren" <[email protected]> Fri, 17 Sep 2004 15:18:46 -0400
Newsgroups gmane.comp.lang.perl.qotw.discuss
Message-ID <[email protected]>
After writing a base10 incrementer I was surprised how simple it was.
(The binary incrementer which appeared in the quiz announcement contains
an extra unnecessary step which seeks the head left after incrementing.)

Afterwards I was motivated to write a base10 slow adder.  The program
contains one loops, which with each iteration decrements the second
argument and increments the first argument, until the second argument
reaches zero:

	# Head is at start of first argument, move to start of second argument
	SeekR1 0 SeekR1 0 R
	SeekR1 1 SeekR1 1 R
	SeekR1 2 SeekR1 2 R
	SeekR1 3 SeekR1 3 R
	SeekR1 4 SeekR1 4 R
	SeekR1 5 SeekR1 5 R
	SeekR1 6 SeekR1 6 R
	SeekR1 7 SeekR1 7 R
	SeekR1 8 SeekR1 8 R
	SeekR1 9 SeekR1 9 R
	SeekR1 _ SeekR2 _ R

	# Head is at start of second argument, move to end of second argument
	SeekR2 0 SeekR2 0 R
	SeekR2 1 SeekR2 1 R
	SeekR2 2 SeekR2 2 R
	SeekR2 3 SeekR2 3 R
	SeekR2 4 SeekR2 4 R
	SeekR2 5 SeekR2 5 R
	SeekR2 6 SeekR2 6 R
	SeekR2 7 SeekR2 7 R
	SeekR2 8 SeekR2 8 R
	SeekR2 9 SeekR2 9 R
	SeekR2 _ Dec    _ L

	# Head is at end of second argument; Decrement
	Dec 9 NoMoveSeekL 8 R
	Dec 8 NoMoveSeekL 7 R
	Dec 7 NoMoveSeekL 6 R
	Dec 6 NoMoveSeekL 5 R
	Dec 5 NoMoveSeekL 4 R
	Dec 4 NoMoveSeekL 3 R
	Dec 3 NoMoveSeekL 2 R
	Dec 2 NoMoveSeekL 1 R
	Dec 1 NoMoveSeekL 0 R
	Dec 0 Dec         9 L
	Dec _ CleanUp     _ R	# Nothing left to decrement

	CleanUp 9 CleanUp _ R
	CleanUp _ End     _ R

	NoMoveSeekL _ SeekL _ L
	NoMoveSeekL 0 SeekL 0 L
	NoMoveSeekL 1 SeekL 1 L
	NoMoveSeekL 2 SeekL 2 L
	NoMoveSeekL 3 SeekL 3 L
	NoMoveSeekL 4 SeekL 4 L
	NoMoveSeekL 5 SeekL 5 L
	NoMoveSeekL 6 SeekL 6 L
	NoMoveSeekL 7 SeekL 7 L
	NoMoveSeekL 8 SeekL 8 L
	NoMoveSeekL 9 SeekL 9 L

	# Head is in second argument, move to end of first argument
	SeekL 0 SeekL 0 L
	SeekL 1 SeekL 1 L
	SeekL 2 SeekL 2 L
	SeekL 3 SeekL 3 L
	SeekL 4 SeekL 4 L
	SeekL 5 SeekL 5 L
	SeekL 6 SeekL 6 L
	SeekL 7 SeekL 7 L
	SeekL 8 SeekL 8 L
	SeekL 9 SeekL 9 L
	SeekL _ Inc   _ L

	# Head is at the end of first argument; Increment
	Inc _ NoMoveSeekR1 1 L
	Inc 0 NoMoveSeekR1 1 L
	Inc 1 NoMoveSeekR1 2 L
	Inc 2 NoMoveSeekR1 3 L
	Inc 3 NoMoveSeekR1 4 L
	Inc 4 NoMoveSeekR1 5 L
	Inc 5 NoMoveSeekR1 6 L
	Inc 6 NoMoveSeekR1 7 L
	Inc 7 NoMoveSeekR1 8 L
	Inc 8 NoMoveSeekR1 9 L
	Inc 9 Inc          0 L

	NoMoveSeekR1 0 SeekR1 0 R
	NoMoveSeekR1 1 SeekR1 1 R
	NoMoveSeekR1 2 SeekR1 2 R
	NoMoveSeekR1 3 SeekR1 3 R
	NoMoveSeekR1 4 SeekR1 4 R
	NoMoveSeekR1 5 SeekR1 5 R
	NoMoveSeekR1 6 SeekR1 6 R
	NoMoveSeekR1 7 SeekR1 7 R
	NoMoveSeekR1 8 SeekR1 8 R
	NoMoveSeekR1 9 SeekR1 9 R
	NoMoveSeekR1 _ SeekR1 _ R

-mct

-- 
perl -e'$u="\4\5\6";sub H{8*($_[1]%79)+($_[0]%8)}sub G{vec$u,H(@_),1}sub S{vec
($n,H(@_),1)=$_[2]}$_=q^{P`clear`;for$iX){PG($iY)?"O":" "forX8);P"\n"}for$iX){
forX8){$c=scalar grep{G@$_}[$i-1Y-1Z-1YZ-1Y+1ZY-1ZY+1Z+1Y-1Z+1YZ+1Y+1];S$iY,G(
$iY)?$c=~/[23]/?1:0:$c==3?1:0}}$u=$n;select$M,$C,$T,.2;redo}^;s/Z/],[\$i/g;s/Y
/,\$_/xg;s/X/(0..7/g;s/P/print+/g;eval' #     Michael C. Toren <[email protected]>