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 assocs sequences sorting binary-search fry math
   4 math.order arrays classes combinators kernel functors math.functions
   5 math.vectors ;
   6 IN: sequences.cords
   7
   8 MIXIN: cord
   9
  10 TUPLE: generic-cord
  11     { head read-only } { tail read-only } ; final
  12 INSTANCE: generic-cord cord
  13
  14 M: cord length
  15     [ head>> length ] [ tail>> length ] bi + ; inline
  16
  17 M: cord virtual-exemplar head>> ; inline
  18
  19 M: cord virtual@
  20     2dup head>> length <
  21     [ head>> ] [ [ head>> length - ] [ tail>> ] bi ] if ; inline
  22
  23 INSTANCE: cord virtual-sequence
  24
  25 GENERIC: cord-append ( seq1 seq2 -- cord )
  26
  27 M: object cord-append
  28     generic-cord boa ; inline
  29
  30 FUNCTOR: define-specialized-cord ( T C -- )
  31
  32 T-cord DEFINES-CLASS ${C}
  33
  34 WHERE
  35
  36 TUPLE: T-cord
  37     { head T read-only } { tail T read-only } ; final
  38 INSTANCE: T-cord cord
  39
  40 M: T cord-append
  41     2dup [ T instance? ] both?
  42     [ T-cord boa ] [ generic-cord boa ] if ; inline
  43
  44 ;FUNCTOR
  45
  46 : cord-map ( cord quot -- cord' )
  47     [ [ head>> ] dip call ]
  48     [ [ tail>> ] dip call ] 2bi cord-append ; inline
  49
  50 : cord-2map ( cord cord quot -- cord' )
  51     [ [ [ head>> ] bi@ ] dip call ]
  52     [ [ [ tail>> ] bi@ ] dip call ] 3bi cord-append ; inline
  53
  54 : cord-both ( cord quot -- h t )
  55     [ [ head>> ] [ tail>> ] bi ] dip bi@ ; inline
  56
  57 : cord-2both ( cord cord quot -- h t )
  58     [ [ [ head>> ] bi@ ] dip call ]
  59     [ [ [ tail>> ] bi@ ] dip call ] 3bi ; inline
  60
  61 M: cord v+                [ v+                ] cord-2map ; inline
  62 M: cord v-                [ v-                ] cord-2map ; inline
  63 M: cord vneg              [ vneg              ] cord-map  ; inline
  64 M: cord v+-               [ v+-               ] cord-2map ; inline
  65 M: cord vs+               [ vs+               ] cord-2map ; inline
  66 M: cord vs-               [ vs-               ] cord-2map ; inline
  67 M: cord vs*               [ vs*               ] cord-2map ; inline
  68 M: cord v*                [ v*                ] cord-2map ; inline
  69 M: cord v/                [ v/                ] cord-2map ; inline
  70 M: cord vmin              [ vmin              ] cord-2map ; inline
  71 M: cord vmax              [ vmax              ] cord-2map ; inline
  72 M: cord v.                [ v.                ] cord-2both + ; inline
  73 M: cord vsqrt             [ vsqrt             ] cord-map  ; inline
  74 M: cord sum               [ sum               ] cord-both + ; inline
  75 M: cord vabs              [ vabs              ] cord-map  ; inline
  76 M: cord vbitand           [ vbitand           ] cord-2map ; inline
  77 M: cord vbitandn          [ vbitandn          ] cord-2map ; inline
  78 M: cord vbitor            [ vbitor            ] cord-2map ; inline
  79 M: cord vbitxor           [ vbitxor           ] cord-2map ; inline
  80 M: cord vbitnot           [ vbitnot           ] cord-map  ; inline
  81 M: cord vand              [ vand              ] cord-2map ; inline
  82 M: cord vandn             [ vandn             ] cord-2map ; inline
  83 M: cord vor               [ vor               ] cord-2map ; inline
  84 M: cord vxor              [ vxor              ] cord-2map ; inline
  85 M: cord vnot              [ vnot              ] cord-map  ; inline
  86 M: cord vlshift           '[ _ vlshift        ] cord-map  ; inline
  87 M: cord vrshift           '[ _ vrshift        ] cord-map  ; inline
  88 M: cord (vmerge-head)     [ head>> ] bi@ (vmerge) cord-append ; inline
  89 M: cord (vmerge-tail)     [ tail>> ] bi@ (vmerge) cord-append ; inline
  90 M: cord v<=               [ v<=               ] cord-2map ; inline
  91 M: cord v<                [ v<                ] cord-2map ; inline
  92 M: cord v=                [ v=                ] cord-2map ; inline
  93 M: cord v>                [ v>                ] cord-2map ; inline
  94 M: cord v>=               [ v>=               ] cord-2map ; inline
  95 M: cord vunordered?       [ vunordered?       ] cord-2map ; inline
  96 M: cord vany?             [ vany?             ] cord-both or  ; inline
  97 M: cord vall?             [ vall?             ] cord-both and ; inline
  98 M: cord vnone?            [ vnone?            ] cord-both and ; inline
  99
 100 M: cord n+v [ n+v ] with cord-map ; inline
 101 M: cord n-v [ n-v ] with cord-map ; inline
 102 M: cord n*v [ n*v ] with cord-map ; inline
 103 M: cord n/v [ n/v ] with cord-map ; inline
 104 M: cord v+n '[ _ v+n ] cord-map ; inline
 105 M: cord v-n '[ _ v-n ] cord-map ; inline
 106 M: cord v*n '[ _ v*n ] cord-map ; inline
 107 M: cord v/n '[ _ v/n ] cord-map ; inline
 108
 109 M: cord norm-sq [ norm-sq ] cord-both + ; inline
 110 M: cord distance v- norm ; inline