TUPLE: testcase before after insn ; C: 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* ] 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 .