Paste: My attempt at AOC day 5

! day 5

: new-constraint ( constraints before after -- constraints ) [ pick index not and ] curry rot [ swapd set-at ] keep ;
: change-constraint ( constraints before after -- constraints ) [ pick index not and ] curry rot [ [ compose ] with change-at ] keep ;
: add-constraint ( constraints before after -- constraints ) 2over swap at [ change-constraint ] [ new-constraint ] if ;

: get-constraint ( constraints pg -- constraint ) swap at [ [ ] ] unless* ;
: try-constraint ( constraints cur befores -- ? ) [ get-constraint ] dip t rot call( befores ? -- befores ? ) nip ;

: manual-matches? ( constraints manual -- ? ) t [ [ [ length 0 > ] dip and ] 2check ] [ drop unclip-last swap 3dup try-constraint nipd ] while 2nip ;

: find-middle ( seq -- middle ) [ length 1 - 2 / ] keep nth ;

: parse-day-five-input ( string -- constraints manuals ) split-lines [ empty? ] split-when first2 [ H{ } clone [ "|" split first2 add-constraint ] reduce ] dip [ "," split ] map ;

: solve-day-five-part-one ( constraints manuals -- n ) [ manual-matches? ] with filter [ find-middle dec> ] map sum ;

! 1|2
! 5|10
! 2|5
!
! 5,2,10,1 [] (things inside [] are verified)
! {5,2,10},1 [] (1 must come before 2)
! 1,5,2,10 []
! {1,5,2},10 [] (10 is good)
! 1,5,2 [10]
! {1,5},2 [10] (2 must come before 5)
! 2,1,5 [10]
! {2,1},5 [10] (5 is good)
! 2,1 [5,10]
! {2},1 [5,10] (1 must come before 2)
! 1,2 [5,10]
! {1},2 [2,5,10] (2 is good)
! 1 [2,5,10]
! {},1 [2,5,10] (1 is good)
! [1,2,5,10]
: *, ( elt -- ) building get reverse! [ push ] keep reverse! drop ;
: correct-manual ( constraints manual -- manual ) [ [ dup length 0 > ] [ unclip-last [ swap try-constraint ] 3check [ *, ] [ prefix ] if ] while 2drop ] { } make ;
: solve-day-five-part-two ( constraints manuals -- n ) dupd [ manual-matches? ] with reject [ correct-manual ] with map [ find-middle dec> ] map sum  ;