{-# Language OverloadedStrings, BangPatterns, MagicHash #-}
module Cryptol.Eval.FFI.Abstract.Export
  ( ExportVal
  , ExporterErrorMessage(..)
  , Export
  , exportValue, exportValues, exportSizes
  , cryStartExport, cryEndExport
  , cry_recv_u8
  , cry_recv_u64
  , cry_recv_u64_digits
  , cry_recv_double
  ) where

import Data.Text(Text)
import qualified Data.Vector as Vector
import qualified Data.IntMap as IntMap
import Control.Exception(Exception,throw)
import Data.IORef(IORef,newIORef,readIORef,writeIORef)
import LibBF
import Foreign
    ( Word8, Word32, Word64, StablePtr, Ptr, Storable(poke),
      newStablePtr, freeStablePtr, castPtrToStablePtr, deRefStablePtr )
import GHC.Num ( Integer(IN, IS, IP) )
import GHC.Base(Int(..))
import Data.Primitive.PrimArray
    ( copyPrimArrayToPtr, sizeofPrimArray, PrimArray(..) )

import Cryptol.Utils.RecordMap ( canonicalFields )
import Cryptol.Eval.Value ( Backend(SWord, SEval), GenValue(..) )
import Cryptol.Eval.Type(conFields)
import Cryptol.Backend.FloatHelpers
import Cryptol.Backend.Concrete ( BV(BV), Concrete(..) )
import Cryptol.Backend.Monad(Eval)
import Cryptol.Backend.SeqMap (enumerateSeqMap)
import Cryptol.Backend(SRational(..))
import Cryptol.Backend.WordValue(asWordVal)

data ExportVal =
    EV8 !Word8              -- ^ Bit, integer sign
  | EV64 !Word64            -- ^ Buffer size, sum tag
  | EVDouble !Double        -- ^ A double
  | EVInteger !Integer      -- ^ Integer, Z, Word, components of Rational


data ExporterErrorMessage =
    UnsupportedValue Text
  | MalformedSum
  deriving Int -> ExporterErrorMessage -> ShowS
[ExporterErrorMessage] -> ShowS
ExporterErrorMessage -> String
(Int -> ExporterErrorMessage -> ShowS)
-> (ExporterErrorMessage -> String)
-> ([ExporterErrorMessage] -> ShowS)
-> Show ExporterErrorMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExporterErrorMessage -> ShowS
showsPrec :: Int -> ExporterErrorMessage -> ShowS
$cshow :: ExporterErrorMessage -> String
show :: ExporterErrorMessage -> String
$cshowList :: [ExporterErrorMessage] -> ShowS
showList :: [ExporterErrorMessage] -> ShowS
Show

instance Exception ExporterErrorMessage

type Value = SEval Concrete (GenValue Concrete)

-- Serialize a value into its external representation.
exportValue :: GenValue Concrete -> [ExportVal] -> Eval [ExportVal]
exportValue :: GenValue Concrete -> [ExportVal] -> Eval [ExportVal]
exportValue GenValue Concrete
v =
  case GenValue Concrete
v of
    VRecord RecordMap Ident (SEval Concrete (GenValue Concrete))
rmap -> RecordMap Ident (Eval (GenValue Concrete))
-> [ExportVal] -> Eval [ExportVal]
forall {a}.
RecordMap a (Eval (GenValue Concrete))
-> [ExportVal] -> Eval [ExportVal]
doRec RecordMap Ident (Eval (GenValue Concrete))
RecordMap Ident (SEval Concrete (GenValue Concrete))
rmap
    VTuple [SEval Concrete (GenValue Concrete)]
vs    -> [SEval Concrete (GenValue Concrete)]
-> [ExportVal] -> Eval [ExportVal]
exportValues [SEval Concrete (GenValue Concrete)]
vs
    VSeq Integer
n SeqMap Concrete (GenValue Concrete)
sm    -> [SEval Concrete (GenValue Concrete)]
-> [ExportVal] -> Eval [ExportVal]
exportValues (Integer
-> SeqMap Concrete (GenValue Concrete)
-> [SEval Concrete (GenValue Concrete)]
forall sym n a.
(Backend sym, Integral n) =>
n -> SeqMap sym a -> [SEval sym a]
enumerateSeqMap Integer
n SeqMap Concrete (GenValue Concrete)
sm)

    -- 1. tag, 2. constructor values
    VEnum SInteger Concrete
tag IntMap (ConValue Concrete)
mp
      | Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
SInteger Concrete
tag Bool -> Bool -> Bool
&& Integer
SInteger Concrete
tag Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
      , let n :: Int
n = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
SInteger Concrete
tag
      , Just ConInfo (Eval (GenValue Concrete))
con <- Int
-> IntMap (ConInfo (Eval (GenValue Concrete)))
-> Maybe (ConInfo (Eval (GenValue Concrete)))
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n IntMap (ConInfo (Eval (GenValue Concrete)))
IntMap (ConValue Concrete)
mp ->
        [SEval Concrete (GenValue Concrete)]
-> [ExportVal] -> Eval [ExportVal]
exportValues (Vector (Eval (GenValue Concrete)) -> [Eval (GenValue Concrete)]
forall a. Vector a -> [a]
Vector.toList (ConInfo (Eval (GenValue Concrete))
-> Vector (Eval (GenValue Concrete))
forall a. ConInfo a -> Vector a
conFields ConInfo (Eval (GenValue Concrete))
con)) ([ExportVal] -> Eval [ExportVal])
-> ([ExportVal] -> [ExportVal]) -> [ExportVal] -> Eval [ExportVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> ExportVal
EV64 (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
:)

      | Bool
otherwise -> ExporterErrorMessage -> [ExportVal] -> Eval [ExportVal]
forall a e. Exception e => e -> a
throw ExporterErrorMessage
MalformedSum

    VBit SBit Concrete
b      -> [ExportVal] -> Eval [ExportVal]
forall a. a -> Eval a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ExportVal] -> Eval [ExportVal])
-> ([ExportVal] -> [ExportVal]) -> [ExportVal] -> Eval [ExportVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [ExportVal] -> [ExportVal]
exportBit Bool
SBit Concrete
b
    VInteger SInteger Concrete
i  -> [ExportVal] -> Eval [ExportVal]
forall a. a -> Eval a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ExportVal] -> Eval [ExportVal])
-> ([ExportVal] -> [ExportVal]) -> [ExportVal] -> Eval [ExportVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [ExportVal] -> [ExportVal]
exportInteger Integer
SInteger Concrete
i
    VRational SRational Concrete
r -> [ExportVal] -> Eval [ExportVal]
forall a. a -> Eval a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ExportVal] -> Eval [ExportVal])
-> ([ExportVal] -> [ExportVal]) -> [ExportVal] -> Eval [ExportVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SRational Concrete -> [ExportVal] -> [ExportVal]
exportRational SRational Concrete
r
    VFloat SFloat Concrete
f
      |  BF -> Integer
bfExpWidth BF
SFloat Concrete
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
8 Bool -> Bool -> Bool
&& BF -> Integer
bfPrecWidth BF
SFloat Concrete
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
24
      Bool -> Bool -> Bool
|| BF -> Integer
bfExpWidth BF
SFloat Concrete
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
11 Bool -> Bool -> Bool
&& BF -> Integer
bfPrecWidth BF
SFloat Concrete
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
53 ->
        [ExportVal] -> Eval [ExportVal]
forall a. a -> Eval a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ExportVal] -> Eval [ExportVal])
-> ([ExportVal] -> [ExportVal]) -> [ExportVal] -> Eval [ExportVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigFloat -> [ExportVal] -> [ExportVal]
exportDouble (BF -> BigFloat
bfValue BF
SFloat Concrete
f)
      | Bool
otherwise -> ExporterErrorMessage -> [ExportVal] -> Eval [ExportVal]
forall a e. Exception e => e -> a
throw (Text -> ExporterErrorMessage
UnsupportedValue Text
"non-standard float")

    VWord WordValue Concrete
w   -> \[ExportVal]
start ->
      do BV
wv <- Concrete -> WordValue Concrete -> SEval Concrete (SWord Concrete)
forall sym.
Backend sym =>
sym -> WordValue sym -> SEval sym (SWord sym)
asWordVal Concrete
Concrete WordValue Concrete
w
         [ExportVal] -> Eval [ExportVal]
forall a. a -> Eval a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SWord Concrete -> [ExportVal] -> [ExportVal]
exportWord SWord Concrete
BV
wv [ExportVal]
start)


    VStream {}  -> ExporterErrorMessage -> [ExportVal] -> Eval [ExportVal]
forall a e. Exception e => e -> a
throw (Text -> ExporterErrorMessage
UnsupportedValue Text
"infinte stream")
    VFun {}     -> ExporterErrorMessage -> [ExportVal] -> Eval [ExportVal]
forall a e. Exception e => e -> a
throw (Text -> ExporterErrorMessage
UnsupportedValue Text
"function")
    VPoly {}    -> ExporterErrorMessage -> [ExportVal] -> Eval [ExportVal]
forall a e. Exception e => e -> a
throw (Text -> ExporterErrorMessage
UnsupportedValue Text
"polymorphic")
    VNumPoly {} -> ExporterErrorMessage -> [ExportVal] -> Eval [ExportVal]
forall a e. Exception e => e -> a
throw (Text -> ExporterErrorMessage
UnsupportedValue Text
"polymorphic")
  where
  doRec :: RecordMap a (Eval (GenValue Concrete))
-> [ExportVal] -> Eval [ExportVal]
doRec RecordMap a (Eval (GenValue Concrete))
rmap = [SEval Concrete (GenValue Concrete)]
-> [ExportVal] -> Eval [ExportVal]
exportValues (((a, Eval (GenValue Concrete)) -> Eval (GenValue Concrete))
-> [(a, Eval (GenValue Concrete))] -> [Eval (GenValue Concrete)]
forall a b. (a -> b) -> [a] -> [b]
map (a, Eval (GenValue Concrete)) -> Eval (GenValue Concrete)
forall a b. (a, b) -> b
snd (RecordMap a (Eval (GenValue Concrete))
-> [(a, Eval (GenValue Concrete))]
forall a b. RecordMap a b -> [(a, b)]
canonicalFields RecordMap a (Eval (GenValue Concrete))
rmap))


-- | Export some top-level sizes.
-- Exported as `u64` if it is less than `2^64-1`.
-- Otherwise exported as: `(2^64-1 : u64)` followed by an unsigned integer
exportSizes :: [Integer] -> [ExportVal] -> [ExportVal]
exportSizes :: [Integer] -> [ExportVal] -> [ExportVal]
exportSizes [Integer]
xs =
  case [Integer]
xs of
    [] -> [ExportVal] -> [ExportVal]
forall a. a -> a
id
    Integer
x : [Integer]
more -> [Integer] -> [ExportVal] -> [ExportVal]
exportSizes [Integer]
more ([ExportVal] -> [ExportVal])
-> ([ExportVal] -> [ExportVal]) -> [ExportVal] -> [ExportVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [ExportVal] -> [ExportVal]
exportSize Integer
x

-- | Export a type-level size.
-- Exported as `u64` if it is less than `2^64-1`.
-- Otherwise exported as: `(2^64-1 : u64)` followed by an unsigned integer
exportSize :: Integer -> [ExportVal] -> [ExportVal]
exportSize :: Integer -> [ExportVal] -> [ExportVal]
exportSize Integer
n [ExportVal]
start
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
m = Word64 -> ExportVal
EV64 (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
n) ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: [ExportVal]
start
  | Bool
otherwise = Integer -> [ExportVal] -> [ExportVal]
exportInteger Integer
n (Word64 -> ExportVal
EV64 Word64
m ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: [ExportVal]
start)
  where m :: Word64
m = Word64
forall a. Bounded a => a
maxBound :: Word64

exportDouble :: BigFloat -> [ExportVal] -> [ExportVal]
exportDouble :: BigFloat -> [ExportVal] -> [ExportVal]
exportDouble BigFloat
bf = (Double -> ExportVal
EVDouble Double
d ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
:)
  where
  (!Double
d,Status
_) = RoundMode -> BigFloat -> (Double, Status)
bfToDouble RoundMode
NearAway BigFloat
bf

-- | Encoding of a bit: 0 or 1
exportBit :: Bool -> [ExportVal] -> [ExportVal]
exportBit :: Bool -> [ExportVal] -> [ExportVal]
exportBit Bool
b = (Word8 -> ExportVal
EV8 Word8
u8 ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
:)
  where
  !u8 :: Word8
u8 = if Bool
b then Word8
1 else Word8
0

-- | Encoding for an integer: sign, buffer size, digits
exportInteger :: Integer -> [ExportVal] -> [ExportVal]
exportInteger :: Integer -> [ExportVal] -> [ExportVal]
exportInteger Integer
i = \[ExportVal]
start -> Integer -> ExportVal
EVInteger Integer
i ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: Word64 -> ExportVal
EV64 Word64
size ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: Word8 -> ExportVal
EV8 Word8
sign ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: [ExportVal]
start
  where
  !sign :: Word8
sign = if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Word8
1 else Word8
0
  !size :: Word64
size = Integer -> Word64
integerSize Integer
i

-- | Encoding of a rational: numerator, denominator; both are integers
exportRational :: SRational Concrete -> [ExportVal] -> [ExportVal]
exportRational :: SRational Concrete -> [ExportVal] -> [ExportVal]
exportRational SRational Concrete
r = Integer -> [ExportVal] -> [ExportVal]
exportInteger (SRational Concrete -> SInteger Concrete
forall sym. SRational sym -> SInteger sym
sDenom SRational Concrete
r) ([ExportVal] -> [ExportVal])
-> ([ExportVal] -> [ExportVal]) -> [ExportVal] -> [ExportVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [ExportVal] -> [ExportVal]
exportInteger (SRational Concrete -> SInteger Concrete
forall sym. SRational sym -> SInteger sym
sNum SRational Concrete
r)

-- | Encoding of a word: buffer size, digits
exportWord :: SWord Concrete -> [ExportVal] -> [ExportVal]
exportWord :: SWord Concrete -> [ExportVal] -> [ExportVal]
exportWord (BV Integer
sz Integer
i) = \[ExportVal]
start ->
  if Integer
sz Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
8 then Word8 -> ExportVal
EV8 (Integer -> Word8
forall a. Num a => Integer -> a
fromInteger Integer
i) ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: [ExportVal]
start else
  if Integer
sz Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
64 then Word64 -> ExportVal
EV64 (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
i) ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: [ExportVal]
start else
  Integer -> ExportVal
EVInteger Integer
i ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: Word64 -> ExportVal
EV64 Word64
size ExportVal -> [ExportVal] -> [ExportVal]
forall a. a -> [a] -> [a]
: [ExportVal]
start
  where
  !size :: Word64
size = Integer -> Word64
integerSize Integer
i

-- | Export a sequence of values: tuples, records, sequences.
-- Note that empty sequences don't have any representation.
exportValues :: [Value] -> [ExportVal] -> Eval [ExportVal]
exportValues :: [SEval Concrete (GenValue Concrete)]
-> [ExportVal] -> Eval [ExportVal]
exportValues [SEval Concrete (GenValue Concrete)]
vs [ExportVal]
done =
  case [SEval Concrete (GenValue Concrete)]
vs of
    SEval Concrete (GenValue Concrete)
mv : [SEval Concrete (GenValue Concrete)]
more ->
      do GenValue Concrete
v <- Eval (GenValue Concrete)
SEval Concrete (GenValue Concrete)
mv
         [SEval Concrete (GenValue Concrete)]
-> [ExportVal] -> Eval [ExportVal]
exportValues [SEval Concrete (GenValue Concrete)]
more ([ExportVal] -> Eval [ExportVal])
-> Eval [ExportVal] -> Eval [ExportVal]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenValue Concrete -> [ExportVal] -> Eval [ExportVal]
exportValue GenValue Concrete
v [ExportVal]
done
    [] -> [ExportVal] -> Eval [ExportVal]
forall a. a -> Eval a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ExportVal]
done


-- | How many Word64s do we need to represent this integer.
integerSize :: Integer -> Word64
integerSize :: Integer -> Word64
integerSize Integer
i =
  case Integer
i of
    IS Int#
_ -> Word64
1
    IP ByteArray#
x -> PrimArray Word64 -> Word64
getSize (ByteArray# -> PrimArray Word64
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x)
    IN ByteArray#
x -> PrimArray Word64 -> Word64
getSize (ByteArray# -> PrimArray Word64
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x)
  where
  getSize :: PrimArray Word64 -> Word64
  getSize :: PrimArray Word64 -> Word64
getSize PrimArray Word64
x = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PrimArray Word64 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word64
x)



cryStartExport ::
    [ExportVal] {-| REVERSED.  Send these to foreign. -} ->
    IO (StablePtr (IORef [ExportVal]))
cryStartExport :: [ExportVal] -> IO (StablePtr (IORef [ExportVal]))
cryStartExport [ExportVal]
vs =
  do IORef [ExportVal]
ref <- [ExportVal] -> IO (IORef [ExportVal])
forall a. a -> IO (IORef a)
newIORef ([ExportVal] -> [ExportVal]
forall a. [a] -> [a]
reverse [ExportVal]
vs)
     IORef [ExportVal] -> IO (StablePtr (IORef [ExportVal]))
forall a. a -> IO (StablePtr a)
newStablePtr IORef [ExportVal]
ref

-- | Get the next data item to export.
-- We assume that this is the only place to manipulate the reference
-- so there's not a race condition. Note that it is also important
-- that we access these from the same thread, otherwise we may miss
-- some of the writes etc.  This should be OK because FFI calls should
-- all be happening on the same thread.
cryExportNext ::
  StablePtr (IORef [ExportVal]) -> IO (Either Word32 ExportVal)
cryExportNext :: StablePtr (IORef [ExportVal]) -> IO (Either Word32 ExportVal)
cryExportNext StablePtr (IORef [ExportVal])
ptr =
  do IORef [ExportVal]
ref <- StablePtr (IORef [ExportVal]) -> IO (IORef [ExportVal])
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr (IORef [ExportVal])
ptr
     [ExportVal]
xs  <- IORef [ExportVal] -> IO [ExportVal]
forall a. IORef a -> IO a
readIORef IORef [ExportVal]
ref
     case [ExportVal]
xs of
       ExportVal
x : [ExportVal]
more -> IORef [ExportVal] -> [ExportVal] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [ExportVal]
ref [ExportVal]
more IO ()
-> IO (Either Word32 ExportVal) -> IO (Either Word32 ExportVal)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Word32 ExportVal -> IO (Either Word32 ExportVal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportVal -> Either Word32 ExportVal
forall a b. b -> Either a b
Right ExportVal
x)
       [] -> Either Word32 ExportVal -> IO (Either Word32 ExportVal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Either Word32 ExportVal
forall a b. a -> Either a b
Left Word32
forall a. Bounded a => a
maxBound)

cryEndExport :: StablePtr (IORef [ExportVal]) -> IO ()
cryEndExport :: StablePtr (IORef [ExportVal]) -> IO ()
cryEndExport = StablePtr (IORef [ExportVal]) -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr


type Export a = Ptr () -> Ptr a -> IO Word32

-- | Get the next data item, which should be uint8_t
cry_recv_u8 :: Export Word8
cry_recv_u8 :: Export Word8
cry_recv_u8 Ptr ()
self Ptr Word8
out =
  do Either Word32 ExportVal
mb <- StablePtr (IORef [ExportVal]) -> IO (Either Word32 ExportVal)
cryExportNext (Ptr () -> StablePtr (IORef [ExportVal])
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
self)
     case Either Word32 ExportVal
mb of
       Left Word32
err -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
err
       Right ExportVal
d ->
         case ExportVal
d of
           EV8 Word8
w        -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
out Word8
w IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
0
           EV64 {}      -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
2
           EVInteger {} -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
3
           EVDouble {}  -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
4


-- | Get the next data item, which shoudl be uint64_t
cry_recv_u64 :: Export Word64
cry_recv_u64 :: Export Word64
cry_recv_u64 Ptr ()
self Ptr Word64
out =
  do Either Word32 ExportVal
mb <- StablePtr (IORef [ExportVal]) -> IO (Either Word32 ExportVal)
cryExportNext (Ptr () -> StablePtr (IORef [ExportVal])
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
self)
     case Either Word32 ExportVal
mb of
       Left Word32
err -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
err
       Right ExportVal
d ->
         case ExportVal
d of
           EV8 {}       -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
1
           EV64 Word64
w       -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
out Word64
w IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
0
           EVInteger {} -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
3
           EVDouble {}  -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
4


-- | Get the digits for an integer
cry_recv_u64_digits :: Export Word64
cry_recv_u64_digits :: Export Word64
cry_recv_u64_digits Ptr ()
self Ptr Word64
out =
  do Either Word32 ExportVal
mb <- StablePtr (IORef [ExportVal]) -> IO (Either Word32 ExportVal)
cryExportNext (Ptr () -> StablePtr (IORef [ExportVal])
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
self)
     case Either Word32 ExportVal
mb of
       Left Word32
err -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
err
       Right ExportVal
d ->
         case ExportVal
d of
           EV8 {}      -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
1
           EV64 {}     -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
2
           EVDouble {} -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
4
           EVInteger Integer
i ->
             do case Integer
i of
                  IS Int#
x -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
out (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Num a => a -> a
abs (Int# -> Int
I# Int#
x)))
                  IP ByteArray#
x -> PrimArray Word64 -> IO ()
doCopy (ByteArray# -> PrimArray Word64
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x)
                  IN ByteArray#
x -> PrimArray Word64 -> IO ()
doCopy (ByteArray# -> PrimArray Word64
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x)
                Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
0
            where
            doCopy :: PrimArray Word64 -> IO ()
            doCopy :: PrimArray Word64 -> IO ()
doCopy PrimArray Word64
x = Ptr Word64 -> PrimArray Word64 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr Word64
out PrimArray Word64
x Int
0 (PrimArray Word64 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word64
x)

cry_recv_double :: Export Double
cry_recv_double :: Export Double
cry_recv_double Ptr ()
self Ptr Double
out =
  do Either Word32 ExportVal
mb <- StablePtr (IORef [ExportVal]) -> IO (Either Word32 ExportVal)
cryExportNext (Ptr () -> StablePtr (IORef [ExportVal])
forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
self)
     case Either Word32 ExportVal
mb of
       Left Word32
err -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
err
       Right ExportVal
d ->
         case ExportVal
d of
           EV8 {}       -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
1
           EV64 {}      -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
2
           EVInteger {} -> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
3
           EVDouble Double
dbl -> Ptr Double -> Double -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Double
out Double
dbl IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
0