/core/growable/growable.factor

http://github.com/abeaumont/factor · Factor · 68 lines · 50 code · 16 blank · 2 comment · 7 complexity · 6a3e9a056417fe5bb99ad4a5643b3ade MD5 · raw file

  1. ! Copyright (C) 2005, 2009 Slava Pestov.
  2. ! See http://factorcode.org/license.txt for BSD license.
  3. USING: accessors kernel math math.private sequences
  4. sequences.private ;
  5. IN: growable
  6. MIXIN: growable
  7. SLOT: length
  8. SLOT: underlying
  9. M: growable length length>> ; inline
  10. M: growable nth-unsafe underlying>> nth-unsafe ; inline
  11. M: growable set-nth-unsafe underlying>> set-nth-unsafe ; inline
  12. : capacity ( seq -- n ) underlying>> length ; inline
  13. : expand ( len seq -- )
  14. [ resize ] change-underlying drop ; inline
  15. GENERIC: contract ( len seq -- )
  16. M: growable contract ( len seq -- )
  17. [ length ] keep
  18. [ [ 0 ] 2dip set-nth-unsafe ] curry
  19. (each-integer) ; inline
  20. M: growable set-length ( n seq -- )
  21. bounds-check-head
  22. 2dup length < [
  23. 2dup contract
  24. ] [
  25. 2dup capacity > [ 2dup expand ] when
  26. ] if
  27. length<< ;
  28. : new-size ( old -- new ) 1 + 3 * ; inline
  29. : ensure ( n seq -- n seq )
  30. bounds-check-head
  31. 2dup length >= [
  32. 2dup capacity >= [ over new-size over expand ] when
  33. [ >fixnum ] dip
  34. over 1 fixnum+fast over length<<
  35. ] [
  36. [ >fixnum ] dip
  37. ] if ; inline
  38. M: growable set-nth ensure set-nth-unsafe ; inline
  39. M: growable clone (clone) [ clone ] change-underlying ; inline
  40. M: growable lengthen ( n seq -- )
  41. 2dup length > [
  42. 2dup capacity > [ over new-size over expand ] when
  43. 2dup length<<
  44. ] when 2drop ; inline
  45. M: growable shorten ( n seq -- )
  46. bounds-check-head
  47. 2dup length < [
  48. 2dup contract
  49. 2dup length<<
  50. ] when 2drop ; inline
  51. M: growable new-resizable new-sequence 0 over set-length ; inline
  52. INSTANCE: growable sequence