From f48c36d1f3f64570b44fae1737ad34f6ce98bd7d Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Tue, 10 Jul 2007 11:38:22 +0000 Subject: [PATCH] PA is now a class instead of a record --- compiler/prelude/PrelNames.lhs | 19 +++++++++---------- compiler/vectorise/VectMonad.hs | 14 +++++++------- compiler/vectorise/Vectorise.hs | 2 +- 3 files changed, 17 insertions(+), 18 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 0ed9c1f..80db9eb 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -217,10 +217,9 @@ genericTyConNames :: [Name] genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName] ndpNames :: [Name] -ndpNames = [ parrayTyConName, paTyConName, closureTyConName +ndpNames = [ parrayTyConName, paClassName, closureTyConName , mkClosureName, applyClosureName , mkClosurePName, applyClosurePName - , closurePAName , lengthPAName, replicatePAName ] \end{code} @@ -689,15 +688,14 @@ checkDotnetResName = varQual dOTNET FSLIT("checkResult") checkDotnetResNam -- NDP stuff parrayTyConName = tcQual nDP_LIFTED FSLIT("PArray") parrayTyConKey -paTyConName = tcQual nDP_LIFTED FSLIT("PA") paTyConKey +paClassName = clsQual nDP_LIFTED FSLIT("PA") paClassKey closureTyConName = tcQual nDP_LIFTED FSLIT(":->") closureTyConKey mkClosureName = varQual nDP_LIFTED FSLIT("mkClosure") mkClosureIdKey applyClosureName = varQual nDP_LIFTED FSLIT("$:") applyClosureIdKey mkClosurePName = varQual nDP_LIFTED FSLIT("mkClosureP") mkClosurePIdKey applyClosurePName = varQual nDP_LIFTED FSLIT("$:^") applyClosurePIdKey -closurePAName = varQual nDP_LIFTED FSLIT("closurePA") closurePAIdKey -lengthPAName = varQual nDP_LIFTED FSLIT("lengthP") lengthPAIdKey -replicatePAName = varQual nDP_LIFTED FSLIT("replicateP") replicatePAIdKey +lengthPAName = methName nDP_LIFTED FSLIT("lengthPA") lengthPAClassOpKey +replicatePAName = methName nDP_LIFTED FSLIT("replicatePA") replicatePAClassOpKey \end{code} %************************************************************************ @@ -767,6 +765,8 @@ randomClassKey = mkPreludeClassUnique 31 randomGenClassKey = mkPreludeClassUnique 32 isStringClassKey = mkPreludeClassUnique 33 + +paClassKey = mkPreludeClassUnique 34 \end{code} %************************************************************************ @@ -878,8 +878,7 @@ opaqueTyConKey = mkPreludeTyConUnique 133 stringTyConKey = mkPreludeTyConUnique 134 parrayTyConKey = mkPreludeTyConUnique 135 -paTyConKey = mkPreludeTyConUnique 136 -closureTyConKey = mkPreludeTyConUnique 137 +closureTyConKey = mkPreludeTyConUnique 136 ---------------- Template Haskell ------------------- @@ -1067,8 +1066,8 @@ applyClosureIdKey = mkPreludeMiscIdUnique 127 mkClosurePIdKey = mkPreludeMiscIdUnique 128 applyClosurePIdKey = mkPreludeMiscIdUnique 129 closurePAIdKey = mkPreludeMiscIdUnique 130 -lengthPAIdKey = mkPreludeMiscIdUnique 131 -replicatePAIdKey = mkPreludeMiscIdUnique 132 +lengthPAClassOpKey = mkPreludeMiscIdUnique 131 +replicatePAClassOpKey = mkPreludeMiscIdUnique 132 ---------------- Template Haskell ------------------- -- USES IdUniques 200-399 diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs index ab77037..289f526 100644 --- a/compiler/vectorise/VectMonad.hs +++ b/compiler/vectorise/VectMonad.hs @@ -4,7 +4,7 @@ module VectMonad ( noV, tryV, maybeV, orElseV, localV, initV, newLocalVar, newTyVar, - Builtins(..), + Builtins(..), paDictTyCon, builtin, GlobalEnv(..), @@ -46,41 +46,41 @@ import FastString data Builtins = Builtins { parrayTyCon :: TyCon - , paTyCon :: TyCon + , paClass :: Class , closureTyCon :: TyCon , mkClosureVar :: Var , applyClosureVar :: Var , mkClosurePVar :: Var , applyClosurePVar :: Var - , closurePAVar :: Var , lengthPAVar :: Var , replicatePAVar :: Var } +paDictTyCon :: Builtins -> TyCon +paDictTyCon = classTyCon . paClass + initBuiltins :: DsM Builtins initBuiltins = do parrayTyCon <- dsLookupTyCon parrayTyConName - paTyCon <- dsLookupTyCon paTyConName + paClass <- dsLookupClass paClassName closureTyCon <- dsLookupTyCon closureTyConName mkClosureVar <- dsLookupGlobalId mkClosureName applyClosureVar <- dsLookupGlobalId applyClosureName mkClosurePVar <- dsLookupGlobalId mkClosurePName applyClosurePVar <- dsLookupGlobalId applyClosurePName - closurePAVar <- dsLookupGlobalId closurePAName lengthPAVar <- dsLookupGlobalId lengthPAName replicatePAVar <- dsLookupGlobalId replicatePAName return $ Builtins { parrayTyCon = parrayTyCon - , paTyCon = paTyCon + , paClass = paClass , closureTyCon = closureTyCon , mkClosureVar = mkClosureVar , applyClosureVar = applyClosureVar , mkClosurePVar = mkClosurePVar , applyClosurePVar = applyClosurePVar - , closurePAVar = closurePAVar , lengthPAVar = lengthPAVar , replicatePAVar = replicatePAVar } diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs index df9fdb9..29774d1 100644 --- a/compiler/vectorise/Vectorise.hs +++ b/compiler/vectorise/Vectorise.hs @@ -181,7 +181,7 @@ paArgType ty (FunTy k1 k2) paArgType ty k | isLiftedTypeKind k = do - tc <- builtin paTyCon + tc <- builtin paDictTyCon return . Just $ TyConApp tc [ty] | otherwise -- 1.7.10.4