{-|
  Copyright  :  (C) 2015-2016, University of Twente,
                    2017     , Myrtle Software Ltd, Google Inc.
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
-}

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

module Clash.Backend where

import Control.Lens                         (Lens')
import qualified  Control.Lens              as Lens
import Data.HashMap.Strict                  (HashMap)
import qualified Data.HashMap.Strict        as HashMap
import Data.HashSet                         (HashSet)
import Data.Maybe                           (fromMaybe)
import Data.Semigroup.Monad                 (Mon (..))
import qualified Data.Text                  as T
import Data.Text                            (Text)
import qualified Data.Text.Lazy             as LT
import Control.Monad.State                  (State)
import Data.Text.Prettyprint.Doc.Extra      (Doc)

import SrcLoc (SrcSpan)

import Clash.Netlist.Id
import {-# SOURCE #-} Clash.Netlist.Types
import Clash.Netlist.BlackBox.Types

import Clash.Annotations.Primitive          (HDL)

#ifdef CABAL
import qualified Paths_clash_lib
import qualified Data.Version
#else
import qualified System.FilePath
#endif

primsRoot :: IO FilePath
#ifdef CABAL
primsRoot :: IO FilePath
primsRoot = FilePath -> IO FilePath
Paths_clash_lib.getDataFileName "prims"
#else
primsRoot = return ("clash-lib" System.FilePath.</> "prims")
#endif

clashVer :: String
#ifdef CABAL
clashVer :: FilePath
clashVer = Version -> FilePath
Data.Version.showVersion Version
Paths_clash_lib.version
#else
clashVer = "development"
#endif

type ModName = Identifier

-- | Is a type used for internal or external use
data Usage
  = Internal
  -- ^ Internal use
  | External Text
  -- ^ External use, field indicates the library name

class Backend state where
  -- | Initial state for state monad
  initBackend :: Int -> HdlSyn -> Bool -> Maybe (Maybe Int) -> state

  -- | What HDL is the backend generating
  hdlKind :: state -> HDL

  -- | Location for the primitive definitions
  primDirs :: state -> IO [FilePath]

  -- | Name of backend, used for directory to put output files in. Should be
  --   constant function / ignore argument.
  name :: state -> String

  -- | File extension for target langauge
  extension :: state -> String

  -- | Get the set of types out of state
  extractTypes     :: state -> HashSet HWType

  -- | Generate HDL for a Netlist component
  genHDL           :: Identifier -> SrcSpan -> HashMap Identifier Word -> Component -> Mon (State state) ((String, Doc),[(String,Doc)])
  -- | Generate a HDL package containing type definitions for the given HWTypes
  mkTyPackage      :: Identifier -> [HWType] -> Mon (State state) [(String, Doc)]
  -- | Convert a Netlist HWType to a target HDL type
  hdlType          :: Usage -> HWType -> Mon (State state) Doc
  -- | Convert a Netlist HWType to an HDL error value for that type
  hdlTypeErrValue  :: HWType       -> Mon (State state) Doc
  -- | Convert a Netlist HWType to the root of a target HDL type
  hdlTypeMark      :: HWType       -> Mon (State state) Doc
  -- | Create a record selector
  hdlRecSel        :: HWType -> Int -> Mon (State state) Doc
  -- | Create a signal declaration from an identifier (Text) and Netlist HWType
  hdlSig           :: LT.Text -> HWType -> Mon (State state) Doc
  -- | Create a generative block statement marker
  genStmt          :: Bool -> State state Doc
  -- | Turn a Netlist Declaration to a HDL concurrent block
  inst             :: Declaration  -> Mon (State state) (Maybe Doc)
  -- | Turn a Netlist expression into a HDL expression
  expr             :: Bool -- ^ Enclose in parentheses?
                   -> Expr -- ^ Expr to convert
                   -> Mon (State state) Doc
  -- | Bit-width of Int,Word,Integer
  iwWidth          :: State state Int
  -- | Convert to a bit-vector
  toBV             :: HWType -> LT.Text -> Mon (State state) Doc
  -- | Convert from a bit-vector
  fromBV           :: HWType -> LT.Text -> Mon (State state) Doc
  -- | Synthesis tool we're generating HDL for
  hdlSyn           :: State state HdlSyn
  -- | mkIdentifier
  mkIdentifier     :: State state (IdType -> Identifier -> Identifier)
  -- | mkIdentifier
  extendIdentifier :: State state (IdType -> Identifier -> Identifier -> Identifier)
  -- | setModName
  setModName       :: ModName -> state -> state
  -- | setSrcSpan
  setSrcSpan       :: SrcSpan -> State state ()
  -- | getSrcSpan
  getSrcSpan       :: State state SrcSpan
  -- | Block of declarations
  blockDecl        :: Text -> [Declaration] -> Mon (State state) Doc
  -- | unextend/unescape identifier
  unextend         :: State state (Identifier -> Identifier)
  addIncludes      :: [(String, Doc)] -> State state ()
  addLibraries     :: [LT.Text] -> State state ()
  addImports       :: [LT.Text] -> State state ()
  addAndSetData    :: FilePath -> State state String
  getDataFiles     :: State state [(String,FilePath)]
  addMemoryDataFile  :: (String,String) -> State state ()
  getMemoryDataFiles :: State state [(String,String)]
  seenIdentifiers  :: Lens' state (HashMap Identifier Word)
  ifThenElseExpr :: state -> Bool

-- | Replace a normal HDL template placeholder with an unescaped/unextended
-- template placeholder.
--
-- Needed when the the place-holder is filled with an escaped/extended identifier
-- inside an escaped/extended identifier and we want to strip the escape
-- /extension markers. Otherwise we end up with illegal identifiers.
escapeTemplate :: Identifier -> Identifier
escapeTemplate :: Identifier -> Identifier
escapeTemplate "~RESULT" = "~ERESULT"
escapeTemplate t :: Identifier
t = Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
t (Maybe Identifier -> Identifier) -> Maybe Identifier -> Identifier
forall a b. (a -> b) -> a -> b
$ do
  Identifier
t1 <- Identifier -> Identifier -> Maybe Identifier
T.stripPrefix "~ARG[" Identifier
t
  Identifier
n  <- Identifier -> Identifier -> Maybe Identifier
T.stripSuffix "]" Identifier
t1
  Identifier -> Maybe Identifier
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Identifier] -> Identifier
T.concat ["~EARG[",Identifier
n,"]"])

mkUniqueIdentifier
  :: Backend s
  => IdType
  -> Identifier
  -> State s Identifier
mkUniqueIdentifier :: IdType -> Identifier -> State s Identifier
mkUniqueIdentifier typ :: IdType
typ nm :: Identifier
nm = do
  IdType -> Identifier -> Identifier
mkId     <- State s (IdType -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier)
mkIdentifier
  IdType -> Identifier -> Identifier -> Identifier
extendId <- State s (IdType -> Identifier -> Identifier -> Identifier)
forall state.
Backend state =>
State state (IdType -> Identifier -> Identifier -> Identifier)
extendIdentifier
  HashMap Identifier Word
seen     <- Getting (HashMap Identifier Word) s (HashMap Identifier Word)
-> StateT s Identity (HashMap Identifier Word)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
Lens.use Getting (HashMap Identifier Word) s (HashMap Identifier Word)
forall state.
Backend state =>
Lens' state (HashMap Identifier Word)
seenIdentifiers
  let i :: Identifier
i = IdType -> Identifier -> Identifier
mkId IdType
typ Identifier
nm
  case Identifier -> HashMap Identifier Word -> Maybe Word
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
i HashMap Identifier Word
seen of
    Just n :: Word
n -> (IdType -> Identifier -> Identifier -> Identifier)
-> Word
-> HashMap Identifier Word
-> Identifier
-> State s Identifier
forall (m :: Type -> Type) s t v.
(MonadState s m, Backend s) =>
(IdType -> t -> Identifier -> Identifier)
-> Word -> HashMap Identifier v -> t -> m Identifier
go IdType -> Identifier -> Identifier -> Identifier
extendId Word
n HashMap Identifier Word
seen Identifier
i
    Nothing -> do
     (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> s -> Identity s
forall state.
Backend state =>
Lens' state (HashMap Identifier Word)
seenIdentifiers ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> s -> Identity s)
-> (HashMap Identifier Word -> HashMap Identifier Word)
-> StateT s Identity ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
Lens.%= (Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
i 0)
     Identifier -> State s Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
i
 where
  go :: (IdType -> t -> Identifier -> Identifier)
-> Word -> HashMap Identifier v -> t -> m Identifier
go extendId :: IdType -> t -> Identifier -> Identifier
extendId n :: Word
n seen :: HashMap Identifier v
seen i :: t
i = do
    let i' :: Identifier
i' = IdType -> t -> Identifier -> Identifier
extendId IdType
typ t
i (FilePath -> Identifier
T.pack ('_'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Word -> FilePath
forall a. Show a => a -> FilePath
show Word
n))
    case Identifier -> HashMap Identifier v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Identifier
i' HashMap Identifier v
seen of
       Just _ -> (IdType -> t -> Identifier -> Identifier)
-> Word -> HashMap Identifier v -> t -> m Identifier
go IdType -> t -> Identifier -> Identifier
extendId (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
+1) HashMap Identifier v
seen t
i
       Nothing -> do
        (HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> s -> Identity s
forall state.
Backend state =>
Lens' state (HashMap Identifier Word)
seenIdentifiers ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> s -> Identity s)
-> (HashMap Identifier Word -> HashMap Identifier Word) -> m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
Lens.%= (Identifier
-> Word -> HashMap Identifier Word -> HashMap Identifier Word
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Identifier
i' (Word
nWord -> Word -> Word
forall a. Num a => a -> a -> a
+1))
        Identifier -> m Identifier
forall (m :: Type -> Type) a. Monad m => a -> m a
return Identifier
i'

preserveSeen
  :: Backend s
  => Mon (State s) a
  -> Mon (State s) a
preserveSeen :: Mon (State s) a -> Mon (State s) a
preserveSeen m :: Mon (State s) a
m = do
  HashMap Identifier Word
s <- State s (HashMap Identifier Word)
-> Mon (State s) (HashMap Identifier Word)
forall (f :: Type -> Type) m. f m -> Mon f m
Mon (Getting (HashMap Identifier Word) s (HashMap Identifier Word)
-> State s (HashMap Identifier Word)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
Lens.use Getting (HashMap Identifier Word) s (HashMap Identifier Word)
forall state.
Backend state =>
Lens' state (HashMap Identifier Word)
seenIdentifiers)
  a
a <- Mon (State s) a
m
  State s () -> Mon (State s) ()
forall (f :: Type -> Type) m. f m -> Mon f m
Mon ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
-> s -> Identity s
forall state.
Backend state =>
Lens' state (HashMap Identifier Word)
seenIdentifiers ((HashMap Identifier Word -> Identity (HashMap Identifier Word))
 -> s -> Identity s)
-> HashMap Identifier Word -> State s ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
Lens..= HashMap Identifier Word
s)
  a -> Mon (State s) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a