aoc-forth

Advent of code solutions in UF forth
git clone git://git.alexwennerberg.com/aoc-forth
Log | Files | Refs | README

05.fs (2185B) - raw


      1 62 constant stack-size
      2 9 constant num-stacks
      3 
      4 : stacks create ( n ) 
      5   0 do here cell+ , stack-size allot loop does> swap stack-size cell+ * + ( [a] -- ) ;
      6 
      7 num-stacks stacks crate-stack
      8 
      9 : 3dup 2 pick 2 pick 2 pick ;
     10 : push ( n a -- ) tuck  @ c!   1 swap +! ;
     11 : ?empty ( a -- f ) dup @ 2 - = ;
     12 : clear-stack ( a -- ) dup 2 + swap ! ;
     13 
     14 \ 99 == error
     15 : pop ( a -- n ) dup ?empty if 99 . cr bye then dup -1 swap +! @ dup 1+ 0 swap c! c@ ;
     16 : c-to-n ( c -- u ) 48 - ;
     17 : move-from ( u2 u3 ) crate-stack swap crate-stack pop swap push ;
     18 \ move u1 items from u2 to u3
     19 : cratemover-9000 ( u1 u2 u3 -- ) rot 0 do 2dup move-from loop 2drop ;
     20 : cratemover-9001 ( u1 u2 u3 -- ) \ a bit sloppy
     21   rot >r crate-stack swap crate-stack ( a3 a2 )
     22   dup dup @ r@ - swap ! swap 
     23   dup dup @ r@ + swap ! swap ( a3 a2 )
     24   @ swap @ ( sp2 sp3 ) r@ - r> 3dup cmove nip erase ;
     25 
     26 : 0idx ( u1 u2 -- u3 u4 ) 1- swap 1- swap ;
     27 : move ( -- ) noop ; : from noop ;
     28 : debug 0 crate-stack 64 9 * dump ;
     29 : to ( -- | n ) bl parse drop c@ c-to-n 0idx cratemover-9000 ;
     30 : push-str ( a1 a2 u -- ) 0 do 2dup c@ swap push 1+ loop 2drop ;
     31 : print-sol num-stacks 0 do r@ crate-stack dup pop dup emit swap push loop ; 
     32 : clear-stacks num-stacks 0 do r@ crate-stack clear-stack loop ;
     33 
     34 \ To save energy, start of input is manually parsed TODO parse
     35 \ Sample
     36   \ 0 crate-stack " ZN" push-str 
     37   \ 1 crate-stack " MCD" push-str 
     38   \ 2 crate-stack " P" push-str 
     39 \ Real input
     40 0 crate-stack " WRF" push-str
     41 1 crate-stack " THMCDVWP" push-str
     42 2 crate-stack " PMZNL" push-str
     43 3 crate-stack " JCHR" push-str
     44 4 crate-stack " CPGHQTB" push-str
     45 5 crate-stack " GCWLFZ" push-str
     46 6 crate-stack " WVLQZJGC" push-str
     47 7 crate-stack " PNRFWTVC" push-str
     48 8 crate-stack " JWHGRSV" push-str
     49 
     50 include input.txt 
     51 print-sol \ part 1
     52 clear-stacks 
     53 
     54 0 crate-stack " WRF" push-str
     55 1 crate-stack " THMCDVWP" push-str
     56 2 crate-stack " PMZNL" push-str
     57 3 crate-stack " JCHR" push-str
     58 4 crate-stack " CPGHQTB" push-str
     59 5 crate-stack " GCWLFZ" push-str
     60 6 crate-stack " WVLQZJGC" push-str
     61 7 crate-stack " PNRFWTVC" push-str
     62 8 crate-stack " JWHGRSV" push-str
     63 
     64 : to ( -- | n ) bl parse drop c@ c-to-n 0idx cratemover-9001 ;
     65 include input.txt 
     66 print-sol \ part 2
     67 bye