scope.hs (1770B)
1 module Scope where 2 3 import Esterel 4 import qualified Data.Set as Set 5 6 scope :: Exp -> ScopeExp 7 scope (Annotated x ()) = case x of 8 Esterel.Nothing -> 9 Annotated Esterel.Nothing (Set.empty, Set.empty) 10 Pause -> 11 Annotated Pause (Set.empty, Set.empty) 12 Loop e -> 13 let ne@(Annotated _ (i, o)) = scope e in 14 Annotated (Loop ne) (i, o) 15 Present s e1 e2 -> 16 -- inputs and outputs of the two branches, adding s 17 let (ne1, ne2, (i, o)) = doBinop e1 e2 in 18 Annotated (Present s ne1 ne2) (i `Set.union` Set.singleton s, o) 19 Seq e1 e2 -> 20 let (ne1, ne2, sc) = doBinop e1 e2 in 21 Annotated (Seq ne1 ne2) sc 22 Par e1 e2 -> let (ne1, ne2, sc) = doBinop e1 e2 in 23 Annotated (Par ne1 ne2) sc 24 Suspend e s -> let (ne, sc) = doUnop addInput e s in 25 Annotated (Suspend ne s) sc 26 Signal s e -> 27 -- remove s from the input and output 28 let (ne, sc) = doUnop removeBoth e s in 29 Annotated (Signal s ne) sc 30 Trap t e -> 31 -- remove s from the input and output 32 let (ne, sc) = doUnop removeBoth e t in 33 Annotated (Trap t ne) sc 34 Emit s -> 35 Annotated (Emit s) (Set.empty, Set.singleton s) 36 Exit t -> 37 Annotated (Exit t) (Set.empty, Set.singleton t) 38 where 39 -- take the union of the two branches 40 doBinop e1 e2 = 41 let ne1@(Annotated _ (i1, o1)) = scope e1 in 42 let ne2@(Annotated _ (i2, o2)) = scope e2 in 43 (ne1, ne2, (i1 `Set.union` i2, o1 `Set.union` o2)) 44 -- take the result of the branch and apply f 45 doUnop f e s = 46 let ne@(Annotated _ (i, o)) = scope e in 47 (ne, f (i, o, s)) 48 addInput (i, o, s) = 49 (i `Set.union` Set.singleton s, o) 50 removeBoth (i, o, s) = 51 (i `Set.difference` Set.singleton s, o `Set.difference` Set.singleton s)