Paste: aoc21
Author: | jon |
Mode: | factor |
Date: | Tue, 1 Jan 2019 18:24:34 |
Plain Text |
: 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 ;
: divr ( regs inputs -- outputs ) [ /i ] 2ary-op-r ;
: divi ( regs inputs -- outputs ) [ /i ] 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 ;
: (execute-insn) ( regs inputs str -- regs' )
{
{ "addr" [ addr ] }
{ "addi" [ addi ] }
{ "mulr" [ mulr ] }
{ "muli" [ muli ] }
{ "divr" [ divr ] }
{ "divi" [ divi ] }
{ "banr" [ banr ] }
{ "bani" [ bani ] }
{ "borr" [ borr ] }
{ "bori" [ bori ] }
{ "setr" [ setr ] }
{ "seti" [ seti ] }
{ "gtrr" [ gtrr ] }
{ "gtri" [ gtri ] }
{ "gtir" [ gtir ] }
{ "eqrr" [ eqrr ] }
{ "eqri" [ eqri ] }
{ "eqir" [ eqir ] }
} case ;
: execute-insn ( regs str -- regs' )
" " split unclip [ [ string>number ] map f prefix ] dip (execute-insn) ;
:: aoc21p1 ( n -- )
<linked-hash> :> seen
0 :> count!
"/tmp/input" ascii file-lines unclip " " split second string>number :> ( program ip )
6 0 <array> :> regs!
n regs set-first
0 :> pc! [
[
pc ip regs set-nth
pc program nth :> insn
pc 28 = [
3 regs nth dup seen at
[ drop seen >alist last first . "done" throw ]
[ t swap seen set-at ] if
] when
regs insn execute-insn regs!
ip regs nth 1 + pc! t
count 1 + count!
] loop
] [ . regs . ] recover count . ;
New Annotation