haskell-posit

Haskell bindings for the SoftPosit C library 🧮 (WIP)

Posit.hs (5563B)

  1 {-# LANGUAGE ForeignFunctionInterface #-}
  2 
  3 module Numeric.Posit (Posit, Posit8, Posit16, Posit32) where
  4 
  5 import Foreign.Storable
  6 import Foreign.Ptr (castPtr)
  7 import Data.Int (Int8, Int16, Int32, Int64)
  8 import Data.Ratio (numerator, denominator)
  9 
 10 foreign import ccall "int_to_posit8" intToPosit8 :: Int64 -> Int8
 11 foreign import ccall "posit8_add" p8Add :: Int8 -> Int8 -> Int8
 12 foreign import ccall "posit8_sub" p8Sub :: Int8 -> Int8 -> Int8
 13 foreign import ccall "posit8_mul" p8Mul :: Int8 -> Int8 -> Int8
 14 foreign import ccall "posit8_div" p8Div :: Int8 -> Int8 -> Int8
 15 foreign import ccall "posit8_neg" p8Neg :: Int8 -> Int8
 16 foreign import ccall "posit8_eq"  p8Eq  :: Int8 -> Int8 -> Bool
 17 foreign import ccall "posit8_le"  p8Le  :: Int8 -> Int8 -> Bool
 18 foreign import ccall "posit8_lt"  p8Lt  :: Int8 -> Int8 -> Bool
 19 
 20 foreign import ccall "int_to_posit16" intToPosit16 :: Int64 -> Int16
 21 foreign import ccall "posit16_add" p16Add :: Int16 -> Int16 -> Int16
 22 foreign import ccall "posit16_sub" p16Sub :: Int16 -> Int16 -> Int16
 23 foreign import ccall "posit16_mul" p16Mul :: Int16 -> Int16 -> Int16
 24 foreign import ccall "posit16_div" p16Div :: Int16 -> Int16 -> Int16
 25 foreign import ccall "posit16_neg" p16Neg :: Int16 -> Int16
 26 foreign import ccall "posit16_eq"  p16Eq  :: Int16 -> Int16 -> Bool
 27 foreign import ccall "posit16_le"  p16Le  :: Int16 -> Int16 -> Bool
 28 foreign import ccall "posit16_lt"  p16Lt  :: Int16 -> Int16 -> Bool
 29 
 30 foreign import ccall "int_to_posit32" intToPosit32 :: Int64 -> Int32
 31 foreign import ccall "posit32_add" p32Add :: Int32 -> Int32 -> Int32
 32 foreign import ccall "posit32_sub" p32Sub :: Int32 -> Int32 -> Int32
 33 foreign import ccall "posit32_mul" p32Mul :: Int32 -> Int32 -> Int32
 34 foreign import ccall "posit32_div" p32Div :: Int32 -> Int32 -> Int32
 35 foreign import ccall "posit32_neg" p32Neg :: Int32 -> Int32
 36 foreign import ccall "posit32_eq"  p32Eq  :: Int32 -> Int32 -> Bool
 37 foreign import ccall "posit32_le"  p32Le  :: Int32 -> Int32 -> Bool
 38 foreign import ccall "posit32_lt"  p32Lt  :: Int32 -> Int32 -> Bool
 39 
 40 -- | 8 bit posit numbers.
 41 newtype Posit8  = Posit8  Int8
 42 
 43 -- | 16 bit posit numbers.
 44 newtype Posit16 = Posit16 Int16
 45 
 46 -- | 32 bit posit numbers.
 47 newtype Posit32 = Posit32 Int32
 48 
 49 type Posit = Posit32
 50 
 51 zero8 :: Posit8
 52 zero8 = Posit8 0
 53 
 54 instance Eq Posit8 where
 55     (Posit8 a) == (Posit8 b) = p8Eq a b
 56 
 57 instance Ord Posit8 where
 58     (Posit8 a) <= (Posit8 b) = p8Le a b
 59     (Posit8 a) <  (Posit8 b) = p8Lt a b
 60 
 61 instance Num Posit8 where
 62     fromInteger = Posit8 . intToPosit8 . fromInteger 
 63 
 64     (Posit8 a) + (Posit8 b) = Posit8 $ p8Add a b
 65     (Posit8 a) - (Posit8 b) = Posit8 $ p8Sub a b
 66     (Posit8 a) * (Posit8 b) = Posit8 $ p8Mul a b
 67     
 68     negate (Posit8 a) = Posit8 $ p8Neg a
 69 
 70     signum p
 71         | p == zero8 = zero8 
 72         | p > zero8  = fromInteger 1 
 73         | otherwise  = fromInteger (-1)
 74 
 75     abs p
 76         | p < zero8 = negate p
 77         | otherwise = p
 78 
 79 instance Fractional Posit8 where
 80     fromRational q = Posit8 $ p8Div n d
 81         where n = intToPosit8 $ fromInteger $ numerator q 
 82               d = intToPosit8 $ fromInteger $ denominator q 
 83     
 84     (Posit8 a) / (Posit8 b) = Posit8 $ p8Div a b
 85 
 86 instance Storable Posit8 where
 87     sizeOf _ = 1
 88     alignment = sizeOf
 89 
 90     peek p = Posit8 <$> peek (castPtr p)
 91     poke p (Posit8 a) = poke (castPtr p) a
 92 
 93 zero16 :: Posit16
 94 zero16 = Posit16 0
 95 
 96 instance Eq Posit16 where
 97     (Posit16 a) == (Posit16 b) = p16Eq a b
 98 
 99 instance Ord Posit16 where
100     (Posit16 a) <= (Posit16 b) = p16Le a b
101     (Posit16 a) <  (Posit16 b) = p16Lt a b
102 
103 instance Num Posit16 where
104     fromInteger = Posit16 . intToPosit16 . fromInteger 
105 
106     (Posit16 a) + (Posit16 b) = Posit16 $ p16Add a b
107     (Posit16 a) - (Posit16 b) = Posit16 $ p16Sub a b
108     (Posit16 a) * (Posit16 b) = Posit16 $ p16Mul a b
109     
110     negate (Posit16 a) = Posit16 $ p16Neg a
111 
112     signum p
113         | p == zero16 = zero16 
114         | p > zero16  = fromInteger 1 
115         | otherwise   = fromInteger (-1)
116 
117     abs p
118         | p < zero16 = negate p
119         | otherwise  = p
120 
121 instance Fractional Posit16 where
122     fromRational q = Posit16 $ p16Div n d
123         where n = intToPosit16 $ fromInteger $ numerator q 
124               d = intToPosit16 $ fromInteger $ denominator q 
125     
126     (Posit16 a) / (Posit16 b) = Posit16 $ p16Div a b
127 
128 instance Storable Posit16 where
129     sizeOf _ = 2
130     alignment = sizeOf
131 
132     peek p = Posit16 <$> peek (castPtr p)
133     poke p (Posit16 a) = poke (castPtr p) a
134 
135 zero32 :: Posit32
136 zero32 = Posit32 0
137 
138 instance Eq Posit32 where
139     (Posit32 a) == (Posit32 b) = p32Eq a b
140 
141 instance Ord Posit32 where
142     (Posit32 a) <= (Posit32 b) = p32Le a b
143     (Posit32 a) <  (Posit32 b) = p32Lt a b
144 
145 instance Num Posit32 where
146     fromInteger = Posit32 . intToPosit32 . fromInteger 
147 
148     (Posit32 a) + (Posit32 b) = Posit32 $ p32Add a b
149     (Posit32 a) - (Posit32 b) = Posit32 $ p32Sub a b
150     (Posit32 a) * (Posit32 b) = Posit32 $ p32Mul a b
151     
152     negate (Posit32 a) = Posit32 $ p32Neg a
153 
154     signum p
155         | p == zero32 = zero32 
156         | p > zero32  = fromInteger 1 
157         | otherwise   = fromInteger (-1)
158 
159     abs p
160         | p < zero32 = negate p
161         | otherwise = p
162 
163 instance Fractional Posit32 where
164     fromRational q = Posit32 $ p32Div n d
165         where n = intToPosit32 $ fromInteger $ numerator q 
166               d = intToPosit32 $ fromInteger $ denominator q 
167     
168     (Posit32 a) / (Posit32 b) = Posit32 $ p32Div a b
169 
170 instance Storable Posit32 where
171     sizeOf _ = 4
172     alignment = sizeOf
173 
174     peek p = Posit32 <$> peek (castPtr p)
175     poke p (Posit32 a) = poke (castPtr p) a
176