basis/sorting/slots/slots.factor

   1 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: combinators.short-circuit fry kernel macros math.order
   4 sequences words sorting sequences.deep assocs splitting.monotonic
   5 math ;
   6 IN: sorting.slots
   7
   8 <PRIVATE
   9
  10 : slot-comparator ( seq -- quot )
  11     [
  12         but-last-slice
  13         [ '[ [ _ execute ] bi@ ] ] map concat
  14     ] [
  15         peek
  16         '[ @ _ execute dup +eq+ eq? [ drop f ] when ]
  17     ] bi ;
  18
  19 PRIVATE>
  20
  21 MACRO: compare-slots ( sort-specs -- <=> )
  22     #! sort-spec: { accessors comparator }
  23     [ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
  24
  25 : sort-by-slots ( seq sort-specs -- seq' )
  26     '[ _ compare-slots ] sort ;
  27
  28 MACRO: split-by-slots ( accessor-seqs -- quot )
  29     [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
  30     '[ [ _ 2&& ] slice monotonic-slice ] ;