unmaintained/isequences/ops/modulus/modulus.factor

   1 ! Copyright (C) 2007 Robbert van Dalen.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 IN: isequences.ops.modulus
   5 USING: generic kernel math sequences isequences.interface isequences.base ;
   6
   7
   8 : %%g++ ( s1 s2 -- ms1 ms2 )
   9     2dup [ i-length ] 2apply 2dup [ 0 = ] 2apply or
  10     [ 3drop drop 0 0 ]
  11     [ 2dup mod -rot swap mod swap rot swap ihead >r ihead r> ] if ;
  12
  13 : %%g-+ ( s1 s2 -- ms1 ms2 )
  14     ;
  15
  16 : %%g+- ( s1 s2 -- ms2 ms2 )
  17     ;
  18
  19 : %%g-- ( s1 s2 -- ms1 ms2 )
  20     ;
  21
  22 : %%g ( s1 s2 --  ms1 ms2 )
  23     2dup [ neg? ] 2apply [ [ %%g-- ] [ %%g+- ] if ]
  24     [ [ %%g-+ ] [ %%g++ ] if ] if ; inline
  25
  26 M: object %% %%g ;