{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

-- | Provides the default (concrete) interpretation for the decoding effect. This
-- implementation assumes that the 'Decodable' type class can be implemented for
-- the underlying type parameter, that is, it must be possible to convert the
-- type to a fixed-width concrete integer.
module LibRISCV.Effects.Decoding.Default.Interpreter where

import Control.Monad.Freer (type (~>))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.BitVector (BV, bitVec)
import Data.Data (Proxy (..))
import Data.IORef (IORef, readIORef, writeIORef)
import Data.Word (Word32)
import LibRISCV.Effects.Decoding.Language (Decoding (..))
import LibRISCV.Internal.Decoder.Instruction (immB, immI, immJ, immS, immU, mkRd, mkRs1, mkRs2, mkShamt)
import LibRISCV.Internal.Decoder.Opcodes (decode)

-- | Decoder state used to implement the stateful 'SetInstr' constructor of the 'Decoding' effect.
type DecoderState = IORef Word32

-- | Type class used to perform conversion from/to a fixed-with concrete integer.
class Decodable a where
    fromWord :: Word32 -> a
    -- ^ Convert from a fixed-with integer to the underlying value type of the interpreter.

    toWord :: a -> Word32
    -- ^ Convert from the underlying value type to a fixed-with integer.

instance Decodable BV where
    fromWord :: Word32 -> BV
fromWord = Int -> Word32 -> BV
forall a. Integral a => Int -> a -> BV
bitVec Int
32
    toWord :: BV -> Word32
toWord = BV -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Concrete implementation of the decoding effect.
defaultDecoding :: forall v m. (Decodable v, MonadIO m) => DecoderState -> Decoding v ~> m
defaultDecoding :: forall v (m :: * -> *).
(Decodable v, MonadIO m) =>
DecoderState -> Decoding v ~> m
defaultDecoding DecoderState
instRef =
    let
        decodeAndConvert :: (a -> Word32) -> IORef a -> IO b
decodeAndConvert a -> Word32
f = (a -> b) -> IO a -> IO b
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> b
forall a. Decodable a => Word32 -> a
fromWord (Word32 -> b) -> (a -> Word32) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word32
f) (IO a -> IO b) -> (IORef a -> IO a) -> IORef a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> IO a
forall a. IORef a -> IO a
readIORef
     in
        IO x -> m x
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> m x) -> (Decoding v x -> IO x) -> Decoding v x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            SetInstr v
v -> DecoderState -> Word32 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef DecoderState
instRef (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ v -> Word32
forall a. Decodable a => a -> Word32
toWord v
v
            WithInstrType Proxy v
Proxy InstructionType -> x
f -> InstructionType -> x
f (InstructionType -> x)
-> (Word32 -> InstructionType) -> Word32 -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> InstructionType
decode (Word32 -> x) -> IO Word32 -> IO x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecoderState -> IO Word32
forall a. IORef a -> IO a
readIORef DecoderState
instRef
            Decoding v x
DecodeRD -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
mkRd DecoderState
instRef
            Decoding v x
DecodeRS1 -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
mkRs1 DecoderState
instRef
            Decoding v x
DecodeRS2 -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
mkRs2 DecoderState
instRef
            Decoding v x
DecodeImmI -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
immI DecoderState
instRef
            Decoding v x
DecodeImmS -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
immS DecoderState
instRef
            Decoding v x
DecodeImmB -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
immB DecoderState
instRef
            Decoding v x
DecodeImmU -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
immU DecoderState
instRef
            Decoding v x
DecodeImmJ -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
immJ DecoderState
instRef
            Decoding v x
DecodeShamt -> (Word32 -> Word32) -> DecoderState -> IO x
forall {b} {a}. Decodable b => (a -> Word32) -> IORef a -> IO b
decodeAndConvert Word32 -> Word32
mkShamt DecoderState
instRef