1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays assocs fry hashtables kernel locals math
4 math.order namespaces sequences vectors ;
7 : flattener ( seq quot -- seq vector quot' )
12 dup [ array? ] [ vector? ] bi or
13 [ _ push-all ] [ _ push ] if
18 : flattening ( seq quot combinator -- seq' )
19 [ flattener ] dip dip { } like ; inline
21 : map-flat ( seq quot -- seq' ) [ each ] flattening ; inline
23 : 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
25 : pad-tail-shorter ( seq1 seq2 elt -- seq1' seq2' )
26 2over longer length swap [ pad-tail ] 2curry bi@ ;
30 yield-hook [ [ ] ] initialize
32 : alist-most ( alist quot -- pair )
33 [ [ ] ] dip '[ [ [ second ] bi@ @ ] most ] map-reduce ; inline
35 : alist-min ( alist -- pair ) [ before=? ] alist-most ;
37 : alist-max ( alist -- pair ) [ after=? ] alist-most ;
39 : penultimate ( seq -- elt ) [ length 2 - ] keep nth ;
41 :: compress-path ( source assoc -- destination )
42 source assoc at :> destination
43 source destination = [ source ] [
44 destination assoc compress-path :> destination'
45 destination' destination = [
46 destination' source assoc set-at
51 : unique ( seq -- assoc )
52 [ dup ] H{ } map>assoc ;
54 : conjoin ( elt assoc -- )
57 : conjoin-at ( value key assoc -- )
58 [ dupd ?set-at ] change-at ;