{-|
  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)