module Synthesizer.LLVM.Simple.SignalPacked where
import Synthesizer.LLVM.Simple.SignalPrivate (Core(Core), alter)
import qualified Synthesizer.LLVM.Simple.Signal as Sig
import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.MaybeContinuation as Maybe
import qualified LLVM.Extra.Control as U
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Core as LLVM
import LLVM.Core (valueOf)
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.State as MS
import Control.Monad (replicateM)
import Data.Word (Word)
import NumericPrelude.Numeric as NP
import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith)
pack, packRotate ::
(Sig.C signal, Serial.C v, a ~ Serial.Element v) =>
signal a -> signal v
pack = packRotate
packRotate = alter (\(Core next start stop) -> Core
(\param s -> do
wInit <- Maybe.lift $ Serial.writeStart
(w2,_,s2) <-
Maybe.fromBool $
U.whileLoop
(valueOf True,
(wInit,
valueOf $ (fromIntegral $ Serial.sizeOfIterator wInit :: Word),
s))
(\(cont,(_w0,i0,_s0)) ->
A.and cont =<<
A.cmp LLVM.CmpGT i0 A.zero)
(\(_,(w0,i0,s0)) -> Maybe.toBool $ do
(a,s1) <- next param s0
Maybe.lift $ do
w1 <- Serial.writeNext a w0
i1 <- A.dec i0
return (w1,i1,s1))
v <- Maybe.lift $ Serial.writeStop w2
return (v, s2))
start
stop)
packSmall ::
(Sig.C signal, Serial.C v, a ~ Serial.Element v) =>
signal a -> signal v
packSmall = alter (\(Core next start stop) -> Core
(\param ->
MS.runStateT $
Serial.withSize $ \n ->
MT.lift . Maybe.lift . Serial.assemble
=<<
replicateM n (MS.StateT $ next param))
start
stop)
unpack, unpackRotate ::
(Sig.C signal,
Serial.Read v, a ~ Serial.Element v, Serial.ReadIt v ~ itv, Memory.C itv) =>
signal v -> signal a
unpack = unpackRotate
unpackRotate = alter (\(Core next start stop) -> Core
(\context (i0,r0,s0) -> do
endOfVector <-
Maybe.lift $ A.cmp LLVM.CmpEQ i0 (valueOf (0::Word))
(i2,r2,s2) <-
Maybe.fromBool $
U.ifThen endOfVector (valueOf True, (i0,r0,s0)) $ do
(cont1, (v1,s1)) <- Maybe.toBool $ next context s0
r1 <- Serial.readStart v1
return (cont1, (valueOf $ fromIntegral $ Serial.size v1, r1, s1))
Maybe.lift $ do
(a,r3) <- Serial.readNext r2
i3 <- A.dec i2
return (a, (i3,r3,s2)))
(fmap (\s -> (A.zero, Tuple.undef, s)) . start)
(\(_,_,state) -> stop state))