basis/math/complex/complex.factor

   1 ! Copyright (C) 2006, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel kernel.private math math.private
   4 math.functions arrays math.functions.private sequences
   5 sequences.private parser ;
   6 IN: math.complex
   7
   8 <PRIVATE
   9
  10 M: real real-part ; inline
  11 M: real imaginary-part drop 0 ; inline
  12 M: complex real-part real>> ; inline
  13 M: complex imaginary-part imaginary>> ; inline
  14 M: complex absq >rect [ sq ] bi@ + ; inline
  15 M: complex hashcode* nip >rect [ hashcode ] bi@ bitxor ; inline
  16 : componentwise ( x y quot -- a b ) [ [ >rect ] bi@ ] dip bi-curry@ bi* ; inline
  17 : complex= ( x y quot -- ? ) componentwise and ; inline
  18 M: complex equal? over complex? [ [ = ] complex= ] [ 2drop f ] if ; inline
  19 M: complex number= [ number= ] complex= ; inline
  20 : complex-op ( x y quot -- z ) componentwise rect> ; inline
  21 M: complex + [ + ] complex-op ; inline
  22 M: complex - [ - ] complex-op ; inline
  23 : *re ( x y -- xr*yr xi*yi ) [ >rect ] bi@ [ * ] bi-curry@ bi* ; inline
  24 : *im ( x y -- xi*yr xr*yi ) swap [ >rect ] bi@ swap [ * ] bi-curry@ bi* ; inline
  25 M: complex * [ *re - ] [ *im + ] 2bi rect> ; inline
  26 : (complex/) ( x y -- r i m ) [ [ *re + ] [ *im - ] 2bi ] keep absq ; inline
  27 : complex/ ( x y quot -- z ) [ (complex/) ] dip curry bi@ rect> ; inline
  28 M: complex / [ / ] complex/ ; inline
  29 M: complex /f [ /f ] complex/ ; inline
  30 M: complex /i [ /i ] complex/ ; inline
  31 M: complex abs absq sqrt ; inline
  32 M: complex sqrt >polar [ sqrt ] [ 2.0 / ] bi* polar> ; inline
  33
  34 PRIVATE>
  35
  36 IN: syntax
  37
  38 ERROR: malformed-complex obj ;
  39
  40 : parse-complex ( seq -- complex )
  41     dup length 2 = [ first2-unsafe rect> ] [ throw-malformed-complex ] if ;
  42
  43 SYNTAX: C{ \ } [ parse-complex ] parse-literal ;
  44
  45 USE: prettyprint.custom
  46
  47 M: complex pprint* pprint-object ;
  48 M: complex pprint-delims drop \ C{ \ } ;
  49 M: complex >pprint-sequence >rect 2array ;