{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Translate Copilot Core expressions and operators to Bluespec.
module Copilot.Compile.Bluespec.Type
  ( transType
  , tVector
  ) where

-- External imports
import Data.String (IsString (..))
import qualified Language.Bluespec.Classic.AST as BS
import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS
import qualified Language.Bluespec.Classic.AST.Builtin.Types as BS

-- Internal imports: Copilot
import Copilot.Core

-- Internal imports
import Copilot.Compile.Bluespec.Name

-- | Translate a Copilot type to a Bluespec type.
transType :: Type a -> BS.CType
transType :: forall a. Type a -> CType
transType Type a
ty = case Type a
ty of
  Type a
Bool   -> CType
BS.tBool
  Type a
Int8   -> CType
BS.tInt  CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum  Integer
8 Position
BS.NoPos
  Type a
Int16  -> CType
BS.tInt  CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
16 Position
BS.NoPos
  Type a
Int32  -> CType
BS.tInt  CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
32 Position
BS.NoPos
  Type a
Int64  -> CType
BS.tInt  CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
64 Position
BS.NoPos
  Type a
Word8  -> CType
BS.tUInt CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum  Integer
8 Position
BS.NoPos
  Type a
Word16 -> CType
BS.tUInt CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
16 Position
BS.NoPos
  Type a
Word32 -> CType
BS.tUInt CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
32 Position
BS.NoPos
  Type a
Word64 -> CType
BS.tUInt CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
64 Position
BS.NoPos

  Type a
Float -> TyCon -> CType
BS.TCon (TyCon -> CType) -> TyCon -> CType
forall a b. (a -> b) -> a -> b
$
    BS.TyCon
      { tcon_name :: Id
BS.tcon_name = Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"Float"
      , tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
BS.KStar
      , tcon_sort :: TISort
BS.tcon_sort = Integer -> CType -> TISort
BS.TItype Integer
0 (CType -> TISort) -> CType -> TISort
forall a b. (a -> b) -> a -> b
$ CType
tFloatingPoint CType -> CType -> CType
`BS.TAp`
                                     Integer -> Position -> CType
BS.cTNum  Integer
8 Position
BS.NoPos CType -> CType -> CType
`BS.TAp`
                                     Integer -> Position -> CType
BS.cTNum Integer
23 Position
BS.NoPos
      }
  Type a
Double -> TyCon -> CType
BS.TCon (TyCon -> CType) -> TyCon -> CType
forall a b. (a -> b) -> a -> b
$
    BS.TyCon
      { tcon_name :: Id
BS.tcon_name = Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"Double"
      , tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
BS.KStar
      , tcon_sort :: TISort
BS.tcon_sort = Integer -> CType -> TISort
BS.TItype Integer
0 (CType -> TISort) -> CType -> TISort
forall a b. (a -> b) -> a -> b
$ CType
tFloatingPoint CType -> CType -> CType
`BS.TAp`
                                     Integer -> Position -> CType
BS.cTNum Integer
11 Position
BS.NoPos CType -> CType -> CType
`BS.TAp`
                                     Integer -> Position -> CType
BS.cTNum Integer
52 Position
BS.NoPos
      }
  Array Type t
ty' -> CType
tVector CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
len Position
BS.NoPos CType -> CType -> CType
`BS.TAp` Type t -> CType
forall a. Type a -> CType
transType Type t
ty'
    where
      len :: Integer
len = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Type (Array n t) -> Int
forall (n :: Nat) t. KnownNat n => Type (Array n t) -> Int
typeLength Type a
Type (Array n t)
ty
  Struct a
s -> TyCon -> CType
BS.TCon (TyCon -> CType) -> TyCon -> CType
forall a b. (a -> b) -> a -> b
$
    BS.TyCon
      { tcon_name :: Id
BS.tcon_name = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$
                       String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$
                       String -> String
uppercaseName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
                       a -> String
forall a. Struct a => a -> String
typeName a
s
      , tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
BS.KStar
      , tcon_sort :: TISort
BS.tcon_sort =
          StructSubType -> [Id] -> TISort
BS.TIstruct StructSubType
BS.SStruct ([Id] -> TISort) -> [Id] -> TISort
forall a b. (a -> b) -> a -> b
$
          (Value a -> Id) -> [Value a] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (\(Value Type t
_tu Field s t
field) ->
                Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$
                String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$
                String -> String
lowercaseName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
                Field s t -> String
forall (s :: Symbol) t. KnownSymbol s => Field s t -> String
fieldName Field s t
field)
              (a -> [Value a]
forall a. Struct a => a -> [Value a]
toValues a
s)
      }

-- | The @Vector@ Bluespec data type.
tVector :: BS.CType
tVector :: CType
tVector = TyCon -> CType
BS.TCon (TyCon -> CType) -> TyCon -> CType
forall a b. (a -> b) -> a -> b
$
  BS.TyCon
    { tcon_name :: Id
BS.tcon_name = Id
BS.idVector
    , tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just (Kind -> Kind -> Kind
BS.Kfun Kind
BS.KNum (Kind -> Kind -> Kind
BS.Kfun Kind
BS.KStar Kind
BS.KStar))
    , tcon_sort :: TISort
BS.tcon_sort =
        BS.TIdata
          { tidata_cons :: [Id]
BS.tidata_cons = [Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"V"]
          , tidata_enum :: Bool
BS.tidata_enum = Bool
False
          }
    }

-- | The @FloatingPoint@ Bluespec struct type.
tFloatingPoint :: BS.CType
tFloatingPoint :: CType
tFloatingPoint = TyCon -> CType
BS.TCon (TyCon -> CType) -> TyCon -> CType
forall a b. (a -> b) -> a -> b
$
  BS.TyCon
    { tcon_name :: Id
BS.tcon_name = Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"FloatingPoint"
    , tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just (Kind -> Kind -> Kind
BS.Kfun Kind
BS.KNum (Kind -> Kind -> Kind
BS.Kfun Kind
BS.KNum Kind
BS.KStar))
    , tcon_sort :: TISort
BS.tcon_sort =
        StructSubType -> [Id] -> TISort
BS.TIstruct StructSubType
BS.SStruct [ Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"sign"
                               , Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"exp"
                               , Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"sfd"
                               ]
    }