{-# LANGUAGE PatternGuards #-}
module Language.KansasLava.Netlist.Inst(genInst') where
import Language.KansasLava.Types
import Language.Netlist.AST hiding (U)
import Language.Netlist.Util
import Language.KansasLava.Rep
import qualified Data.Map as M
import Data.Bits
import Data.List
import Data.Reify.Graph (Unique)
import Language.KansasLava.Netlist.Utils
import Debug.Trace
genInst' :: M.Map Unique (Entity Unique)
-> Unique
-> Entity Unique
-> [Decl]
genInst' env i e =
genInst env i e
genInst :: M.Map Unique (Entity Unique) -> Unique -> Entity Unique -> [Decl]
genInst _ _ (Entity _ [(_,ty)] _) | toStdLogicTy ty == V 0 = []
genInst env i (Entity (BlackBox _) ins outs) =
genInst env i (Entity (Prim "id") ins outs)
genInst env i (Entity (Prim "retime") outs [("i0",ty,dr),("pulse",_,_)]) =
genInst env i (Entity (Prim "id") outs [("i0",ty,dr)])
genInst _ _ (Entity (Comment comments) [] []) =
[ CommentDecl (unlines comments)
]
genInst env i (Entity (Comment comments) ins@[_] outs@[_]) =
CommentDecl (unlines comments) :
genInst env i (Entity (Prim "id") ins outs)
genInst env i (Entity (Prim "const") outputs [in0,_])
= genInst env i (Entity (Prim "id") outputs [in0])
genInst env i (Entity (Prim "pair") outputs inputs)
= genInst' env i (Entity (Prim "concat") outputs inputs)
genInst env i (Entity (Prim "triple") outputs inputs)
= genInst' env i (Entity (Prim "concat") outputs inputs)
genInst env i (Entity (Prim "fst") outputs inputs)
= genInst env i (Entity (Prim "project") outputs (addNum 0 inputs))
genInst env i (Entity (Prim "snd") outputs inputs)
= genInst' env i (Entity (Prim "project") outputs (addNum 1 inputs))
genInst env i (Entity (Prim "fst3") outputs inputs)
= genInst env i (Entity (Prim "project") outputs (addNum 0 inputs))
genInst env i (Entity (Prim "snd3") outputs inputs)
= genInst env i (Entity (Prim "project") outputs (addNum 1 inputs))
genInst env i (Entity (Prim "thd3") outputs inputs)
= genInst env i (Entity (Prim "project") outputs (addNum 2 inputs))
genInst _ i (Entity (Prim "id") [(vO,tyO)] [(_,tyI,d)]) =
case toStdLogicTy tyO of
MatrixTy n (V _)
-> [ MemAssign (sigName vO i) (ExprLit Nothing $ ExprNum j)
$ ExprIndex varname
(ExprLit Nothing $ ExprNum j)
| j <- [0..(fromIntegral n - 1)]
]
_ -> [ NetAssign (sigName vO i) $ toStdLogicExpr tyI d ]
where
(ExprVar varname) = toStdLogicExpr tyI d
genInst _ i (Entity (Prim "concat") [("o0",ty)] ins)
| case toStdLogicTy ty of
MatrixTy {} -> True
_ -> False
=
[ MemAssign
(sigName "o0" i)
(ExprLit Nothing $ ExprNum j)
(stdLogicToMem tyIn $ toStdLogicExpr tyIn dr)
| (j,(_,tyIn,dr)) <- zip [0..] ins
]
genInst env i (Entity (Prim "concat") outs ins@[(_,B,_)]) =
genInst env i (Entity (Prim "concat")
outs
(ins ++ [("_",V 0,Lit (RepValue []))]))
genInst _ i (Entity (Prim "concat") [("o0",_)] inps) =
[ CommentDecl (show inps)
, NetAssign (sigName "o0" i) val]
where val = ExprConcat
[ toStdLogicExpr ty s | (_,ty, s) <- reverse inps ]
genInst _ i (Entity (Prim "index")
[("o0",_)]
[("i0", GenericTy, Generic idx),
("i1",ty@MatrixTy {},dr)
]) =
[ NetAssign (sigName "o0" i)
(reverse vs !! (fromIntegral idx))
]
where
ExprConcat vs = toStdLogicExpr ty dr
genInst _ i e@(Entity (Prim "index")
[("o0",t)]
[("i0", ixTy, ix),
("i1",ty@MatrixTy {},dr)
]) =
[ NetAssign (sigName "o0" i)
(memToStdLogic t
(ExprIndex varname
(toMemIndex ixTy ix)))
]
where
varname = case toStdLogicExpr ty dr of
ExprVar v -> v
other -> case dr of
Port v n -> sigName v (fromIntegral n)
_ -> error (show ("genInst/index",e,other))
genInst _ i (Entity (Prim "unconcat") outs [("i0", ty@(MatrixTy n inTy), dr)])
| length outs == n =
[ NetAssign (sigName ('o':show j) i)
(memToStdLogic inTy
(ExprIndex varname
(ExprLit Nothing $ ExprNum j)))
| (j,_) <- zip [0..] outs
]
where
(ExprVar varname) = toStdLogicExpr ty dr
genInst _ i e@(Entity (Prim "project")
[("o0",tyOut)]
[("i0", GenericTy, Generic ix),
("i1",TupleTy tys,input)]) =
case toStdLogicType tyOut of
SL ->
[ NetAssign (sigName "o0" i)
(prodSlices input tys !! fromIntegral ix)
]
SLV _n ->
[ NetAssign (sigName "o0" i)
(prodSlices input tys !! fromIntegral ix)
]
SLVA n _ ->
let tys' = concat
[ case ty of
MatrixTy n' ty' | j == ix -> replicate n' ty'
_ | j == ix -> error "found a non-Matrix project to a Matrix"
_ -> [ ty ]
| (ty,j) <- zip tys [0..] ]
slices = prodSlices input tys'
select = take n . drop (fromIntegral ix)
in
[ MemAssign (sigName "o0" i)
(ExprLit Nothing $ ExprNum $ j)
(stdLogicToMem ty' slice)
| (j,(ty',slice)) <- zip [0..]
(select (zip tys' slices))
]
_ -> error $ show ("project",e)
genInst _ i (Entity (Prim "mux") [("o0",ty)] [("i0",_,Lit (RepValue [Just True])),("i1",fTy,_),("i2",tTy,t)])
| ty == tTy && ty == fTy
= assignDecl "o0" i ty $ \ toExpr -> toExpr t
genInst _ i (Entity (Prim "mux") [("o0",ty)] [("i0",_,Lit (RepValue [Just False])),("i1",fTy,f),("i2",tTy,_)])
| ty == tTy && ty == fTy
= assignDecl "o0" i ty $ \ toExpr -> toExpr f
genInst _ i (Entity (Prim "mux") [("o0",ty)] [("i0",cTy,c),("i1",fTy,f),("i2",tTy,t)])
| ty == tTy && ty == fTy
= assignDecl "o0" i ty $ \ toExpr ->
(ExprCond cond
(toExpr t)
(toExpr f))
where cond = ExprBinary Equals (toTypedExpr cTy c) (ExprLit Nothing (ExprBit T))
genInst env i (Entity (Prim op) [("o0",ty@(SampledTy m n))] ins)
| op `elem` ["+","-","*","negate"]
= genInst env i (Entity (External $ "lava_sampled_" ++ sanitizeName op) [("o0",ty)]
(ins ++ [ ("frac_width",
GenericTy,
Generic $ fromIntegral $ n - log2 m)
, ("width",GenericTy, Generic $ fromIntegral n)
]))
genInst env i (Entity (Prim op) [("o0",B)] [("i0",SampledTy m n,d0),("i1",SampledTy m' n',d1)])
| op `elem` [".>.",".<.",".>=.",".<=."] && m == m' && n == n
= genInst env i $ Entity (Prim op) [("o0",B)] [("i0",S n,d0),("i1",S n',d1)]
genInst _ i (Entity (Prim "/") [("o0",SampledTy m n)] [ ("i0",iTy,v), ("i1",_,Lit lit)])
| (val' `mod` (2^frac_width) == 0) && (2^(log2 val - 1) == val)
= [ InstDecl "Sampled_fixedDivPowOfTwo" ("inst" ++ show i)
[ ("shift_by",ExprLit Nothing (ExprNum $ log2 val - 1))
, ("frac_width", ExprLit Nothing $ ExprNum $ fromIntegral frac_width)
, ("width", ExprLit Nothing $ ExprNum $ fromIntegral n)
]
[ ("i0",toStdLogicExpr iTy v)
]
[ ("o0",ExprVar $ sigName "o0" i) ]
]
where val' = fromRepToInteger lit
val = val' `div` (2 ^ frac_width)
frac_width = n - log2 m
genInst _ i (Entity (Prim "spliceStdLogicVector") [("o0",V outs)] [("i0",_,Generic x),("i1",V ins,w)])
| null zs =
[ NetAssign (sigName "o0" i) slice
]
| otherwise =
[ NetAssign (sigName "o0" i) $ ExprConcat
[ ExprLit (Just $ length zs) $ ExprBitVector [ F | _ <- zs ]
, slice
]
]
where
xs = take outs [x..]
ys = take (ins - fromIntegral x) xs
zs = drop (ins - fromIntegral x) xs
slice = ExprSlice nm (ExprLit Nothing (ExprNum $ last ys)) (ExprLit Nothing (ExprNum $ head ys))
nm = case toTypedExpr (V ins) w of
ExprVar n -> n
_ -> error $ " problem with spliceStdLogicVector " ++ show w
genInst env i (Entity (Prim "coerce") [("o0",tO)] [("i0",tI,w)])
| typeWidth tI == typeWidth tO =
case (toStdLogicTy tI,toStdLogicTy tO) of
(a,b) | a == b -> genInst env i (Entity (Prim "id") [("o0",tO)] [("i0",tI,w)])
(MatrixTy 1 (V 1),B) ->
[ NetAssign (sigName "o0" i)
(toStdLogicExpr' tI w)
]
(MatrixTy _ _,V _) ->
[ NetAssign (sigName "o0" i)
(toStdLogicExpr tI w)
]
(B,MatrixTy 1 (V 1)) ->
[ MemAssign (sigName "o0" i) (ExprLit Nothing $ ExprNum 0)
$ stdLogicToMem B
$ toStdLogicExpr tI w
]
(B,V 1) ->
[ NetAssign (sigName "o0" i)
$ stdLogicToMem B
$ toStdLogicExpr tI w
]
(V _,MatrixTy n0 (V n1)) ->
[ MemAssign (sigName "o0" i) (ExprLit Nothing $ ExprNum $ fromIntegral $j)
$ ExprSlice (slvVarName tI w)
(ExprLit Nothing $ ExprNum $ fromIntegral $ (j + 1) * n1 - 1)
(ExprLit Nothing $ ExprNum $ fromIntegral $ j * n1)
| j <- [0..(n0 - 1)]
]
(V 1,B) ->
[ NetAssign (sigName "o0" i)
$ memToStdLogic B
$ toStdLogicExpr tI w
]
other -> error $ "coerce failure: " ++ show other
| otherwise = error $ "coerce attempting to resize : " ++ show (tO,tI)
genInst _ i (Entity (Prim "unsigned") [("o0",tO)] [("i0",tI,w)])
| isMatrixStdLogicTy tI = error "input of unsigned uses matrix representation"
| isMatrixStdLogicTy tO = error "output of unsigned uses matrix representation"
| typeWidth tI == typeWidth tO && tI == B && isStdLogicVectorTy tO =
[ NetAssign (sigName "o0" i) $ mkExprConcat $ [(tI,ExprVar nm)]
]
| typeWidth tI == typeWidth tO =
[ NetAssign (sigName "o0" i) $ toStdLogicExpr tI w
]
| typeWidth tI > typeWidth tO =
[ NetAssign (sigName "o0" i) $
case toStdLogicExpr tI w of
ExprVar nm' -> ExprSlice nm' (ExprLit Nothing (ExprNum (fromIntegral (typeWidth tO - 1))))
(ExprLit Nothing (ExprNum 0))
ExprLit _ (ExprNum n) ->
toTypedExpr
tO
n
other -> error $ "(signed) problem , tI > tO, " ++ show (w,tI,tO,other)
]
| typeWidth tI < typeWidth tO =
[ NetAssign (sigName "o0" i) $ ExprConcat
[ ExprLit (Just zeros) $ ExprBitVector $ replicate zeros F
, ExprVar nm
]
]
where
zeros = typeWidth tO - typeWidth tI
nm = case toStdLogicExpr tI w of
ExprVar n -> n
other -> error $ " problem with unsigned: " ++ show (w,tI,tO,other)
genInst _ i (Entity (Prim "signed") [("o0",tO)] [("i0",tI,w)])
| isMatrixStdLogicTy tI = error "input of signed uses matrix representation"
| isMatrixStdLogicTy tO = error "output of signed uses matrix representation"
| typeWidth tI == typeWidth tO && tI == B && isStdLogicVectorTy tO =
[ NetAssign (sigName "o0" i) $ mkExprConcat $ [(tI,ExprVar nm)]
]
| typeWidth tI == typeWidth tO =
[ NetAssign (sigName "o0" i) $ toStdLogicExpr tI w
]
| typeWidth tI > typeWidth tO =
[ NetAssign (sigName "o0" i) $
ExprSlice nm (ExprLit Nothing (ExprNum (fromIntegral (typeWidth tO - 1)))) (ExprLit Nothing (ExprNum 0))
]
| otherwise =
[ NetAssign (sigName "o0" i) $ ExprConcat $
replicate zeros
(ExprIndex nm (ExprLit Nothing (ExprNum (fromIntegral (typeWidth tI - 1)))))
++
[ ExprVar nm
]
]
where
zeros = typeWidth tO - typeWidth tI
nm = case toStdLogicExpr tI w of
ExprVar n -> n
other -> error $ " problem with signed: " ++ show (w,tI,tO,other)
genInst env i (Entity (Prim "*") outs@[("o0",U n)] ins) =
genInst env i $ Entity (External "lava_unsigned_mul")
outs
(ins ++ [("width",GenericTy,Generic $ fromIntegral n)])
genInst env i (Entity (Prim "*") outs@[("o0",S n)] ins) =
genInst env i $ Entity (External "lava_signed_mul")
outs
(ins ++ [("width",GenericTy,Generic $ fromIntegral n)])
genInst env i (Entity (Prim "negate") [("o0",U n)] [("i0",U m,dr)]) =
genInst env i (Entity (Prim "negate") [("o0",S n)] [("i0",S m,dr)])
genInst _ i (Entity (Prim ".==.")
[("o0",B)]
[ ("i0",ty0,_)
, ("i1",_,_)
]) | typeWidth ty0 == 0
=
[ NetAssign (sigName "o0" i) (ExprLit Nothing (ExprBit T))
]
genInst _ i (Entity n@(Prim _) [("o0",oTy)] ins)
| Just (NetlistOp arity f) <- lookup n specials, arity == length ins =
[NetAssign (sigName "o0" i)
(f oTy [(inTy, driver) | (_,inTy,driver) <- ins])]
genInst _ i (Entity (Prim "write") [ ("o0",_) ]
[ ("clk",ClkTy,clk)
, ("rst",B,_)
, ("wEn",B,wEn)
, ("wAddr",wAddrTy,wAddr)
, ("wData",wDataTy,wData)
, ("element_count",GenericTy,_)
, ("clk_en",B,clk_en)
]) =
[ mkProcessDecl
[ ( Event (toStdLogicExpr B clk) PosEdge
, If (isHigh (toStdLogicExpr B clk_en))
(If (isHigh (toStdLogicExpr B wEn))
(statements
[Assign (ExprIndex (sigName "o0" i)
(toMemIndex wAddrTy wAddr))
(stdLogicToMem wDataTy $ toStdLogicExpr wDataTy wData)
])
Nothing)
Nothing
)
]
]
genInst _ i (Entity (Prim "delay") [("o0",ty)] [ ("i0",tI,d)
, ("clk",ClkTy,clk)
, ("rst",B,_)
, ("clk_en",B,clk_en)
]) | ty == tI =
[ mkProcessDecl
[ ( Event (toStdLogicExpr B clk) PosEdge
, If (isHigh (toStdLogicExpr B clk_en))
(assignStmt "o0" i tI d)
Nothing
)
]
]
genInst _ i (Entity (Prim "register") [("o0",ty)] [ ("i0",tI,d)
, ("def",GenericTy,n)
, ("clk",ClkTy,clk)
, ("rst",B,rst)
, ("clk_en",B,clk_en)
]) | ty == tI =
[ ProcessDecl
(Event (toStdLogicExpr B clk) PosEdge)
(let rst_code = Just ( Event (toStdLogicExpr B rst) PosEdge
, assignStmt "o0" i ty n
)
in case rst of
Port {} -> rst_code
Pad {} -> rst_code
Lit (RepValue [Just False]) -> Nothing
_ -> error "genInst 'register' has strange reset value"
)
( If (isHigh (toStdLogicExpr B clk_en))
(assignStmt "o0" i tI d)
Nothing
)
]
genInst env i (Entity (Prim "RAM") outputs@[("o0",data_ty)] inputs) | goodAddrType addr_ty =
case (toStdLogicTy data_ty,toStdLogicTy addr_ty) of
(V n, V 0) -> genInst env i $ zeroArg $ inst n 1
(B , V 0) -> genInst env i $ boolTrick ["wData","o0"] $ zeroArg $ inst 1 1
(B , V m) -> genInst env i $ boolTrick ["wData","o0"] $ inst 1 m
(V n, V m) -> genInst env i $ inst n m
_ -> error "RAM typing issue (should not happen)"
where
("rAddr",addr_ty,_) = last inputs
inst :: Int -> Int -> Entity Int
inst n m = Entity
(External "lava_bram")
outputs
(inputs ++ [("data_width",GenericTy,Generic $ fromIntegral n)
,("addr_width",GenericTy,Generic $ fromIntegral m)
])
zeroArg (Entity nm outs ins) =
Entity nm outs $
[ (n,V 1,Lit $ RepValue [Just False])
| n <- ["wAddr","rAddr"]
] ++
[ (n,t,d) | (n,t,d) <- ins, n /= "wAddr"
&& n /= "rAddr"
]
goodAddrType ty =
case ty of
U _ -> True
_ -> error $ "unsupported address type for BRAMs: " ++ show ty
boolTrick :: [String] -> Entity s -> Entity s
boolTrick nms (Entity (External nm) outs ins) =
Entity (External nm)
[ (trick n,t) | (n,t) <- outs ]
[ (trick n,t,d) | (n,t,d) <- ins ]
where
trick n | n `elem` nms = n ++ "(0)"
| otherwise = n
boolTrick _ _ = error "applying bool Trick to non-external entity"
genInst _ i (Entity (Prim "asyncRead")
[("o0",ty)]
[ ("i0",ty1@MatrixTy {},dr1)
, ("i1",ty2,dr2)
]) =
case (dr1,toStdLogicType ty) of
(Port v n,SLV _) ->
[NetAssign (sigName "o0" i)
(memToStdLogic ty $
ExprIndex (sigName v (fromIntegral n))
(toMemIndex ty2 dr2)
)
]
_ -> error "bad array as input to asyncRead or strange output type"
where
MatrixTy _ (V _) = toStdLogicTy ty1
genInst _ i (Entity (Prim "rom") [("o0",MatrixTy {})] [(_,RomTy {},_)]) =
[ CommentDecl (sigName "o0" i ++ " is a constant array") ]
genInst _ i (Entity name@(External nm) outputs inputs) =
trace (show ("mkInst",name,[ t | (_,t) <- outputs ],[ t | (_,t,_) <- inputs ]))
[ InstDecl nm ("inst" ++ show i)
[ (n,case x of
Generic v -> ExprLit Nothing (ExprNum v)
_ -> error $ "genInst, Generic, " ++ show (n,nTy,x)
)
| (n,nTy,x) <- inputs, isGenericTy nTy
]
[ (n,toStdLogicExpr nTy x) | (n,nTy,x) <- inputs, not (isGenericTy nTy) ]
[ (n,ExprVar $ sigName (fixName nTy n) i) | (n,nTy) <- outputs ]
]
where isGenericTy GenericTy = True
isGenericTy _ = False
fixName B n | "(0)" `isSuffixOf` n = reverse (drop 3 (reverse n))
fixName _ n = n
genInst _ i (Entity (Function mp) [(vout,tyout)] [(_,tyin,d)]) =
[ NetAssign (sigName vout i)
(ExprCase (toStdLogicExpr tyin d)
[ ([toStdLogicExpr tyin ix],toStdLogicExpr tyout val)
| (ix,val) <- mp
]
(Just $ toStdLogicExpr tyout (0 :: Integer))
)
]
genInst _ i other = error $ show ("genInst",i,other)
data NetlistOperation = NetlistOp Int (Type -> [(Type,Driver Unique)] -> Expr)
mkSpecialUnary
:: (Type -> Expr -> Expr)
-> (Type -> Driver Unique -> Expr)
-> [(String, UnaryOp)]
-> [(Id, NetlistOperation)]
mkSpecialUnary coerceR coerceF ops =
[( Prim lavaName
, NetlistOp 1 (uop netListOp)
)
| (lavaName,netListOp) <- ops
]
where uop op fTy [(ity,i)] = coerceR fTy (ExprUnary op (coerceF ity i))
uop op _ _ = error $ "unary op " ++ show op ++ " can have only one argument"
mkSpecialBinary
:: (Type -> Expr -> Expr)
-> (Type -> Driver Unique -> Expr)
-> [(String, BinaryOp)]
-> [(Id, NetlistOperation)]
mkSpecialBinary coerceR coerceF ops =
[( Prim lavaName
, NetlistOp 2 (binop netListOp)
)
| (lavaName,netListOp) <- ops
]
where
resign sz n = if n >= 2^(sz-1) then n - 2^sz else n
mkBool True = ExprLit Nothing (ExprBit T)
mkBool False = ExprLit Nothing (ExprBit F)
binop op fTy [(lty,l),(rty,r)] =
case (l,r) of
(Lit ll,Lit rl)
-> let il = fromRepToInteger ll
ir = fromRepToInteger rl
in case (op,lty,rty) of
(GreaterThan,S x,S y) -> mkBool (resign x il > resign y ir)
(Minus,U x,U y) | x == y && il >= ir
-> toStdLogicExpr fTy (il - ir)
(And,U x,U y) | x == y
-> toStdLogicExpr fTy (il .&. ir)
other -> error $ show ("mkSpecialBinary (constant)",op,il,ir,other)
_ -> coerceR fTy (ExprBinary op (coerceF lty l)(coerceF rty r))
binop op _ _ = error $ "Binary op " ++ show op ++ " must have exactly 2 arguments"
mkSpecialShifts :: [(String, Ident)] -> [(Id, NetlistOperation)]
mkSpecialShifts ops =
[(Prim lavaName
, NetlistOp 2 (binop funName)
)
| (lavaName, funName) <- ops
]
where
binop op fTy [(lty,l),(rty,r)] =
toStdLogicExpr fTy $ ExprFunCall op [toTypedExpr lty l, toIntegerExpr rty r]
binop op _ _ = error $ "Binary op " ++ show op ++ " must have exactly 2 arguments"
mkSpecialTestBit :: [(Id, NetlistOperation)]
mkSpecialTestBit =
[(Prim lavaName
, NetlistOp 2 binop
)
| lavaName <- ["testBit"]
]
where binop _ [(lty,l),(rty,r)] =
let (ExprVar varname) = toStdLogicExpr lty l
in (ExprIndex varname (toIntegerExpr rty r))
binop _ _ = error "Binary op testBit must have exactly 2 arguments"
specials :: [(Id, NetlistOperation)]
specials =
mkSpecialBinary (const active_high) toTypedExpr
[ (".<.",LessThan)
, (".>.",GreaterThan)
, (".<=.",LessEqual)
, (".>=.",GreaterEqual)
, (".==.",Equals)
, ("./=.",NotEquals)
]
++ mkSpecialBinary toStdLogicExpr toTypedExpr
[("+",Plus)
, ("-",Minus)
, ("/", Divide)
]
++ mkSpecialBinary (\ _ e -> e) toStdLogicExpr
[ ("or2",Or), ("and2",And), ("xor2",Xor)
, ("nand2",Nand), ("nor2",Nor)
]
++ mkSpecialUnary toStdLogicExpr toTypedExpr
[("negate",Neg)]
++ mkSpecialUnary (\ _ e -> e) toStdLogicExpr
[("not",LNeg)
,("complement",LNeg)
]
++ mkSpecialTestBit
++ mkSpecialShifts
[ ("shiftL", "shift_left")
, ("shiftR", "shift_right")
, ("shiftLA", "shift_left")
, ("shiftRA", "shift_right")
, ("rotateL", "rotate_left")
, ("rotateR", "rotate_right")
]
slvVarName :: (Show v, ToStdLogicExpr v) => Type -> v -> Ident
slvVarName tI w = case toStdLogicExpr tI w of
ExprVar varname -> varname
_ -> error $ "Can't get the name of variable " ++ show w
mkProcessDecl :: [(Event, Stmt)] -> Decl
mkProcessDecl [(e,s)] = ProcessDecl e Nothing s
mkProcessDecl _ = error "mkProcessDecl"