compile.hs (13654B)
1 module Compile where 2 3 import Esterel 4 import Lustre 5 6 import qualified Data.Set as Set 7 8 import Data.List 9 10 -- compile a module 11 compile (Module name inputs outputs x) = 12 let Annotated _ ((i, o), n) = x in 13 reverse ( 14 -- generate the root node 15 Node name x 16 (map toISignal inputs) 17 (map toOSignal outputs) 18 -- create local variables for undeclared input signals 19 (toIControl ++ [toOControl] 20 ++ map toISignal (toList $ Set.difference i (Set.fromList inputs))) 21 ( 22 -- input control is passed at the first tick and isn't passed afterwards 23 [Decl [toIControlO] (Binop Fby Lustre.True Lustre.False)] 24 -- input suspend is initially false 25 ++ [Decl [toISuspendO] Lustre.False] 26 -- input reset is initially false 27 ++ [Decl [toIResetO] Lustre.False] 28 -- call the node for the root AST element 29 ++ [Decl (toOArgs o) $ Call (toNode n) $ toIArgs i] 30 -- set unused output signals to false 31 ++ map (\x -> Decl [x] Lustre.False) 32 (toOArgsS $ Set.difference (Set.fromList outputs) o) 33 -- initialize undeclared input signals to false 34 ++ map (\x -> Decl [toISignal x] $ Var $ toOSignal x) 35 (toList $ Set.difference i $ Set.fromList inputs) 36 ) 37 :compileExp x) 38 39 where 40 41 -- functions to generate argument names 42 -- most of these functions exist with a trailing P to add a prefix to the name 43 44 -- name of an argument for an input signal (ie. received by the node) 45 toISignalP pref sig = pref ++ "input_signal_" ++ sig 46 toISignal = toISignalP "" 47 -- name of an argument for an output signal (ie. produced by the node) 48 toOSignalP pref sig = pref ++ "output_signal_" ++ sig 49 toOSignal = toOSignalP "" 50 -- name of the input control 51 toIControlOP pref = pref ++ "input_control" 52 toIControlO = toIControlOP "" 53 -- name of the raw input control (ie. before using suspend and reset) 54 toIControlNROP pref = pref ++ "input_raw_control" 55 -- name of the suspend wire 56 toISuspendOP pref = pref ++ "input_suspend" 57 toISuspendO = toISuspendOP "" 58 -- name of the reset wire 59 toIResetOP pref = pref ++ "input_reset" 60 toIResetO = toIResetOP "" 61 -- combine the input control, reset and suspend 62 toIControlP pref = toIControlMP pref pref pref 63 toIControlMP pref1 pref2 pref3 = 64 toIControlOP pref1:toIResetOP pref2:[toISuspendOP pref3] 65 toIControl = toIControlP "" 66 -- name of the output control 67 toOControlP pref = pref ++ "output_control" 68 toOControl = toOControlP "" 69 -- prepare the input signals 70 toIArgsSP pref sigs = map (toISignalP pref) $ toList sigs 71 -- prepare the output signals 72 toOArgsSP pref sigs = map (toOSignalP pref) $ toList sigs 73 toOArgsS = toOArgsSP "" 74 -- combine the input control, reset, suspend, and input signals 75 toIArgsP pref = toIArgsMP pref pref pref pref 76 toIArgsMP pref1 pref2 pref3 pref4 sigs = 77 toIControlMP pref1 pref2 pref3 ++ toIArgsSP pref4 sigs 78 toIArgs = toIArgsP "" 79 -- combine the output control and output signals 80 toOArgsP pref sigs = toOControlP pref:toOArgsSP pref sigs 81 toOArgs = toOArgsP "" 82 -- clumsy hack to combine the raw input control, reset and suspend 83 toIControlNRP pref = [toIControlNROP pref, toIResetOP pref, toISuspendOP pref] 84 toIArgsNRP pref sigs = toIControlNRP pref ++ toIArgsSP pref sigs 85 toIArgsNR = toIArgsNRP "" 86 87 -- local variables for all nodes 88 defaultLocal = [toIControlO, "irsuspended"] 89 90 -- declarations for all nodes 91 -- these declarations set irsuspended and the input control taking into 92 -- account input_suspend, input_raw_control, and input_reset 93 defaultDecls = [ 94 Decl ["irsuspended"] $ Binop Fby Lustre.False $ 95 Binop And (Unop Not $ Var toIResetO) $ 96 Binop Or (Binop And (Var toISuspendO) (Var $ toIControlNROP "")) $ 97 Binop And (Unop Pre $ Var "irsuspended") (Var toISuspendO), 98 Decl [toIControlO] $ 99 Binop And (Unop Not $ Var toIResetO) $ 100 Binop And (Unop Not $ Var toISuspendO) $ 101 Binop Or 102 (Var $ toIControlNROP "") (Unop Pre $ Var "irsuspended")] 103 104 -- convert a set (used in the AST annotation for input and output signals) to 105 -- a list (used for the nodes), ensuring that the order is reasonable 106 toList = Data.List.sort . Set.toList 107 108 -- convert the unique node identifier to a lustre node name 109 toNode i = name ++ show i 110 111 -- compute the or of one or two signals 112 orSignal l = case l of 113 [x] -> x 114 [x,y] -> Binop Or x y 115 _ -> error "assertion failed" 116 117 -- define output signals (without prefix) of s as the or of output signals in 118 -- s1 with prefix p1 and s2 with prefix p2 119 orSignals :: String -> Set.Set Sig -> String -> Set.Set Sig -> [Decl] 120 orSignals p1 s1 p2 s2 = 121 map (\s -> Decl [toOSignal s] $ 122 orSignal ([Var $ toOSignalP p1 s | s `Set.member` s1] 123 ++ [Var $ toOSignalP p2 s | s `Set.member` s2])) $ 124 toList $ Set.union s1 s2 125 126 -- compile an AST node to a list of local variables, a list of declarations 127 -- and a list of child nodes 128 -- this is where the actual work is performed 129 compileDecls (Annotated e ((_, o), _)) = 130 case e of 131 132 Esterel.Nothing -> 133 (defaultLocal, 134 defaultDecls 135 -- output control is input control 136 ++ [Decl [toOControl] $ Var toIControlO], 137 []) 138 139 Esterel.Pause -> 140 (defaultLocal, 141 defaultDecls 142 -- output control is false -> pre(input control) 143 ++ [Decl [toOControl] (Binop Fby Lustre.False $ 144 Unop Pre $ Var toIControlO)], 145 []) 146 147 Esterel.Emit s -> 148 (defaultLocal, 149 defaultDecls 150 -- output control is input control 151 ++ [Decl [toOControl] $ Var toIControlO] 152 -- output signal is input control 153 ++ [Decl [toOSignal s] (Var toIControlO)], 154 []) 155 156 Esterel.Exit t -> 157 (defaultLocal, 158 defaultDecls 159 -- output control is false 160 ++ [Decl [toOControl] Lustre.False] 161 -- output trap (aka. signal) is input control 162 ++ [Decl [toOSignal t] $ Var toIControlO], 163 []) 164 165 Esterel.Signal s e@(Annotated _ ((i', o'), n')) -> 166 let others = compileExp e in 167 let in_o = s `Set.member` o' in 168 let in_i = s `Set.member` i' in 169 (defaultLocal ++ [toOSignal s | in_o] ++ [toISignal s | in_i], 170 defaultDecls 171 -- nothing to do except creating local variables to store s without 172 -- propagating it, and set it to false without receiving it 173 ++ [Decl (toOArgs o') $ Call (toNode n') (toIArgs i')] 174 ++ [Decl [toISignal s] Lustre.False | in_i], 175 others) 176 177 Esterel.Suspend e@(Annotated _ ((i', o'), n')) s -> 178 let others = compileExp e in 179 (defaultLocal ++ [toISuspendOP "sub"], 180 defaultDecls 181 -- nothing to do except pass a modified suspend which takes our own 182 -- suspend and signal s into account 183 ++ [Decl (toOArgs o') $ 184 Call (toNode n') $ 185 toIArgsMP "" "" "sub" "" i'] 186 ++ [Decl [toISuspendOP "sub"] $ 187 Binop Fby Lustre.False $ 188 Binop Or (Var toISuspendO) (Var $ toISignal s)], 189 others) 190 191 Esterel.Trap t e@(Annotated _ ((i', o'), n')) -> 192 let others = compileExp e in 193 let in_o = t `Set.member` o' in 194 let in_i = t `Set.member` i' in 195 (defaultLocal 196 ++ [toIResetOP "sub"] 197 ++ [toOSignal t | in_o] ++ [toISignal t | in_i] 198 ++ [toOControlP "sub"], 199 defaultDecls 200 -- call the child node with a modified reset and produce a modified 201 -- output control 202 ++ [Decl (toOControlP "sub":toOArgsSP "" o') $ 203 Call (toNode n') $ 204 toIArgsMP "" "sub" "" "" i'] 205 -- initialize variables if needed 206 ++ [Decl [toISignal t] Lustre.False | in_i] 207 -- we yield output control either when doing so naturally or when t is 208 -- raised 209 ++ [Decl [toOControl] $ 210 Binop Or (Var $ toOControlP "sub") (Var $ toOSignal t)] 211 -- we pass reset to our child nodes either when we get it from our 212 -- father or when t was raised 213 ++ [Decl [toIResetOP "sub"] $ 214 Binop Or (Var toIResetO) (Unop Pre $ 215 Var $ toOSignal t)], 216 others) 217 218 Esterel.Loop e@(Annotated _ ((i', o'), n')) -> 219 let others = compileExp e in 220 (defaultLocal ++ [toIControlOP "sub"] ++ [toOControlP "sub"], 221 defaultDecls 222 -- we never yield control 223 ++ [Decl [toOControl] Lustre.False] 224 -- the input control of the loop body either when we get input 225 -- control or when the loop body yields output control 226 ++ [Decl [toIControlOP "sub"] $ 227 Binop Or (Var toIControlO) (Var $ toOControlP "sub")] 228 -- perform the call 229 ++ [Decl (toOControlP "sub":toOArgsSP "" o') $ 230 Call (toNode n') $ 231 toIArgsMP "sub" "" "" "" i'], 232 others) 233 234 Esterel.Seq 235 e1@(Annotated _ ((i1', o1'), n1')) 236 e2@(Annotated _ ((i2', o2'), n2')) -> 237 let others1 = compileExp e1 in 238 let others2 = compileExp e2 in 239 (defaultLocal 240 ++ [toOControlP "sub1"] 241 ++ toIControlP "sub2" 242 ++ toOArgsSP "sub1" o1' 243 ++ toOArgsSP "sub2" o2', 244 defaultDecls 245 -- call the first child 246 ++ [Decl (toOArgsP "sub1" o1') $ 247 Call (toNode n1') (toIArgs i1')] 248 -- call the second child 249 ++ [Decl (toOControl:toOArgsSP "sub2" o2') $ 250 Call (toNode n2') $ 251 toIArgsMP "sub2" "" "" "" i2'] 252 -- input control of second node is output control of first node 253 ++ [Decl [toIControlOP "sub2"] $ Var $ toOControlP "sub1"] 254 -- signals are raised if one of the children raised them 255 ++ orSignals "sub1" o1' "sub2" o2', 256 others1 ++ others2) 257 258 Esterel.Present s 259 e1@(Annotated _ ((i1', o1'), n1')) 260 e2@(Annotated _ ((i2', o2'), n2')) -> 261 let others1 = compileExp e1 in 262 let others2 = compileExp e2 in 263 let subcall input output node pref = 264 [Decl (toOArgsP pref output) $ 265 Call (toNode node) $ 266 toIArgsMP pref "" "" "" input] in 267 (defaultLocal 268 ++ [toIControlOP "sub1", toIControlOP "sub2"] 269 ++ toOArgsP "sub1" o1' 270 ++ toOArgsP "sub2" o2', 271 defaultDecls 272 -- control should pass to the then branch 273 ++ [Decl [toIControlOP "sub1"] $ 274 Binop And (Var toIControlO) (Var $ toISignal s)] 275 -- control should pass to the else branch 276 ++ [Decl [toIControlOP "sub2"] $ 277 Binop And (Var toIControlO) (Unop Not $ Var $ toISignal s)] 278 -- we yield control when either branch yields control 279 ++ [Decl [toOControl] $ 280 Binop Or (Var $ toOControlP "sub1") (Var $ toOControlP "sub2")] 281 -- call for the then branch 282 ++ subcall i1' o1' n1' "sub1" 283 -- call for the else branch 284 ++ subcall i2' o2' n2' "sub2" 285 -- signals are raised if one of the branches raised them 286 ++ orSignals "sub1" o1' "sub2" o2', 287 others1 ++ others2) 288 289 Esterel.Par 290 e1@(Annotated _ ((i1', o1'), n1')) 291 e2@(Annotated _ ((i2', o2'), n2')) -> 292 let others1 = compileExp e1 in 293 let others2 = compileExp e2 in 294 let subcall input output node pref = 295 [Decl (toOArgsP pref output) $ 296 Call (toNode node) (toIControl ++ map 297 (\x -> "combined_signal_" ++ x) 298 (toList input))] in 299 let termination pref1 pref2 = 300 [Decl [pref1 ++ "_finished"] $ 301 Binop Or (Var $ toOControlP pref2) $ 302 Binop Fby Lustre.False $ 303 Unop Pre $ 304 Binop And (Var $ pref1 ++ "_finished") $ 305 Unop Not $ Var $ pref2 ++ "_finished"] in 306 -- we declare local variables for each signal and to indicate whether the 307 -- branches have finished, and combined_signals variable to allow the two 308 -- branches to communicate 309 (defaultLocal 310 ++ ("sub1_finished":"sub2_finished":( 311 toOArgsP "sub1" o1' ++ toOArgsP "sub2" o2') 312 ++ map (\x -> "combined_signal_" ++ x) 313 (toList $ i1' `Set.union` i2')), 314 defaultDecls 315 -- store the termination of the first branch 316 ++ termination "sub1" "sub2" 317 -- store the termination of the second branch 318 ++ termination "sub2" "sub1" 319 -- we yield control if both branches have yielded control 320 ++ [Decl [toOControl] $ 321 Binop And (Var "sub1_finished") $ 322 Var "sub2_finished"] 323 -- call the first branch 324 ++ subcall i1' o1' n1' "sub1" 325 -- call the second branch 326 ++ subcall i2' o2' n2' "sub2" 327 -- signals are raised if one of the branches raised them 328 ++ orSignals "sub1" o1' "sub2" o2' 329 -- define the signal combinations 330 ++ map (\x -> Decl ["combined_signal_" ++ x] $ 331 if x `Set.member` o 332 then Binop Or (Var $ toISignal x) (Var $ toOSignal x) 333 else Var $ toISignal x) (toList $ 334 Set.union i1' i2'), 335 others1 ++ others2) 336 337 -- compile an AST node with annotations, using compileDecls and adding 338 -- boilerplate 339 compileExp x@(Annotated _ ((i, o), n)) = 340 let (lvars, decls, others) = compileDecls x in 341 Node (toNode n) 342 x 343 (toIArgsNR i) 344 (toOArgs o) 345 lvars 346 decls 347 :others 348