basis/math/ranges/ranges.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel layouts math math.order namespaces sequences
   4 sequences.private accessors classes.tuple arrays ;
   5 IN: math.ranges
   6
   7 TUPLE: range
   8 { from read-only }
   9 { length read-only }
  10 { step read-only } ;
  11
  12 : <range> ( a b step -- range )
  13     [ over - ] dip [ /i 1 + 0 max ] keep range boa ; inline
  14
  15 M: range length ( seq -- n )
  16     length>> ;
  17
  18 M: range nth-unsafe ( n range -- obj )
  19     [ step>> * ] keep from>> + ;
  20
  21 ! For ranges with many elements, the default element-wise methods
  22 ! sequences define are unsuitable because they're O(n)
  23 M: range equal? over range? [ tuple= ] [ 2drop f ] if ;
  24
  25 M: range hashcode* tuple-hashcode ;
  26
  27 INSTANCE: range immutable-sequence
  28
  29 <PRIVATE
  30
  31 : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline
  32
  33 : (a, ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline
  34
  35 : ,b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline
  36
  37 PRIVATE>
  38
  39 : [a,b] ( a b -- range ) twiddle <range> ; inline
  40
  41 : (a,b] ( a b -- range ) twiddle (a, <range> ; inline
  42
  43 : [a,b) ( a b -- range ) twiddle ,b) <range> ; inline
  44
  45 : (a,b) ( a b -- range ) twiddle (a, ,b) <range> ; inline
  46
  47 : [0,b] ( b -- range ) 0 swap [a,b] ; inline
  48
  49 : [1,b] ( b -- range ) 1 swap [a,b] ; inline
  50
  51 : [0,b) ( b -- range ) 0 swap [a,b) ; inline
  52
  53 : range-increasing? ( range -- ? )
  54     step>> 0 > ;
  55
  56 : range-decreasing? ( range -- ? )
  57     step>> 0 < ;
  58
  59 : first-or-peek ( seq head? -- elt )
  60     [ first ] [ peek ] if ;
  61
  62 : range-min ( range -- min )
  63     dup range-increasing? first-or-peek ;
  64
  65 : range-max ( range -- max )
  66     dup range-decreasing? first-or-peek ;
  67
  68 : clamp-to-range ( n range -- n )
  69     [ range-min ] [ range-max ] bi clamp ;
  70
  71 : sequence-index-range  ( seq -- range )
  72     length [0,b) ;