From 8153abb4f08f21e097eca9bd38fa6155675be40b Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Fri, 3 Jul 2009 18:33:46 +0200 Subject: [PATCH] Add predicates for testing representability of types. These predicates try to build a VHDL type from a Core Type, to see if it will be representable in hardware. --- NormalizeTools.hs | 8 ++++++++ VHDLTools.hs | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/NormalizeTools.hs b/NormalizeTools.hs index 1785eed..5ea3a7d 100644 --- a/NormalizeTools.hs +++ b/NormalizeTools.hs @@ -14,6 +14,7 @@ import qualified Control.Monad.Trans.Writer as Writer import qualified "transformers" Control.Monad.Trans as Trans import qualified Data.Map as Map import Data.Accessor +import Data.Accessor.MonadState as MonadState -- GHC API import CoreSyn @@ -32,6 +33,8 @@ import Outputable ( showSDoc, ppr, nest ) -- Local imports import NormalizeTypes +import Pretty +import qualified VHDLTools -- Create a new internal var with the given name and type. A Unique is -- appended to the given name, to ensure uniqueness (not strictly neccesary, @@ -235,3 +238,8 @@ substitute ((b, e):subss) expr = substitute subss' expr' -- an initial state. runTransformSession :: UniqSupply.UniqSupply -> TransformSession a -> a runTransformSession uniqSupply session = State.evalState session (emptyTransformState uniqSupply) + +-- Is the given expression representable at runtime, based on the type? +isRepr :: CoreSyn.CoreExpr -> TransformMonad Bool +isRepr (Type ty) = return False +isRepr expr = Trans.lift $ MonadState.lift tsType $ VHDLTools.isReprType (CoreUtils.exprType expr) diff --git a/VHDLTools.hs b/VHDLTools.hs index 359597f..8bc45f7 100644 --- a/VHDLTools.hs +++ b/VHDLTools.hs @@ -479,3 +479,11 @@ mkTyConHType tycon args = where tyvars = TyCon.tyConTyVars tycon subst = CoreSubst.extendTvSubstList CoreSubst.emptySubst (zip tyvars args) + +-- Is the given type representable at runtime? +isReprType :: Type.Type -> TypeSession Bool +isReprType ty = do + ty_either <- vhdl_ty_either ty + return $ case ty_either of + Left _ -> False + Right _ -> True -- 2.30.2