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
  36     dup length
  37     [ drop 0 ]
  38     [ swap [ first-unsafe ] [ last-unsafe ] bi + * 2 / ] if-zero ;
  39
  40 <PRIVATE
  41
  42 : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline
  43
  44 : (a.. ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline
  45
  46 : ..b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline
  47
  48 PRIVATE>
  49
  50 : [a..b] ( a b -- range ) twiddle <range> ; inline
  51
  52 : (a..b] ( a b -- range ) twiddle (a.. <range> ; inline
  53
  54 : [a..b) ( a b -- range ) twiddle ..b) <range> ; inline
  55
  56 : (a..b) ( a b -- range ) twiddle (a.. ..b) <range> ; inline
  57
  58 : [0..b] ( b -- range ) 0 swap [a..b] ; inline
  59
  60 : [1..b] ( b -- range ) 1 swap [a..b] ; inline
  61
  62 : [0..b) ( b -- range ) 0 swap [a..b) ; inline
  63
  64 : [1..b) ( b -- range ) 1 swap [a..b) ; inline