From 4ba440d842e9a0502b429fbc04e2be41c8037a4c Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sat, 19 Jan 2019 19:20:33 +0000 Subject: Add brittany formatting instead of stylish-haskell --- src/VeriFuzz/Graph/ASTGen.hs | 58 ++++++++++++++++++++--------------------- src/VeriFuzz/Graph/CodeGen.hs | 55 ++++++++++++++++++++++---------------- src/VeriFuzz/Graph/Random.hs | 44 +++++++++++++++---------------- src/VeriFuzz/Graph/RandomAlt.hs | 21 ++++++++------- 4 files changed, 93 insertions(+), 85 deletions(-) (limited to 'src/VeriFuzz/Graph') diff --git a/src/VeriFuzz/Graph/ASTGen.hs b/src/VeriFuzz/Graph/ASTGen.hs index f7bd058..0403f51 100644 --- a/src/VeriFuzz/Graph/ASTGen.hs +++ b/src/VeriFuzz/Graph/ASTGen.hs @@ -12,10 +12,12 @@ Generates the AST from the graph directly. module VeriFuzz.Graph.ASTGen where -import Data.Foldable (fold) -import Data.Graph.Inductive (LNode, Node) -import qualified Data.Graph.Inductive as G -import Data.Maybe (catMaybes) +import Data.Foldable ( fold ) +import Data.Graph.Inductive ( LNode + , Node + ) +import qualified Data.Graph.Inductive as G +import Data.Maybe ( catMaybes ) import VeriFuzz.Circuit import VeriFuzz.Internal.Gen import VeriFuzz.Verilog.AST @@ -33,52 +35,48 @@ fromGate Or = BinOr fromGate Xor = BinXor inputsC :: Circuit -> [Node] -inputsC c = - inputs (getCircuit c) +inputsC c = inputs (getCircuit c) outputsC :: Circuit -> [Node] -outputsC c = - outputs (getCircuit c) +outputsC c = outputs (getCircuit c) genPortsAST :: (Circuit -> [Node]) -> Circuit -> [Port] -genPortsAST f c = - port . frNode <$> f c - where - port = Port Wire 4 +genPortsAST f c = port . frNode <$> f c where port = Port Wire 4 -- | Generates the nested expression AST, so that it can then generate the -- assignment expressions. genAssignExpr :: Gate -> [Node] -> Maybe Expr -genAssignExpr _ [] = Nothing -genAssignExpr _ [n] = Just . Id $ frNode n -genAssignExpr g (n:ns) = BinOp wire op <$> genAssignExpr g ns - where - wire = Id $ frNode n - op = fromGate g +genAssignExpr _ [] = Nothing +genAssignExpr _ [n ] = Just . Id $ frNode n +genAssignExpr g (n : ns) = BinOp wire op <$> genAssignExpr g ns + where + wire = Id $ frNode n + op = fromGate g -- | Generate the continuous assignment AST for a particular node. If it does -- not have any nodes that link to it then return 'Nothing', as that means that -- the assignment will just be empty. genContAssignAST :: Circuit -> LNode Gate -> Maybe ModItem genContAssignAST c (n, g) = ModCA . ContAssign name <$> genAssignExpr g nodes - where - gr = getCircuit c - nodes = G.pre gr n - name = frNode n + where + gr = getCircuit c + nodes = G.pre gr n + name = frNode n genAssignAST :: Circuit -> [ModItem] genAssignAST c = catMaybes $ genContAssignAST c <$> nodes - where - gr = getCircuit c - nodes = G.labNodes gr + where + gr = getCircuit c + nodes = G.labNodes gr genModuleDeclAST :: Circuit -> ModDecl genModuleDeclAST c = ModDecl i output ports items - where - i = Identifier "gen_module" - ports = genPortsAST inputsC c - output = [Port Wire 90 "y"] - items = genAssignAST c ++ [ModCA . ContAssign "y" . fold $ portToExpr <$> ports] + where + i = Identifier "gen_module" + ports = genPortsAST inputsC c + output = [Port Wire 90 "y"] + items = + genAssignAST c ++ [ModCA . ContAssign "y" . fold $ portToExpr <$> ports] generateAST :: Circuit -> VerilogSrc generateAST c = VerilogSrc [Description $ genModuleDeclAST c] diff --git a/src/VeriFuzz/Graph/CodeGen.hs b/src/VeriFuzz/Graph/CodeGen.hs index 57e7b2a..3c45a9c 100644 --- a/src/VeriFuzz/Graph/CodeGen.hs +++ b/src/VeriFuzz/Graph/CodeGen.hs @@ -12,13 +12,19 @@ Define the code generation directly from the random DAG. module VeriFuzz.Graph.CodeGen ( generate - ) where + ) +where -import Data.Foldable (fold) -import Data.Graph.Inductive (Graph, LNode, Node, labNodes, pre) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import qualified Data.Text as T +import Data.Foldable ( fold ) +import Data.Graph.Inductive ( Graph + , LNode + , Node + , labNodes + , pre + ) +import Data.Maybe ( fromMaybe ) +import Data.Text ( Text ) +import qualified Data.Text as T import VeriFuzz.Circuit import VeriFuzz.Internal.Gen import VeriFuzz.Internal.Shared @@ -30,30 +36,33 @@ toOperator Xor = " ^ " statList :: Gate -> [Node] -> Maybe Text statList g n = toStr <$> safe tail n - where - toStr = fold . fmap ((<> toOperator g) . fromNode) + where toStr = fold . fmap ((<> toOperator g) . fromNode) lastEl :: [Node] -> Maybe Text lastEl n = fromNode <$> safe head n toStmnt :: (Graph gr) => gr Gate e -> LNode Gate -> Text toStmnt graph (n, g) = - fromMaybe T.empty $ Just " assign " <> Just (fromNode n) - <> Just " = " <> statList g nodeL <> lastEl nodeL <> Just ";\n" - where - nodeL = pre graph n + fromMaybe T.empty + $ Just " assign " + <> Just (fromNode n) + <> Just " = " + <> statList g nodeL + <> lastEl nodeL + <> Just ";\n" + where nodeL = pre graph n generate :: (Graph gr) => gr Gate e -> Text generate graph = "module generated_module(\n" - <> fold (imap " input wire " ",\n" inp) - <> T.intercalate ",\n" (imap " output wire " "" out) - <> ");\n" - <> fold (toStmnt graph <$> labNodes graph) - <> "endmodule\n\nmodule main;\n initial\n begin\n " - <> "$display(\"Hello, world\");\n $finish;\n " - <> "end\nendmodule" - where - inp = inputs graph - out = outputs graph - imap b e = fmap ((\s -> b <> s <> e) . fromNode) + <> fold (imap " input wire " ",\n" inp) + <> T.intercalate ",\n" (imap " output wire " "" out) + <> ");\n" + <> fold (toStmnt graph <$> labNodes graph) + <> "endmodule\n\nmodule main;\n initial\n begin\n " + <> "$display(\"Hello, world\");\n $finish;\n " + <> "end\nendmodule" + where + inp = inputs graph + out = outputs graph + imap b e = fmap ((\s -> b <> s <> e) . fromNode) diff --git a/src/VeriFuzz/Graph/Random.hs b/src/VeriFuzz/Graph/Random.hs index ef0a0c5..5b36c48 100644 --- a/src/VeriFuzz/Graph/Random.hs +++ b/src/VeriFuzz/Graph/Random.hs @@ -12,18 +12,21 @@ Define the random generation for the directed acyclic graph. module VeriFuzz.Graph.Random where -import Data.Graph.Inductive (Context, LEdge) -import qualified Data.Graph.Inductive as G -import Data.Graph.Inductive.PatriciaTree (Gr) -import Data.List (nub) -import Test.QuickCheck (Arbitrary, Gen) -import qualified Test.QuickCheck as QC +import Data.Graph.Inductive ( Context + , LEdge + ) +import qualified Data.Graph.Inductive as G +import Data.Graph.Inductive.PatriciaTree + ( Gr ) +import Data.List ( nub ) +import Test.QuickCheck ( Arbitrary + , Gen + ) +import qualified Test.QuickCheck as QC dupFolder :: (Eq a, Eq b) => Context a b -> [Context a b] -> [Context a b] -dupFolder cont ns = - unique cont : ns - where - unique (a, b, c, d) = (nub a, b, c, nub d) +dupFolder cont ns = unique cont : ns + where unique (a, b, c, d) = (nub a, b, c, nub d) -- | Remove duplicates. rDups :: (Eq a, Eq b) => Gr a b -> Gr a b @@ -33,26 +36,23 @@ rDups g = G.buildGr $ G.ufold dupFolder [] g -- `n` that is passed to it. arbitraryEdge :: (Arbitrary e) => Int -> Gen (LEdge e) arbitraryEdge n = do - x <- with $ \a -> a < n && a > 0 && a /= n-1 + x <- with $ \a -> a < n && a > 0 && a /= n - 1 y <- with $ \a -> x < a && a < n && a > 0 z <- QC.arbitrary return (x, y, z) - where - with = QC.suchThat $ QC.resize n QC.arbitrary + where with = QC.suchThat $ QC.resize n QC.arbitrary -- | Gen instance for a random acyclic DAG. -randomDAG :: (Arbitrary l, Arbitrary e, Eq l, Eq e) - => Gen (Gr l e) -- ^ The generated graph. It uses Arbitrary to +randomDAG :: (Arbitrary l, Arbitrary e, Eq l, Eq e) => Gen (Gr l e) -- ^ The generated graph. It uses Arbitrary to -- generate random instances of each node randomDAG = do list <- QC.infiniteListOf QC.arbitrary - l <- QC.infiniteListOf aE - QC.sized (\n -> return . G.mkGraph (nodes list n) $ take (10*n) l) - where - nodes l n = zip [0..n] $ take n l - aE = QC.sized arbitraryEdge + l <- QC.infiniteListOf aE + QC.sized (\n -> return . G.mkGraph (nodes list n) $ take (10 * n) l) + where + nodes l n = zip [0 .. n] $ take n l + aE = QC.sized arbitraryEdge -- | Generate a random acyclic DAG with an IO instance. -genRandomDAG :: (Arbitrary l, Arbitrary e, Eq l, Eq e) - => IO (Gr l e) +genRandomDAG :: (Arbitrary l, Arbitrary e, Eq l, Eq e) => IO (Gr l e) genRandomDAG = QC.generate randomDAG diff --git a/src/VeriFuzz/Graph/RandomAlt.hs b/src/VeriFuzz/Graph/RandomAlt.hs index 21ef678..c5fad9e 100644 --- a/src/VeriFuzz/Graph/RandomAlt.hs +++ b/src/VeriFuzz/Graph/RandomAlt.hs @@ -12,17 +12,18 @@ Define the random generation for the directed acyclic graph. module VeriFuzz.Graph.RandomAlt where -import qualified Data.Graph.Inductive.Arbitrary as G -import Data.Graph.Inductive.PatriciaTree (Gr) -import Test.QuickCheck (Arbitrary, Gen) -import qualified Test.QuickCheck as QC +import qualified Data.Graph.Inductive.Arbitrary + as G +import Data.Graph.Inductive.PatriciaTree + ( Gr ) +import Test.QuickCheck ( Arbitrary + , Gen + ) +import qualified Test.QuickCheck as QC -randomDAG :: (Arbitrary l, Arbitrary e) - => Gen (Gr l e) -randomDAG = - G.looplessGraph <$> QC.arbitrary +randomDAG :: (Arbitrary l, Arbitrary e) => Gen (Gr l e) +randomDAG = G.looplessGraph <$> QC.arbitrary -- | Generate a random acyclic DAG with an IO instance. -genRandomDAG :: (Arbitrary l, Arbitrary e) - => IO (Gr l e) +genRandomDAG :: (Arbitrary l, Arbitrary e) => IO (Gr l e) genRandomDAG = QC.generate randomDAG -- cgit