{-|
  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           Text.Read                    (readMaybe)
import           TextShow                     (showtl)

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 el :: Element
el = [Text -> Element
Text "$unsigned(", Element
el, Text -> Element
Text ")"]

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

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

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

unsignedLiteral :: Int -> Integer -> Element
unsignedLiteral :: Int -> Integer -> Element
unsignedLiteral wordSize :: Int
wordSize wordVal :: Integer
wordVal =
  Text -> Element
Text ([Text] -> Text
LT.concat [ if Integer
wordVal Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then "-" else ""
                  , Int -> Text
forall a. TextShow a => a -> Text
showtl Int
wordSize
                  , "'d"
                  , Integer -> Text
forall a. TextShow 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 prefix :: Text
prefix nm0 :: Text
nm0 = do
  Text
nm1 <- Text -> Text -> Maybe Text
stripPrefix Text
prefix Text
nm0
  Text
nm2 <- Text -> Text -> Maybe Text
stripSuffix "#" 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 baseName :: Text
baseName tf :: Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox)
tf isDecl :: Bool
isDecl primName :: Text
primName args :: [Either Term Type]
args _resTy :: 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
    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 ["Can only make blackboxes for '", Text -> String
unpack Text
baseName, "X#'"])
    Just n :: 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)