X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectMonad.hs;h=0329af8bb5625eadf9f1a242a84eda7a7734603b;hb=f83010b119096699d1efef2f7bb45460719c48f9;hp=ed18f1f7a93d648ba9079832b5e31e81879a05eb;hpb=ea81010210486aa7b8b3ef36c65f794a33dbfefe;p=ghc-hetmet.git diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs index ed18f1f..0329af8 100644 --- a/compiler/vectorise/VectMonad.hs +++ b/compiler/vectorise/VectMonad.hs @@ -3,7 +3,7 @@ module VectMonad ( VM, noV, tryV, maybeV, orElseV, fixV, localV, closedV, initV, - cloneName, newLocalVar, newTyVar, + cloneName, newExportedVar, newLocalVar, newDummyVar, newTyVar, Builtins(..), paDictTyCon, paDictDataCon, builtin, @@ -47,6 +47,7 @@ import FamInstEnv import Panic import Outputable import FastString +import SrcLoc ( noSrcSpan ) import Control.Monad ( liftM ) @@ -280,12 +281,25 @@ cloneName mk_occ name = liftM make (liftDs newUnique) (nameSrcSpan name) | otherwise = mkSystemName u occ_name +newExportedVar :: OccName -> Type -> VM Var +newExportedVar occ_name ty + = do + mod <- liftDs getModuleDs + u <- liftDs newUnique + + let name = mkExternalName u mod occ_name noSrcSpan + + return $ Id.mkExportedLocalId name ty + newLocalVar :: FastString -> Type -> VM Var newLocalVar fs ty = do u <- liftDs newUnique return $ mkSysLocal fs u ty +newDummyVar :: Type -> VM Var +newDummyVar = newLocalVar FSLIT("ds") + newTyVar :: FastString -> Kind -> VM Var newTyVar fs k = do