2017 day 21 optimize

[aoc_eblake.git] / 2019 / intcode.barem4

_ -*- m4 -*-
_ This file extends barem4.txt, which demonstrates how the m4 langauge
_ is Turing complete with JUST the define builtin.  (It also uses the
_ `dnl' builtin, spelled as `_' for legibility, but the concept still
_ works even if you strip all comments out.)  This is an implementation
_ of the core engine for an Intcode virtual machine, from Advent of
_ Code 2019 https://adventofcode.com/2019 (see days 2, 5, 7, and 9
_ for the machine definition, and then odd days 11-25 for more uses).
_ In general, you will still need to write some more code in barem4
_ in order to manage execution of this engine, since some of the Advent
_ of Code puzzles require repeated executions.
_
_ barem4.txt was written by Douglas McIlroy, and can be found at
_ www.cs.dartmouth.edu/~doug/barem4.txt
_
_ I'm tempted to redefine the various switch macros to properly quote
_ arguments, by using DOL(@). But for now, premature quote stripping
_ doesn't break anything in this file.
_
_ Although this file implements the intcode engine, you still need to
_ load your program and input separately.  The initial program is loaded
_ by defining macros M_<base2> where the machine will start executing at
_ instruction M_0.  The input instruction, opcode 3, defaults to consuming
_ integers defined in the I<base2> namespace, although this can be changed
_ by redefining `input'.  Note that I've also written encode.m4, which
_ can be used to convert an input file containing an intcode program
_ consisting of a comma-separated list of decimal numbers into a series
_ of macro definitions, for easier loading of a program for this engine:
_
_ m4 -Dfile=dayN.input encode.m4 | m4 barem4.txt - intcode.barem4 dayN.barem4
_
_ For some slight optimizations, inline several constants rather than
_ repeating use of multiple succ() each time they are reused.  And add a
_ couple more common constants.
_
define(`five', succ(four))_
define(`six', succ(five))_
define(`seven', succ(six))_
define(`eight', succ(seven))_
define(`nine', succ(eight))_
define(`ten', succ(nine))_
define(`sixteen', square(four))_
define(`thirty_two', mul(four, eight))_
define(`sixty_four', square(eight))_
define(`hundred', square(ten))_
_
_ There are several places where it is necessary to compute a macro name
_ to then invoke, such as when combining a namespace with an index.  While
_ `if_T' and `_head' do the same thing (at least, as long as `if' is not
_ coded with switch), it's nicer to have a name that expresses intent.
_
define(`expand', `$1')_
_
_ Define one more logic operator, xor.
_
define(`xor', `if(`$1', `not(`$2')', `$2')')_
_
_ Extend the logic operators into bitwise versions.  The bitwise operators
_ only operate on positive numbers, and the result extends to the larger
_ of the two inputs, which may be non-canonical until using trim.  This is
_ another situation where it is easier to use a second-level defining setup.
_ This even works for unary not into bnot, since m4 ignores excess args.
_ The `l2b' helper converts logical values into bits.
_
_ Examples:
_   band((0,(1,(0,(1,(1,()))))), (0,(0,(1,(1,()))))) ==> (0,(0,(0,(1,(0,())))))
_   bor((0,(1,(0,(1,())))), (0,(0,(1,(1,(0,())))))) ==> (0,(1,(1,(1,(0,())))))
_   bxor((0,(1,(0,(1,())))), (0,(0,(1,(1,()))))) ==> (0,(1,(1,(0,()))))
_   bnot((0,(1,(0,(1,()))))) ==> (1,(0,(1,(0,()))))
_
define(`l2b', `(l2b_$1,$2)')_
case(`l2b_T', `1')_
case(`l2b_F', `0')_
_
define(`mkbitwise',_
__`define(`b$1', `_b$1(_split$'`1, _split$'`2)')'_
__`define(`_b$1', `b$1_$'`1_$'`3($'`2, $'`4)')'_
__`case(`b$1__', `()')'_
__`case(`b$1__0', `l2b($1(`F', `F'),b$1((), $'`2))')'_
__`case(`b$1__1', `l2b($1(`F', `T'),b$1((), $'`2))')'_
__`case(`b$1_0_', `l2b($1(`F', `F'),b$1($'`1, ()))')'_
__`case(`b$1_0_0', `l2b($1(`F', `F'),b$1($'`1, $'`2))')'_
__`case(`b$1_0_1', `l2b($1(`F', `T'),b$1($'`1, $'`2))')'_
__`case(`b$1_1_', `l2b($1(`T', `F'),b$1($'`1, ()))')'_
__`case(`b$1_1_0', `l2b($1(`T', `F'),b$1($'`1, $'`2))')'_
__`case(`b$1_1_1', `l2b($1(`T', `T'),b$1($'`1, $'`2))')')_
_
mkbitwise(`and')_
mkbitwise(`or')_
mkbitwise(`xor')_
mkbitwise(`not')_
_
_ Extend the arithmetic operations to handle negative numbers.  This is
_ done by using a sign-magnitude form: positive numbers remain as-is, and
_ the operations now understand a list with a leading N as a negative.
_
define(`neg_one', `(N,(1,()))')_
_
_ The sign of a number is N, 0, or 1 for negative, zero, positive.
_
define(`sign', `if(iszero($1), `0',
  `if(eq(head($1),N), N, 1)')')_
_
_ Negating a number is easy.
_
switch1of1(`neg', `sign($1)')_
case(`neg_0', `()')_
case(`neg_1', `(N,$1)')_
case(`neg_N', `tail($1)')_
_
_ Same with absolute value.
_
switch1of1(`abs', `sign($1)')_
case(`abs_0', `()')_
case(`abs_1', `$1')_
case(`abs_N', `tail($1)')_
_
_ Sign-magnitude with arbitrary-width integers is the preferred mode of
_ computation, but a typical task in modern computing is to use a fixed-width
_ word with sign extension and twos-complement inversion, with common
_ widths of 8, 16, 32, and 64, already defined as useful constants.
_
_ The function `invert(<value>)' preserves sign, but computes the
_ twos-complement magnitude of <value> occupying the same number of bits.
_
_ Examples:
_   invert(zero) ==> ()
_   invert((0,(0,()))) ==> (0,(0,()))
_   invert((1,(0,(0,())))) ==> (1,(1,(1,())))
_   invert((1,(1,(1,())))) ==> (1,(0,(0,())))
_   invert((N,(1,(0,(1,(0,())))))) ==> (N,(1,(1,(0,(1,())))))
_
switch1of1(`invert', `sign($1)')_
case(`invert_0', `$1')_
case(`invert_1', `succ(bnot($1))')_
case(`invert_N', `(N,succ(bnot(tail($1))))')_
_
_ The function `extend(<value>, <width>)' returns a non-canonical positive
_ number with <width> bits, as follows.  If <value> was already non-negative,
_ but shorter than <width>, then insignificant zeros are inserted. If <value>
_ was positive but larger than <width>, bits beyond <width> are discarded.
_ If <value> was negative, then the twos complement inversion is performed.
_ The helper `_extend' iterates until the counter reaches zero.
_
_ Examples:
_   extend(one, eight) ==> (1,(0,(0,(0,(0,(0,(0,(0,()))))))))
_   extend(five, two) ==> (1,(0,()))
_   extend(neg_one, four)
_     ==> invert(_extend(tail((N,(1,()))),(0,(0,(1,())))))
_     ==> invert((1,(0,(0,(0,())))))
_     ==> succ(bnot((1,(0,(0,(0,()))))))
_     ==> succ((0,(1,(1,(1,())))))
_     ==> (1,(1,(1,(1,()))))
_
define(`extend', `if(eq(head($1),N), `invert(_extend(tail($1), $2))',
  `_extend($1, $2)')')_
define(`_extend', `if(iszero($2), `()',
  `l2b(eq(head($1),1),_extend(tail($1), _dim($2,'one`)))')')_
_
_ Create a true subtraction. While dim requires positive inputs and clamps
_ at zero, sub can handle negative inputs as well as output.  Note that
_ the result may not be canonical.
_
switch2of2(`sub', `sign($1)', `sign($2)')_
case(`sub_0_0', `()')_
case(`sub_0_1', `(N,$2)')_
case(`sub_0_N', `tail($2)')_
case(`sub_1_0', `$1')_
case(`sub_1_1', `_sub($1, $2)')_
case(`sub_1_N', `add($1, tail($2))')_
case(`sub_N_0', `$1')_
case(`sub_N_1', `(N,add(tail($1), $2))')_
case(`sub_N_N', `_sub(tail($2), tail($1))')_
_
define(`_sub', `if(lt($1, $2), `(N,_dim($2, $1))', `_dim($1, $2)')')_
_
_ The predecessor and decr functions are also useful shorthands comparable to
_ succ and incr, although on loop bounds that can have non-significant zeroes,
_ it is faster still to directly count down via _dim($1,'one`).
_
define(`pred', `sub($1, 'one`)')_
define(`decr', `define(`$1', pred($1))')_
_
_ Extend other existing operators to handle negative inputs.  Functions
_ defined by switch are easy: add new cases to the existing call.
_ This extended `succ' continues to produce canonical values, although it
_ means it is slower on negatives than on positives.
_
define(`succ', `_succ(_split$1)')_
case(`_succ_1', `(0,_succ(_split$2))')_
case(`succ_N', `if(et($1, 'neg_one`), `()',
  `(N,trim(_dim(tail($1),''one``)))')')_
_
case(`add__N', `$2')_
case(`add_0_N', `trim(_sub($1, tail($2)))')_
case(`add_1_N', `trim(_sub($1, tail($2)))')_
case(`add_N_', `$1')_
case(`add_N_0', `trim(_sub($2, tail($1)))')_
case(`add_N_1', `trim(_sub($2, tail($1)))')_
case(`add_N_N', `(N,add(tail($1), tail($2)))')_
_
case(`compare__N', `if(iszero($2), `EQ', `GT')')_
case(`compare_0_N', `if(and(iszero($1), iszero($2)), `EQ', `GT')')_
case(`compare_1_N', `GT')_
case(`compare_N_', `if(iszero($1), `EQ', `LT')')_
case(`compare_N_0', `if(and(iszero($1), iszero($2)), `EQ', `LT')')_
case(`compare_N_1', `LT')_
case(`compare_N_N', `compare(tail($2), tail($1))')_
_
_ That said, `succ', `add', `_dim', and `compare' are used frequently, and can
_ be made more efficient by rewriting with split; which requires rewriting
_ the bulk of the cases without tail.  Now, for `succ' and `add', when a
_ negative value is involved, the result might not be canonical.  (These
_ rewrites for speed could be commented out if the earlier canonical behavior
_ is needed).
_
case(`succ_N', `if(et($1,'one`), 'zero`, `(N,_dim($1,''one``))')')_
_
define(`add', `_add(_split$1, _split$2)')_
define(`_add', `add_$1_$3($2, $4)')_
case(`add__0', `(0,$2)')_
case(`add__1', `(1,$2)')_
case(`add__N', `(N,$2)')_
case(`add_0_', `(0,$1)')_
case(`add_0_0', `(0,add($1,$2))')_
case(`add_0_1', `(1,add($1,$2))')_
case(`add_0_N', `_sub((0,$1),$2)')_
case(`add_1_', `(1,$1)')_
case(`add_1_0', `(1,add($1,$2))')_
case(`add_1_1', `(0,succ(add($1,$2)))')_
case(`add_1_N', `_sub((1,$1),$2)')_
case(`add_N_', `(N,$1)')_
case(`add_N_0', `_sub((0,$2), $1)')_
case(`add_N_1', `_sub((1,$2), $1)')_
case(`add_N_N', `(N,add($1,$2))')_
_
define(`_dim', `_dim_(_split$1, _split$2)')_
define(`_dim_', `dim_$1_$3($2, $4)')_
case(`dim__', zero)_
case(`dim__0', zero)_ only possible with non-canonical input
_ dim__1 not possible, because dim filtered by le.
case(`dim_0_', `(0,$1)')_
case(`dim_1_', `(1,$1)')_
case(`dim_0_0', `(0,_dim($1, $2))')_
case(`dim_1_1', `(0,_dim($1, $2))')_
case(`dim_1_0', `(1,_dim($1, $2))')_
case(`dim_0_1', `(1,_dim($1, succ($2)))')_
_
define(`compare', `_compare_(_split$1, _split$2)')_
define(`_compare_', `compare_$1_$3($2, $4)')_
case(`compare_0_0', `compare($1, $2)')_
case(`compare_0_1', `_switch1(`_compare', compare($1, $2))(`LT')')_
case(`compare_1_0', `_switch1(`_compare', compare($1, $2))(`GT')')_
case(`compare_1_1', `compare($1, $2)')_
case(`compare_N_N', `compare($2, $1)')_
_
case(`_compare_LT', `LT')_
case(`_compare_EQ', `$1')_
case(`_compare_GT', `GT')_
_
_ Meanwhile, functions defined by open-coded if require a re-write.
_ First up, `isempty' can be rewritten for no ghost defines, by exploiting
_ the fact that a recognized macro can inject a comma changing the length
_ of a list, and thereby the second element of that list, while an
_ unrecognized name "expands" to itself and does not munge the list.
_
define(`isempty', `_tail(expand(`_isempty'_head$1)`T', `F')')_
define(`_isempty', `,')_
_
_ Similarly, it's nice to know when a list is present, including when it
_ is the empty list.
_
define(`islist', `_tail(expand(`_islist'$1)`T',`F')')_
define(`_islist', `,')_
_
_ iszero is called frequently.  In addition to adding support for negatives,
_ the switch to split results in less work per recursion.
_
define(`iszero', `_iszero(_split$1)')_
define(`_iszero', `iszero_$1($2)')_
case(`iszero_', `T')_
case(`iszero_0', `iszero($1)')_
case(`iszero_1', `F')_
case(`iszero_N', `iszero($1)')_
_
switch1of2(`mul', `sign($2)')_
case(`mul_N', `neg(_mul($1, tail($2)))')_
case(`mul_0', `()')_
case(`mul_1', `_mul($1, $2)')_
case(`_mul_N', `(N,_mul(tail($1), $2))')_
_
_ Relying on canonical numbers requires lots of `trim' calls; it is often
_ better to rework things to not depend on trim, but when it is needed,
_ it should be fast.  Remember, iszero can stop iterating at the first 1,
_ but trim must iterate all the way to the end of the number.
_
define(`trim', `if(iszero($1), `()',
  `_trim(_split$1)')')_
define(`_trim', `($1,trim($2))')_
_
_ Note that base2(<negative>) does not produce a valid macro suffix; intcode
_ memory and inputs have non-negative indices.  But for debug, displaying
_ a negative with a prefix `-' rather than a suffix N is preferable.
_ Also, being able to ignore non-significant trailing zeroes while still
_ producing 0 for the empty string is important; but checking iszero
_ must be avoided to minimize extra scans of the full number, except when
_ handling non-canonical negatives.  This is done by having the helper
_ `_base2(<head>, <tail>, <defer>, <seed>)'.  `base2' supplies `0' for <seed>,
_ and `base2_' ends recursion and prints <seed> (empty if any other digits
_ were seen, otherwise the original number was zero).  `base2_0' prints
_ nothing, but adds a 0 to <defer> and passes <seed> along.  All other numbers
_ (in this case `base2_1', but the concept works for `base10' as well)
_ print themselves plus the current <defer>, then drop <defer> and <seed>.
_
_ Examples:
_   base2(zero) ==> _base2(_split(), `', `0') ==> _base2(`',`', `', `0')
_     ==> base2_(`', `', `0') => 0
_   base2(one) ==> _base2(1, (), `', `0') ==> base2_1((), `', `0')
_     => _base2(_split(), `')1 => base2_(`', `')1 => 1
_   base2((0,(1,(0,())))) ==> base2_0((1,(0,())), `', `0')
_     ==> _base2(_split(1,(0,())), `0') ==> base2_1((0,()), `0')
_     ==> _base2(_split(0,()), `')10 ==> base2_0((), `')10
_     ==> _base2(_split(), `0')10 ==> base2_(`', `0')10 => 10
_
define(`base2', `_base2(_split$1, `', `0')')_
define(`_base2', `base2_$1($2, $3, $4)')_
case(`base2_', `$3')_
case(`base2_0', `_base2(_split$1, 0$2, $3)')_
case(`base2_1', `_base2(_split$1)1$2')_
case(`base2_N', `if(iszero($1), 0, ``-'base2($1)')')_
_
_ At this time, teaching pow, div, mod, or qr to handle negatives is overkill.
_ However, the existing qr is inefficient: is uses `mul(two,<exp>)' twice
_ instead of `add(<exp>,<exp>)' (which preserves canonical numbers) or
_ `(0,<exp>)' (which can create trailing zeroes, but is faster).  But since I
_ taught `base2' to deal with trailing zeroes, there is no need to spend time
_ on `trim' here. And `_qrnorm' calls `dim' which makes a duplicate `lt' call.
_ More importantly, `qr' outputs a list rather than two items, which means more
_ macro calls to break that list back into components.  It is not too hard
_ to rewrite things to use a different return convention; where `qr'
_ returns `(q,r)', my `remquo' returns `r,q'.
_
define(`remquo',
  `if(lt($1, $2), `$1,'zero,
  `_remquo(head($1), $2, remquo(tail($1), $2))')')_
define(`_remquo', `_norm($2, (0,$4), ($1,$3))')_
define(`_norm', `if(lt($3,$1), `$3,$2', `_dim($3,$1),succ($2)')')_
define(`div',`_tail(remquo($1, $2))')_
define(`mod',`_head(remquo($1, $2))')_
_
_ Since intcode is typically displayed in signed decimal (even though that
_ form cannot be directly parsed by barem4), it is worth having a conversion
_ to decimal output.
_
switch1of1(`base10', `sign($1)')_
case(`base10_0', `0')_
case(`base10_1', `_base10(remquo($1, 'ten`))')_
case(`base10_N', ``-'_base10(remquo(tail($1), 'ten`))')_
_
define(`_base10', `if(iszero($2), `',
  `_base10(remquo($2,'ten`))')_switch1(`dig', base2($1))`'')_
_
_ Display is easier when mapping from values to digits.
_
switch1of1(`dig', `base2($1)')_
case(`dig_0', `0')_
case(`dig_1', `1')_
case(`dig_10', `2')_
case(`dig_11', `3')_
case(`dig_100', `4')_
case(`dig_101', `5')_
case(`dig_110', `6')_
case(`dig_111', `7')_
case(`dig_1000', `8')_
case(`dig_1001', `9')_
_
_ The converse direction is also useful.  Note that while barem4 numbers
_ are written lsb first, this utility function accepts decimal digits with
_ the most significant digit first.  That is:
_
_   dec2num((1,(2,()))) ==> (0,(0,(1,(1,()))))
_
define(`dec2num', `_dec($1,'zero`)')_
switch1of2(`_dec', `head($1)')_
case(`_dec_', `$2')_
define(`mkdec', `case(`_dec_'base10($1),
  `_dec(tail('DOL(1)`), add(mul('DOL(2)`,''ten``),$1))')')_
mkdec(zero)_
mkdec(one)_
mkdec(two)_
mkdec(three)_
mkdec(four)_
mkdec(five)_
mkdec(six)_
mkdec(seven)_
mkdec(eight)_
mkdec(nine)_
_
_ The intcode VM halts on opcode 99.  This is thus a useful constant.
_
define(`ninety_nine', dec2num((9,(9,()))))_
_
_ Several Intcode puzzles produce output that is encoded in (a subset of)
_ ASCII.  As m4 does not natively have any way to map integers to characters,
_ I get to open-code a table for this.  (GNU m4 comes with format(%c), but
_ this being barem4, that's out of the question).  Note that without
_ changequote, it is impossible to output a backtick; and outputting an
_ apostrophe relies on luck (while you can define a macro to expand to
_ apostrophe, using it inside other macros tends to prematurely end what was
_ supposed to be a longer string).  Output of other characters like `(', `,',
_ and `)' is possible with sufficient quoting.  At any rate, since not
_ everything can be output, I've chosen to instead output escape sequences
_ for anything difficult, with \\ for backslash, \x60 and \x27 for `', and \xXX
_ for anything else less than space that is not newline or tab.  NUL, and
_ any negative values or values > 127, fail the `isasc' predicate (at least
_ one Intcode puzzle has a solution as the first non-ASCII output).  This is
_ made easier with a base16() function; which can be implemented with repeated
_ tail instead of remquo.  Since this will be used for \x01-\x1f, this function
_ does not eliminate trailing zeroes that might have been placed by
_ extend(<value>, eight); but true 0 is always compacted to `0'.
_
switch1of1(`base16', `sign($1)')_
case(`base16_0', `0')_
case(`base16_1', `_base16d_1(_split$1)')_
case(`base16_N', ``-'base16_1(tail($1))')_
_
define(`_base16d_1', `_base16d_2($1, _split$2)')_
define(`_base16d_2', `_base16d_3($1, $2, _split$3)')_
define(`_base16d_3', `_base16d_4($1, $2, $3, _split$4)')_
define(`_base16d_4', `if(isempty($5), `', `base16_1($5)')dig_$4$3$2$1`'')_
_
_ Some additional digits.  This includes cases where a non-trimmed value
_ results from how base16d splits lists into digits.
_
case(`dig_0000', `0')_
case(`dig_000', `0')_
case(`dig_00', `0')_
case(`dig_0001', `1')_
case(`dig_001', `1')_
case(`dig_01', `1')_
case(`dig_0010', `2')_
case(`dig_010', `2')_
case(`dig_0011', `3')_
case(`dig_011', `3')_
case(`dig_0100', `4')_
case(`dig_0101', `5')_
case(`dig_0110', `6')_
case(`dig_0111', `7')_
case(`dig_1010', ``a'')_
case(`dig_1011', ``b'')_
case(`dig_1100', ``c'')_
case(`dig_1101', ``d'')_
case(`dig_1110', ``e'')_
case(`dig_1111', ``f'')_
_
_ Now for the ASCII table. Do a first pass that assigns escape sequences for
_ everything, then a second pass of specific characters.  Use of `pred' for
_ looping preserves non-significant zeroes.  Define both `asc_1' and `asc_01'
_ for convenience, through varied `mkasc' definitions.  `safeasc' is suitable
_ as a formatter for use with `dump' if NUL or large values might be mixed in.
_
define(`nl', `
')_
define(`isasc', `and(gt($1, 'zero`), lt($1, 'mul(eight,sixteen)`))')_
define(`asc', `_switch1(`asc', base16($1))`'')_
define(`safeasc', `if(isasc($1), `asc($1)', `\{base10($1)}')')_
_
define(`mkasc', `if(iszero($1), `', `define(`asc_'base16($1),
  `\x0'base16($1))mkasc(pred($1))')')_
mkasc(mul(three, five))_
define(`mkasc', `if(iszero($1), `', `define(`asc_'base16($1),
  `\x'base16($1))mkasc(pred($1))')')_
mkasc(pred(mul(eight, sixteen)))_
define(`mkasc', `define(`asc_$1', ``$2'')')_
mkasc(`9', `    ')mkasc(`09', ` ')mkasc(`a', nl)mkasc(`0a', nl)_
mkasc(`20', ` ')mkasc(`21', `!')mkasc(`22', `"')mkasc(`23', `#')_
mkasc(`24', `$')mkasc(`25', `%')mkasc(`26', `&')mkasc(`28', `(')_
mkasc(`29', `)')mkasc(`2a', `*')mkasc(`2b', `+')mkasc(`2c', `,')_
mkasc(`2d', `-')mkasc(`2e', `.')mkasc(`2f', `/')mkasc(`30', `0')_
mkasc(`31', `1')mkasc(`32', `2')mkasc(`33', `3')mkasc(`34', `4')_
mkasc(`35', `5')mkasc(`36', `6')mkasc(`37', `7')mkasc(`38', `8')_
mkasc(`39', `9')mkasc(`3a', `:')mkasc(`3b', `;')mkasc(`3c', `<')_
mkasc(`3d', `=')mkasc(`3e', `>')mkasc(`3f', `?')mkasc(`40', `@')_
mkasc(`41', `A')mkasc(`42', `B')mkasc(`43', `C')mkasc(`44', `D')_
mkasc(`45', `E')mkasc(`46', `F')mkasc(`47', `G')mkasc(`48', `H')_
mkasc(`49', `I')mkasc(`4a', `J')mkasc(`4b', `K')mkasc(`4c', `L')_
mkasc(`4d', `M')mkasc(`4e', `N')mkasc(`4f', `O')mkasc(`50', `P')_
mkasc(`51', `Q')mkasc(`52', `R')mkasc(`53', `S')mkasc(`54', `T')_
mkasc(`55', `U')mkasc(`56', `V')mkasc(`57', `W')mkasc(`58', `X')_
mkasc(`59', `Y')mkasc(`5a', `Z')mkasc(`5b', `[')mkasc(`5c', `\\')_
mkasc(`5d', `]')mkasc(`5e', `^')mkasc(`5f', `_')_
mkasc(`61', `a')mkasc(`62', `b')mkasc(`63', `c')mkasc(`64', `d')_
mkasc(`65', `e')mkasc(`66', `f')mkasc(`67', `g')mkasc(`68', `h')_
mkasc(`69', `i')mkasc(`6a', `j')mkasc(`6b', `k')mkasc(`6c', `l')_
mkasc(`6d', `m')mkasc(`6e', `n')mkasc(`6f', `o')mkasc(`70', `p')_
mkasc(`71', `q')mkasc(`72', `r')mkasc(`73', `s')mkasc(`74', `t')_
mkasc(`75', `u')mkasc(`76', `v')mkasc(`77', `w')mkasc(`78', `x')_
mkasc(`79', `y')mkasc(`7a', `z')mkasc(`7b', `{')mkasc(`7c', `|')_
mkasc(`7d', `}')mkasc(`7e', `~')_
_
_ A VM has three status bits, `halt<ns>_' (opcode 99 has been executed),
_ `pause<ns>_' (temporary pause related to op 3 and 4 doing I/O), and
_ `fatal<ns>_' (program was invalid, unable to continue), each defaulting
_ to F.  `run' stops looping if any is set to T, but each call to run
_ clears `pause<ns>'.  For convenience, `halt(<ns>)' sets the halt bit,
_ ishalt(<ns>) queries it, and so on (this lets me experiment with other
_ representations, such as an integer bimask instead of separate bits).
_
define(`halt', `define(`halt$1_', T)')_
define(`ishalt', `halt$1_()')_
define(`pause', `define(`pause$1_', T)')_
define(`ispause', `pause$1_()')_
define(`fatal', `define(`fatal$1_', T)')_
define(`isfatal', `fatal$1_()')_
_
_ A common pattern in the engine is accessing an index from an offset in a
_ namespace; common namespaces are `M' for memory, `I' for inputs, `O' for
_ outputs, and `_OP' for operations. For safety, `fetch' expands to 99 if
_ the index is negative, or to 0 if the index is undefined in the namespace.
_ This task is easier with a helper predicate `isundef(<namespace>, <index>)'
_ that determines if a potential macro name produces a list with an empty
_ third element (true for all barem4 integers), while anything else is
_ nonempty.  Similar to isempty above, abuse the knowledge that any
_ defined memory location will have a head of `', `0', `1', or `N' which
_ will produce a comma to shift arguments; an undefined macro will not
_ expand.  In fact, isundef even reports T for any negative <value>.
_
define(`isundef', `_tail(_switch1(`_isundef',
  head(_switch1(`$1', base2($2))))`F', `T')')_
define(`_isundef_', `,')_
define(`_isundef_0', `,')_
define(`_isundef_1', `,')_
define(`_isundef_N', `,')_
_
_ Fetch an argument from a namespaced array, or a safe alternative if the
_ offset is not yet defined.  It is actually more efficient to evaluate the
_ assumed macro name first, and then massage the results on failure, than to
_ run base2() multiple times for both isundef and the actual fetch.
_
define(`fetch', `_switch1(`fetch', _head$2)(`$1', base2($2))')_
case(`fetch_N', `ninety_nine')_
case(`fetch_', `_fetch($1_$2)')_
case(`fetch_0', `_fetch($1_$2)')_
case(`fetch_1', `_fetch($1_$2)')_
define(`_fetch', `_tail(expand(`_islist'$1)`$1','zero`)')_
_
_ In an instruction, the source for an argument depends on the mode.
_ `get(<mode>, <value>, <ns>)' can read from M<ns>_<value>, use <value> as-is,
_ or read from M<ns>_<add(<value>,rel<ns>)>.  The sink for an argument,
_ `put(<mode>, <addr>, <value>, <ns>)' likewise depends on the <mode>, although
_ an immediate cannot be a sink.  The <ns> argument is optional; most
_ days only run one machine at once.  But days 7 and 23 are easiest to
_ solve if they run parallel copies of the VM, each with a consistent
_ <ns> suffix used in `M', `I', `O', `pc', `halt', `pause', `fatal', and
_ `rel'. `put' does not check that <addr> is non-negative.  For large programs,
_ it can be more efficient to have `get' try M<ns>_<value> and fall back to
_ M_<value> before defaulting to 0, than to have to pre-copy all of `M'
_ over to M<ns> up front.
_
define(`get', `get_$1($2, `$3')')_
case(`get_0', `_get(base2($1), `$2')')_
case(`get_1', `$1')_
case(`get_2', `_get(base2(add($1, rel$2)), `$2')')_
define(`_get', `_get_($1, M$2_$1)')_
define(`_get_', `_tail(expand(`_islist'$2)`$2', `_fetch(M_$1)')')_
_
define(`put', `put_$1($2, $3, `$4')')_
case(`put_0', `define(`M$3_'base2($1), `$2')')_
case(`put_1', `fatal(`$3')')_
case(`put_2', `define(`M$3_'base2(add($1, rel$3)), `$2')')_
_
_ An intcode instruction can consist of up to four fields.  In decimal
_ representation, the value 12001 decodes to op 01 (add), using mode
_ 0 for its first operand (absolute address), mode 1 for its second
_ operand (literal), and mode 2 for its third (relative address).
_ Performing division at runtime is expensive; better is to create a
_ lookup table of all 27 variants of each opcode, to eventually call
_ into OP<n>(<mode1>, <mode2>, <mode3>, <ns>).  Even though instructions are
_ variable width (based on how many operands they consume), it does not hurt
_ to pass unused modes to an operand.  Although a well-formed intcode
_ instruction will never invoke an invalid command, this engine sets the
_ fatal flag when it detects such attempts, done by by defining `_OP<n>'
_ with the decode of known combos, and undefined otherwise.
_
define(`decode', `_switch1(`_OP', base2($1))')_
_
_ Define the actual operations, with the helper `mkop'.  Each
_ OP<n>(<mode1>, <mode2>, <mode3>, <ns>) must output the new value of pc<ns>,
_ in addition to any other side effects it may have.  Defining a macro
_ requires defining each of its 27 _OP variants, for decoding.
_
define(`mkop', `_mkop($1, base2($1), `$2')')_
define(`_mkop', `_mkop1($1, `$2,0')_mkop1(add('hundred`, $1),
  `$2,1')_mkop1(add('(0,hundred)`, $1), `$2,2')define(`OP$2', `$3')')_
define(`_mkop1', `_mkop2($1, `$2,0')_mkop2(add('mul(ten,hundred)`, $1),
  `$2,1')_mkop2(add('(0,mul(ten,hundred))`, $1), `$2,2')')_
define(`_mkop2', `_mkop3($1, `$2,0')_mkop3(add('square(hundred)`, $1),
  `$2,1')_mkop3(add('(0,square(hundred))`, $1), `$2,2')')_
define(`_mkop3', `define(`_OP_'base2($1), `$2')')_
_
_ OP 1: Add ARG1 ARG2 DST
_ Store ARG1 + ARG2 into DST
_
mkop(one, `put_$3(get_0(add(pc$4, 'three`), `$4'),
  add(get_$1(get_0(succ(pc$4), `$4'), `$4'),
  get_$2(get_0(succ(succ(pc$4)), `$4'), `$4')), `$4')add(pc$4, 'four`)')_
_
_ OP 2: Mul ARG1 ARG2 DST
_ Store ARG1 * ARG2 into DST
_
mkop(two, `put_$3(get_0(add(pc$4, 'three`), `$4'),
  mul(get_$1(get_0(succ(pc$4), `$4'), `$4'),
  get_$2(get_0(succ(succ(pc$4)), `$4'), `$4')), `$4')add(pc$4, 'four`)')_
_
_ OP 3: Input DST
_ Store input into DST.  This command relies on `read(<ns>)' macro returning up
_ to two values <good,data>.  If good is T, data is stored and execution
_ continues by incrementing pc<ns>. If good is F, value is ignored, execution
_ is paused, and pc<ns> left unchanged so more input can be supplied before the
_ next `run' to resume.  The default `read' macro consumes data from the
_ `I<ns>' namespace at offset `i<ns>off', returning F when it hits the end of
_ the array; but wrappers can redefine it to take on other input effects.
_
mkop(three, `_input($1, `$4', read(`$4'))')_
define(`_input', `if($3,
  `put_$1(get_0(succ(pc$2), `$4'), $4, `$2')succ(succ(pc$2))',
  `pause(`$2')pc$2')')_
_
define(`read', `_read($1, _switch1(`I$1', base2(i$1off)))')_
define(`_read', `if(islist($2), `T,$2incr(`i$1off')', `F')')_
_
_ OP 4: Output SRC
_ Use the value at SRC as output.  This command relies on the `write(<val>,
_ <ns>)' macro doing something useful, returning T to continue or F to pause
_ execution; either way, the next run resumes on the next instruction.  The
_ default implementation stores val into the next slot of the `O<ns>'
_ namespace, using `o<ns>off', and returns T; but wrappers can redefine it to
_ take on other output effects (such as copying data between parallel
_ machines, printing a base10 representation to stdout, or even mapping
_ numbers into corresponding ASCII output to stdout).  Since `write' is
_ called as the condition to an `if', the caller cannot use it to output
_ any data to the screen.  If that is desired, define a one-shot `hook' to
_ do whatever is desired after the op finishes.  `hook' auto-resets to empty.
_
mkop(four, `if(write(get_$1(get_0(succ(pc$4), `$4'), `$4'), `$4'),
  `', `pause(`$4')')succ(succ(pc$4))')_
_
define(`write', `define(`O$2_'base2(o$2off), trim($1))incr(`o$2off')T')_
define(`hook', `')_
_
_ OP 5: Jump-If-True SRC DST
_ If SRC is non-zero, jump to DST instead of continuing.
_
mkop(five, `if(iszero(get_$1(get_0(succ(pc$4), `$4'), `$4')),
  `add(pc$4, three)', `get_$2(get_0(succ(succ(pc$4)), `$4'), `$4')')')_
_
_ OP 6: Jump-If-False SRC DST
_ If SRC is zero, jump to DST instead of continuing.
_
mkop(six, `if(not(iszero(get_$1(get_0(succ(pc$4), `$4'), `$4'))),
  `add(pc$4, three)', `get_$2(get_0(succ(succ(pc$4)), `$4'), `$4')')')_
_
_ OP 7: Less-Than ARG1 ARG2 DST
_ Store ARG1 < ARG2 into DST
_
mkop(seven, `put_$3(get_0(add(pc$4, 'three`), `$4'),
  if(lt(get_$1(get_0(succ(pc$4), `$4'), `$4'),
  get_$2(get_0(succ(succ(pc$4)), `$4'), `$4')), 'one`, 'zero`),
  `$4')add(pc$4, 'four`)')_
_
_ OP 8: Equals ARG1 ARG2 DST
_ Store ARG1 + ARG2 into DST
_
mkop(eight, `put_$3(get_0(add(pc$4, 'three`), `$4'),
  if(et(get_$1(get_0(succ(pc$4), `$4'), `$4'),
  get_$2(get_0(succ(succ(pc$4)), `$4'), `$4')), 'one`, 'zero`),
  `$4')add(pc$4, 'four`)')_
_
_ OP 9: RelAdjust ARG
_ Adjust `rel' by ARG, affecting all mode-2 loads and stores.
_
mkop(nine, `define(`rel$4', add(rel$4, get_$1(get_0(succ(pc$4), `$4'),
  `$4')))succ(succ(pc$4))')_
_
_ OP 99: Halt
mkop(ninety_nine, `halt(`$4')pc$4')_
_
_ Time for some meta-programming.  `curry(`<name>', `<args>...')(<extra>)'
_ results in a call to <name>(<args>, <extra>).  If <args> is to supply more
_ than one argument, at least the commas must be quoted; the quoting will
_ be stripped during the final call to <name>.  This implementation allows up
_ to three <extra> parameters (more would be possible by using DOL(@), but
_ since barem4 lacks shift, I'm avoiding that).  The main use case for
_ currying is to emulate partial application: a function that requires more
_ than one argument (such as `isundef'), but where the early arguments can
_ be fixed, can be called in a context that normally only provides one
_ argument (such as `map'), letting me implement `copy' on top of `map'.
_
define(`curry', `$1($2,_curry')_
define(`_curry', ``$1',`$2',`$3')')_
_
_ `compose(`<outer>', `<inner>', <args>...)' results in a nested call to
_ `<outer>(<inner>(<args...))'.  As with `curry', this implementation
_ only supports up to three <args>.  This is useful in situations where
_ arguments from one source must be transformed before consumption by another
_ function.  `ccompose(`<outer>', `<inner>')(<args>...)' is a curried compose.
_
define(`compose', `$1($2(`$3', `$4', `$5'))')_
define(`ccompose', `curry(`compose', ``$1', `$2'')')_
_
_ This is a workhorse iterator over a namespace.  `map_cond(<start>, <cond>,
_ <func>, <ns>)' checks `<cond>(<value>)', starting at <start>.  <cond> must
_ return T or F; if it returns F, `map_cond' then calls `<func>(<ns>, <value>)'
_ outside of argument collection (unless `map_cond' itself was called during
_ a macro argument), so that <func> can provide output to stdout; if <cond>
_ was good enough for its side effects, <func> can be `nop'.  Iteration
_ continues with successively larger values from <start>, until <cond>
_ returns T to end iteration; <func> is not called for the <value> that
_ ends the loop.
_
define(`nop', `')_
define(`map_cond', `if($2($1), `',
  `$3(`$4', $1)`'map_cond(succ($1), `$2', `$3', `$4')')')_
_
_ `map(`<condfunc>', `<ns>')' is a simpler wrapper around `map_cond'; it
_ always starts at zero, and has only a single function as `<condfunc>(<ns>,
_ <value>)', which must return F to continue and T to halt, and where output
_ to stdout is not possible.
_
define(`map', `map_cond('zero`, `curry(`$1', ``$2'')', `nop', `$2')')_
_
_ Several Advent of Code puzzles want to run the virtual machine more than
_ once, resetting it back to the original state between runs before making
_ some other tweak.  For example, the day 2 puzzle is about optimizing the
_ final value of M_0 after setting M_1 and M_10 two various values between
_ decimal 0 and 99 inclusive.  This is made easier by having a function
_ that copies all values into a destination namespace from a source,
_ starting from index 0, and ending when predicate(<ns>, <val>) returns T.
_ There are two common predicates: `isundef' declared above which stops at
_ the first <val> that has never been assigned, and `limit(<val>)' which
_ produces a function that returns T upon reaching M_<val>.  With the latter,
_ unassigned locations in the source are assigned `zero' in the destination.
_
_ Example: starting with `M_0' => one, `M_1' => three, and `M_10' not yet
_ defined, then
_   copy(`B', `M', `isundef') ==> `B_0' => one, `B_1' => three
_ while
_   copy(`B', `M', `limit(three)') ==> as above, plus `B_10' => zero
_
_ The definition of `limit' is interesting: on each invocation, it updates
_ the definition of a helper macro that will determine the desired condition,
_ then produces the name of that helper.  Thus, `limit(three)(`M', three)'
_ will ultimately result in T, while `limit(three)(`M', zero)' is F.
_
define(`limit', `define(`_limit', `le($1, 'DOL(2)`)')_limit')_
_
_ `copy(<dst_ns>, <src_ns>, <cond>)' copies items from <src_ns> to <dst_ns>,
_ starting at zero, until `<cond>(<src_ns>, <value>)' returns T.  This
_ relies on the helper `_copy(<cond>, <dst_ns>, <src_ns>, <value>)'.
_
define(`copy', `map(`curry(`_copy', ``$3',`$1'')', `$2')')_
define(`_copy', `if($1(`$3', $4), `T',
  `define(`$2_'base2($4), fetch(`$3', $4))F')')_
_
_ Another common desire is to display a namespace, whether with a `comma'
_ or `nl' separator.  `dump(<format>, <sep>, <cond>, <ns>)' calls
_ `<format>(fetch(<ns>, <value>))' for each <value> from 0 until <cond>
_ returns T, and calling `<sep>`'' between items after the first.
_
define(`dump', `if($3(`$4', 'zero`), `', `$1(fetch(`$4', ''zero``))`'map_cond(
  ''one``, `curry(`$3', ``$4'')', `$2`'ccompose(`$1', `fetch')',
  `$4')')')_
define(`comma', `,')_
_
_ An intcode machine tracks the non-negative program counter, `pc'.  Relative
_ addressing also relies on a `rel' offset, which can be negative, but the sum
_ must still be non-negative.  There are also three status bits, described
_ earlier.  Then there is `ioff', used by the default `read' for reading the
_ `I' namespace, and `ooff', used used by the default `write' for writing to
_ the `O' namespace.  The function `reset' puts all of these values back to
_ their starting value of zero or F.  As mentioned above, all of these take
_ an optional namespace suffix, to facilitate tracking state of parallel VMs.
_
define(`reset',
  `define(`pc$1', 'zero`)define(`rel$1', 'zero`)define(`halt$1_',
  F)define(`pause$1_', F)define(`fatal$1_', F)define(`i$1off',
  'zero`)define(`o$1off', 'zero`)')_
reset()_
_
_ `step' is the heart of the engine, which loads, decodes, and executes a
_ single instruction. `run' is a wrapper that resets the pause bit in status,
_ uses `step', and then repeats if all status bits are still zero.  Individual
_ instructions are responsible for updating `pc' as one of their side effects
_ (since intcode operations are variable width, and because of jump commands),
_ and may also update status to affect whether operation continues.  Note
_ that this file does not call step or run; it is assumed that a wrapper
_ setup will fine-tune the machine (such as using `copy' to save or restore
_ pristine memory, alter initial values, tweak the behaviors of input or
_ output to match the program's needs) and then call `run' one or more times.
_ `op' also runs any `hook' (such as when `write' wants to display a prompt).
_
define(`step', `op(`$1', decode(get_0(pc$1, `$1')))')_
define(`op', `if(isempty($3), `fatal($1)',
  `define(`pc$1', OP$2($3, $4, $5, `$1'))hook()define(`hook', `')')')_
define(`run', `define(`pause$1_', F)step(`$1')if(or(halt$1_,
  or(pause$1_, fatal$1_)), `', `run(`$1')')')_
_
_ And with that, have fun!