{-# LANGUAGE UndecidableInstances #-}

module Feldspar.Run.Marshal where



import qualified Prelude
import Prelude hiding (length)

import Data.Typeable

import Feldspar
import Feldspar.Run.Representation
import Feldspar.Run.Compile
import Feldspar.Run.Frontend

import Language.Embedded.Backend.C (ExternalCompilerOpts (..), Default (..))



newtype Parser a = Parser {Parser a -> String -> (a, String)
runParser :: String -> (a, String)}
  deriving (a -> Parser b -> Parser a
(a -> b) -> Parser a -> Parser b
(forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser b -> Parser a
$c<$ :: forall a b. a -> Parser b -> Parser a
fmap :: (a -> b) -> Parser a -> Parser b
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
Functor)

instance Applicative Parser
  where
    pure :: a -> Parser a
pure a
a = (String -> (a, String)) -> Parser a
forall a. (String -> (a, String)) -> Parser a
Parser ((String -> (a, String)) -> Parser a)
-> (String -> (a, String)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \String
s -> (a
a,String
s)
    <*> :: Parser (a -> b) -> Parser a -> Parser b
(<*>) = Parser (a -> b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Parser
  where
    return :: a -> Parser a
return = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Parser a
p >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
k  = (String -> (b, String)) -> Parser b
forall a. (String -> (a, String)) -> Parser a
Parser ((String -> (b, String)) -> Parser b)
-> (String -> (b, String)) -> Parser b
forall a b. (a -> b) -> a -> b
$ \String
s -> let (a
a,String
s') = Parser a -> String -> (a, String)
forall a. Parser a -> String -> (a, String)
runParser Parser a
p String
s in Parser b -> String -> (b, String)
forall a. Parser a -> String -> (a, String)
runParser (a -> Parser b
k a
a) String
s'

readParser :: forall a . (Read a, Typeable a) => Parser a
readParser :: Parser a
readParser = (String -> (a, String)) -> Parser a
forall a. (String -> (a, String)) -> Parser a
Parser ((String -> (a, String)) -> Parser a)
-> (String -> (a, String)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \String
s -> case ReadS a
forall a. Read a => ReadS a
reads String
s of
    [(a
a,String
s')] -> (a
a,String
s')
    [(a, String)]
_        -> String -> (a, String)
forall a. HasCallStack => String -> a
error (String -> (a, String)) -> String -> (a, String)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
        [ String
"toHaskell: cannot read"
        , String -> String
forall a. Show a => a -> String
show String
s
        , String
"as type"
        ,  TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined :: a))
        ]

parse :: Parser a -> String -> a
parse :: Parser a -> String -> a
parse = ((a, String) -> a
forall a b. (a, b) -> a
fst ((a, String) -> a) -> (String -> (a, String)) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((String -> (a, String)) -> String -> a)
-> (Parser a -> String -> (a, String)) -> Parser a -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> String -> (a, String)
forall a. Parser a -> String -> (a, String)
runParser

-- | Serialization/deserialization of Haskell values
--
-- The following property must hold for all @a@:
--
-- > a = parse toHaskell (fromHaskell a) Prelude.== a
class MarshalHaskell a
  where
    -- | Serialize a Haskell value
    fromHaskell :: a -> String
    default fromHaskell :: Show a => a -> String
    fromHaskell = a -> String
forall a. Show a => a -> String
show

    -- | Deserialize a Haskell value
    toHaskell :: Parser a
    default toHaskell :: (Read a, Typeable a) => Parser a
    toHaskell = Parser a
forall a. (Read a, Typeable a) => Parser a
readParser

instance MarshalHaskell Int
instance MarshalHaskell Int8
instance MarshalHaskell Int16
instance MarshalHaskell Int32
instance MarshalHaskell Int64
instance MarshalHaskell Word8
instance MarshalHaskell Word16
instance MarshalHaskell Word32
instance MarshalHaskell Word64
instance MarshalHaskell Float
instance MarshalHaskell Double

instance MarshalHaskell (Complex Float)
  where
    fromHaskell :: Complex Float -> String
fromHaskell (Float
r :+ Float
i) = (Float, Float) -> String
forall a. MarshalHaskell a => a -> String
fromHaskell (Float
r,Float
i)
    toHaskell :: Parser (Complex Float)
toHaskell = ((Float, Float) -> Complex Float)
-> Parser (Float, Float) -> Parser (Complex Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Float -> Float -> Complex Float)
-> (Float, Float) -> Complex Float
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Float -> Float -> Complex Float
forall a. a -> a -> Complex a
(:+)) Parser (Float, Float)
forall a. MarshalHaskell a => Parser a
toHaskell

instance MarshalHaskell (Complex Double)
  where
    fromHaskell :: Complex Double -> String
fromHaskell (Double
r :+ Double
i) = (Double, Double) -> String
forall a. MarshalHaskell a => a -> String
fromHaskell (Double
r,Double
i)
    toHaskell :: Parser (Complex Double)
toHaskell = ((Double, Double) -> Complex Double)
-> Parser (Double, Double) -> Parser (Complex Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double -> Complex Double)
-> (Double, Double) -> Complex Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Complex Double
forall a. a -> a -> Complex a
(:+)) Parser (Double, Double)
forall a. MarshalHaskell a => Parser a
toHaskell

instance (MarshalHaskell a, MarshalHaskell b) => MarshalHaskell (a,b)
  where
    fromHaskell :: (a, b) -> String
fromHaskell (a
a,b
b) = [String] -> String
unwords [a -> String
forall a. MarshalHaskell a => a -> String
fromHaskell a
a, b -> String
forall a. MarshalHaskell a => a -> String
fromHaskell b
b]
    toHaskell :: Parser (a, b)
toHaskell = (,) (a -> b -> (a, b)) -> Parser a -> Parser (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
forall a. MarshalHaskell a => Parser a
toHaskell Parser (b -> (a, b)) -> Parser b -> Parser (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser b
forall a. MarshalHaskell a => Parser a
toHaskell

instance (MarshalHaskell a, MarshalHaskell b, MarshalHaskell c) => MarshalHaskell (a,b,c)
  where
    fromHaskell :: (a, b, c) -> String
fromHaskell (a
a,b
b,c
c) = [String] -> String
unwords [a -> String
forall a. MarshalHaskell a => a -> String
fromHaskell a
a, b -> String
forall a. MarshalHaskell a => a -> String
fromHaskell b
b, c -> String
forall a. MarshalHaskell a => a -> String
fromHaskell c
c]
    toHaskell :: Parser (a, b, c)
toHaskell = (,,) (a -> b -> c -> (a, b, c))
-> Parser a -> Parser (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
forall a. MarshalHaskell a => Parser a
toHaskell Parser (b -> c -> (a, b, c)) -> Parser b -> Parser (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser b
forall a. MarshalHaskell a => Parser a
toHaskell Parser (c -> (a, b, c)) -> Parser c -> Parser (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser c
forall a. MarshalHaskell a => Parser a
toHaskell

instance (MarshalHaskell a, MarshalHaskell b, MarshalHaskell c, MarshalHaskell d) => MarshalHaskell (a,b,c,d)
  where
    fromHaskell :: (a, b, c, d) -> String
fromHaskell (a
a,b
b,c
c,d
d) = [String] -> String
unwords [a -> String
forall a. MarshalHaskell a => a -> String
fromHaskell a
a, b -> String
forall a. MarshalHaskell a => a -> String
fromHaskell b
b, c -> String
forall a. MarshalHaskell a => a -> String
fromHaskell c
c, d -> String
forall a. MarshalHaskell a => a -> String
fromHaskell d
d]
    toHaskell :: Parser (a, b, c, d)
toHaskell = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Parser a -> Parser (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
forall a. MarshalHaskell a => Parser a
toHaskell Parser (b -> c -> d -> (a, b, c, d))
-> Parser b -> Parser (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser b
forall a. MarshalHaskell a => Parser a
toHaskell Parser (c -> d -> (a, b, c, d))
-> Parser c -> Parser (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser c
forall a. MarshalHaskell a => Parser a
toHaskell Parser (d -> (a, b, c, d)) -> Parser d -> Parser (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser d
forall a. MarshalHaskell a => Parser a
toHaskell

instance MarshalHaskell a => MarshalHaskell [a]
  where
    fromHaskell :: [a] -> String
fromHaskell [a]
as = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [a]
as) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. MarshalHaskell a => a -> String
fromHaskell [a]
as

    toHaskell :: Parser [a]
toHaskell = do
        Int
len <- Parser Int
forall a. MarshalHaskell a => Parser a
toHaskell
        Int -> Parser a -> Parser [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Parser a
forall a. MarshalHaskell a => Parser a
toHaskell

-- | Serialization/deserialization of Feldspar values
class (MarshalHaskell (HaskellRep a)) => MarshalFeld a
  where
    -- | The Haskell representation of a Feldspar value
    type HaskellRep a

    -- | Serialize a Feldspar value to a handle
    fwrite :: Handle -> a -> Run ()

    default fwrite :: (PrimType b, Formattable b, a ~ Data b) =>
        Handle -> a -> Run ()
    fwrite Handle
hdl a
i = Handle -> String -> Data b -> String -> Run ()
forall a.
(Formattable a, PrimType a) =>
Handle -> String -> Data a -> String -> Run ()
fput Handle
hdl String
"" a
Data b
i String
""

    -- | Deserialize a Feldspar value from a handle
    fread :: Handle -> Run a

    default fread :: (PrimType b, Formattable b, a ~ Data b) => Handle -> Run a
    fread = Handle -> Run a
forall a. (Formattable a, PrimType a) => Handle -> Run (Data a)
fget

-- | Write a value to @stdout@
writeStd :: MarshalFeld a => a -> Run ()
writeStd :: a -> Run ()
writeStd = Handle -> a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
stdout

-- | Read a value from @stdin@
readStd :: MarshalFeld a => Run a
readStd :: Run a
readStd = Handle -> Run a
forall a. MarshalFeld a => Handle -> Run a
fread Handle
stdin

instance MarshalFeld (Data Int8)   where type HaskellRep (Data Int8)   = Int8
instance MarshalFeld (Data Int16)  where type HaskellRep (Data Int16)  = Int16
instance MarshalFeld (Data Int32)  where type HaskellRep (Data Int32)  = Int32
instance MarshalFeld (Data Int64)  where type HaskellRep (Data Int64)  = Int64
instance MarshalFeld (Data Word8)  where type HaskellRep (Data Word8)  = Word8
instance MarshalFeld (Data Word16) where type HaskellRep (Data Word16) = Word16
instance MarshalFeld (Data Word32) where type HaskellRep (Data Word32) = Word32
instance MarshalFeld (Data Word64) where type HaskellRep (Data Word64) = Word64
instance MarshalFeld (Data Float)  where type HaskellRep (Data Float)  = Float
instance MarshalFeld (Data Double) where type HaskellRep (Data Double) = Double

instance MarshalFeld (Data (Complex Float))
  where
    type HaskellRep (Data (Complex Float)) = Complex Float
    fwrite :: Handle -> Data (Complex Float) -> Run ()
fwrite Handle
hdl Data (Complex Float)
c = Handle -> (Data Float, Data Float) -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl (Data (Complex Float) -> Data Float
forall a.
(PrimType a, PrimType (Complex a)) =>
Data (Complex a) -> Data a
realPart Data (Complex Float)
c, Data (Complex Float) -> Data Float
forall a.
(PrimType a, PrimType (Complex a)) =>
Data (Complex a) -> Data a
imagPart Data (Complex Float)
c)
    fread :: Handle -> Run (Data (Complex Float))
fread = ((Data Float, Data Float) -> Data (Complex Float))
-> Run (Data Float, Data Float) -> Run (Data (Complex Float))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Data Float -> Data Float -> Data (Complex Float))
-> (Data Float, Data Float) -> Data (Complex Float)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Data Float -> Data Float -> Data (Complex Float)
forall a.
(Num a, PrimType a, PrimType (Complex a)) =>
Data a -> Data a -> Data (Complex a)
complex) (Run (Data Float, Data Float) -> Run (Data (Complex Float)))
-> (Handle -> Run (Data Float, Data Float))
-> Handle
-> Run (Data (Complex Float))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Run (Data Float, Data Float)
forall a. MarshalFeld a => Handle -> Run a
fread

instance MarshalFeld (Data (Complex Double))
  where
    type HaskellRep (Data (Complex Double)) = Complex Double
    fwrite :: Handle -> Data (Complex Double) -> Run ()
fwrite Handle
hdl Data (Complex Double)
c = Handle -> (Data Double, Data Double) -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl (Data (Complex Double) -> Data Double
forall a.
(PrimType a, PrimType (Complex a)) =>
Data (Complex a) -> Data a
realPart Data (Complex Double)
c, Data (Complex Double) -> Data Double
forall a.
(PrimType a, PrimType (Complex a)) =>
Data (Complex a) -> Data a
imagPart Data (Complex Double)
c)
    fread :: Handle -> Run (Data (Complex Double))
fread = ((Data Double, Data Double) -> Data (Complex Double))
-> Run (Data Double, Data Double) -> Run (Data (Complex Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Data Double -> Data Double -> Data (Complex Double))
-> (Data Double, Data Double) -> Data (Complex Double)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Data Double -> Data Double -> Data (Complex Double)
forall a.
(Num a, PrimType a, PrimType (Complex a)) =>
Data a -> Data a -> Data (Complex a)
complex) (Run (Data Double, Data Double) -> Run (Data (Complex Double)))
-> (Handle -> Run (Data Double, Data Double))
-> Handle
-> Run (Data (Complex Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Run (Data Double, Data Double)
forall a. MarshalFeld a => Handle -> Run a
fread

instance (MarshalFeld a, MarshalFeld b) => MarshalFeld (a,b)
  where
    type HaskellRep (a,b) = (HaskellRep a, HaskellRep b)
    fwrite :: Handle -> (a, b) -> Run ()
fwrite Handle
hdl (a
a,b
b) = Handle -> a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl a
a Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> Run ()
forall r. PrintfType r => Handle -> String -> r
fprintf Handle
hdl String
" " Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> b -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl b
b
    fread :: Handle -> Run (a, b)
fread Handle
hdl = (,) (a -> b -> (a, b)) -> Run a -> Run (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Run a
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl Run (b -> (a, b)) -> Run b -> Run (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> Run b
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl

instance (MarshalFeld a, MarshalFeld b, MarshalFeld c) => MarshalFeld (a,b,c)
  where
    type HaskellRep (a,b,c) = (HaskellRep a, HaskellRep b, HaskellRep c)
    fwrite :: Handle -> (a, b, c) -> Run ()
fwrite Handle
hdl (a
a,b
b,c
c)
        =  Handle -> a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl a
a Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> Run ()
forall r. PrintfType r => Handle -> String -> r
fprintf Handle
hdl String
" "
        Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> b -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl b
b Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> Run ()
forall r. PrintfType r => Handle -> String -> r
fprintf Handle
hdl String
" "
        Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> c -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl c
c
    fread :: Handle -> Run (a, b, c)
fread Handle
hdl = (,,) (a -> b -> c -> (a, b, c)) -> Run a -> Run (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Run a
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl Run (b -> c -> (a, b, c)) -> Run b -> Run (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> Run b
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl Run (c -> (a, b, c)) -> Run c -> Run (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> Run c
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl

instance (MarshalFeld a, MarshalFeld b, MarshalFeld c, MarshalFeld d) => MarshalFeld (a,b,c,d)
  where
    type HaskellRep (a,b,c,d) = (HaskellRep a, HaskellRep b, HaskellRep c, HaskellRep d)
    fwrite :: Handle -> (a, b, c, d) -> Run ()
fwrite Handle
hdl (a
a,b
b,c
c,d
d)
        =  Handle -> a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl a
a Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> Run ()
forall r. PrintfType r => Handle -> String -> r
fprintf Handle
hdl String
" "
        Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> b -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl b
b Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> Run ()
forall r. PrintfType r => Handle -> String -> r
fprintf Handle
hdl String
" "
        Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> c -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl c
c Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> Run ()
forall r. PrintfType r => Handle -> String -> r
fprintf Handle
hdl String
" "
        Run () -> Run () -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> d -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl d
d
    fread :: Handle -> Run (a, b, c, d)
fread Handle
hdl = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Run a -> Run (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Run a
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl Run (b -> c -> d -> (a, b, c, d))
-> Run b -> Run (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> Run b
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl Run (c -> d -> (a, b, c, d)) -> Run c -> Run (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> Run c
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl Run (d -> (a, b, c, d)) -> Run d -> Run (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> Run d
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl

instance (MarshalHaskell (Internal a), MarshalFeld a, Syntax a) =>
    MarshalFeld (Arr a)
  where
    type HaskellRep (Arr a) = [Internal a]

    fwrite :: Handle -> Arr a -> Run ()
fwrite Handle
hdl Arr a
arr = do
        Data Word32
len <- Data Word32 -> Run (Data Word32)
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m a
shareM (Data Word32 -> Run (Data Word32))
-> Data Word32 -> Run (Data Word32)
forall a b. (a -> b) -> a -> b
$ Arr a -> Data Word32
forall a. Finite a => a -> Data Word32
length Arr a
arr
        Handle -> String -> Data Word32 -> String -> Run ()
forall a.
(Formattable a, PrimType a) =>
Handle -> String -> Data a -> String -> Run ()
fput Handle
hdl String
"" Data Word32
len String
" "
        IxRange (Data Word32) -> (Data Word32 -> Run ()) -> Run ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Word32
0,Int
1,Data Word32 -> Border (Data Word32)
forall i. i -> Border i
Excl Data Word32
len) ((Data Word32 -> Run ()) -> Run ())
-> (Data Word32 -> Run ()) -> Run ()
forall a b. (a -> b) -> a -> b
$ \Data Word32
i -> do
            a
a <- Arr a -> Data Word32 -> Run a
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Arr a -> Data Word32 -> m a
getArr Arr a
arr Data Word32
i
            Handle -> a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl a
a
            Handle -> String -> Run ()
forall r. PrintfType r => Handle -> String -> r
fprintf Handle
hdl String
" "

    fread :: Handle -> Run (Arr a)
fread Handle
hdl = do
        Data Word32
len <- Handle -> Run (Data Word32)
forall a. (Formattable a, PrimType a) => Handle -> Run (Data a)
fget Handle
hdl
        Arr a
arr <- Data Word32 -> Run (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Word32 -> m (Arr a)
newArr Data Word32
len
        IxRange (Data Word32) -> (Data Word32 -> Run ()) -> Run ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Word32
0,Int
1,Data Word32 -> Border (Data Word32)
forall i. i -> Border i
Excl Data Word32
len) ((Data Word32 -> Run ()) -> Run ())
-> (Data Word32 -> Run ()) -> Run ()
forall a b. (a -> b) -> a -> b
$ \Data Word32
i -> do
            a
a <- Handle -> Run a
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl
            Arr a -> Data Word32 -> a -> Run ()
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> Data Word32 -> a -> m ()
setArr Arr a
arr Data Word32
i a
a
        Arr a -> Run (Arr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Arr a
arr

instance (MarshalHaskell (Internal a), MarshalFeld a, Syntax a) =>
    MarshalFeld (IArr a)
  where
    type HaskellRep (IArr a) = [Internal a]

    fwrite :: Handle -> IArr a -> Run ()
fwrite Handle
hdl IArr a
arr = do
        Data Word32
len <- Data Word32 -> Run (Data Word32)
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m a
shareM (Data Word32 -> Run (Data Word32))
-> Data Word32 -> Run (Data Word32)
forall a b. (a -> b) -> a -> b
$ IArr a -> Data Word32
forall a. Finite a => a -> Data Word32
length IArr a
arr
        Handle -> String -> Data Word32 -> String -> Run ()
forall a.
(Formattable a, PrimType a) =>
Handle -> String -> Data a -> String -> Run ()
fput Handle
hdl String
"" Data Word32
len String
" "
        IxRange (Data Word32) -> (Data Word32 -> Run ()) -> Run ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Word32
0,Int
1,Data Word32 -> Border (Data Word32)
forall i. i -> Border i
Excl Data Word32
len) ((Data Word32 -> Run ()) -> Run ())
-> (Data Word32 -> Run ()) -> Run ()
forall a b. (a -> b) -> a -> b
$ \Data Word32
i -> do
            Handle -> a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl (a -> Run ()) -> a -> Run ()
forall a b. (a -> b) -> a -> b
$ IArr a -> Data Word32 -> a
forall a. Syntax a => IArr a -> Data Word32 -> a
arrIx IArr a
arr Data Word32
i
            Handle -> String -> Run ()
forall r. PrintfType r => Handle -> String -> r
fprintf Handle
hdl String
" "

    fread :: Handle -> Run (IArr a)
fread Handle
hdl = do
        Data Word32
len <- Handle -> Run (Data Word32)
forall a. (Formattable a, PrimType a) => Handle -> Run (Data a)
fget Handle
hdl
        Arr a
arr <- Data Word32 -> Run (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Word32 -> m (Arr a)
newArr Data Word32
len
        IxRange (Data Word32) -> (Data Word32 -> Run ()) -> Run ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Word32
0,Int
1,Data Word32 -> Border (Data Word32)
forall i. i -> Border i
Excl Data Word32
len) ((Data Word32 -> Run ()) -> Run ())
-> (Data Word32 -> Run ()) -> Run ()
forall a b. (a -> b) -> a -> b
$ \Data Word32
i -> do
            a
a <- Handle -> Run a
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl
            Arr a -> Data Word32 -> a -> Run ()
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> Data Word32 -> a -> m ()
setArr Arr a
arr Data Word32
i a
a
        IArr a
iarr <- Arr a -> Run (IArr a)
forall (m :: * -> *) a. MonadComp m => Arr a -> m (IArr a)
unsafeFreezeArr Arr a
arr
        IArr a -> Run (IArr a)
forall (m :: * -> *) a. Monad m => a -> m a
return IArr a
iarr

-- | Connect a Feldspar function between serializable types to @stdin@/@stdout@
connectStdIO :: (MarshalFeld a, MarshalFeld b) => (a -> Run b) -> Run ()
connectStdIO :: (a -> Run b) -> Run ()
connectStdIO a -> Run b
f = (Run a
forall a. MarshalFeld a => Run a
readStd Run a -> (a -> Run b) -> Run b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Run b
f) Run b -> (b -> Run ()) -> Run ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Run ()
forall a. MarshalFeld a => a -> Run ()
writeStd

-- | Connect a Feldspar function between serializable types to @stdin@/@stdout@.
-- The input/output will be in the form of a list as recognized by 'toHaskell' /
-- 'fromHaskell' (i.e. the length followed by the elements in sequence).
--
-- The function will be mapped over the input list in a lazy manner.
streamStdIO :: (MarshalFeld a, MarshalFeld b) => (a -> Run b) -> Run ()
streamStdIO :: (a -> Run b) -> Run ()
streamStdIO a -> Run b
f = do
    Data Word32
n :: Data Length <- Run (Data Word32)
forall a. MarshalFeld a => Run a
readStd
    Data Word32 -> Run ()
forall a. MarshalFeld a => a -> Run ()
writeStd Data Word32
n
    IxRange (Data Word32) -> (Data Word32 -> Run ()) -> Run ()
forall (m :: * -> *) n.
(MonadComp m, Integral n, PrimType n) =>
IxRange (Data n) -> (Data n -> m ()) -> m ()
for (Data Word32
0,Int
1,Data Word32 -> Border (Data Word32)
forall i. i -> Border i
Excl Data Word32
n) ((Data Word32 -> Run ()) -> Run ())
-> (Data Word32 -> Run ()) -> Run ()
forall a b. (a -> b) -> a -> b
$ \Data Word32
_ ->
      (a -> Run b) -> Run ()
forall a b.
(MarshalFeld a, MarshalFeld b) =>
(a -> Run b) -> Run ()
connectStdIO ((a -> Run b) -> Run ()) -> (a -> Run b) -> Run ()
forall a b. (a -> b) -> a -> b
$ \a
a -> String -> Run ()
forall r. PrintfType r => String -> r
printf String
" " Run () -> Run b -> Run b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Run b
f a
a
  -- TODO Better to continue until EOF, but I wasn't able to make this work.
  -- Presumably, one needs to check for EOF inside each `fread` and signal that
  -- somehow.

-- | A version of 'marshalled' that takes 'ExternalCompilerOpts' as additional
-- argument
marshalled' :: (MarshalFeld a, MarshalFeld b)
    => CompilerOpts
    -> ExternalCompilerOpts
    -> (a -> Run b)  -- ^ Function to compile
    -> ((HaskellRep a -> IO (HaskellRep b)) -> IO c)
         -- ^ Function that has access to the compiled executable as a function
    -> IO c
marshalled' :: CompilerOpts
-> ExternalCompilerOpts
-> (a -> Run b)
-> ((HaskellRep a -> IO (HaskellRep b)) -> IO c)
-> IO c
marshalled' CompilerOpts
opts ExternalCompilerOpts
eopts a -> Run b
f (HaskellRep a -> IO (HaskellRep b)) -> IO c
body =
    CompilerOpts
-> ExternalCompilerOpts
-> Run ()
-> ((String -> IO String) -> IO c)
-> IO c
forall (m :: * -> *) a b.
MonadRun m =>
CompilerOpts
-> ExternalCompilerOpts
-> m a
-> ((String -> IO String) -> IO b)
-> IO b
withCompiled' CompilerOpts
opts ExternalCompilerOpts
eopts ((a -> Run b) -> Run ()
forall a b.
(MarshalFeld a, MarshalFeld b) =>
(a -> Run b) -> Run ()
connectStdIO a -> Run b
f) (((String -> IO String) -> IO c) -> IO c)
-> ((String -> IO String) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \String -> IO String
g ->
      (HaskellRep a -> IO (HaskellRep b)) -> IO c
body ((String -> HaskellRep b) -> IO String -> IO (HaskellRep b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Parser (HaskellRep b) -> String -> HaskellRep b
forall a. Parser a -> String -> a
parse Parser (HaskellRep b)
forall a. MarshalHaskell a => Parser a
toHaskell) (IO String -> IO (HaskellRep b))
-> (HaskellRep a -> IO String) -> HaskellRep a -> IO (HaskellRep b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
g (String -> IO String)
-> (HaskellRep a -> String) -> HaskellRep a -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HaskellRep a -> String
forall a. MarshalHaskell a => a -> String
fromHaskell)

-- | Compile a function and make it available as an 'IO' function. Note that
-- compilation only happens once, even if the function is used many times in the
-- body.
--
-- For example, given the following Feldspar function:
--
-- > sumArr :: DIArr Int32 -> Run (Data Int32)
-- > sumArr arr = do
-- >     r <- initRef 0
-- >     for (0,1,Excl $ length arr) $ \i -> modifyRef r (+ arrIx arr i)
-- >     unsafeFreezeRef r
--
-- 'marshalled' can be used as follows:
--
-- > *Main> marshalled sumArr $ \f -> (f [3,4,5] >>= print) >> (f [6,7,8,9] >>= print)
marshalled :: (MarshalFeld a, MarshalFeld b)
    => (a -> Run b)  -- ^ Function to compile
    -> ((HaskellRep a -> IO (HaskellRep b)) -> IO c)
         -- ^ Function that has access to the compiled executable as a function
    -> IO c
marshalled :: (a -> Run b)
-> ((HaskellRep a -> IO (HaskellRep b)) -> IO c) -> IO c
marshalled = CompilerOpts
-> ExternalCompilerOpts
-> (a -> Run b)
-> ((HaskellRep a -> IO (HaskellRep b)) -> IO c)
-> IO c
forall a b c.
(MarshalFeld a, MarshalFeld b) =>
CompilerOpts
-> ExternalCompilerOpts
-> (a -> Run b)
-> ((HaskellRep a -> IO (HaskellRep b)) -> IO c)
-> IO c
marshalled' CompilerOpts
forall a. Default a => a
def ExternalCompilerOpts
forall a. Default a => a
def

-- | A version of 'marshalledStream' that takes 'ExternalCompilerOpts' as
-- additional argument
marshalledStream' :: (MarshalFeld a, MarshalFeld b)
    => CompilerOpts
    -> ExternalCompilerOpts
    -> (a -> Run b)  -- ^ Function to compile
    -> (([HaskellRep a] -> IO [HaskellRep b]) -> IO c)
         -- ^ Function that has access to the compiled executable as a function
    -> IO c
marshalledStream' :: CompilerOpts
-> ExternalCompilerOpts
-> (a -> Run b)
-> (([HaskellRep a] -> IO [HaskellRep b]) -> IO c)
-> IO c
marshalledStream' CompilerOpts
opts ExternalCompilerOpts
eopts a -> Run b
f ([HaskellRep a] -> IO [HaskellRep b]) -> IO c
body =
    CompilerOpts
-> ExternalCompilerOpts
-> Run ()
-> ((String -> IO String) -> IO c)
-> IO c
forall (m :: * -> *) a b.
MonadRun m =>
CompilerOpts
-> ExternalCompilerOpts
-> m a
-> ((String -> IO String) -> IO b)
-> IO b
withCompiled' CompilerOpts
opts ExternalCompilerOpts
eopts ((a -> Run b) -> Run ()
forall a b.
(MarshalFeld a, MarshalFeld b) =>
(a -> Run b) -> Run ()
streamStdIO a -> Run b
f) (((String -> IO String) -> IO c) -> IO c)
-> ((String -> IO String) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \String -> IO String
g ->
      ([HaskellRep a] -> IO [HaskellRep b]) -> IO c
body (([HaskellRep a] -> IO [HaskellRep b]) -> IO c)
-> ([HaskellRep a] -> IO [HaskellRep b]) -> IO c
forall a b. (a -> b) -> a -> b
$ \[HaskellRep a]
is -> do
        Parser [HaskellRep b] -> String -> [HaskellRep b]
forall a. Parser a -> String -> a
parse Parser [HaskellRep b]
forall a. MarshalHaskell a => Parser a
toHaskell (String -> [HaskellRep b]) -> IO String -> IO [HaskellRep b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
g ([HaskellRep a] -> String
forall a. MarshalHaskell a => a -> String
fromHaskell [HaskellRep a]
is)

-- | Compile a function and make it available as an 'IO' function. The compiled
-- function will be applied repeatedly over the list of inputs producing a list
-- of outputs. Note that compilation only happens once, even if the function is
-- used many times in the body.
marshalledStream :: (MarshalFeld a, MarshalFeld b)
    => (a -> Run b)  -- ^ Function to compile
    -> (([HaskellRep a] -> IO [HaskellRep b]) -> IO c)
         -- ^ Function that has access to the compiled executable as a function
    -> IO c
marshalledStream :: (a -> Run b)
-> (([HaskellRep a] -> IO [HaskellRep b]) -> IO c) -> IO c
marshalledStream = CompilerOpts
-> ExternalCompilerOpts
-> (a -> Run b)
-> (([HaskellRep a] -> IO [HaskellRep b]) -> IO c)
-> IO c
forall a b c.
(MarshalFeld a, MarshalFeld b) =>
CompilerOpts
-> ExternalCompilerOpts
-> (a -> Run b)
-> (([HaskellRep a] -> IO [HaskellRep b]) -> IO c)
-> IO c
marshalledStream' CompilerOpts
forall a. Default a => a
def ExternalCompilerOpts
forall a. Default a => a
def