Paste: aoc16

TUPLE: testcase before after insn ;
C: <testcase> testcase

: 2ary-op-r ( regs inputs quot: ( a b -- c ) -- outputs )
  [ clone ] 2dip [ '[ [ second swap nth ] [ third swap nth ] 2bi @ ]
   [ fourth swap set-nth ] 2bi ] 2curry keep ; inline
: 2ary-op-i ( regs inputs quot: ( a b -- c ) -- outputs )
  [ clone ] 2dip [ '[ [ second swap nth ] [ third ] bi @ ]
  [ fourth swap set-nth ] 2bi ] 2curry keep ; inline
: 2ary-op-ir ( regs inputs quot: ( a b -- c ) -- outputs )
  [ clone ] 2dip [ '[ [ second swap ] [ third swap nth ] bi @ ]
  [ fourth swap set-nth ] 2bi ] 2curry keep ; inline


: addr ( regs inputs -- outputs ) [ + ] 2ary-op-r ;
: addi ( regs inputs -- outputs ) [ + ] 2ary-op-i ;
: mulr ( regs inputs -- outputs ) [ * ] 2ary-op-r ;
: muli ( regs inputs -- outputs ) [ * ] 2ary-op-i ;
: banr ( regs inputs -- outputs ) [ bitand ] 2ary-op-r ;
: bani ( regs inputs -- outputs ) [ bitand ] 2ary-op-i ;
: borr ( regs inputs -- outputs ) [ bitor ] 2ary-op-r ;
: bori ( regs inputs -- outputs ) [ bitor ] 2ary-op-i ;
: setr ( regs inputs -- outputs )
  [ clone ] dip [ [ second swap nth ] [ fourth swap set-nth ] 2bi ] curry keep ;
: seti ( regs inputs -- outputs )
  [ clone ] dip [ [ nip second ] [ fourth swap set-nth ] 2bi ] curry keep ;
: gtrr ( regs inputs -- outputs ) [ > 1 0 ? ] 2ary-op-r ;
: gtri ( regs inputs -- outputs ) [ > 1 0 ? ] 2ary-op-i ;
: gtir ( regs inputs -- outputs ) [ > 1 0 ? ] 2ary-op-ir ;
: eqrr ( regs inputs -- outputs ) [ = 1 0 ? ] 2ary-op-r ;
: eqri ( regs inputs -- outputs ) [ = 1 0 ? ] 2ary-op-i ;
: eqir ( regs inputs -- outputs ) [ = 1 0 ? ] 2ary-op-ir ;

CONSTANT: all-insn {
  bori
}
CONSTANT: unknown-insn {
bani  banr  setr eqrr  eqri gtri   gtrr eqir gtir   seti 
mulr borr addr muli addi  
}
CONSTANT: insntable H{
{ 0 muli }
{ 2 addi }
{ 1 bani }
{ 3 seti }
{ 4 eqrr }
   { 5 eqir }
   { 6 setr }
 { 7 bori }
  { 8 gtri }
  { 9 eqri }  
{ 10 gtir }
{ 11 borr }
{ 12 addr }
{ 13 gtrr }
{ 14 mulr }
{ 15 banr } 
}

: (insn-match) ( testcase insn -- ? )
  [ [ [ before>> ] [ insn>> ] bi ] [ execute( a b -- c ) ] bi* ] curry
  [ after>> ] bi = ;
: insn-match ( testcase -- n )
  all-insn [ (insn-match) ] with count ;
: insn-matching ( testcase -- insn )
  all-insn [
    2dup (insn-match) [ swap insn>> first 2array ] [ 2drop f ] if
  ] with map sift ;

"/tmp/input" ascii file-lines 3112 head
4 group [
  first3 swap
  [ [ ": ,[]" split harvest 4 tail* [ string>number ] map ] bi@ ]
  [ " " split [ string>number ] map ] bi* <testcase>
] map
[ [ insn-match 3 >= ] count . ]
[ [ insn-match 1 = ] filter [ insn-matching ] map harvest . ] bi
! remove progressively the instructions from all-insn


"/tmp/input" ascii file-lines 3114 tail
{ 0 0 0 0 } [ " " split [ string>number ] map dup first insntable at
execute( a b -- c ) ] reduce .