Add fourmolu as formatter

.github/workflows/ci.yml

@@ -13,6 +13,19 @@ concurrency:
   cancel-in-progress: true
 
 jobs:
+  fourmolu:
+    runs-on: ubuntu-latest
+    steps:
+      # Note that you must checkout your code before running haskell-actions/run-fourmolu
+      - uses: actions/checkout@v3
+      - uses: haskell-actions/run-fourmolu@v9
+        with:
+          version: "0.14.0.0"
+          pattern: |
+            *.hs
+            !clash-ghc/src-bin-*
+
+
   build_mac_windows:
     name: Build and run limited tests
     runs-on: ${{ matrix.os }}

Clash.hs

@@ -1,70 +1,82 @@
 {-# LANGUAGE TypeApplications #-}
-
 {-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
 module Main where
 
+import Clash.Backend
+import Clash.Backend.SystemVerilog
+import Clash.Backend.VHDL
+import Clash.Backend.Verilog
 import Clash.Driver
 import Clash.Driver.Types
 import Clash.GHC.Evaluator
 import Clash.GHC.GenerateBindings
 import Clash.GHC.NetlistTypes
 import Clash.GHC.PartialEval
-import Clash.Backend
-import Clash.Backend.SystemVerilog
-import Clash.Backend.VHDL
-import Clash.Backend.Verilog
 import Clash.Util
 
 import Control.DeepSeq
 import Data.Proxy
 import qualified Data.Time.Clock as Clock
 import GHC.Stack (HasCallStack)
 
-genSystemVerilog
-  :: ClashOpts
-  -> String
-  -> IO ()
+genSystemVerilog ::
+  ClashOpts ->
+  String ->
+  IO ()
 genSystemVerilog = doHDL (Proxy @SystemVerilogState)
 
-genVHDL
-  :: ClashOpts
-  -> String
-  -> IO ()
+genVHDL ::
+  ClashOpts ->
+  String ->
+  IO ()
 genVHDL = doHDL (Proxy @VHDLState)
 
-genVerilog
-  :: ClashOpts
-  -> String
-  -> IO ()
+genVerilog ::
+  ClashOpts ->
+  String ->
+  IO ()
 genVerilog = doHDL (Proxy @VerilogState)
 
-doHDL
-  :: forall s
-   . HasCallStack
-  => Backend s
-  => Proxy s
-  -> ClashOpts
-  -> String
-  -> IO ()
+doHDL ::
+  forall s.
+  (HasCallStack) =>
+  (Backend s) =>
+  Proxy s ->
+  ClashOpts ->
+  String ->
+  IO ()
 doHDL Proxy opts src = do
   startTime <- Clock.getCurrentTime
   let backend = initBackend @s opts
-  pd      <- primDirs backend
+  pd <- primDirs backend
   (clashEnv, clashDesign) <-
     generateBindings opts (return ()) pd ["."] [] (hdlKind backend) src Nothing
-  prepTime <- startTime `deepseq` designBindings clashDesign `deepseq` envTyConMap clashEnv `deepseq` envCustomReprs clashEnv `deepseq` Clock.getCurrentTime
+  prepTime <-
+    startTime
+      `deepseq` designBindings clashDesign
+      `deepseq` envTyConMap clashEnv
+      `deepseq` envCustomReprs clashEnv
+      `deepseq` Clock.getCurrentTime
   let prepStartDiff = reportTimeDiff prepTime startTime
   putStrLn $ "Loading dependencies took " ++ prepStartDiff
 
-  generateHDL clashEnv clashDesign (Just backend)
-    (ghcTypeToHWType (opt_intWidth opts)) ghcEvaluator evaluator Nothing startTime
+  generateHDL
+    clashEnv
+    clashDesign
+    (Just backend)
+    (ghcTypeToHWType (opt_intWidth opts))
+    ghcEvaluator
+    evaluator
+    Nothing
+    startTime
 
 main :: IO ()
 main =
-  let opts = defClashOpts
-               { opt_cachehdl = False
-               , opt_debug = debugSilent
-               , opt_clear = True
-               }
+  let opts =
+        defClashOpts
+          { opt_cachehdl = False
+          , opt_debug = debugSilent
+          , opt_clear = True
+          }
    in genVHDL opts "./examples/FIR.hs"

benchmark/benchmark-concurrency.hs

@@ -10,22 +10,23 @@ import System.Environment (getArgs, withArgs)
 import Clash.Backend
 import Clash.Backend.VHDL (VHDLState)
 import Clash.Driver
-import Clash.Driver.Types (ClashEnv(..), ClashOpts(..))
+import Clash.Driver.Types (ClashEnv (..), ClashOpts (..))
 
-import Clash.GHC.PartialEval
 import Clash.GHC.Evaluator
 import Clash.GHC.NetlistTypes (ghcTypeToHWType)
+import Clash.GHC.PartialEval
 
 import BenchmarkCommon
 
 main :: IO ()
 main = do
   args <- getArgs
-  let (idirs0,rest)         = partition ((== "-i") . take 2) args
-      idirs1                = ".":map (drop 2) idirs0
-      (fileArgs,optionArgs) = break (isPrefixOf "-") rest
-      tests | null fileArgs = concurrencyTests
-            | otherwise     = fileArgs
+  let (idirs0, rest) = partition ((== "-i") . take 2) args
+      idirs1 = "." : map (drop 2) idirs0
+      (fileArgs, optionArgs) = break (isPrefixOf "-") rest
+      tests
+        | null fileArgs = concurrencyTests
+        | otherwise = fileArgs
 
   withArgs optionArgs (defaultMain $ fmap (benchFile idirs1) tests)
  where
@@ -37,9 +38,18 @@ main = do
 benchFile :: [FilePath] -> FilePath -> Benchmark
 benchFile idirs src =
   env ((,) <$> runInputStage idirs src <*> getCurrentTime) $
-    \ ~((clashEnv, clashDesign),startTime) -> do
-      bench ("Generating HDL: " ++ src)
-            (nfIO (generateHDL clashEnv clashDesign
-                     (Just (initBackend @VHDLState (envOpts clashEnv)))
-                     (ghcTypeToHWType (opt_intWidth (envOpts clashEnv)))
-                     ghcEvaluator evaluator Nothing startTime))
+    \ ~((clashEnv, clashDesign), startTime) -> do
+      bench
+        ("Generating HDL: " ++ src)
+        ( nfIO
+            ( generateHDL
+                clashEnv
+                clashDesign
+                (Just (initBackend @VHDLState (envOpts clashEnv)))
+                (ghcTypeToHWType (opt_intWidth (envOpts clashEnv)))
+                ghcEvaluator
+                evaluator
+                Nothing
+                startTime
+            )
+        )

benchmark/benchmark-normalization.hs

@@ -1,41 +1,42 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE PartialTypeSignatures #-}
-
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -Wno-partial-type-signatures #-}
 
-import           Clash.Driver
-import           Clash.Driver.Types
+import Clash.Driver
+import Clash.Driver.Types
 
-import           Clash.GHC.PartialEval
-import           Clash.GHC.Evaluator
-import           Clash.GHC.NetlistTypes       (ghcTypeToHWType)
+import Clash.GHC.Evaluator
+import Clash.GHC.NetlistTypes (ghcTypeToHWType)
+import Clash.GHC.PartialEval
 
-import           Clash.Netlist.Types          (TopEntityT(topId))
-import qualified Clash.Util.Supply            as Supply
+import Clash.Netlist.Types (TopEntityT (topId))
+import qualified Clash.Util.Supply as Supply
 
-import           Criterion.Main
+import Criterion.Main
 
-import           Control.DeepSeq              (NFData(..), rwhnf)
-import           Data.List                    (isPrefixOf, partition)
-import           System.Environment           (getArgs, withArgs)
+import Control.DeepSeq (NFData (..), rwhnf)
+import Data.List (isPrefixOf, partition)
+import System.Environment (getArgs, withArgs)
 
 import BenchmarkCommon
 
--- | Run benchmark the normalization process
---
--- You can provide you own test cases as commandline arguments.
---
--- All arguments from the first one starting with a '-' are given to criterion.
--- All argument before that are interpreted as test cases.
+{- | Run benchmark the normalization process
+
+You can provide you own test cases as commandline arguments.
+
+All arguments from the first one starting with a '-' are given to criterion.
+All argument before that are interpreted as test cases.
+-}
 main :: IO ()
 main = do
   args <- getArgs
-  let (idirs0,rest)         = partition ((== "-i") . take 2) args
-      idirs1                = ".":map (drop 2) idirs0
-      (fileArgs,optionArgs) = break (isPrefixOf "-") rest
-      tests | null fileArgs = defaultTests
-            | otherwise     = fileArgs
+  let (idirs0, rest) = partition ((== "-i") . take 2) args
+      idirs1 = "." : map (drop 2) idirs0
+      (fileArgs, optionArgs) = break (isPrefixOf "-") rest
+      tests
+        | null fileArgs = defaultTests
+        | otherwise = fileArgs
 
   withArgs optionArgs (defaultMain $ fmap (benchFile idirs1) tests)
 
@@ -45,28 +46,31 @@ benchFile idirs src =
     \ ~(clashEnv, clashDesign, supplyN) -> do
       let topEntities = fmap topId (designEntities clashDesign)
           topEntity = case topEntities of
-                        t:_ -> t
-                        _ -> error "no top entities"
-      bench ("normalization of " ++ src)
-            (nfIO
-              (normalizeEntity
+            t : _ -> t
+            _ -> error "no top entities"
+      bench
+        ("normalization of " ++ src)
+        ( nfIO
+            ( normalizeEntity
                 clashEnv
                 (designBindings clashDesign)
                 (ghcTypeToHWType (opt_intWidth (envOpts clashEnv)))
                 ghcEvaluator
                 evaluator
                 topEntities
                 supplyN
-                topEntity))
+                topEntity
+            )
+        )
 
-setupEnv
-  :: [FilePath]
-  -> FilePath
-  -> IO (ClashEnv, ClashDesign, Supply.Supply)
+setupEnv ::
+  [FilePath] ->
+  FilePath ->
+  IO (ClashEnv, ClashDesign, Supply.Supply)
 setupEnv idirs src = do
   (clashEnv, clashDesign) <- runInputStage idirs src
   supplyN <- Supply.newSupply
-  return (clashEnv, clashDesign ,supplyN)
+  return (clashEnv, clashDesign, supplyN)
 
 instance NFData Supply.Supply where
   rnf = rwhnf

benchmark/common/BenchmarkCommon.hs

@@ -2,19 +2,19 @@
 
 module BenchmarkCommon where
 
-import Clash.Annotations.Primitive (HDL(VHDL))
+import Clash.Annotations.Primitive (HDL (VHDL))
 import Clash.Backend
 import Clash.Backend.VHDL
 import Clash.Core.Var
 import Clash.Driver
 import Clash.Driver.Types
-import Clash.Netlist.Types (TopEntityT(topId))
+import Clash.Netlist.Types (TopEntityT (topId))
 import Clash.Util.Supply as Supply
 
-import Clash.GHC.PartialEval
 import Clash.GHC.Evaluator
 import Clash.GHC.GenerateBindings
 import Clash.GHC.NetlistTypes
+import Clash.GHC.PartialEval
 
 defaultTests :: [FilePath]
 defaultTests =
@@ -29,42 +29,46 @@ defaultTests =
 
 opts :: [FilePath] -> ClashOpts
 opts idirs =
-  defClashOpts{
-      opt_cachehdl=False
-    , opt_clear=True
+  defClashOpts
+    { opt_cachehdl = False
+    , opt_clear = True
     , opt_errorExtra = True
-    , opt_importPaths=idirs
-    , opt_specLimit=100 -- For "ManyEntitiesVaried"
+    , opt_importPaths = idirs
+    , opt_specLimit = 100 -- For "ManyEntitiesVaried"
     }
 
 hdl :: HDL
 hdl = VHDL
 
-runInputStage
-  :: [FilePath]
-  -> FilePath
-  -> IO (ClashEnv, ClashDesign)
+runInputStage ::
+  [FilePath] ->
+  FilePath ->
+  IO (ClashEnv, ClashDesign)
 runInputStage idirs src = do
   let o = opts idirs
   let backend = initBackend @VHDLState o
   pds <- primDirs backend
   generateBindings o (return ()) pds (opt_importPaths o) [] (hdlKind backend) src Nothing
 
-runNormalisationStage
-  :: [FilePath]
-  -> String
-  -> IO (ClashEnv, ClashDesign, Id)
+runNormalisationStage ::
+  [FilePath] ->
+  String ->
+  IO (ClashEnv, ClashDesign, Id)
 runNormalisationStage idirs src = do
   supplyN <- Supply.newSupply
   (env, design) <- runInputStage idirs src
   let topEntityNames = fmap topId (designEntities design)
   case topEntityNames of
-    topEntity:_ -> do
+    topEntity : _ -> do
       transformedBindings <-
-            normalizeEntity env (designBindings design)
-              (ghcTypeToHWType (opt_intWidth (opts idirs)))
-              ghcEvaluator
-              evaluator
-              topEntityNames supplyN topEntity
-      return (env, design{designBindings=transformedBindings},topEntity)
+        normalizeEntity
+          env
+          (designBindings design)
+          (ghcTypeToHWType (opt_intWidth (opts idirs)))
+          ghcEvaluator
+          evaluator
+          topEntityNames
+          supplyN
+          topEntity
+      return (env, design{designBindings = transformedBindings}, topEntity)
     _ -> error "no top entities"