From 3e79d0d7d1567079e36a47c68a9ac3e58bf9f8b1 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 29 Mar 2013 20:24:39 -0700
Subject: [PATCH] core-foundation.numbers: support converting CFNumber back to
 factor.

---
 basis/core-foundation/numbers/numbers.factor | 31 ++++++++++++++++++--
 1 file changed, 29 insertions(+), 2 deletions(-)

diff --git a/basis/core-foundation/numbers/numbers.factor b/basis/core-foundation/numbers/numbers.factor
index 81440e20f6..d3447d8450 100644
--- a/basis/core-foundation/numbers/numbers.factor
+++ b/basis/core-foundation/numbers/numbers.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.data alien.syntax kernel math
-core-foundation ;
+USING: alien.c-types alien.data alien.syntax combinators
+core-foundation kernel math ;
+QUALIFIED-WITH: alien.c-types c
 FROM: math => float ;
 IN: core-foundation.numbers
 
@@ -28,6 +29,10 @@ CONSTANT: kCFNumberMaxType 16
 
 FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
 
+FUNCTION: CFNumberType CFNumberGetType ( CFNumberRef number ) ;
+
+FUNCTION: Boolean CFNumberGetValue ( CFNumberRef number, CFNumberType theType, void* valuePtr ) ;
+
 GENERIC: <CFNumber> ( number -- alien )
 
 M: integer <CFNumber>
@@ -42,3 +47,25 @@ M: t <CFNumber>
 M: f <CFNumber>
     drop f kCFNumberIntType 0 int <ref> CFNumberCreate ;
 
+ERROR: unsupported-number-type type ;
+
+: (CFNumber>number) ( alien c-type -- number )
+    [
+        0 swap <ref> [ CFNumberGetValue drop ] keep
+    ] keep deref ; inline
+
+: CFNumber>number ( alien -- number )
+    dup CFNumberGetType dup {
+        { kCFNumberSInt8Type [ SInt8 (CFNumber>number) ] }
+        { kCFNumberSInt16Type [ SInt16 (CFNumber>number) ] }
+        { kCFNumberSInt32Type [ SInt32 (CFNumber>number) ] }
+        { kCFNumberSInt64Type [ SInt64 (CFNumber>number) ] }
+        { kCFNumberFloat64Type [ double (CFNumber>number) ] }
+        { kCFNumberCharType [ char (CFNumber>number) ] }
+        { kCFNumberShortType [ c:short (CFNumber>number) ] }
+        { kCFNumberIntType [ int (CFNumber>number) ] }
+        { kCFNumberLongType [ long (CFNumber>number) ] }
+        { kCFNumberLongLongType [ longlong (CFNumber>number) ] }
+        { kCFNumberDoubleType [ double (CFNumber>number) ] }
+        [ unsupported-number-type ]
+    } case ;