<commit_before>{-# LANGUAGE UndecidableInstances #-}
module Feldspar.Multicore.Channel where

import Feldspar hiding ((==))
import Feldspar.Multicore.Frontend
import Feldspar.Multicore.Pipe
import Feldspar.Multicore.Representation
import Feldspar.Vector hiding (ofLength, VecChanSizeSpec)


--------------------------------------------------------------------------------
-- Channel interface
--------------------------------------------------------------------------------

host :: CoreId
host = sharedId

data Chan a
  where
    HostToCoreChan :: ChanType a
                   => SizeSpec a
                   -> HostToCorePipe (ChanElemType a)
                   -> Chan a

    CoreToHostChan :: ChanType a
                   => SizeSpec a
                   -> CoreToHostPipe (ChanElemType a)
                   -> Chan a

    CoreToCoreChan :: ChanType a
                   => SizeSpec a
                   -> CorePipe (ChanElemType a)
                   -> Chan a

class ChanType a
  where
    type ChanElemType a :: *
    type SizeSpec a :: *
    newChan :: CoreId -> CoreId -> SizeSpec a -> Multicore (Chan a)

class ChanType a => Transferable' m a
  where
    readChan :: Chan a -> m a
    writeChan :: Chan a -> a -> m ()

class    (Transferable' Host a, Transferable' CoreComp a) => Transferable a
instance (Transferable' Host a, Transferable' CoreComp a) => Transferable a


data VecChanSizeSpec = VecChanSizeSpec Length Length

ofLength :: Length -> Length -> VecChanSizeSpec
ofLength = VecChanSizeSpec


--------------------------------------------------------------------------------
-- Instances
--------------------------------------------------------------------------------

instance PrimType a => ChanType (Data a)
  where
    type ChanElemType (Data a) = a
    type SizeSpec (Data a)     = Length
    newChan from to l
        | host == from = do
            p :: HostToCorePipe a <- allocHostPipe to l
            onHost $ initPipe p
            return $ HostToCoreChan l p
        | host == to   = do
            p :: CoreToHostPipe a <- allocHostPipe from l
            onHost $ initPipe p
            return $ CoreToHostChan l p
        | otherwise = do
            p <- allocCorePipe from to l
            onHost $ initPipe p
            return $ CoreToCoreChan l p

instance PrimType a => Transferable' Host (Data a)
  where
    readChan (CoreToHostChan _ p) = do
        arr <- newArr 1
        pullPipe p (0,0) arr
        elem <- getArr 0 arr
        return elem
    writeChan (HostToCoreChan _ p) v = do
        arr <- newArr 1
        setArr 0 v arr
        pushPipe p (0,0) arr

instance PrimType a => Transferable' CoreComp (Data a)
  where
    readChan (HostToCoreChan _ p) = readPipe p
    readChan (CoreToCoreChan _ p) = readPipe p
    writeChan (CoreToHostChan _ p) v = writePipe v p
    writeChan (CoreToCoreChan _ p) v = writePipe v p


instance PrimType a => ChanType (Vector (Data a))
  where
    type ChanElemType (Vector (Data a)) = a
    type SizeSpec     (Vector (Data a)) = VecChanSizeSpec
    newChan from to s@(VecChanSizeSpec n m)
        | host == from = do
            p :: HostToCorePipe a <- allocHostPipe to l
            onHost $ initPipe p
            return $ HostToCoreChan s p
        | host == to   = do
            p :: CoreToHostPipe a <- allocHostPipe from l
            onHost $ initPipe p
            return $ CoreToHostChan s p
        | otherwise = do
            p <- allocCorePipe from to l
            onHost $ initPipe p
            return $ CoreToCoreChan s p
      where
        l = n * m<commit_msg>Refactoring multicore channel creation<commit_after>{-# LANGUAGE UndecidableInstances #-}
module Feldspar.Multicore.Channel where

import Data.Proxy

import Feldspar hiding ((==))
import Feldspar.Multicore.Frontend
import Feldspar.Multicore.Pipe
import Feldspar.Multicore.Representation
import Feldspar.Vector hiding (ofLength, VecChanSizeSpec)


--------------------------------------------------------------------------------
-- Channel interface
--------------------------------------------------------------------------------

host :: CoreId
host = sharedId

data Chan a
  where
    HostToCoreChan :: ChanType a
                   => SizeSpec a
                   -> HostToCorePipe (ChanElemType a)
                   -> Chan a

    CoreToHostChan :: ChanType a
                   => SizeSpec a
                   -> CoreToHostPipe (ChanElemType a)
                   -> Chan a

    CoreToCoreChan :: ChanType a
                   => SizeSpec a
                   -> CorePipe (ChanElemType a)
                   -> Chan a

class PrimType (ChanElemType a) => ChanType a
  where
    type ChanElemType a :: *
    type SizeSpec a :: *

    newChan :: CoreId -> CoreId -> SizeSpec a -> Multicore (Chan a)
    newChan from to s
        | host == from = do
            p :: HostToCorePipe (ChanElemType a) <- allocHostPipe to l
            onHost $ initPipe p
            return $ HostToCoreChan s p
        | host == to   = do
            p :: CoreToHostPipe (ChanElemType a) <- allocHostPipe from l
            onHost $ initPipe p
            return $ CoreToHostChan s p
        | otherwise = do
            p <- allocCorePipe from to l
            onHost $ initPipe p
            return $ CoreToCoreChan s p
        where
            l = pipeSize (Proxy :: Proxy a) s

    pipeSize :: proxy a -> SizeSpec a -> Length

class ChanType a => Transferable' m a
  where
    readChan :: Chan a -> m a
    writeChan :: Chan a -> a -> m ()

class    (Transferable' Host a, Transferable' CoreComp a) => Transferable a
instance (Transferable' Host a, Transferable' CoreComp a) => Transferable a


data VecChanSizeSpec = VecChanSizeSpec Length Length

ofLength :: Length -> Length -> VecChanSizeSpec
ofLength = VecChanSizeSpec


--------------------------------------------------------------------------------
-- Instances
--------------------------------------------------------------------------------

instance PrimType a => ChanType (Data a)
  where
    type ChanElemType (Data a) = a
    type SizeSpec (Data a)     = Length
    pipeSize _ = id


instance PrimType a => Transferable' Host (Data a)
  where
    readChan (CoreToHostChan _ p) = do
        arr <- newArr 1
        pullPipe p (0,0) arr
        elem <- getArr 0 arr
        return elem
    writeChan (HostToCoreChan _ p) v = do
        arr <- newArr 1
        setArr 0 v arr
        pushPipe p (0,0) arr

instance PrimType a => Transferable' CoreComp (Data a)
  where
    readChan (HostToCoreChan _ p) = readPipe p
    readChan (CoreToCoreChan _ p) = readPipe p
    writeChan (CoreToHostChan _ p) v = writePipe v p
    writeChan (CoreToCoreChan _ p) v = writePipe v p


instance PrimType a => ChanType (Vector (Data a))
  where
    type ChanElemType (Vector (Data a)) = a
    type SizeSpec     (Vector (Data a)) = VecChanSizeSpec
    pipeSize _ (VecChanSizeSpec n m) = n * m
{'fraction_non_alphanumeric': 0.16142588030720184, 'fraction_numerical': 0.0023185045645558616, 'mean_word_length': 1.530058651026393, 'pattern_counts': {'":': 0, '<': 18, '<?xml version=': 0, '>': 54, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3202568', 'n_tokens_mistral': 2043, 'n_tokens_neox': 1866, 'n_words': 656}