From: Christiaan Baaij Date: Mon, 13 Jul 2009 13:25:53 +0000 (+0200) Subject: Pulled 'varToVHDLExpr' into the TypeSession monad X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=bf59dcfb13123d9ce146742e15e7b1a128d9c4e9;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Pulled 'varToVHDLExpr' into the TypeSession monad --- diff --git a/Generate.hs b/Generate.hs index 4f0acf3..4846d58 100644 --- a/Generate.hs +++ b/Generate.hs @@ -38,12 +38,21 @@ import Pretty -- | A function to wrap a builder-like function that expects its arguments to -- be expressions. -genExprArgs :: - TypeState - -> (dst -> func -> [AST.Expr] -> res) - -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res) -genExprArgs ty_state wrap dst func args = wrap dst func args' - where args' = map (either ((varToVHDLExpr ty_state).exprToVar) id) args +genExprArgs wrap dst func args = do + args' <- eitherCoreOrExprArgs args + wrap dst func args' + +idM :: a -> VHDLSession a +idM e = return e + +eitherM :: (a -> m c) -> (b -> m c) -> Either a b -> m c +eitherM f1 f2 e = do + case e of + Left e1 -> f1 e1 + Right e2 -> f2 e2 + +eitherCoreOrExprArgs :: [Either CoreSyn.CoreExpr AST.Expr] -> VHDLSession [AST.Expr] +eitherCoreOrExprArgs args = mapM (eitherM (\x -> MonadState.lift vsType $ (varToVHDLExpr (exprToVar x))) idM) args -- | A function to wrap a builder-like function that expects its arguments to -- be variables. @@ -79,34 +88,34 @@ genExprRes wrap dst func args = do -- | Generate a binary operator application. The first argument should be a -- constructor from the AST.Expr type, e.g. AST.And. -genOperator2 :: TypeState -> (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder -genOperator2 ty_state op = (genExprArgs ty_state) $ genExprRes (genOperator2' op) +genOperator2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder +genOperator2 op = genExprArgs $ genExprRes (genOperator2' op) genOperator2' :: (AST.Expr -> AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr genOperator2' op _ f [arg1, arg2] = return $ op arg1 arg2 -- | Generate a unary operator application -genOperator1 :: TypeState -> (AST.Expr -> AST.Expr) -> BuiltinBuilder -genOperator1 ty_state op = (genExprArgs ty_state) $ genExprRes (genOperator1' op) +genOperator1 :: (AST.Expr -> AST.Expr) -> BuiltinBuilder +genOperator1 op = genExprArgs $ genExprRes (genOperator1' op) genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr genOperator1' op _ f [arg] = return $ op arg -- | Generate a unary operator application -genNegation :: TypeState -> BuiltinBuilder -genNegation ty_state = genVarArgs $ genExprRes (genNegation' ty_state) -genNegation' :: TypeState -> dst -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession AST.Expr -genNegation' ty_state _ f [arg] = return $ op ((varToVHDLExpr ty_state) arg) - where - ty = Var.varType arg - (tycon, args) = Type.splitTyConApp ty - name = Name.getOccString (TyCon.tyConName tycon) - op = case name of - "SizedInt" -> AST.Neg - otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name +genNegation :: BuiltinBuilder +genNegation = genVarArgs $ genExprRes genNegation' +genNegation' :: dst -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession AST.Expr +genNegation' _ f [arg] = do + arg1 <- MonadState.lift vsType $ varToVHDLExpr arg + let ty = Var.varType arg + let (tycon, args) = Type.splitTyConApp ty + let name = Name.getOccString (TyCon.tyConName tycon) + case name of + "SizedInt" -> return $ AST.Neg arg1 + otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name -- | Generate a function call from the destination binder, function name and a -- list of expressions (its arguments) -genFCall :: TypeState -> Bool -> BuiltinBuilder -genFCall ty_state switch = (genExprArgs ty_state) $ genExprRes (genFCall' switch) +genFCall :: Bool -> BuiltinBuilder +genFCall switch = genExprArgs $ genExprRes (genFCall' switch) genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr genFCall' switch (Left res) f args = do let fname = varToString f @@ -116,8 +125,8 @@ genFCall' switch (Left res) f args = do map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name -genFromSizedWord :: TypeState -> BuiltinBuilder -genFromSizedWord ty_state = (genExprArgs ty_state) $ genExprRes genFromSizedWord' +genFromSizedWord :: BuiltinBuilder +genFromSizedWord = genExprArgs $ genExprRes genFromSizedWord' genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr genFromSizedWord' (Left res) f args = do let fname = varToString f @@ -198,23 +207,29 @@ genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do { ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms] } -genFoldl :: TypeState -> BuiltinBuilder -genFoldl ty_state = genFold ty_state True +genFoldl :: BuiltinBuilder +genFoldl = genFold True + +genFoldr :: BuiltinBuilder +genFoldr = genFold False + +genFold :: Bool -> BuiltinBuilder +genFold left = genVarArgs (genFold' left) -genFoldr :: TypeState -> BuiltinBuilder -genFoldr ty_state = genFold ty_state False +genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm] +genFold' left res f args@[folded_f , start ,vec]= do + len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty (Var.varType vec)) + genFold'' len left res f args -genFold :: TypeState -> Bool -> BuiltinBuilder -genFold ty_state left = genVarArgs (genFold' ty_state left) -genFold' :: TypeState -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm] +genFold'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm] -- Special case for an empty input vector, just assign start to res -genFold' ty_state left (Left res) _ [_, start, vec] | len == 0 = return [mkUncondAssign (Left res) ((varToVHDLExpr ty_state) start)] - where - len = State.evalState (tfp_to_int $ (tfvec_len_ty . Var.varType) vec) ty_state +genFold'' len left (Left res) _ [_, start, vec] | len == 0 = do + arg <- MonadState.lift vsType $ varToVHDLExpr start + return [mkUncondAssign (Left res) arg] -genFold' ty_state left (Left res) f [folded_f, start, vec] = do +genFold'' len left (Left res) f [folded_f, start, vec] = do -- The vector length - len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec + --len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec -- An expression for len-1 let len_min_expr = (AST.PrimLit $ show (len-1)) -- evec is (TFVec n), so it still needs an element type @@ -262,7 +277,7 @@ genFold' ty_state left (Left res) f [folded_f, start, vec] = do -- Output to tmp[current n] let resname = mkIndexedName tmp_name n_cur -- Input from start - let argexpr1 = (varToVHDLExpr ty_state) start + argexpr1 <- MonadState.lift vsType $ varToVHDLExpr start -- Input from vec[current n] let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur app_concsms <- genApplication (Right resname) folded_f ( if left then @@ -389,27 +404,33 @@ genConcat' (Left res) f args@[arg] = do { vecSlice init last = AST.NSlice (AST.SliceName (varToVHDLName res) (AST.ToRange init last)) -genIteraten :: TypeState -> BuiltinBuilder -genIteraten ty_state dst f args = genIterate ty_state dst f (tail args) +genIteraten :: BuiltinBuilder +genIteraten dst f args = genIterate dst f (tail args) + +genIterate :: BuiltinBuilder +genIterate = genIterateOrGenerate True + +genGeneraten :: BuiltinBuilder +genGeneraten dst f args = genGenerate dst f (tail args) -genIterate :: TypeState -> BuiltinBuilder -genIterate ty_state = genIterateOrGenerate ty_state True +genGenerate :: BuiltinBuilder +genGenerate = genIterateOrGenerate False -genGeneraten :: TypeState -> BuiltinBuilder -genGeneraten ty_state dst f args = genGenerate ty_state dst f (tail args) +genIterateOrGenerate :: Bool -> BuiltinBuilder +genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter) -genGenerate :: TypeState -> BuiltinBuilder -genGenerate ty_state = genIterateOrGenerate ty_state False +genIterateOrGenerate' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm] +genIterateOrGenerate' iter (Left res) f args = do + len <- MonadState.lift vsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res) + genIterateOrGenerate'' len iter (Left res) f args -genIterateOrGenerate :: TypeState -> Bool -> BuiltinBuilder -genIterateOrGenerate ty_state iter = genVarArgs (genIterateOrGenerate' ty_state iter) -genIterateOrGenerate' :: TypeState -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm] +genIterateOrGenerate'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm] -- Special case for an empty input vector, just assign start to res -genIterateOrGenerate' ty_state iter (Left res) _ [app_f, start] | len == 0 = return [mkUncondAssign (Left res) (AST.PrimLit "\"\"")] - where len = State.evalState (tfp_to_int $ (tfvec_len_ty . Var.varType) res) ty_state -genIterateOrGenerate' ty_state iter (Left res) f [app_f, start] = do +genIterateOrGenerate'' len iter (Left res) _ [app_f, start] | len == 0 = return [mkUncondAssign (Left res) (AST.PrimLit "\"\"")] + +genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do -- The vector length - len <- MonadState.lift vsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res) + -- len <- MonadState.lift vsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res) -- An expression for len-1 let len_min_expr = (AST.PrimLit $ show (len-1)) -- -- evec is (TFVec n), so it still needs an element type @@ -451,7 +472,7 @@ genIterateOrGenerate' ty_state iter (Left res) f [app_f, start] = do -- Output to tmp[current n] let resname = mkIndexedName tmp_name n_cur -- Input from start - let argexpr = (varToVHDLExpr ty_state) start + argexpr <- MonadState.lift vsType $ varToVHDLExpr start let startassign = mkUncondAssign (Right resname) argexpr app_concsms <- genApplication (Right resname) app_f [Right argexpr] -- Return the conditional generate part @@ -483,14 +504,14 @@ genApplication :: -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply -> VHDLSession [AST.ConcSm] -- ^ The resulting concurrent statements genApplication dst f args = do - ty_state <- getA vsType case Var.globalIdVarDetails f of IdInfo.DataConWorkId dc -> case dst of -- It's a datacon. Create a record from its arguments. Left bndr -> do -- We have the bndr, so we can get at the type labels <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr) - return $ zipWith mkassign labels $ map (either (exprToVHDLExpr ty_state) id) args + args' <- eitherCoreOrExprArgs args + return $ zipWith mkassign labels $ args' where mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm mkassign label arg = @@ -503,7 +524,7 @@ genApplication dst f args = do -- the associated builder if there is any and the argument count matches -- (this should always be the case if it typechecks, but just to be -- sure...). - case (Map.lookup (varToString f) (globalNameTable ty_state)) of + case (Map.lookup (varToString f) globalNameTable) of Just (arg_count, builder) -> if length args == arg_count then builder dst f args @@ -515,28 +536,28 @@ genApplication dst f args = do -- This is a local id, so it should be a function whose definition we -- have and which can be turned into a component instantiation. case (Map.lookup f signatures) of - Just signature -> let + Just signature -> do + args' <- eitherCoreOrExprArgs args -- We have a signature, this is a top level binding. Generate a -- component instantiation. - entity_id = ent_id signature + let entity_id = ent_id signature -- TODO: Using show here isn't really pretty, but we'll need some -- unique-ish value... - label = "comp_ins_" ++ (either show prettyShow) dst - portmaps = mkAssocElems (map (either (exprToVHDLExpr ty_state) id) args) ((either varToVHDLName id) dst) signature - in - return [mkComponentInst label entity_id portmaps] + let label = "comp_ins_" ++ (either show prettyShow) dst + let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature + return [mkComponentInst label entity_id portmaps] Nothing -> do -- No signature, so this must be a local variable reference. It -- should have a representable type (and thus, no arguments) and a -- signal should be generated for it. Just generate an -- unconditional assignment here. - ty_state <- getA vsType - return $ [mkUncondAssign dst ((varToVHDLExpr ty_state) f)] + f' <- MonadState.lift vsType $ varToVHDLExpr f + return $ [mkUncondAssign dst f'] IdInfo.ClassOpId cls -> do -- FIXME: Not looking for what instance this class op is called for -- Is quite stupid of course. - case (Map.lookup (varToString f) (globalNameTable ty_state)) of + case (Map.lookup (varToString f) globalNameTable) of Just (arg_count, builder) -> if length args == arg_count then builder dst f args @@ -959,50 +980,50 @@ genUnconsVectorFuns elemTM vectorTM = -- | The builtin functions we support. Maps a name to an argument count and a -- builder function. -globalNameTable :: TypeState -> NameTable -globalNameTable ty_state = Map.fromList - [ (exId , (2, genFCall ty_state False ) ) - , (replaceId , (3, genFCall ty_state False ) ) - , (headId , (1, genFCall ty_state True ) ) - , (lastId , (1, genFCall ty_state True ) ) - , (tailId , (1, genFCall ty_state False ) ) - , (initId , (1, genFCall ty_state False ) ) - , (takeId , (2, genFCall ty_state False ) ) - , (dropId , (2, genFCall ty_state False ) ) - , (selId , (4, genFCall ty_state False ) ) - , (plusgtId , (2, genFCall ty_state False ) ) - , (ltplusId , (2, genFCall ty_state False ) ) - , (plusplusId , (2, genFCall ty_state False ) ) - , (mapId , (2, genMap ) ) - , (zipWithId , (3, genZipWith ) ) - , (foldlId , (3, genFoldl ty_state ) ) - , (foldrId , (3, genFoldr ty_state ) ) - , (zipId , (2, genZip ) ) - , (unzipId , (1, genUnzip ) ) - , (shiftlId , (2, genFCall ty_state False ) ) - , (shiftrId , (2, genFCall ty_state False ) ) - , (rotlId , (1, genFCall ty_state False ) ) - , (rotrId , (1, genFCall ty_state False ) ) - , (concatId , (1, genConcat ) ) - , (reverseId , (1, genFCall ty_state False ) ) - , (iteratenId , (3, genIteraten ty_state ) ) - , (iterateId , (2, genIterate ty_state ) ) - , (generatenId , (3, genGeneraten ty_state ) ) - , (generateId , (2, genGenerate ty_state ) ) - , (emptyId , (0, genFCall ty_state False ) ) - , (singletonId , (1, genFCall ty_state False ) ) - , (copynId , (2, genFCall ty_state False ) ) - , (copyId , (1, genCopy ) ) - , (lengthTId , (1, genFCall ty_state False ) ) - , (nullId , (1, genFCall ty_state False ) ) - , (hwxorId , (2, genOperator2 ty_state AST.Xor ) ) - , (hwandId , (2, genOperator2 ty_state AST.And ) ) - , (hworId , (2, genOperator2 ty_state AST.Or ) ) - , (hwnotId , (1, genOperator1 ty_state AST.Not ) ) - , (plusId , (2, genOperator2 ty_state (AST.:+:) ) ) - , (timesId , (2, genOperator2 ty_state (AST.:*:) ) ) - , (negateId , (1, genNegation ty_state ) ) - , (minusId , (2, genOperator2 ty_state (AST.:-:) ) ) - , (fromSizedWordId , (1, genFromSizedWord ty_state ) ) - , (fromIntegerId , (1, genFromInteger ) ) +globalNameTable :: NameTable +globalNameTable = Map.fromList + [ (exId , (2, genFCall False ) ) + , (replaceId , (3, genFCall False ) ) + , (headId , (1, genFCall True ) ) + , (lastId , (1, genFCall True ) ) + , (tailId , (1, genFCall False ) ) + , (initId , (1, genFCall False ) ) + , (takeId , (2, genFCall False ) ) + , (dropId , (2, genFCall False ) ) + , (selId , (4, genFCall False ) ) + , (plusgtId , (2, genFCall False ) ) + , (ltplusId , (2, genFCall False ) ) + , (plusplusId , (2, genFCall False ) ) + , (mapId , (2, genMap ) ) + , (zipWithId , (3, genZipWith ) ) + , (foldlId , (3, genFoldl ) ) + , (foldrId , (3, genFoldr ) ) + , (zipId , (2, genZip ) ) + , (unzipId , (1, genUnzip ) ) + , (shiftlId , (2, genFCall False ) ) + , (shiftrId , (2, genFCall False ) ) + , (rotlId , (1, genFCall False ) ) + , (rotrId , (1, genFCall False ) ) + , (concatId , (1, genConcat ) ) + , (reverseId , (1, genFCall False ) ) + , (iteratenId , (3, genIteraten ) ) + , (iterateId , (2, genIterate ) ) + , (generatenId , (3, genGeneraten ) ) + , (generateId , (2, genGenerate ) ) + , (emptyId , (0, genFCall False ) ) + , (singletonId , (1, genFCall False ) ) + , (copynId , (2, genFCall False ) ) + , (copyId , (1, genCopy ) ) + , (lengthTId , (1, genFCall False ) ) + , (nullId , (1, genFCall False ) ) + , (hwxorId , (2, genOperator2 AST.Xor ) ) + , (hwandId , (2, genOperator2 AST.And ) ) + , (hworId , (2, genOperator2 AST.Or ) ) + , (hwnotId , (1, genOperator1 AST.Not ) ) + , (plusId , (2, genOperator2 (AST.:+:) ) ) + , (timesId , (2, genOperator2 (AST.:*:) ) ) + , (negateId , (1, genNegation ) ) + , (minusId , (2, genOperator2 (AST.:-:) ) ) + , (fromSizedWordId , (1, genFromSizedWord ) ) + , (fromIntegerId , (1, genFromInteger ) ) ] diff --git a/VHDL.hs b/VHDL.hs index 2ac2a12..0385909 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -286,14 +286,13 @@ mkConcSm (bndr, expr@(Case (Var scrut) b ty [alt])) = -- binders in the alts and only variables in the case values and a variable -- for a scrutinee. We check the constructor of the second alt, since the -- first is the default case, if there is any. -mkConcSm (bndr, (Case (Var scrut) b ty [(_, _, Var false), (con, _, Var true)])) = do { - ; ty_state <- getA vsType - ; let { cond_expr = (varToVHDLExpr ty_state scrut) AST.:=: (altconToVHDLExpr con) - ; true_expr = (varToVHDLExpr ty_state true) - ; false_expr = (varToVHDLExpr ty_state false) - } ; - ; return [mkCondAssign (Left bndr) cond_expr true_expr false_expr] - } +mkConcSm (bndr, (Case (Var scrut) b ty [(_, _, Var false), (con, _, Var true)])) = do + scrut' <- MonadState.lift vsType $ varToVHDLExpr scrut + let cond_expr = scrut' AST.:=: (altconToVHDLExpr con) + true_expr <- MonadState.lift vsType $ varToVHDLExpr true + false_expr <- MonadState.lift vsType $ varToVHDLExpr false + return [mkCondAssign (Left bndr) cond_expr true_expr false_expr] + mkConcSm (_, (Case (Var _) _ _ alts)) = error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives" mkConcSm (_, Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee" mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr diff --git a/VHDLTools.hs b/VHDLTools.hs index e7c598d..2d36049 100644 --- a/VHDLTools.hs +++ b/VHDLTools.hs @@ -122,11 +122,10 @@ mkComponentInst label entity_id portassigns = AST.CSISm compins -- Functions to generate VHDL Exprs ----------------------------------------------------------------------------- --- Turn a variable reference into a AST expression -varToVHDLExpr :: TypeState -> Var.Var -> AST.Expr -varToVHDLExpr ty_state var = +varToVHDLExpr :: Var.Var -> TypeSession AST.Expr +varToVHDLExpr var = do case Id.isDataConWorkId_maybe var of - Just dc -> dataconToVHDLExpr dc + Just dc -> return $ dataconToVHDLExpr dc -- This is a dataconstructor. -- Not a datacon, just another signal. Perhaps we should check for -- local/global here as well? @@ -134,17 +133,15 @@ varToVHDLExpr ty_state var = -- should still be translated to integer literals. It is probebly not the -- best solution to translate them here. -- FIXME: Find a better solution for translating instances of tfp integers - Nothing -> - let - ty = Var.varType var - res = case Type.splitTyConApp_maybe ty of - Just (tycon, args) -> - case Name.getOccString (TyCon.tyConName tycon) of - "Dec" -> AST.PrimLit $ (show (fst ( State.runState (tfp_to_int ty) ty_state ) ) ) - otherwise -> AST.PrimName $ AST.NSimple $ varToVHDLId var - in - res - + Nothing -> do + let ty = Var.varType var + case Type.splitTyConApp_maybe ty of + Just (tycon, args) -> + case Name.getOccString (TyCon.tyConName tycon) of + "Dec" -> do + len <- tfp_to_int ty + return $ AST.PrimLit $ (show len) + otherwise -> return $ AST.PrimName $ AST.NSimple $ varToVHDLId var -- Turn a VHDLName into an AST expression vhdlNameToVHDLExpr = AST.PrimName @@ -153,7 +150,7 @@ vhdlNameToVHDLExpr = AST.PrimName idToVHDLExpr = vhdlNameToVHDLExpr . AST.NSimple -- Turn a Core expression into an AST expression -exprToVHDLExpr ty_state = (varToVHDLExpr ty_state) . exprToVar +exprToVHDLExpr core = varToVHDLExpr (exprToVar core) -- Turn a alternative constructor into an AST expression. For -- dataconstructors, this is only the constructor itself, not any arguments it