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 -}
121 , tReceivedValues :: [(v, [x])]
122 -- ^ values from input interface for testing purpose
123 , tSynthesisMethod :: SynthesisMethod tag v x t
124 -- ^ synthesis method
125 , tLibPath :: String
126 -- ^ IP-core library directory
127 , tPath :: String
128 -- ^ output directory, where CAD create project directory with 'tName' name
129 , tTemplates :: [FilePath]
130 , tSimulationCycleN :: Int
131 -- ^ number of simulation and testbench cycles
132 , tSourceCodeType :: FrontendType
133 -- ^ source code format type
134 }
135
136 instance SynthesisMethodConstraints tag v x t => Default (TargetSynthesis tag v x t) where
137 def =
138 TargetSynthesis
139 { tName = undefined
140 , tMicroArch = undefined
141 , tSourceCode = Nothing
142 , tDFG = undefined
143 , tReceivedValues = def
144 , tSynthesisMethod = stateOfTheArtSynthesisIO def
145 , tLibPath = "hdl"
146 , tTemplates = defProjectTemplates
147 , tPath = joinPath ["gen"]
148 , tSimulationCycleN = 5
149 , tSourceCodeType = Lua
150 }
151
152 instance (UnitTag tag, VarValTime v x t) => ProcessorUnit (TargetSynthesis tag v x t) v x t where
153 tryBind _ _ = error "Not Implemented"
154 process TargetSynthesis{tMicroArch} = process tMicroArch
155 parallelismType TargetSynthesis{tMicroArch} = parallelismType tMicroArch
156
157 runTargetSynthesis leaf = do
158 (_root, prj) <- synthesizeTargetSystem leaf
159 traverse runTestbench prj
160
161 synthesizeTargetSystem ::
162 (UnitTag tag, VarValTime v x t) =>
163 TargetSynthesis tag v x t ->
164 IO
165 ( DefTree tag v x t
166 , Either
167 String
168 (Project (BusNetwork tag v x t) v x)
169 )
170 synthesizeTargetSystem
171 TargetSynthesis
172 { tName
173 , tMicroArch
174 , tSourceCode
175 , tDFG
176 , tReceivedValues
177 , tSynthesisMethod
178 , tLibPath
179 , tPath
180 , tTemplates
181 , tSimulationCycleN
182 , tSourceCodeType
183 } = do
184 -- TODO: check that tName is a valid verilog module name
185 when (' ' `elem` tName) $ error "TargetSynthesis name contain wrong symbols"
186 tDFG' <- maybe (return tDFG) translateToIntermediate tSourceCode
187 root <- synthesisTreeRootIO (mkModelWithOneNetwork tMicroArch tDFG')
188 prj <-
189 synthesise root >>= \case
190 Left err -> return $ Left err
191 Right leafNode -> do
192 Right <$> writeProject' leafNode
193 return (root, prj)
194 where
195 translateToIntermediate src = do
196 infoM "NITTA" "Lua transpiler..."
197 let tmp = frDataFlow $ translate tSourceCodeType src
198 noticeM "NITTA" "Lua transpiler...ok"
199 return tmp
200
201 synthesise root = do
202 infoM "NITTA" "synthesis process..."
203 node <- tSynthesisMethod root
204 case (isComplete node, isLeaf node) of
205 (True, True) -> do
206 noticeM "NITTA" "synthesis process...ok"
207 return $ Right node
208 (False, True) -> do
209 let msg = "synthesis process...fail; is not complete"
210 noticeM "NITTA" msg
211 return $ Left msg
212 (True, False) -> do
213 let msg = "synthesis process...fail; is not leaf"
214 noticeM "NITTA" msg
215 return $ Left msg
216 (False, False) -> do
217 let msg = "synthesis process...fail; is not complete; is not leaf"
218 noticeM "NITTA" msg
219 return $ Left msg
220
221 writeProject' leaf = do
222 pInProjectNittaPath <- either (error . T.unpack) id <$> collectNittaPath tTemplates
223 pwd <- getCurrentDirectory
224 let prj =
225 Project
226 { pName = T.pack tName
227 , pLibPath = tLibPath
228 , pTargetProjectPath = tPath </> tName
229 , pAbsTargetProjectPath = pwd </> tPath </> tName
230 , pInProjectNittaPath
231 , pAbsNittaPath = pwd </> tPath </> tName </> pInProjectNittaPath
232 , pUnit = targetUnit leaf
233 , pUnitEnv = bnEnv $ targetUnit leaf
234 , -- because application algorithm can be refactored we need to use
235 -- synthesised version
236 pTestCntx = simulateDataFlowGraph tSimulationCycleN def tReceivedValues $ targetDFG leaf
237 , pTemplates = tTemplates
238 }
239 writeProject prj
240 return prj
241
242 {- | Make a model of NITTA process with one network and a specific algorithm. All
243 functions are already bound to the network.
244 -}
245 mkModelWithOneNetwork arch dfg =
246 TargetSystem
247 { mUnit = foldl (flip bind) arch $ functions dfg
248 , mDataFlowGraph = dfg
249 }