2009-01-13 18:12:43 -05:00
|
|
|
! Copyright (C) 2008, 2009 Slava Pestov.
|
2008-12-06 12:17:19 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: kernel sequences sequences.private arrays vectors fry
|
2009-08-02 11:26:52 -04:00
|
|
|
math math.order namespaces assocs locals ;
|
2008-12-06 12:17:19 -05:00
|
|
|
IN: compiler.utilities
|
|
|
|
|
|
|
|
: flattener ( seq quot -- seq vector quot' )
|
|
|
|
over length <vector> [
|
|
|
|
dup
|
|
|
|
'[
|
|
|
|
@ [
|
2009-08-09 17:29:21 -04:00
|
|
|
dup [ array? ] [ vector? ] bi or
|
2008-12-06 12:17:19 -05:00
|
|
|
[ _ push-all ] [ _ push ] if
|
|
|
|
] when*
|
|
|
|
]
|
|
|
|
] keep ; inline
|
|
|
|
|
|
|
|
: flattening ( seq quot combinator -- seq' )
|
|
|
|
[ flattener ] dip dip { } like ; inline
|
|
|
|
|
|
|
|
: map-flat ( seq quot -- seq' ) [ each ] flattening ; inline
|
|
|
|
|
|
|
|
: 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
|
2009-01-13 18:12:43 -05:00
|
|
|
|
|
|
|
SYMBOL: yield-hook
|
|
|
|
|
2009-02-10 17:16:12 -05:00
|
|
|
yield-hook [ [ ] ] initialize
|
2009-06-19 19:28:30 -04:00
|
|
|
|
2009-08-08 01:24:46 -04:00
|
|
|
: alist-most ( alist quot -- pair )
|
|
|
|
[ [ ] ] dip '[ [ [ second ] bi@ @ ] most ] map-reduce ; inline
|
|
|
|
|
2009-09-28 00:29:48 -04:00
|
|
|
: alist-min ( alist -- pair ) [ before=? ] alist-most ;
|
2009-08-08 01:24:46 -04:00
|
|
|
|
2009-09-28 00:29:48 -04:00
|
|
|
: alist-max ( alist -- pair ) [ after=? ] alist-most ;
|
2009-07-16 03:17:58 -04:00
|
|
|
|
|
|
|
: penultimate ( seq -- elt ) [ length 2 - ] keep nth ;
|
2009-08-02 11:26:52 -04:00
|
|
|
|
|
|
|
:: compress-path ( source assoc -- destination )
|
2009-10-27 22:50:31 -04:00
|
|
|
source assoc at :> destination
|
|
|
|
source destination = [ source ] [
|
|
|
|
destination assoc compress-path :> destination'
|
|
|
|
destination' destination = [
|
|
|
|
destination' source assoc set-at
|
|
|
|
] unless
|
|
|
|
destination'
|
|
|
|
] if ;
|