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

  Blackbox generation for GHC.Word.WordX# data constructors. (System)Verilog only!
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Clash.Primitives.GHC.Word (wordTF) where

import           Clash.Core.Literal           (Literal(..))
import           Clash.Core.Term              (Term(Literal))
import           Clash.Core.Type              (Type)
import           Clash.Primitives.GHC.Literal
  (literalTF, unsigned, unsignedLiteral, assign)
import           Clash.Netlist.Types          (BlackBox(BBTemplate))
import           Clash.Netlist.BlackBox.Types
  (BlackBoxFunction, Element(Arg, Result), emptyBlackBoxMeta
  ,BlackBoxMeta, bbKind, TemplateKind(TDecl))

-- | Template function for Word8,Word16,.. Constructs "clean" literals. This
-- function generates valid (System)Verilog only!
wordTF :: BlackBoxFunction
wordTF :: BlackBoxFunction
wordTF = Text
-> (Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox))
-> BlackBoxFunction
literalTF Text
"GHC.Word.W" Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox)
wordTF'

getWordLit
  :: Literal
  -> Maybe Integer
getWordLit :: Literal -> Maybe Integer
getWordLit =
  \case
    WordLiteral Integer
i   -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Word8Literal Integer
i  -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Word16Literal Integer
i -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Word32Literal Integer
i -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Word64Literal Integer
i -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Literal
_               -> Maybe Integer
forall a. Maybe a
Nothing

wordTF'
  :: Bool
  -- ^ Is declaration
  -> [Either Term Type]
  -- ^ Arguments
  -> Int
  -- ^ Word size
  -> (BlackBoxMeta, BlackBox)
wordTF' :: Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox)
wordTF' Bool
False [Left (Literal (Literal -> Maybe Integer
getWordLit -> Just Integer
n))] Int
wordSize =
  -- Literal as expression:
  ( BlackBoxMeta
emptyBlackBoxMeta
  , BlackBoxTemplate -> BlackBox
BBTemplate [Int -> Integer -> Element
unsignedLiteral Int
wordSize Integer
n])

wordTF' Bool
True [Left (Literal (Literal -> Maybe Integer
getWordLit -> Just Integer
n))] Int
wordSize =
  -- Literal as declaration:
  ( BlackBoxMeta
emptyBlackBoxMeta
  , BlackBoxTemplate -> BlackBox
BBTemplate (Element -> BlackBoxTemplate -> BlackBoxTemplate
assign Element
Result [Int -> Integer -> Element
unsignedLiteral Int
wordSize Integer
n]))

wordTF' Bool
_isDecl [Either Term Type]
_args Int
_wordSize =
  -- Not a literal. We need an assignment as Verilog does not support truncating
  -- arbitrary expression.
  ( BlackBoxMeta
emptyBlackBoxMeta {bbKind :: TemplateKind
bbKind = TemplateKind
TDecl }
  , BlackBoxTemplate -> BlackBox
BBTemplate (Element -> BlackBoxTemplate -> BlackBoxTemplate
assign Element
Result (Element -> BlackBoxTemplate
unsigned (Int -> Element
Arg Int
0))))