{- CAO Compiler Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . -} {- Module : $Header$ Description : Variables Copyright : (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho License : GPL Maintainer : Paulo Silva Stability : experimental Portability : non-portable () Variables -} module Language.CAO.Common.Var ( module Language.CAO.Common.Name -- * Names , Var , varType , varId , varScope , VarUniq , Scope (..) , iNIT_VAR_ID -- Create variables , mkLId , mkGId , mkLConst , mkGConst , globalInit , isGlobalInit , getSymbol -- Modify variable , setId , setType , setIndConst , setName , setSymbol -- Query namespaces , nsVar , nsStructFld , nsPolInd , nsTyVar , nsFunName , isProcVar , isLocal , isGlobal , isGlobalVar , isNotExternal -- Consts , indVar , indConst -- Vars used in SSA -- Create Ssa Var , mkPhiFunVar , mkStoreInit , mkLoadGlobal , mkStoreGlobal , storeVar , loadStruct , loadVar , loadVarRng , loadMatrix , loadMatrixRng , loadMatrixColRng , loadMatrixRowRng , ssaDecl , sfield , vind , vrange , mind , mrange , mcolrange , mrowrange , isPhiFun , isStoreVar , isStoreGlobal , isStoreInit , isSsaDecl , isLoadGlobal , isLoadStruct , isLoadVar , isLoadVarRange , isLoadMat , isLoadMatRange , isLoadMatRowR , isLoadMatColR , isLValSField , isLValVInd , isLValVRng , isLValMInd , isLValMRng , isLValMColRng , isLValMRowRng -- C Function , getTName , getOpName , isCFunction , isCRef , isCGlobalRef , isCRefCall , isCStruct , isCCast , isCAssign , isCComp , cCast , cGlobalRef , mkCRef , mkCStruct , cFun ) where import Language.CAO.Type import Language.CAO.Type.Utils import Language.CAO.Index import Language.CAO.Common.Name import Language.CAO.Platform.Naming import Language.CAO.Common.Outputable -- | An AST Variable -- A variable in the CAO AST is any identifier which is not a keyword. -- data Var = Var { -- | @vname@ field, of type 'Name'. A 'Name' is just a string symbol -- of a 'NameSpace' (CAO variables, function symbols, -- struct fields, ...) vname :: !Name -- | @vuniq@, a 'VarUniq', or unique identifier. , vuniq :: !VarUniq -- | @vkind@ of type 'VarKind' is an annotation for the different -- kinds of variables. , vkind :: !VarKind } deriving (Show, Read) -- | Datatype representing different kinds of variables. -- Those kinds of variables are normal variables, constants, -- and special variables used in intermediate stages of the -- compiler. data VarKind -- | A normal CAO identifier. = VarId { -- | The 'Type' of the identifier. vtype :: !(Type Var) -- | @vscope@ of type 'Scope'. An identifier can be of scope -- @Local@ or @Global@. Function names and struct fields -- can only have 'Global' scope. , vscope :: !Scope } -- | CAO constant. | ConstId { -- | @vtype@. 'Type' of the constant. vtype :: !(Type Var) -- | @vconst@. The expression of type 'IExpr' defining the -- constant. , vconst :: !(Maybe (IExpr Var)) -- | @vscope@. The 'Scope' of the constant. Local or Global. , vscope :: !Scope } -- | Special variables for SSA: phi function, load/store, ... | SsaVar { -- | The 'SVKind' represents the kind of special SSA variable. -- Load/store, phi function, matrix/vector access, ... _vkind :: !SVKind } -- | Special variable for C function names | CVar { -- | @vtype@. The CAO 'Type' of the function name. vtype :: !(Type Var) -- | @opname@. The code of the function. Used for -- generating the C code. , opname :: !OpCode -- | @tname@. The string symbol of the type. Used for -- generating the C code. , tname :: !String -- | A 'CKind', or the kind of special variable. , _ckind :: !CKind } deriving (Show, Read) -- | SSA Variable Kind. data SVKind = PhiFun -- ^ Phi function. | LoadF LK -- ^ Load. 'LK' is the kind of specific Load. | StoreF SK -- ^ Store. 'SK' is the kind of specific Store. | AccessF (Type Var) AK -- ^ Access to a value in a container. The two -- arguments are the 'Type' of the value being -- accessed and the kind of specific access function -- 'AK'. | DeclF -- ^ Declaration functions. Should be removed in SsaBack -- They are used only to mark a variable declaration. -- TODO: maybe no longer needed. deriving (Show, Read) -- | Load kind. data LK -- | Load global variable. = LGlobal -- | Load struct. | LStruct -- | Load vector value. | LVect -- | Load vector range. | LVectRng -- | Load matrix value. | LMat -- | Load matrix row and column range. | LMatRng -- | Load matrix row range. | LMatRRng -- | Load matrix column range. | LMatCRng deriving (Show, Read) -- | Kind of store functions. data SK -- | Store global variable. = SGlobal -- | Store variable. | SVar -- | Store variable initialization. | SInit deriving (Show, Read) -- | Access kind. data AK -- | Access struct field. = ASField -- | Access vector value. | AVInd -- | Access vector range. | AVRng -- | Access matrix value. | AMInd -- | Access matrix row and column range. | AMRng -- | Access matrix column range. | AMColRng -- | Access matrix row range. | AMRowRng deriving (Show, Read) -- | Kind of special C variable. data CKind -- | A C function. = CFun -- | A C ref. | CRef -- | A C struct. | CStruct deriving (Show, Read) instance PP SVKind where ppr PhiFun = text "phi" ppr (LoadF _) = text "load" ppr (StoreF _) = text "store" ppr (AccessF _ ak) = text "access" <+> ppr ak ppr DeclF = text "ssa_decl" instance PP AK where ppr ASField = text "sfield" ppr AVInd = text "var" ppr AVRng = text "varrange" ppr AMInd = text "mind" ppr AMRng = text "mrange" ppr AMColRng = text "mcolrange" ppr AMRowRng = text "mrowrange" instance PP CKind where ppr CFun = text "cfun" ppr CRef = text "cref" ppr CStruct = text "cstruct" instance IsName Var where varName = vname -- | A unique identifier is a synonym to integer. type VarUniq = Int -- | @iNIT_VAR_ID@ is the initial identifier. Values below 1000 are reserved as -- identifiers for special variables. iNIT_VAR_ID :: VarUniq iNIT_VAR_ID = 1000 pHI_FUNCTION :: VarUniq pHI_FUNCTION = 134 sTORE_INIT :: VarUniq sTORE_INIT = 135 lOAD_GLOBAL :: VarUniq lOAD_GLOBAL = 136 sTORE_GLOBAL :: VarUniq sTORE_GLOBAL = 137 sTORE_VAR :: VarUniq sTORE_VAR = 100 lOAD_STRUCT :: VarUniq lOAD_STRUCT = 101 lOAD_VAR :: VarUniq lOAD_VAR = 102 lOAD_VAR_RNG :: VarUniq lOAD_VAR_RNG = 103 lOAD_MATRIX :: VarUniq lOAD_MATRIX = 104 lOAD_MATRIX_RANGE :: VarUniq lOAD_MATRIX_RANGE = 105 lOAD_MATRIX_ROW_RNG :: VarUniq lOAD_MATRIX_ROW_RNG = 106 lOAD_MATRIX_COL_RNG :: VarUniq lOAD_MATRIX_COL_RNG = 107 sFIELD :: VarUniq sFIELD = 108 vIND :: VarUniq vIND = 109 vRANGE :: VarUniq vRANGE = 110 mIND :: VarUniq mIND = 111 mRANGE :: VarUniq mRANGE = 112 mCOLRANGE :: VarUniq mCOLRANGE = 113 mROWRANGE :: VarUniq mROWRANGE = 114 gLOBAL_INIT :: VarUniq gLOBAL_INIT = 115 sSA_DECL ::VarUniq sSA_DECL = 116 -- C Functions cGLOBAL_REF :: VarUniq cGLOBAL_REF = 41 -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- -- | The @Scope@ of a variable. data Scope = Global -- ^ A global variable. | Local -- ^ Local variable. deriving (Show, Read) instance PP Scope where ppr Global = text "Global" ppr Local = text "Local" instance Eq Var where v1 == v2 = vuniq v1 == vuniq v2 instance Ord Var where v1 `compare` v2 = vuniq v1 `compare` vuniq v2 instance PP Var where ppr = pprVar instance PP VarKind where ppr = pprVarKind pprVar :: Var -> CDoc pprVar (Var n i vk) = text (nameStr n) <> ifPprIds (int i) <> ifPprDebug (text "@ID=" <> int i) <> ifPprDebug (pprVarKind vk) pprVarKind :: VarKind -> CDoc pprVarKind (VarId t s) = text "@Type=" <> noPprDebug (ppr t) <> text "@Scope=" <> ppr s pprVarKind (ConstId t c s) = text "@Type=" <> noPprDebug (ppr t) <> text "@Value=" <> ppr c <> text "@Scope=" <> ppr s pprVarKind (SsaVar k) = brackets $ ppr k pprVarKind (CVar t _ tn k) = text "@Type=" <> noPprDebug (ppr t) <> text "@TName=" <> text tn <> text "@Kind=" <> ppr k -- | Create local variable. {-# INLINE mkLId #-} mkLId :: Name -> VarUniq -> Type Var -> Var mkLId v i t = Var v i $ VarId t Local -- | Create global variable. {-# INLINE mkGId #-} mkGId :: Name -> VarUniq -> Type Var -> Var mkGId v i t = Var v i $ VarId t Global -- | Create local constant. {-# INLINE mkLConst #-} mkLConst :: Name -> VarUniq -> Type Var -> Maybe (IExpr Var) -> Var mkLConst v i t e = Var v i $ ConstId t e Local -- | Create global constant. {-# INLINE mkGConst #-} mkGConst :: Name -> VarUniq -> Type Var -> Maybe (IExpr Var) -> Var mkGConst v i t e = Var v i $ ConstId t e Global -- | Global @init@ function identifier. Used to initialize global variables. globalInit :: String -> [Var] -> Var globalInit s vars = Var (mkFunName s) gLOBAL_INIT globalInitK where globalInitK :: VarKind globalInitK = VarId (FuncSig [] (Tuple []) (Proc vars)) Global -- | Check if variable is a global init. isGlobalInit :: Var -> Bool isGlobalInit v = varId v == gLOBAL_INIT -- | Set type of variable. setType :: Type Var -> Var -> Var setType ty (Var n u v@(VarId _ _)) = Var n u (v {vtype = ty}) setType ty (Var a b c@(ConstId _ _ _)) = Var a b (c {vtype = ty}) setType _ v = v setIndConst :: IExpr Var -> Var -> Var setIndConst e v = v { vkind = aux (vkind v) } where aux (ConstId c _ s) = ConstId c (Just e) s aux k = k -- | Set variable name setName :: Name -> Var -> Var setName n v = v { vname = n } -- | Get string symbol of a variable name. getSymbol :: Var -> String getSymbol = nameStr . vname -- | Set string symbol of the name of a variable. setSymbol :: String -> Var -> Var setSymbol s v = v { vname = setNameStr s (vname v) } -- | Set variable identifier. setId :: VarUniq -> Var -> Var setId u (Var n _ vk) = Var n u vk -- | Get type name of a special C variable. getTName :: Var -> String getTName = tname . vkind -- | Get 'opname' of a special C variable. getOpName :: Var -> OpCode getOpName = opname . vkind -- | Get the type of a variable. {-# INLINE varType #-} varType :: Var -> Type Var varType (Var _ _ (VarId ty _)) = ty varType (Var _ _ (ConstId ty _ _)) = ty varType (Var _ _ (SsaVar (AccessF ty _))) = ty varType (Var _ _ (CVar ty _ _ _)) = ty varType v = error $ ".:\ \ Unexpected case: " ++ showPpr v -- | Get variable scope. {-# INLINE varScope #-} varScope :: Var -> Scope varScope (Var _ _ v@(VarId {})) = vscope v varScope (Var _ _ v@(ConstId {})) = vscope v varScope _ = Global -- | Get variable unique identifier. {-# INLINE varId #-} varId :: Var -> VarUniq varId = vuniq -- | Check if a variable is of 'Local' scope. {-# INLINE isLocal #-} isLocal :: Var -> Bool isLocal (Var _ _ (VarId _ Local)) = True isLocal (Var _ _ (ConstId _ _ Local)) = True isLocal _ = False -- | Check if a variable is of 'Global' scope. {-# INLINE isGlobal #-} isGlobal :: Var -> Bool isGlobal (Var _ _ (VarId _ Global)) = True isGlobal (Var _ _ (ConstId _ _ Global)) = True isGlobal _ = False -- | Check if a CAO variable is of 'Local' scope. {-# INLINE isGlobalVar #-} isGlobalVar :: Var -> Bool isGlobalVar (Var n _ (VarId _ Global)) = isVarName n isGlobalVar (Var n _ (ConstId _ _ Global)) = isVarName n isGlobalVar _ = False -- XXX: Not used -- | Check if variable is not external. {-# INLINE isNotExternal #-} isNotExternal :: Var -> Bool isNotExternal (Var _ _ (ConstId _ Nothing Global)) = False isNotExternal _ = True -- | Check if an AST variable is a CAO variable. {-# INLINE nsVar #-} nsVar :: Var -> Bool nsVar (Var n _ (VarId{})) = isVarName n nsVar (Var n _ (ConstId{})) = isVarName n nsVar _ = False -- | Check if an AST variable is a struct field. {-# INLINE nsStructFld #-} nsStructFld :: Var -> Bool nsStructFld (Var n _ (VarId{})) = isStructFldName n nsStructFld _ = False -- | Check if an AST variable is polynomial index. {-# INLINE nsPolInd #-} nsPolInd :: Var -> Bool nsPolInd (Var n _ (VarId{})) = isPolIndName n nsPolInd _ = False -- | Check if an AST variable is a type identifier. {-# INLINE nsTyVar #-} nsTyVar :: Var -> Bool nsTyVar (Var n _ (VarId{})) = isTvName n nsTyVar _ = False -- | Check if an AST variable is a function identifier. {-# INLINE nsFunName #-} nsFunName :: Var -> Bool nsFunName (Var n _ (VarId{})) = isFunName n nsFunName _ = False -- | Check if an AST variable is a procedure. {-# INLINE isProcVar #-} isProcVar :: Var -> Bool isProcVar (Var _ _ (VarId t _)) = isProc t isProcVar _ = False -- | Check if an AST variable an index variable. {-# INLINE indVar #-} indVar :: Var -> Bool indVar (Var n _ (ConstId {})) = isVarName n indVar _ = False -- | Get expression defining a constant (when existing). {-# INLINE indConst #-} indConst :: Var -> Maybe (IExpr Var) indConst (Var _ _ v@(ConstId {})) = vconst v indConst _ = Nothing -- | Create phi function variable. mkPhiFunVar :: Name -> Var mkPhiFunVar n = Var n pHI_FUNCTION $ SsaVar PhiFun -- | Create store init variable. mkStoreInit :: Name -> Var mkStoreInit n = Var n sTORE_INIT $ SsaVar $ StoreF SInit -- | Create load global variable. mkLoadGlobal :: Name -> Var mkLoadGlobal n = Var n lOAD_GLOBAL $ SsaVar (LoadF LGlobal) -- | Create store global variable. mkStoreGlobal :: Name -> Var mkStoreGlobal n = Var n sTORE_GLOBAL $ SsaVar (StoreF SGlobal) -- | Store var. storeVar :: Var storeVar = Var (mkFunName "store_v") sTORE_VAR storeVarK where storeVarK :: VarKind storeVarK = SsaVar (StoreF SVar) -- | Load struct. loadStruct :: Var loadStruct = Var (mkFunName "load_s") lOAD_STRUCT loadStructK where loadStructK :: VarKind loadStructK = SsaVar (LoadF LStruct) -- | Load variable. loadVar :: Var loadVar = Var (mkFunName "load_v") lOAD_VAR loadVarK where loadVarK :: VarKind loadVarK = SsaVar (LoadF LVect) -- | Load variable range. loadVarRng :: Var loadVarRng = Var (mkFunName "load_v_range") lOAD_VAR_RNG loadVarRngK where loadVarRngK :: VarKind loadVarRngK = SsaVar (LoadF LVectRng) -- | Load matrix value. loadMatrix :: Var loadMatrix = Var (mkFunName "load_m") lOAD_MATRIX loadMatrixK where loadMatrixK :: VarKind loadMatrixK = SsaVar (LoadF LMat) -- | Load matrix range. loadMatrixRng :: Var loadMatrixRng = Var (mkFunName "load_m_range") lOAD_MATRIX_RANGE loadMatrixRngK where loadMatrixRngK :: VarKind loadMatrixRngK = SsaVar (LoadF LMatRng) -- | Load matrix column range. loadMatrixColRng :: Var loadMatrixColRng = Var (mkFunName "load_m_col_range") lOAD_MATRIX_COL_RNG loadMatrixColRngK where loadMatrixColRngK :: VarKind loadMatrixColRngK = SsaVar (LoadF LMatCRng) -- | Load matrix row range. loadMatrixRowRng :: Var loadMatrixRowRng = Var (mkFunName "load_m_row_range") lOAD_MATRIX_ROW_RNG loadMatrixRowRngK where loadMatrixRowRngK :: VarKind loadMatrixRowRngK = SsaVar (LoadF LMatRRng) -- | Special marker for variable declarations in SSA. ssaDecl :: Var ssaDecl = Var (mkFunName "ssa_decl") sSA_DECL ssaDeclK where ssaDeclK :: VarKind ssaDeclK = SsaVar DeclF -- | Access struct field. sfield :: Type Var -> Var sfield t = Var (mkFunName "sfield") sFIELD sfieldK where sfieldK :: VarKind sfieldK = SsaVar (AccessF t ASField) -- | Access vector element. vind :: Type Var -> Var vind t = Var (mkFunName "vind") vIND vindK where vindK :: VarKind vindK = SsaVar (AccessF t AVInd) -- | Access vector range. vrange :: Type Var -> Var vrange t = Var (mkFunName "vrange") vRANGE vrangeK where vrangeK :: VarKind vrangeK = SsaVar (AccessF t AVRng) -- | Access matrix element. mind :: Type Var -> Var mind t = Var (mkFunName "mind") mIND mindK where mindK :: VarKind mindK = SsaVar (AccessF t AMInd) -- | Access matrix range. mrange :: Type Var -> Var mrange t = Var (mkFunName "mrange") mRANGE mrangeK where mrangeK :: VarKind mrangeK = SsaVar (AccessF t AMRng) -- | Access matrix column range. mcolrange :: Type Var -> Var mcolrange t = Var (mkFunName "mcolrange") mCOLRANGE mcolrangeK where mcolrangeK :: VarKind mcolrangeK = SsaVar (AccessF t AMColRng) -- | Access matrix row range. mrowrange :: Type Var -> Var mrowrange t = Var (mkFunName "mrowrange") mROWRANGE mrowrangeK where mrowrangeK :: VarKind mrowrangeK = SsaVar (AccessF t AMRowRng) -- | Check if variable is a phi function. {-# INLINE isPhiFun #-} isPhiFun :: Var -> Bool isPhiFun (Var _ _ (SsaVar PhiFun)) = True isPhiFun _ = False -- | Check if variable is a store global function. {-# INLINE isStoreGlobal #-} isStoreGlobal :: Var -> Bool isStoreGlobal (Var _ _ (SsaVar (StoreF SGlobal))) = True isStoreGlobal _ = False -- | Check if variable is a store function. {-# INLINE isStoreVar #-} isStoreVar :: Var -> Bool isStoreVar (Var _ _ (SsaVar (StoreF SVar))) = True isStoreVar _ = False -- | Check if variable is a store with initialization function. {-# INLINE isStoreInit #-} isStoreInit :: Var -> Bool isStoreInit (Var _ _ (SsaVar (StoreF SInit))) = True isStoreInit _ = False -- | Check if variable is a ssa declaration. {-# INLINE isSsaDecl #-} isSsaDecl :: Var -> Bool isSsaDecl (Var _ _ (SsaVar DeclF)) = True isSsaDecl _ = False -- | Check if variable is a load global. {-# INLINE isLoadGlobal #-} isLoadGlobal :: Var -> Bool isLoadGlobal (Var _ _ (SsaVar (LoadF LGlobal))) = True isLoadGlobal _ = False -- | Check if variable is a load struct. {-# INLINE isLoadStruct #-} isLoadStruct :: Var -> Bool isLoadStruct (Var _ _ (SsaVar (LoadF LStruct))) = True isLoadStruct _ = False -- | Check if variable is a load var. {-# INLINE isLoadVar #-} isLoadVar :: Var -> Bool isLoadVar (Var _ _ (SsaVar (LoadF LVect))) = True isLoadVar _ = False -- | Check if variable is a load var range. {-# INLINE isLoadVarRange #-} isLoadVarRange :: Var -> Bool isLoadVarRange (Var _ _ (SsaVar (LoadF LVectRng))) = True isLoadVarRange _ = False -- | Check if variable is a load matrix . {-# INLINE isLoadMat #-} isLoadMat :: Var -> Bool isLoadMat (Var _ _ (SsaVar (LoadF LMat))) = True isLoadMat _ = False -- | Check if variable is a load matrix range. {-# INLINE isLoadMatRange #-} isLoadMatRange :: Var -> Bool isLoadMatRange (Var _ _ (SsaVar (LoadF LMatRng))) = True isLoadMatRange _ = False -- | Check if variable is a load matrix row range. {-# INLINE isLoadMatRowR #-} isLoadMatRowR :: Var -> Bool isLoadMatRowR (Var _ _ (SsaVar (LoadF LMatRRng))) = True isLoadMatRowR _ = False -- | Check if variable is a load matrix column range. {-# INLINE isLoadMatColR #-} isLoadMatColR :: Var -> Bool isLoadMatColR (Var _ _ (SsaVar (LoadF LMatCRng))) = True isLoadMatColR _ = False -- | Check if variable is a struct field 'LValue'. {-# INLINE isLValSField #-} isLValSField :: Var -> Bool isLValSField (Var _ _ (SsaVar (AccessF _ ASField))) = True isLValSField _ = False -- | Check if variable is a vector element 'LValue'. {-# INLINE isLValVInd #-} isLValVInd :: Var -> Bool isLValVInd (Var _ _ (SsaVar (AccessF _ AVInd))) = True isLValVInd _ = False -- | Check if variable is a vector range 'LValue'. {-# INLINE isLValVRng #-} isLValVRng :: Var -> Bool isLValVRng (Var _ _ (SsaVar (AccessF _ AVRng))) = True isLValVRng _ = False -- | Check if variable is a matrix element 'LValue'. {-# INLINE isLValMInd #-} isLValMInd :: Var -> Bool isLValMInd (Var _ _ (SsaVar (AccessF _ AMInd))) = True isLValMInd _ = False -- | Check if variable is a matrix range 'LValue'. {-# INLINE isLValMRng #-} isLValMRng :: Var -> Bool isLValMRng (Var _ _ (SsaVar (AccessF _ AMRng))) = True isLValMRng _ = False -- | Check if variable is a matrix column range 'LValue'. {-# INLINE isLValMColRng #-} isLValMColRng :: Var -> Bool isLValMColRng (Var _ _ (SsaVar (AccessF _ AMColRng))) = True isLValMColRng _ = False -- | Check if variable is a matrix row range 'LValue'. {-# INLINE isLValMRowRng #-} isLValMRowRng :: Var -> Bool isLValMRowRng (Var _ _ (SsaVar (AccessF _ AMRowRng))) = True isLValMRowRng _ = False -- | Check if variable is a C function. {-# INLINE isCFunction #-} isCFunction :: Var -> Bool isCFunction (Var _ _ (CVar _ _ _ CFun)) = True isCFunction _ = False -- | Check if variable is a C reference. isCRef :: Var -> Bool isCRef (Var _ _ (CVar _ _ _ CRef)) = True isCRef _ = False -- | Check if variable is a C reference. isCRefCall :: Var -> Bool isCRefCall (Var _ uid (CVar _ _ _ CFun)) = uid == code_ref isCRefCall _ = False -- | Check if variable is a C reference call. isCStruct :: Var -> Bool isCStruct (Var _ _ (CVar _ _ _ CStruct)) = True isCStruct _ = False -- | Check if a variable is a C cast. isCCast :: Var -> Bool isCCast (Var _ uid (CVar _ _ _ CFun)) = uid == code_cast isCCast _ = False -- | Check if a variable is a C assignment isCAssign :: Var -> Bool isCAssign (Var _ uid (CVar _ _ _ CFun)) = uid == code_assign isCAssign _ = False -- | Check if variable is a C comp. isCComp :: Var -> Bool isCComp (Var _ uid (CVar _ _ _ CFun)) = isCompCode uid isCComp _ = False -- | Check if variable is a C global reference. isCGlobalRef :: Var -> Bool isCGlobalRef (Var _ uid (CVar _ _ _ CFun)) = uid == cGLOBAL_REF isCGlobalRef _ = False -- | Create a C cast function variable. cCast :: Type Var -> String -> String -> String -> Var cCast v tp tn td = Var (mkFunName $ tp ++ "_" ++ tn ++ "_cast_" ++ td) code_cast cCastK where cCastK = CVar v code_cast tn CFun -- | Create C global reference. cGlobalRef :: String -> Var cGlobalRef tp = Var (mkFunName $ tp ++ "_global_ref") cGLOBAL_REF cGlobalRefK where cGlobalRefK = CVar Bullet code_ref "global" CFun -- | Create a C reference variable. mkCRef :: String -> VarUniq -> String -> Var mkCRef nm uid tn = Var (mkVarName nm) uid $ CVar Bullet (-1) tn CRef -- | Create a C struct variable mkCStruct :: String -> VarUniq -> Type Var -> String -> String -> Var mkCStruct nm uid typ tp tn = Var (mkVarName $ tp ++ "_" ++ nm) uid cstructK where cstructK = CVar typ (-1) tn CStruct assembleName :: String -> String -> OpCode -> Name assembleName tp tn op = mkFunName $ tp ++ "_" ++ tn ++ "_" ++ operName op cFun :: OpCode -> Type Var -> String -> String -> Var cFun op t tp tn = Var (assembleName tp tn op) op $ CVar t op tn CFun