core/ranges/ranges.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors classes.tuple kernel math math.order sequences
   4 sequences.private ;
   5 IN: ranges
   6
   7 TUPLE: range
   8 { from read-only }
   9 { length read-only }
  10 { step read-only } ;
  11
  12 <PRIVATE
  13
  14 : sign/mod ( x y -- z w )
  15     [ [ /i ] 2keep pick * - ] keep 0 < [ neg ] when ; inline
  16
  17 PRIVATE>
  18
  19 : <range> ( a b step -- range )
  20     [ over - ] dip
  21     [ sign/mod 0 < [ 1 + ] unless 0 max ] keep
  22     range boa ; inline
  23
  24 M: range length length>> ; inline
  25
  26 M: range nth-unsafe
  27     [ step>> * ] keep from>> + ; inline
  28
  29 ! We want M\ tuple hashcode, not M\ sequence hashcode here!
  30 ! sequences hashcode is O(n) in number of elements
  31 M: range hashcode* tuple-hashcode ;
  32
  33 INSTANCE: range immutable-sequence
  34
  35 M: range sum [ length ] [ first ] [ last ] tri + * 2 / ;
  36
  37 <PRIVATE
  38
  39 : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline
  40
  41 : (a.. ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline
  42
  43 : ..b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline
  44
  45 PRIVATE>
  46
  47 : [a..b] ( a b -- range ) twiddle <range> ; inline
  48
  49 : (a..b] ( a b -- range ) twiddle (a.. <range> ; inline
  50
  51 : [a..b) ( a b -- range ) twiddle ..b) <range> ; inline
  52
  53 : (a..b) ( a b -- range ) twiddle (a.. ..b) <range> ; inline
  54
  55 : [0..b] ( b -- range ) 0 swap [a..b] ; inline
  56
  57 : [1..b] ( b -- range ) 1 swap [a..b] ; inline
  58
  59 : [0..b) ( b -- range ) 0 swap [a..b) ; inline
  60
  61 : [1..b) ( b -- range ) 1 swap [a..b) ; inline