aboutsummaryrefslogtreecommitdiffstats
path: root/src/VeriFuzz/Circuit/CodeGen.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/VeriFuzz/Circuit/CodeGen.hs')
-rw-r--r--src/VeriFuzz/Circuit/CodeGen.hs62
1 files changed, 62 insertions, 0 deletions
diff --git a/src/VeriFuzz/Circuit/CodeGen.hs b/src/VeriFuzz/Circuit/CodeGen.hs
new file mode 100644
index 0000000..91da48c
--- /dev/null
+++ b/src/VeriFuzz/Circuit/CodeGen.hs
@@ -0,0 +1,62 @@
+{-|
+Module : VeriFuzz.Circuit.Random
+Description : Code generation directly from DAG.
+Copyright : (c) 2018-2019, Yann Herklotz Grave
+License : BSD-3
+Maintainer : ymherklotz [at] gmail [dot] com
+Stability : experimental
+Portability : POSIX
+
+Define the code generation directly from the random DAG.
+-}
+
+module VeriFuzz.Circuit.CodeGen
+ ( generate
+ )
+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 VeriFuzz.Circuit
+import VeriFuzz.Internal.Gen
+import VeriFuzz.Internal.Shared
+
+toOperator :: Gate -> Text
+toOperator And = " & "
+toOperator Or = " | "
+toOperator Xor = " ^ "
+
+statList :: Gate -> [Node] -> Maybe Text
+statList g n = toStr <$> safe tail n 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
+
+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)