basis/cords/cords.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs sequences sorting binary-search math
   4 math.order arrays combinators kernel ;
   5 IN: cords
   6
   7 <PRIVATE
   8
   9 TUPLE: simple-cord first second ;
  10
  11 M: simple-cord length
  12     [ first>> length ] [ second>> length ] bi + ;
  13
  14 M: simple-cord virtual-seq first>> ;
  15
  16 M: simple-cord virtual@
  17     2dup first>> length <
  18     [ first>> ] [ [ first>> length - ] [ second>> ] bi ] if ;
  19
  20 TUPLE: multi-cord count seqs ;
  21
  22 M: multi-cord length count>> ;
  23
  24 M: multi-cord virtual@
  25     dupd
  26     seqs>> [ first <=> ] with search nip
  27     [ first - ] [ second ] bi ;
  28
  29 M: multi-cord virtual-seq
  30     seqs>> [ f ] [ first second ] if-empty ;
  31
  32 : <cord> ( seqs -- cord )
  33     dup length 2 = [
  34         first2 simple-cord boa
  35     ] [
  36         [ 0 [ length + ] accumulate ] keep zip multi-cord boa
  37     ] if ;
  38
  39 PRIVATE>
  40
  41 UNION: cord simple-cord multi-cord ;
  42
  43 INSTANCE: cord virtual-sequence
  44
  45 INSTANCE: multi-cord virtual-sequence
  46
  47 : cord-append ( seq1 seq2 -- cord )
  48     {
  49         { [ over empty? ] [ nip ] }
  50         { [ dup empty? ] [ drop ] }
  51         { [ 2dup [ cord? ] both? ] [ [ seqs>> values ] bi@ append <cord> ] }
  52         { [ over cord? ] [ [ seqs>> values ] dip suffix <cord> ] }
  53         { [ dup cord? ] [ seqs>> values swap prefix <cord> ] }
  54         [ 2array <cord> ]
  55     } cond ;
  56
  57 : cord-concat ( seqs -- cord )
  58     {
  59         { [ dup empty? ] [ drop f ] }
  60         { [ dup length 1 = ] [ first ] }
  61         [
  62             [
  63                 {
  64                     { [ dup cord? ] [ seqs>> values ] }
  65                     { [ dup empty? ] [ drop { } ] }
  66                     [ 1array ]
  67                 } cond
  68             ] map concat <cord>
  69         ]
  70     } cond ;