{-# 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
class MarshalHaskell a
where
fromHaskell :: a -> String
default fromHaskell :: Show a => a -> String
fromHaskell = a -> String
forall a. Show a => a -> String
show
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
class (MarshalHaskell (HaskellRep a)) => MarshalFeld a
where
type HaskellRep a
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
""
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
writeStd :: MarshalFeld a => a -> Run ()
writeStd :: a -> Run ()
writeStd = Handle -> a -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
stdout
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
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
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
marshalled' :: (MarshalFeld a, MarshalFeld b)
=> CompilerOpts
-> ExternalCompilerOpts
-> (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
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)
marshalled :: (MarshalFeld a, MarshalFeld b)
=> (a -> Run b)
-> ((HaskellRep a -> IO (HaskellRep b)) -> IO c)
-> 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
marshalledStream' :: (MarshalFeld a, MarshalFeld b)
=> CompilerOpts
-> ExternalCompilerOpts
-> (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
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)
marshalledStream :: (MarshalFeld a, MarshalFeld b)
=> (a -> Run b)
-> (([HaskellRep a] -> IO [HaskellRep b]) -> IO c)
-> 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