<commit_before>{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
module CLaSH.Driver where

import           Control.Monad.State          (evalState)
import qualified Data.ByteString.Lazy         as LZ
import           Data.Maybe                   (fromMaybe,listToMaybe)
import qualified Control.Concurrent.Supply    as Supply
import qualified Data.HashMap.Lazy            as HashMap
import           Data.List                    (isSuffixOf)
import           Data.Text.Lazy               (pack)
import qualified System.Directory             as Directory
import qualified System.FilePath              as FilePath
import qualified System.IO                    as IO
import           Text.PrettyPrint.Leijen.Text (Doc,hPutDoc)
import           Unbound.LocallyNameless      (name2String)

import           CLaSH.Core.Term              (TmName)
import           CLaSH.Driver.PrepareBinding
import           CLaSH.Driver.TestbenchGen
import           CLaSH.Netlist                (genNetlist)
import           CLaSH.Netlist.VHDL           (genVHDL)
import           CLaSH.Netlist.Types          (Component(..))
import           CLaSH.Normalize              (runNormalization, normalize, cleanupGraph)
import           CLaSH.Primitives.Types
import           CLaSH.Primitives.Util
import           CLaSH.Rewrite.Types          (DebugLevel(..))
import           CLaSH.Util

import qualified Data.Time.Clock as Clock

#ifdef CABAL
import           Paths_clash
#else
getDataFileName :: FilePath -> IO FilePath
getDataFileName = return . ("../" ++)
#endif

generateVHDL ::
  String
  -> IO ()
generateVHDL modName = do
  start <- Clock.getCurrentTime

  primitiveDir   <- getDataFileName "primitives"
  primitiveFiles <- fmap (filter (isSuffixOf ".json")) $
                      Directory.getDirectoryContents primitiveDir

  let primitiveFiles' = map (FilePath.combine primitiveDir) primitiveFiles

  primitives <- fmap concat $ mapM
                  ( return
                  . fromMaybe []
                  . decodeAndReport
                  <=< LZ.readFile
                  ) primitiveFiles'

  let primMap = HashMap.fromList $ zip (map name primitives) primitives

  (bindingsMap,dfunMap,clsOpMap) <- prepareBinding primMap modName

  let topEntities = HashMap.toList
                  $ HashMap.filterWithKey isTopEntity bindingsMap

      testInputs  = HashMap.toList
                  $ HashMap.filterWithKey isTestInput bindingsMap

      expectedOutputs = HashMap.toList
                      $ HashMap.filterWithKey isExpectedOutput bindingsMap

  case topEntities of
    [topEntity] -> do
      let bindingsMap' = HashMap.map snd bindingsMap
      (supplyN,supplyTB) <- fmap Supply.splitSupply Supply.newSupply
      let transformedBindings
            = runNormalization DebugFinal supplyN bindingsMap' dfunMap clsOpMap
            $ (normalize [fst topEntity]) >>= cleanupGraph [fst topEntity]
      normTime <- Clock.getCurrentTime
      traceIf True ("\nNormalisation took " ++ show (Clock.diffUTCTime normTime start)) $ return ()
      (netlist,vhdlState) <- genNetlist Nothing (HashMap.fromList $ transformedBindings)
                              primMap
                              Nothing
                              (fst topEntity)
      netlistTime <- Clock.getCurrentTime
      traceIf True ("\nNetlist generation took " ++ show (Clock.diffUTCTime netlistTime normTime)) $ return ()

      (testBench,vhdlState') <- genTestBench DebugNone supplyTB dfunMap clsOpMap primMap vhdlState
                                  bindingsMap'
                                  (listToMaybe $ map fst testInputs)
                                  (listToMaybe $ map fst expectedOutputs)
                                  (head $ filter (\(Component cName _ _ _ _) -> cName == (pack "topEntity_0")) netlist)
      let dir = "./vhdl/" ++ (fst $ snd topEntity) ++ "/"
      prepareDir dir
      mapM_ (writeVHDL dir) $ evalState (mapM genVHDL (netlist ++ testBench)) vhdlState'
      end <- Clock.getCurrentTime
      traceIf True ("\nTotal compilation took " ++ show (Clock.diffUTCTime end start)) $ return ()

    [] -> error $ $(curLoc) ++ "No 'topEntity' found"
    _  -> error $ $(curLoc) ++ "Multiple 'topEntity's found"

isTopEntity ::
  TmName
  -> a
  -> Bool
isTopEntity var _ = name2String var == "topEntity"

isTestInput ::
  TmName
  -> a
  -> Bool
isTestInput var _ = name2String var == "testInput"

isExpectedOutput ::
  TmName
  -> a
  -> Bool
isExpectedOutput var _ = name2String var == "expectedOutput"

-- | Prepares the directory for writing VHDL files. This means creating the<commit_msg>Improve time reporting of compilation steps<commit_after>{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
module CLaSH.Driver where

import           Control.Monad.State          (evalState)
import qualified Data.ByteString.Lazy         as LZ
import           Data.Maybe                   (fromMaybe,listToMaybe)
import qualified Control.Concurrent.Supply    as Supply
import qualified Data.HashMap.Lazy            as HashMap
import           Data.List                    (isSuffixOf)
import           Data.Text.Lazy               (pack)
import qualified System.Directory             as Directory
import qualified System.FilePath              as FilePath
import qualified System.IO                    as IO
import           Text.PrettyPrint.Leijen.Text (Doc,hPutDoc)
import           Unbound.LocallyNameless      (name2String)

import           CLaSH.Core.Term              (TmName)
import           CLaSH.Driver.PrepareBinding
import           CLaSH.Driver.TestbenchGen
import           CLaSH.Netlist                (genNetlist)
import           CLaSH.Netlist.VHDL           (genVHDL)
import           CLaSH.Netlist.Types          (Component(..))
import           CLaSH.Normalize              (runNormalization, normalize, cleanupGraph)
import           CLaSH.Primitives.Types
import           CLaSH.Primitives.Util
import           CLaSH.Rewrite.Types          (DebugLevel(..))
import           CLaSH.Util

import qualified Data.Time.Clock as Clock

#ifdef CABAL
import           Paths_clash
#else
getDataFileName :: FilePath -> IO FilePath
getDataFileName = return . ("../" ++)
#endif

generateVHDL ::
  String
  -> IO ()
generateVHDL modName = do
  start <- Clock.getCurrentTime

  primitiveDir   <- getDataFileName "primitives"
  primitiveFiles <- fmap (filter (isSuffixOf ".json")) $
                      Directory.getDirectoryContents primitiveDir

  let primitiveFiles' = map (FilePath.combine primitiveDir) primitiveFiles

  primitives <- fmap concat $ mapM
                  ( return
                  . fromMaybe []
                  . decodeAndReport
                  <=< LZ.readFile
                  ) primitiveFiles'

  let primMap = HashMap.fromList $ zip (map name primitives) primitives

  (bindingsMap,dfunMap,clsOpMap) <- prepareBinding primMap modName

  let topEntities = HashMap.toList
                  $ HashMap.filterWithKey isTopEntity bindingsMap

      testInputs  = HashMap.toList
                  $ HashMap.filterWithKey isTestInput bindingsMap

      expectedOutputs = HashMap.toList
                      $ HashMap.filterWithKey isExpectedOutput bindingsMap

  case topEntities of
    [topEntity] -> do
      let bindingsMap' = HashMap.map snd bindingsMap
      (supplyN,supplyTB) <- fmap Supply.splitSupply Supply.newSupply

      prepTime <- dfunMap `seq` Clock.getCurrentTime
      traceIf True ("Loading dependencies took " ++ show (Clock.diffUTCTime prepTime start)) $ return ()

      let transformedBindings
            = runNormalization DebugNone supplyN bindingsMap' dfunMap clsOpMap
            $ (normalize [fst topEntity]) >>= cleanupGraph [fst topEntity]

      normTime <- transformedBindings `seq` Clock.getCurrentTime
      traceIf True ("Normalisation took " ++ show (Clock.diffUTCTime normTime prepTime)) $ return ()

      (netlist,vhdlState) <- genNetlist Nothing (HashMap.fromList $ transformedBindings)
                              primMap
                              Nothing
                              (fst topEntity)

      netlistTime <- netlist `seq` Clock.getCurrentTime
      traceIf True ("Netlist generation took " ++ show (Clock.diffUTCTime netlistTime normTime)) $ return ()

      (testBench,vhdlState') <- genTestBench DebugNone supplyTB dfunMap clsOpMap primMap vhdlState
                                  bindingsMap'
                                  (listToMaybe $ map fst testInputs)
                                  (listToMaybe $ map fst expectedOutputs)
                                  (head $ filter (\(Component cName _ _ _ _) -> cName == (pack "topEntity_0")) netlist)

      testBenchTime <- testBench `seq` Clock.getCurrentTime
      traceIf True ("Testbench generation took " ++ show (Clock.diffUTCTime testBenchTime netlistTime)) $ return ()

      let dir = "./vhdl/" ++ (fst $ snd topEntity) ++ "/"
      prepareDir dir
      mapM_ (writeVHDL dir) $ evalState (mapM genVHDL (netlist ++ testBench)) vhdlState'

      end <- Clock.getCurrentTime
      traceIf True ("Total compilation took " ++ show (Clock.diffUTCTime end start)) $ return ()

    [] -> error $ $(curLoc) ++ "No 'topEntity' found"
    _  -> error $ $(curLoc) ++ "Multiple 'topEntity's found"

isTopEntity ::
  TmName
  -> a
  -> Bool
isTopEntity var _ = name2String var == "topEntity"

isTestInput ::
  TmName
  -> a
  -> Bool
isTestInput var _ = name2String var == "testInput"

isExpectedOutput ::
  TmName
  -> a
  -> Bool
isExpectedOutput var _ = name2String var == "expectedOutput"

-- | Prepares the directory for writing VHDL files. This means creating the
{'fraction_non_alphanumeric': 0.08324862776987192, 'fraction_numerical': 0.0010164667615368977, 'mean_word_length': 2.1008509297195084, 'pattern_counts': {'":': 0, '<': 31, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4359629', 'n_tokens_mistral': 2801, 'n_tokens_neox': 2649, 'n_words': 696}