never executed always true always false
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2
3 {- |
4 Module : NITTA.Synthesis
5 Description : Entry point for synthesis process and target system generation.
6 Copyright : (c) Aleksandr Penskoi, 2021
7 License : BSD3
8 Maintainer : aleksandr.penskoi@gmail.com
9 Stability : experimental
10
11 TargetSynthesis is an entry point for synthesis process. TargetSynthesis flow shown on fig.
12
13 @
14 ====================================================================================================================
15 Prepare
16 NITTA.Synthesis:TargetSynthesis NITTA.Project...
17 # tName NITTA.Frontends
18 # tMicroArch -----------------------------\
19 # tSourceCode -+ | /--+-- mkModelWithOneNetwork
20 | | | |
21 *<-translate | | |
22 | | | v NITTA.Model:TargetSystem----------\
23 # tDFG <-------+ +--------*--------> # mUnit | | NITTA.Model...
24 | | | | /-----------\
25 | v | | | Target |
26 +----------------------------------------*-----------> # mDataFlowGraph | \-----+ System |
27 | | Imitation |
28 # tReceivedValues | | Model |
29 # tVerbose | \-----------/
30 # tSynthesisMethod ----------------------------------\ |
31 | |
32 | |
33 ===================================================================================================================
34 | | Synthesis process
35 NITTA.Synthesis.Types:Tree | | NITTA.Synthesis.Types
36 # sID | | NITTA.Synthesis.Method
37 # sState <------------------------------------------------------------+
38 # sDecision |
39 # option |
40 # decision *<-- search for best synthesis path
41 # metrics |
42 # score v
43 # sSubForestVar ------------------------->// * // -----\
44 |
45 v
46 NITTA.Synthesis.Types:Tree
47 # sState
48 # sTarget
49 /------------------------------- # mUnit
50 | /---------------------- # mDataFlowGraph
51 | | # ...
52 | | # ...
53 | |
54 ===================================================================================================================
55 | | Target project generation
56 NITTA.Project.Types:Project | | NITTA.Project....
57 | # pName <--------- $tName | |
58 | # pLibPath | +<----- $tReceivedValues
59 | # pTargetProjectPath | |
60 | # pModel<----------------------/ *<----- functional simulation (FIXME)
61 | |
62 | # pTestCntx <---------------------------/
63 |
64 |
65 *<---------- $writeProject
66 | # TargetSystem
67 | # hardware
68 | # software
69 | # TestBench
70 | # Templates
71 |
72 \---> filesystem
73 @
74 -}
75 module NITTA.Synthesis (
76 module NITTA.Synthesis.Explore,
77 module NITTA.Synthesis.Method,
78 module NITTA.Synthesis.Steps,
79 module NITTA.Synthesis.Types,
80 mkModelWithOneNetwork,
81 TargetSynthesis (..),
82 runTargetSynthesis,
83 synthesizeTargetSystem,
84 ) where
85
86 import Control.Monad (when)
87 import Data.Default as D
88 import Data.Text (Text)
89 import Data.Text qualified as T
90 import NITTA.Frontends
91 import NITTA.Intermediate.DataFlow
92 import NITTA.Intermediate.Simulation
93 import NITTA.Intermediate.Types
94 import NITTA.Model.Networks.Bus
95 import NITTA.Model.ProcessorUnits.Types
96 import NITTA.Model.TargetSystem
97 import NITTA.Model.Time
98 import NITTA.Project (Project (..), collectNittaPath, defProjectTemplates, runTestbench, writeProject)
99 import NITTA.Synthesis.Explore
100 import NITTA.Synthesis.Method
101 import NITTA.Synthesis.Steps
102 import NITTA.Synthesis.Types
103 import System.Directory
104 import System.FilePath
105 import System.Log.Logger
106
107 {- | Description of synthesis task. Applicable for target system synthesis and
108 testing purpose.
109 -}
110 data TargetSynthesis tag v x t = TargetSynthesis
111 { tName :: String
112 -- ^ target name, used for top level module name and project path
113 , tMicroArch :: BusNetwork tag v x t
114 -- ^ composition of processor units, IO ports and its interconnect
115 , tSourceCode :: Maybe Text
116 -- ^ optional application source code (lua)
117 , tDFG :: DataFlowGraph v x
118 -- ^ algorithm in intermediate data flow graph representation (if
119 -- tSourceCode present will be overwritten)
120 , tReceivedValues :: [(v, [x])]
121 -- ^ values from input interface for testing purpose
122 , tSynthesisMethod :: SynthesisMethod tag v x t
123 -- ^ synthesis method
124 , tLibPath :: String
125 -- ^ IP-core library directory
126 , tPath :: String
127 -- ^ output directory, where CAD create project directory with 'tName' name
128 , tTemplates :: [FilePath]
129 , tSimulationCycleN :: Int
130 -- ^ number of simulation and testbench cycles
131 , tSourceCodeType :: FrontendType
132 -- ^ source code format type
133 }
134
135 instance SynthesisMethodConstraints tag v x t => Default (TargetSynthesis tag v x t) where
136 def =
137 TargetSynthesis
138 { tName = undefined
139 , tMicroArch = undefined
140 , tSourceCode = Nothing
141 , tDFG = undefined
142 , tReceivedValues = def
143 , tSynthesisMethod = stateOfTheArtSynthesisIO def
144 , tLibPath = "hdl"
145 , tTemplates = defProjectTemplates
146 , tPath = joinPath ["gen"]
147 , tSimulationCycleN = 5
148 , tSourceCodeType = Lua
149 }
150
151 instance (UnitTag tag, VarValTime v x t) => ProcessorUnit (TargetSynthesis tag v x t) v x t where
152 tryBind _ _ = error "Not Implemented"
153 process TargetSynthesis{tMicroArch} = process tMicroArch
154 parallelismType TargetSynthesis{tMicroArch} = parallelismType tMicroArch
155
156 runTargetSynthesis leaf = do
157 (_root, prj) <- synthesizeTargetSystem leaf
158 traverse runTestbench prj
159
160 synthesizeTargetSystem ::
161 (UnitTag tag, VarValTime v x t) =>
162 TargetSynthesis tag v x t ->
163 IO
164 ( DefTree tag v x t
165 , Either
166 String
167 (Project (BusNetwork tag v x t) v x)
168 )
169 synthesizeTargetSystem
170 TargetSynthesis
171 { tName
172 , tMicroArch
173 , tSourceCode
174 , tDFG
175 , tReceivedValues
176 , tSynthesisMethod
177 , tLibPath
178 , tPath
179 , tTemplates
180 , tSimulationCycleN
181 , tSourceCodeType
182 } = do
183 -- TODO: check that tName is a valid verilog module name
184 when (' ' `elem` tName) $ error "TargetSynthesis name contain wrong symbols"
185 tDFG' <- maybe (return tDFG) translateToIntermediate tSourceCode
186 root <- synthesisTreeRootIO (mkModelWithOneNetwork tMicroArch tDFG')
187 prj <-
188 synthesise root >>= \case
189 Left err -> return $ Left err
190 Right leafNode -> do
191 Right <$> writeProject' leafNode
192 return (root, prj)
193 where
194 translateToIntermediate src = do
195 infoM "NITTA" "Lua transpiler..."
196 let tmp = frDataFlow $ translate tSourceCodeType src
197 noticeM "NITTA" "Lua transpiler...ok"
198 return tmp
199
200 synthesise root = do
201 infoM "NITTA" "synthesis process..."
202 node <- tSynthesisMethod root
203 case (isComplete node, isLeaf node) of
204 (True, True) -> do
205 noticeM "NITTA" "synthesis process...ok"
206 return $ Right node
207 (False, True) -> do
208 let msg = "synthesis process...fail; is not complete"
209 noticeM "NITTA" msg
210 return $ Left msg
211 (True, False) -> do
212 let msg = "synthesis process...fail; is not leaf"
213 noticeM "NITTA" msg
214 return $ Left msg
215 (False, False) -> do
216 let msg = "synthesis process...fail; is not complete; is not leaf"
217 noticeM "NITTA" msg
218 return $ Left msg
219
220 writeProject' leaf = do
221 pInProjectNittaPath <- either (error . T.unpack) id <$> collectNittaPath tTemplates
222 pwd <- getCurrentDirectory
223 let prj =
224 Project
225 { pName = T.pack tName
226 , pLibPath = tLibPath
227 , pTargetProjectPath = tPath </> tName
228 , pAbsTargetProjectPath = pwd </> tPath </> tName
229 , pInProjectNittaPath
230 , pAbsNittaPath = pwd </> tPath </> tName </> pInProjectNittaPath
231 , pUnit = targetUnit leaf
232 , pUnitEnv = bnEnv $ targetUnit leaf
233 , -- because application algorithm can be refactored we need to use
234 -- synthesised version
235 pTestCntx = simulateDataFlowGraph tSimulationCycleN def tReceivedValues $ targetDFG leaf
236 , pTemplates = tTemplates
237 }
238 writeProject prj
239 return prj
240
241 {- | Make a model of NITTA process with one network and a specific algorithm. All
242 functions are already bound to the network.
243 -}
244 mkModelWithOneNetwork arch dfg =
245 TargetSystem
246 { mUnit = foldl (flip bind) arch $ functions dfg
247 , mDataFlowGraph = dfg
248 }