    {-|
      Copyright  :  (C) 2019, Myrtle Software Ltd
      License    :  BSD2 (see the file LICENSE)
      Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>

      Blackbox generation for literal data constructors. (System)Verilog only!
    -}
    {-# LANGUAGE OverloadedStrings #-}

    module Clash.Primitives.GHC.Literal
     ( assign
     , signed
     , signedLiteral
     , unsigned
     , unsignedLiteral
     , literalTF
     )
     where

    import qualified Data.Text.Lazy               as LT
    import           Data.Text
      (Text, stripPrefix, stripSuffix, unpack)
    import           Data.Text.Extra              (showtl)
    import           Text.Read                    (readMaybe)

    import           Clash.Core.Term              (Term)
    import           Clash.Core.Type              (Type)
    import           Clash.Netlist.Types          (BlackBox)
    import           Clash.Netlist.BlackBox.Types
      (BlackBoxFunction, Element(Text), BlackBoxMeta)

    unsigned :: Element -> [Element]
    unsigned :: Element -> [Element]
    unsigned Element
    el = [Text -> Element
    Text Text
    "$unsigned(", Element
    el, Text -> Element
    Text Text
    ")"]

    signed :: Element -> [Element]
    signed :: Element -> [Element]
    signed Element
    el = [Text -> Element
    Text Text
    "$signed(", Element
    el, Text -> Element
    Text Text
    ")"]

    assign :: Element -> [Element] -> [Element]
    assign :: Element -> [Element] -> [Element]
    assign Element
    lhs [Element]
    rhs = Text -> Element
    Text Text
    "assign " Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : Element
    lhs Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : Text -> Element
    Text Text
    " = " Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    rhs [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Text -> Element
    Text Text
    ";"]

    signedLiteral :: Int -> Integer -> Element
    signedLiteral :: Int -> Integer -> Element
    signedLiteral Int
    wordSize Integer
    wordVal =
      Text -> Element
    Text ([Text] -> Text
    LT.concat [ if Integer
    wordVal Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 then Text
    "-" else Text
    ""
                      , Int -> Text
    forall a. Show a => a -> Text
    showtl Int
    wordSize
                      , Text
    "'sd"
                      , Integer -> Text
    forall a. Show a => a -> Text
    showtl (Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    wordVal)
                      ])

    unsignedLiteral :: Int -> Integer -> Element
    unsignedLiteral :: Int -> Integer -> Element
    unsignedLiteral Int
    wordSize Integer
    wordVal =
      Text -> Element
    Text ([Text] -> Text
    LT.concat [ if Integer
    wordVal Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 then Text
    "-" else Text
    ""
                      , Int -> Text
    forall a. Show a => a -> Text
    showtl Int
    wordSize
                      , Text
    "'d"
                      , Integer -> Text
    forall a. Show a => a -> Text
    showtl (Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    wordVal)
                      ])

    -- | Parse integer in strings of the form "GHC.Word.WordX#" where
    -- "GHC.Word.Word" is the prefix given.
    readSize :: Text -> Text -> Maybe Int
    readSize :: Text -> Text -> Maybe Int
    readSize Text
    prefix Text
    nm0 = do
      Text
    nm1 <- Text -> Text -> Maybe Text
    stripPrefix Text
    prefix Text
    nm0
      Text
    nm2 <- Text -> Text -> Maybe Text
    stripSuffix Text
    "#" Text
    nm1
      [Char] -> Maybe Int
    forall a. Read a => [Char] -> Maybe a
    readMaybe (Text -> [Char]
    unpack Text
    nm2)

    -- | Constructs "clean" literals.
    literalTF
      :: Text
      -- ^ Base name of constructors (for example: "GHC.Word.W")
      -> (Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox))
      -- ^ Functions processing
      -> BlackBoxFunction
    literalTF :: Text
    -> (Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox))
    -> BlackBoxFunction
    literalTF Text
    baseName Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox)
    tf Bool
    isDecl Text
    primName [Either Term Type]
    args [Type]
    _resTy = Either [Char] (BlackBoxMeta, BlackBox)
    -> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
    forall a. a -> NetlistMonad a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Either [Char] (BlackBoxMeta, BlackBox)
     -> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox)))
    -> Either [Char] (BlackBoxMeta, BlackBox)
    -> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
    forall a b. (a -> b) -> a -> b
    $
      case Text -> Text -> Maybe Int
    readSize Text
    baseName Text
    primName of
        Maybe Int
    Nothing ->
          [Char] -> Either [Char] (BlackBoxMeta, BlackBox)
    forall a b. a -> Either a b
    Left ([[Char]] -> [Char]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[Char]
    "Can only make blackboxes for '", Text -> [Char]
    unpack Text
    baseName, [Char]
    "X#'"])
        Just Int
    n ->
          (BlackBoxMeta, BlackBox) -> Either [Char] (BlackBoxMeta, BlackBox)
    forall a b. b -> Either a b
    Right (Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox)
    tf Bool
    isDecl [Either Term Type]
    args Int
    n)