{-|
  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 LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

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

import           Clash.Core.Literal
  (Literal(IntegerLiteral, IntLiteral, Int64Literal))
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 i :: Integer
i -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    IntLiteral i :: Integer
i     -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    Int64Literal i :: Integer
i   -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    _                -> 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 "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' False [Left (Literal (Literal -> Maybe Integer
getIntLit -> Just n :: Integer
n))] intSize :: Int
intSize =
  -- Literal as expression:
  ( BlackBoxMeta
emptyBlackBoxMeta
  , BlackBoxTemplate -> BlackBox
BBTemplate [Int -> Integer -> Element
signedLiteral Int
intSize Integer
n])

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

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