projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Added 'div' to set of vectorising functions
[ghc-hetmet.git] / compiler / vectorise / VectBuiltIn.hs
diff --git a/compiler/vectorise/VectBuiltIn.hs b/compiler/vectorise/VectBuiltIn.hs
index 204f2df..9d790c6 100644 (file)
--- a/compiler/vectorise/VectBuiltIn.hs
+++ b/compiler/vectorise/VectBuiltIn.hs
@@ -1,12 +1,6 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module VectBuiltIn (
-  Builtins(..), sumTyCon, prodTyCon, combinePAVar,
+  Builtins(..), sumTyCon, prodTyCon, uarrTy, intPrimArrayTy,
+  combinePAVar,
   initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
   initBuiltinPAs, initBuiltinPRs,
   initBuiltinBoxedTyCons,
@@ -19,7 +13,7 @@ module VectBuiltIn (
 import DsMonad
 import IfaceEnv        ( lookupOrig )
 
-import Module          ( Module )
+import Module
 import DataCon         ( DataCon, dataConName, dataConWorkId )
 import TyCon           ( TyCon, tyConName, tyConDataCons )
 import Var             ( Var )
@@ -29,16 +23,15 @@ import NameEnv
 import OccName
 
 import TypeRep         ( funTyCon )
-import Type            ( Type )
+import Type            ( Type, mkTyConApp )
 import TysPrim
 import TysWiredIn      ( unitTyCon, unitDataCon,
                          tupleTyCon,
-                         intTyCon, intTyConName,
+                         intTyCon, intTyConName, intTy,
                          doubleTyCon, doubleTyConName,
                          boolTyCon, boolTyConName, trueDataCon, falseDataCon,
-                         parrTyCon, parrTyConName )
+                         parrTyConName )
 import PrelNames       ( gHC_PARR )
-import Module
 import BasicTypes      ( Boxity(..) )
 
 import FastString
@@ -49,7 +42,7 @@ import Control.Monad   ( liftM, zipWithM )
 import Data.List       ( unzip4 )
 
 mAX_NDP_PROD :: Int
-mAX_NDP_PROD = 3
+mAX_NDP_PROD = 5
 
 mAX_NDP_SUM :: Int
 mAX_NDP_SUM = 3
@@ -60,10 +53,14 @@ mAX_NDP_COMBINE = 2
 mkNDPModule :: FastString -> Module
 mkNDPModule m = mkModule ndpPackageId (mkModuleNameFS m)
 
+nDP_UARR, nDP_PARRAY, nDP_REPR, nDP_CLOSURE, nDP_UNBOXED, nDP_INSTANCES, nDP_COMBINATORS,
+    nDP_PRELUDE_PARR, nDP_PRELUDE_INT, nDP_PRELUDE_DOUBLE :: Module
+
+nDP_UARR        = mkNDPModule FSLIT("Data.Array.Parallel.Unlifted.Flat.UArr")
 nDP_PARRAY      = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.PArray")
 nDP_REPR        = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Repr")
 nDP_CLOSURE     = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Closure")
-nDP_PRIM        = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Prim")
+nDP_UNBOXED     = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Unboxed")
 nDP_INSTANCES   = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Instances")
 nDP_COMBINATORS = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Combinators")
 
@@ -78,8 +75,7 @@ data Builtins = Builtins {
                 , preprTyCon       :: TyCon
                 , prTyCon          :: TyCon
                 , prDataCon        :: DataCon
-                , parrayIntPrimTyCon :: TyCon
-                , parrayBoolPrimTyCon :: TyCon
+                , uarrTyCon        :: TyCon
                 , voidTyCon        :: TyCon
                 , wrapTyCon        :: TyCon
                 , enumerationTyCon :: TyCon
@@ -103,6 +99,12 @@ data Builtins = Builtins {
                 , liftingContext   :: Var
                 }
 
+uarrTy :: Type -> Builtins -> Type
+uarrTy ty bi = mkTyConApp (uarrTyCon bi) [ty]
+
+intPrimArrayTy :: Builtins -> Type
+intPrimArrayTy = uarrTy intTy
+
 sumTyCon :: Int -> Builtins -> TyCon
 sumTyCon n bi
   | n >= 2 && n <= mAX_NDP_SUM = sumTyCons bi ! n
@@ -128,8 +130,7 @@ initBuiltins
       preprTyCon   <- externalTyCon nDP_PARRAY FSLIT("PRepr")
       prTyCon      <- externalTyCon nDP_PARRAY FSLIT("PR")
       let [prDataCon] = tyConDataCons prTyCon
-      parrayIntPrimTyCon <- externalTyCon nDP_PRIM FSLIT("PArray_Int#")
-      parrayBoolPrimTyCon <- externalTyCon nDP_PRIM FSLIT("PArray_Bool#")
+      uarrTyCon    <- externalTyCon nDP_UARR   FSLIT("UArr")
       closureTyCon <- externalTyCon nDP_CLOSURE FSLIT(":->")
 
       voidTyCon    <- externalTyCon nDP_REPR FSLIT("Void")
@@ -146,10 +147,10 @@ initBuiltins
       applyClosureVar  <- externalVar nDP_CLOSURE FSLIT("$:")
       mkClosurePVar    <- externalVar nDP_CLOSURE FSLIT("mkClosureP")
       applyClosurePVar <- externalVar nDP_CLOSURE FSLIT("$:^")
-      replicatePAIntPrimVar <- externalVar nDP_PRIM FSLIT("replicatePA_Int#")
-      upToPAIntPrimVar <- externalVar nDP_PRIM FSLIT("upToPA_Int#")
-      selectPAIntPrimVar <- externalVar nDP_PRIM FSLIT("selectPA_Int#")
-      truesPABoolPrimVar <- externalVar nDP_PRIM FSLIT("truesPA_Bool#")
+      replicatePAIntPrimVar <- externalVar nDP_UNBOXED FSLIT("replicatePA_Int#")
+      upToPAIntPrimVar <- externalVar nDP_UNBOXED FSLIT("upToPA_Int#")
+      selectPAIntPrimVar <- externalVar nDP_UNBOXED FSLIT("selectPA_Int#")
+      truesPABoolPrimVar <- externalVar nDP_UNBOXED FSLIT("truesPA_Bool#")
       lengthPAVar      <- externalVar nDP_PARRAY FSLIT("lengthPA#")
       replicatePAVar   <- externalVar nDP_PARRAY FSLIT("replicatePA#")
       emptyPAVar       <- externalVar nDP_PARRAY FSLIT("emptyPA")
@@ -170,8 +171,7 @@ initBuiltins
                , preprTyCon       = preprTyCon
                , prTyCon          = prTyCon
                , prDataCon        = prDataCon
-               , parrayIntPrimTyCon = parrayIntPrimTyCon
-               , parrayBoolPrimTyCon = parrayBoolPrimTyCon
+               , uarrTyCon        = uarrTyCon
                , voidTyCon        = voidTyCon
                , wrapTyCon        = wrapTyCon
                , enumerationTyCon = enumerationTyCon
@@ -196,7 +196,7 @@ initBuiltins
                }
 
 initBuiltinVars :: Builtins -> DsM [(Var, Var)]
-initBuiltinVars bi
+initBuiltinVars _
   = do
       uvars <- zipWithM externalVar umods ufs
       vvars <- zipWithM externalVar vmods vfs
@@ -221,17 +221,30 @@ preludeVars
     , mk gHC_PARR FSLIT("crossMapP")  nDP_COMBINATORS FSLIT("crossMapPA")
     , mk gHC_PARR FSLIT("singletonP") nDP_COMBINATORS FSLIT("singletonPA")
     , mk gHC_PARR FSLIT("concatP")    nDP_COMBINATORS FSLIT("concatPA")
+    , mk gHC_PARR FSLIT("+:+")        nDP_COMBINATORS FSLIT("appPA")
 
     , mk nDP_PRELUDE_INT  FSLIT("plus") nDP_PRELUDE_INT FSLIT("plusV")
     , mk nDP_PRELUDE_INT  FSLIT("minus") nDP_PRELUDE_INT FSLIT("minusV")
     , mk nDP_PRELUDE_INT  FSLIT("mult")  nDP_PRELUDE_INT FSLIT("multV")
+    , mk nDP_PRELUDE_INT  FSLIT("intDiv")  nDP_PRELUDE_INT FSLIT("intDivV")
     , mk nDP_PRELUDE_INT  FSLIT("sumP")  nDP_PRELUDE_INT FSLIT("sumPA")
     , mk nDP_PRELUDE_INT  FSLIT("upToP") nDP_PRELUDE_INT FSLIT("upToPA")
 
+    , mk nDP_PRELUDE_INT  FSLIT("eq") nDP_PRELUDE_INT FSLIT("eqV")
+    , mk nDP_PRELUDE_INT  FSLIT("neq") nDP_PRELUDE_INT FSLIT("neqV")
+    , mk nDP_PRELUDE_INT  FSLIT("le")  nDP_PRELUDE_INT FSLIT("leV")
+    , mk nDP_PRELUDE_INT  FSLIT("lt") nDP_PRELUDE_INT FSLIT("ltV")
+    , mk nDP_PRELUDE_INT  FSLIT("ge") nDP_PRELUDE_INT FSLIT("geV")
+    , mk nDP_PRELUDE_INT  FSLIT("gt")  nDP_PRELUDE_INT FSLIT("gtV")
+
     , mk nDP_PRELUDE_DOUBLE  FSLIT("plus") nDP_PRELUDE_DOUBLE FSLIT("plusV")
     , mk nDP_PRELUDE_DOUBLE  FSLIT("minus") nDP_PRELUDE_DOUBLE FSLIT("minusV")
     , mk nDP_PRELUDE_DOUBLE  FSLIT("mult")  nDP_PRELUDE_DOUBLE FSLIT("multV")
     , mk nDP_PRELUDE_DOUBLE  FSLIT("sumP")  nDP_PRELUDE_DOUBLE FSLIT("sumPA")
+    , mk nDP_PRELUDE_DOUBLE  FSLIT("minIndexP") 
+         nDP_PRELUDE_DOUBLE  FSLIT("minIndexPA")
+    , mk nDP_PRELUDE_DOUBLE  FSLIT("maxIndexP")
+         nDP_PRELUDE_DOUBLE  FSLIT("maxIndexPA")
 
     , mk nDP_PRELUDE_DOUBLE  FSLIT("eq") nDP_PRELUDE_DOUBLE FSLIT("eqV")
     , mk nDP_PRELUDE_DOUBLE  FSLIT("neq") nDP_PRELUDE_DOUBLE FSLIT("neqV")
@@ -264,7 +277,7 @@ defaultTyCons :: [TyCon]
 defaultTyCons = [intTyCon, boolTyCon, doubleTyCon]
 
 initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
-initBuiltinDataCons bi = [(dataConName dc, dc)| dc <- defaultDataCons]
+initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
 
 defaultDataCons :: [DataCon]
 defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
@@ -277,6 +290,7 @@ initBuiltinDicts ps
   where
     (tcs, mods, fss) = unzip3 ps
 
+initBuiltinPAs :: Builtins -> DsM [(Name, Var)]
 initBuiltinPAs = initBuiltinDicts . builtinPAs
 
 builtinPAs :: Builtins -> [(Name, Module, FastString)]
@@ -295,11 +309,12 @@ builtinPAs bi
   where
     mk name mod fs = (name, mod, fs)
 
-    tups = map mk_tup [2..3]
+    tups = map mk_tup [2..mAX_NDP_PROD]
     mk_tup n = mk (tyConName $ tupleTyCon Boxed n)
                   nDP_INSTANCES
                   (mkFastString $ "dPA_" ++ show n)
 
+initBuiltinPRs :: Builtins -> DsM [(Name, Var)]
 initBuiltinPRs = initBuiltinDicts . builtinPRs
 
 builtinPRs :: Builtins -> [(Name, Module, FastString)]
@@ -331,7 +346,7 @@ initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
 initBuiltinBoxedTyCons = return . builtinBoxedTyCons
 
 builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
-builtinBoxedTyCons bi =
+builtinBoxedTyCons _ =
   [(tyConName intPrimTyCon, intTyCon)]
 
 externalVar :: Module -> FastString -> DsM Var
@@ -342,6 +357,7 @@ externalTyCon :: Module -> FastString -> DsM TyCon
 externalTyCon mod fs
   = dsLookupTyCon =<< lookupOrig mod (mkOccNameFS tcName fs)
 
+unitTyConName :: Name
 unitTyConName = tyConName unitTyCon
 
 
@@ -349,7 +365,7 @@ primMethod :: TyCon -> String -> DsM (Maybe Var)
 primMethod tycon method
   | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
   = liftM Just
-  $ dsLookupGlobalId =<< lookupOrig nDP_PRIM (mkVarOcc $ method ++ suffix)
+  $ dsLookupGlobalId =<< lookupOrig nDP_UNBOXED (mkVarOcc $ method ++ suffix)
 
   | otherwise = return Nothing
 
@@ -357,10 +373,12 @@ primPArray :: TyCon -> DsM (Maybe TyCon)
 primPArray tycon
   | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
   = liftM Just
-  $ dsLookupTyCon =<< lookupOrig nDP_PRIM (mkOccName tcName $ "PArray" ++ suffix)
+  $ dsLookupTyCon =<< lookupOrig nDP_UNBOXED (mkOccName tcName $ "PArray" ++ suffix)
 
   | otherwise = return Nothing
 
+prim_ty_cons :: NameEnv String
 prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
   where
     mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)
+
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)