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

  Blackbox generation for GHC.Int.IntX# data constructors. (System)Verilog only!
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Clash.Primitives.GHC.Int (intTF) where

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

getIntLit
  :: Literal
  -> Maybe Integer
getIntLit :: Literal -> Maybe Integer
getIntLit =
  \case
    IntegerLiteral Integer
i -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    IntLiteral Integer
i     -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Int8Literal Integer
i    -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Int16Literal Integer
i   -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Int32Literal Integer
i   -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Int64Literal Integer
i   -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Literal
_                -> Maybe Integer
forall a. Maybe a
Nothing

-- | Template function for Int8,Int16,.. Constructs "clean" literals.
intTF :: BlackBoxFunction
intTF :: BlackBoxFunction
intTF = Text
-> (Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox))
-> BlackBoxFunction
literalTF Text
"GHC.Int.I" Bool -> [Either Term Type] -> Int -> (BlackBoxMeta, BlackBox)
intTF'

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

intTF' Bool
True [Left (Literal (Literal -> Maybe Integer
getIntLit -> Just Integer
n))] Int
intSize =
  -- Literal as declaration:
  ( BlackBoxMeta
emptyBlackBoxMeta
  , BlackBoxTemplate -> BlackBox
BBTemplate (Element -> BlackBoxTemplate -> BlackBoxTemplate
assign Element
Result [Int -> Integer -> Element
signedLiteral Int
intSize Integer
n]))

intTF' Bool
_isDecl [Either Term Type]
_args Int
_intSize =
  -- 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
signed (Int -> Element
Arg Int
0))))