basis/sequences/cords/cords.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors classes functors kernel math math.vectors
   4 sequences ;
   5 IN: sequences.cords
   6
   7 MIXIN: cord
   8
   9 TUPLE: generic-cord
  10     { head read-only } { tail read-only } ; final
  11 INSTANCE: generic-cord cord
  12
  13 M: cord length
  14     [ head>> length ] [ tail>> length ] bi + ; inline
  15
  16 M: cord virtual-exemplar head>> ; inline
  17
  18 M: cord virtual@
  19     2dup head>> length <
  20     [ head>> ] [ [ head>> length - ] [ tail>> ] bi ] if ; inline
  21
  22 INSTANCE: cord virtual-sequence
  23
  24 GENERIC: cord-append ( seq1 seq2 -- cord )
  25
  26 M: object cord-append
  27     generic-cord boa ; inline
  28
  29 <FUNCTOR: define-specialized-cord ( T C -- )
  30
  31 T-cord DEFINES-CLASS ${C}
  32
  33 WHERE
  34
  35 TUPLE: T-cord
  36     { head T read-only } { tail T read-only } ; final
  37 INSTANCE: T-cord cord
  38
  39 M: T cord-append
  40     2dup [ T instance? ] both?
  41     [ T-cord boa ] [ generic-cord boa ] if ; inline
  42
  43 ;FUNCTOR>
  44
  45 : cord-map ( cord quot -- cord' )
  46     [ [ head>> ] dip call ]
  47     [ [ tail>> ] dip call ] 2bi cord-append ; inline
  48
  49 :: cord-2map ( cord-a cord-b quot fallback -- cord' )
  50     cord-a cord-b 2dup [ cord? ] both? [
  51         [ [ head>> ] bi@ quot call ]
  52         [ [ tail>> ] bi@ quot call ] 2bi cord-append
  53     ] [ fallback call ] if ; inline
  54
  55 : cord-both ( cord quot -- h t )
  56     [ [ head>> ] [ tail>> ] bi ] dip bi@ ; inline
  57
  58 :: cord-2both ( cord-a cord-b quot combine fallback -- result )
  59     cord-a cord-b 2dup [ cord? ] both? [
  60         [ [ head>> ] bi@ quot call ]
  61         [ [ tail>> ] bi@ quot call ] 2bi combine call
  62     ] [ fallback call ] if ; inline
  63
  64 <PRIVATE
  65 : split-shuffle ( shuf -- sh uf )
  66     dup length 2 /i cut* ; foldable
  67 PRIVATE>
  68
  69 M: cord v+                [ v+                ] [ call-next-method ] cord-2map ; inline
  70 M: cord v-                [ v-                ] [ call-next-method ] cord-2map ; inline
  71 M: cord vneg              [ vneg              ] cord-map  ; inline
  72 M: cord v+-               [ v+-               ] [ call-next-method ] cord-2map ; inline
  73 M: cord vs+               [ vs+               ] [ call-next-method ] cord-2map ; inline
  74 M: cord vs-               [ vs-               ] [ call-next-method ] cord-2map ; inline
  75 M: cord vs*               [ vs*               ] [ call-next-method ] cord-2map ; inline
  76 M: cord v*                [ v*                ] [ call-next-method ] cord-2map ; inline
  77 M: cord v/                [ v/                ] [ call-next-method ] cord-2map ; inline
  78 M: cord vmin              [ vmin              ] [ call-next-method ] cord-2map ; inline
  79 M: cord vmax              [ vmax              ] [ call-next-method ] cord-2map ; inline
  80 M: cord vdot              [ vdot              ] [ + ] [ call-next-method ] cord-2both ; inline
  81 M: cord vsqrt             [ vsqrt             ] cord-map  ; inline
  82 M: cord sum               [ sum               ] cord-both + ; inline
  83 M: cord vabs              [ vabs              ] cord-map  ; inline
  84 M: cord vbitand           [ vbitand           ] [ call-next-method ] cord-2map ; inline
  85 M: cord vbitandn          [ vbitandn          ] [ call-next-method ] cord-2map ; inline
  86 M: cord vbitor            [ vbitor            ] [ call-next-method ] cord-2map ; inline
  87 M: cord vbitxor           [ vbitxor           ] [ call-next-method ] cord-2map ; inline
  88 M: cord vbitnot           [ vbitnot           ] cord-map  ; inline
  89 M: cord vand              [ vand              ] [ call-next-method ] cord-2map ; inline
  90 M: cord vandn             [ vandn             ] [ call-next-method ] cord-2map ; inline
  91 M: cord vor               [ vor               ] [ call-next-method ] cord-2map ; inline
  92 M: cord vxor              [ vxor              ] [ call-next-method ] cord-2map ; inline
  93 M: cord vnot              [ vnot              ] cord-map  ; inline
  94 M: cord vlshift           '[ _ vlshift        ] cord-map  ; inline
  95 M: cord vrshift           '[ _ vrshift        ] cord-map  ; inline
  96 M: cord (vmerge-head)     [ head>> ] bi@ (vmerge) cord-append ; inline
  97 M: cord (vmerge-tail)     [ tail>> ] bi@ (vmerge) cord-append ; inline
  98 M: cord v<=               [ v<=               ] [ call-next-method ] cord-2map ; inline
  99 M: cord v<                [ v<                ] [ call-next-method ] cord-2map ; inline
 100 M: cord v=                [ v=                ] [ call-next-method ] cord-2map ; inline
 101 M: cord v>                [ v>                ] [ call-next-method ] cord-2map ; inline
 102 M: cord v>=               [ v>=               ] [ call-next-method ] cord-2map ; inline
 103 M: cord vunordered?       [ vunordered?       ] [ call-next-method ] cord-2map ; inline
 104 M: cord vany?             [ vany?             ] cord-both or  ; inline
 105 M: cord vall?             [ vall?             ] cord-both and ; inline
 106 M: cord vnone?            [ vnone?            ] cord-both and ; inline
 107 M: cord vshuffle-elements
 108     [ [ head>> ] [ tail>> ] bi ] [ split-shuffle ] bi*
 109     [ vshuffle2-elements ] bi-curry@ 2bi cord-append ; inline
 110
 111 M: cord n+v [ n+v ] with cord-map ; inline
 112 M: cord n-v [ n-v ] with cord-map ; inline
 113 M: cord n*v [ n*v ] with cord-map ; inline
 114 M: cord n/v [ n/v ] with cord-map ; inline
 115 M: cord v+n '[ _ v+n ] cord-map ; inline
 116 M: cord v-n '[ _ v-n ] cord-map ; inline
 117 M: cord v*n '[ _ v*n ] cord-map ; inline
 118 M: cord v/n '[ _ v/n ] cord-map ; inline
 119
 120 M: cord norm-sq [ norm-sq ] cord-both + ; inline
 121 M: cord distance v- norm ; inline