{-|
  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
  String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
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 String (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either String (BlackBoxMeta, BlackBox)
 -> NetlistMonad (Either String (BlackBoxMeta, BlackBox)))
-> Either String (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
forall a b. (a -> b) -> a -> b
$
  case Text -> Text -> Maybe Int
readSize Text
baseName Text
primName of
    Maybe Int
Nothing ->
      String -> Either String (BlackBoxMeta, BlackBox)
forall a b. a -> Either a b
Left ([String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [String
"Can only make blackboxes for '", Text -> String
unpack Text
baseName, String
"X#'"])
    Just Int
n ->
      (BlackBoxMeta, BlackBox) -> Either String (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)