From 8ea1583f4b0f63a5c2b0d46594eac3955297e65c Mon Sep 17 00:00:00 2001
From: Yann Herklotz <ymherklotz@gmail.com>
Date: Sat, 22 Dec 2018 14:30:08 +0000
Subject: [Fix #2] Add generation of AST from Circuit

---
 src/Test/VeriFuzz/Circuit.hs      |  4 +++-
 src/Test/VeriFuzz/Graph/ASTGen.hs | 29 +++++++++++++++++++++--------
 src/Test/VeriFuzz/Internal/Gen.hs | 17 ++++++++---------
 src/Test/VeriFuzz/VerilogAST.hs   |  2 +-
 4 files changed, 33 insertions(+), 19 deletions(-)

(limited to 'src/Test')

diff --git a/src/Test/VeriFuzz/Circuit.hs b/src/Test/VeriFuzz/Circuit.hs
index d934a3d..dc0ec81 100644
--- a/src/Test/VeriFuzz/Circuit.hs
+++ b/src/Test/VeriFuzz/Circuit.hs
@@ -12,7 +12,7 @@ Definition of the circuit graph.
 
 module Test.VeriFuzz.Circuit where
 
-import           Data.Graph.Inductive
+import           Data.Graph.Inductive (Gr, LNode)
 import           System.Random
 import           Test.QuickCheck
 
@@ -25,6 +25,8 @@ data Gate = And
 -- | Newtype for the Circuit which implements a Graph from fgl.
 newtype Circuit = Circuit { getCircuit :: Gr Gate () }
 
+newtype CNode = CNode { getCNode :: LNode Gate }
+
 instance Random Gate where
   randomR (a, b) g =
     case randomR (fromEnum a, fromEnum b) g of
diff --git a/src/Test/VeriFuzz/Graph/ASTGen.hs b/src/Test/VeriFuzz/Graph/ASTGen.hs
index fffb3f8..97b6c1c 100644
--- a/src/Test/VeriFuzz/Graph/ASTGen.hs
+++ b/src/Test/VeriFuzz/Graph/ASTGen.hs
@@ -14,16 +14,20 @@ Generates the AST from the graph directly.
 
 module Test.VeriFuzz.Graph.ASTGen where
 
-import qualified Data.Graph.Inductive       (LNode, Node)
+import           Data.Graph.Inductive       (LNode, Node)
 import qualified Data.Graph.Inductive       as G
+import           Data.Maybe                 (catMaybes)
 import qualified Data.Text                  as T
 import           Test.VeriFuzz.Circuit
 import           Test.VeriFuzz.Internal.Gen
 import           Test.VeriFuzz.VerilogAST
 
+-- | Converts a 'Node' to an 'Identifier'.
 frNode :: Node -> Identifier
 frNode = Identifier . fromNode
 
+-- | Converts a 'Gate' to a 'BinaryOperator', which should be a bijective
+-- mapping.
 fromGate :: Gate -> BinaryOperator
 fromGate And = BinAnd
 fromGate Or  = BinOr
@@ -31,18 +35,27 @@ fromGate Xor = BinXor
 
 genPortsAST :: Circuit -> [Port]
 genPortsAST c =
-  ((Port Input . frNode) <$> inp) ++ ((Port Output) . frNode <$> out)
+  (Port Input . frNode <$> inp) ++ (Port Output . frNode <$> out)
   where
     inp = inputs graph
     out = outputs graph
     graph = getCircuit c
 
-genAssignExpr :: Gate -> [Node] -> Expression
-genAssignExpr g ns = (error "FIXME: Not yet done")
+-- | Generates the nested expression AST, so that it can then generate the
+-- assignment expressions.
+genAssignExpr :: Gate -> [Node] -> Maybe Expression
+genAssignExpr g [] = Nothing
+genAssignExpr g (n:[]) = Just . PrimExpr . PrimId $ frNode n
+genAssignExpr g (n:ns) = OpExpr wire op <$> genAssignExpr g ns
+  where
+    wire = PrimExpr . PrimId $ frNode n
+    op = fromGate g
 
-genContAssignAST :: Circuit -> LNode Gate -> ContAssign
-genContAssignAST c (n, g) =
-  ContAssign name $ genAssignExpr g nodes
+-- | 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 ContAssign
+genContAssignAST c (n, g) = ContAssign name <$> genAssignExpr g nodes
   where
     gr = getCircuit c
     nodes = G.pre gr n
@@ -50,7 +63,7 @@ genContAssignAST c (n, g) =
 
 genAssignAST :: Circuit -> [ContAssign]
 genAssignAST c =
-  nodes
+  catMaybes $ genContAssignAST c <$> nodes
   where
     gr = getCircuit c
     nodes = G.labNodes gr
diff --git a/src/Test/VeriFuzz/Internal/Gen.hs b/src/Test/VeriFuzz/Internal/Gen.hs
index a8bd57a..2eba531 100644
--- a/src/Test/VeriFuzz/Internal/Gen.hs
+++ b/src/Test/VeriFuzz/Internal/Gen.hs
@@ -12,23 +12,22 @@ Internal helpers for generation.
 
 module Test.VeriFuzz.Internal.Gen where
 
-import           Data.Graph.Inductive     (Graph, Node)
-import qualified Data.Graph.Inductive     as G
-import qualified Data.Text                as T
-import           Test.VeriFuzz.VerilogAST
+import           Data.Graph.Inductive (Graph, Node)
+import qualified Data.Graph.Inductive as G
+import qualified Data.Text            as T
 
 fromNode :: Node -> T.Text
-fromNode node = Identifier . T.pack $ "w" <> show node
+fromNode node = T.pack $ "w" <> show node
 
 filterGr :: (Graph gr) => gr n e -> (Node -> Bool) -> [Node]
 filterGr graph f =
   filter f $ G.nodes graph
 
-only :: (Graph gr) => (gr n e -> Node -> Int) -> (gr n e -> Node -> Int) -> gr n e -> Node -> [Node]
-only fun1 fun2 n = fun1 graph n == 0 && fun2 graph n /= 0
+only :: (Graph gr) => gr n e -> (gr n e -> Node -> Int) -> (gr n e -> Node -> Int) -> Node -> Bool
+only graph fun1 fun2 n = fun1 graph n == 0 && fun2 graph n /= 0
 
 inputs :: (Graph gr) => gr n e -> [Node]
-inputs graph = filterGr graph $ only G.indeg G.outdeg
+inputs graph = filterGr graph $ only graph G.indeg G.outdeg
 
 outputs :: (Graph gr) => gr n e -> [Node]
-outputs graph = filterGr graph $ only G.outdeg G.indeg
+outputs graph = filterGr graph $ only graph G.outdeg G.indeg
diff --git a/src/Test/VeriFuzz/VerilogAST.hs b/src/Test/VeriFuzz/VerilogAST.hs
index fc3c07b..cf470a5 100644
--- a/src/Test/VeriFuzz/VerilogAST.hs
+++ b/src/Test/VeriFuzz/VerilogAST.hs
@@ -104,7 +104,7 @@ instance QC.Arbitrary Identifier where
     (QC.shuffle (['a'..'z'] <> ['A'..'Z']) >>= QC.sublistOf)
 
 instance QC.Arbitrary Number where
-  arbitrary = Number <$> (suchThat QC.arbitrary (>0)) <*> QC.arbitrary
+  arbitrary = Number <$> suchThat QC.arbitrary (>0) <*> QC.arbitrary
 
 instance QC.Arbitrary BinaryOperator where
   arbitrary = QC.elements [BinAnd, BinOr, BinXor]
-- 
cgit