basis/core-foundation/numbers/numbers.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types alien.data alien.syntax combinators
   4 core-foundation kernel math ;
   5 QUALIFIED-WITH: alien.c-types c
   6 FROM: math => float ;
   7 IN: core-foundation.numbers
   8
   9 TYPEDEF: void* CFNumberRef
  10
  11 TYPEDEF: int CFNumberType
  12 CONSTANT: kCFNumberSInt8Type 1
  13 CONSTANT: kCFNumberSInt16Type 2
  14 CONSTANT: kCFNumberSInt32Type 3
  15 CONSTANT: kCFNumberSInt64Type 4
  16 CONSTANT: kCFNumberFloat32Type 5
  17 CONSTANT: kCFNumberFloat64Type 6
  18 CONSTANT: kCFNumberCharType 7
  19 CONSTANT: kCFNumberShortType 8
  20 CONSTANT: kCFNumberIntType 9
  21 CONSTANT: kCFNumberLongType 10
  22 CONSTANT: kCFNumberLongLongType 11
  23 CONSTANT: kCFNumberFloatType 12
  24 CONSTANT: kCFNumberDoubleType 13
  25 CONSTANT: kCFNumberCFIndexType 14
  26 CONSTANT: kCFNumberNSIntegerType 15
  27 CONSTANT: kCFNumberCGFloatType 16
  28 CONSTANT: kCFNumberMaxType 16
  29
  30 FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr )
  31
  32 FUNCTION: CFNumberType CFNumberGetType ( CFNumberRef number )
  33
  34 FUNCTION: Boolean CFNumberGetValue ( CFNumberRef number, CFNumberType theType, void* valuePtr )
  35
  36 GENERIC: <CFNumber> ( number -- alien )
  37
  38 M: integer <CFNumber>
  39     [ f kCFNumberLongLongType ] dip longlong <ref> CFNumberCreate ;
  40
  41 M: float <CFNumber>
  42     [ f kCFNumberDoubleType ] dip double <ref> CFNumberCreate ;
  43
  44 M: t <CFNumber>
  45     drop f kCFNumberIntType 1 int <ref> CFNumberCreate ;
  46
  47 M: f <CFNumber>
  48     drop f kCFNumberIntType 0 int <ref> CFNumberCreate ;
  49
  50 ERROR: unsupported-number-type type ;
  51
  52 : (CFNumber>number) ( alien c-type -- number )
  53     [
  54         0 swap <ref> [ CFNumberGetValue drop ] keep
  55     ] keep deref ; inline
  56
  57 : CFNumber>number ( alien -- number )
  58     dup CFNumberGetType dup {
  59         { kCFNumberSInt8Type [ SInt8 (CFNumber>number) ] }
  60         { kCFNumberSInt16Type [ SInt16 (CFNumber>number) ] }
  61         { kCFNumberSInt32Type [ SInt32 (CFNumber>number) ] }
  62         { kCFNumberSInt64Type [ SInt64 (CFNumber>number) ] }
  63         { kCFNumberFloat64Type [ double (CFNumber>number) ] }
  64         { kCFNumberCharType [ char (CFNumber>number) ] }
  65         { kCFNumberShortType [ c:short (CFNumber>number) ] }
  66         { kCFNumberIntType [ int (CFNumber>number) ] }
  67         { kCFNumberLongType [ long (CFNumber>number) ] }
  68         { kCFNumberLongLongType [ longlong (CFNumber>number) ] }
  69         { kCFNumberDoubleType [ double (CFNumber>number) ] }
  70         [ unsupported-number-type ]
  71     } case ;