Eliminate hardcoded names of D.A.P
authorManuel M T Chakravarty <chak@cse.unsw.edu.au>
Wed, 15 Jun 2011 12:07:20 +0000 (22:07 +1000)
committerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Wed, 15 Jun 2011 14:40:33 +0000 (00:40 +1000)
compiler/ghc.cabal.in
compiler/vectorise/Vectorise/Builtins.hs
compiler/vectorise/Vectorise/Builtins/Initialise.hs
compiler/vectorise/Vectorise/Builtins/Modules.hs
compiler/vectorise/Vectorise/Builtins/Prelude.hs [deleted file]
compiler/vectorise/Vectorise/Env.hs
compiler/vectorise/Vectorise/Monad.hs

index 4ffb915..841d85e 100644 (file)
@@ -456,7 +456,6 @@ Library
         Vectorise.Builtins.Base
         Vectorise.Builtins.Initialise
         Vectorise.Builtins.Modules
-        Vectorise.Builtins.Prelude
         Vectorise.Builtins
         Vectorise.Monad.Base
         Vectorise.Monad.Naming
index 3647a7f..125d264 100644 (file)
@@ -8,32 +8,33 @@
 --   civilized panic message if the specified thing cannot be found.
 --
 module Vectorise.Builtins (
-       -- * Builtins
-       Builtins(..),
-       indexBuiltin,
-       
-       -- * Wrapped selectors
-       selTy,
-       selReplicate,
-       selPick,
-       selTags,
-       selElements,
-       sumTyCon,
-       prodTyCon,
-       prodDataCon,
-       combinePDVar,
-       scalarZip,
-       closureCtrFun,
+  -- * Builtins
+  Builtins(..),
+  indexBuiltin,
+  
+  -- * Wrapped selectors
+  selTy,
+  selReplicate,
+  selPick,
+  selTags,
+  selElements,
+  sumTyCon,
+  prodTyCon,
+  prodDataCon,
+  combinePDVar,
+  scalarZip,
+  closureCtrFun,
 
-       -- * Initialisation
-       initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
-       initBuiltinPAs, initBuiltinPRs,
-       initBuiltinBoxedTyCons, initBuiltinScalars,
-       
-       -- * Lookup
-       primMethod,
-       primPArray
+  -- * Initialisation
+  initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
+  initBuiltinPAs, initBuiltinPRs,
+  initBuiltinBoxedTyCons,
+  
+  -- * Lookup
+  primMethod,
+  primPArray
 ) where
+  
 import Vectorise.Builtins.Base
 import Vectorise.Builtins.Modules
 import Vectorise.Builtins.Initialise
@@ -48,7 +49,8 @@ import Var
 import Control.Monad
 
 
--- | Lookup a method function given its name and instance type.
+-- |Lookup a method function given its name and instance type.
+--
 primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
 primMethod  tycon method (Builtins { dphModules = mods })
   | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
@@ -58,7 +60,8 @@ primMethod  tycon method (Builtins { dphModules = mods })
 
   | otherwise = return Nothing
 
--- | Lookup the representation type we use for PArrays that contain a given element type.
+-- |Lookup the representation type we use for PArrays that contain a given element type.
+--
 primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
 primPArray tycon (Builtins { dphModules = mods })
   | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
index 5a6cf88..9fdf3ba 100644 (file)
@@ -1,14 +1,13 @@
 
-
 module Vectorise.Builtins.Initialise (
-       -- * Initialisation
-       initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
-       initBuiltinPAs, initBuiltinPRs,
-       initBuiltinBoxedTyCons, initBuiltinScalars,
+  -- * Initialisation
+  initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
+  initBuiltinPAs, initBuiltinPRs,
+  initBuiltinBoxedTyCons
 ) where
+
 import Vectorise.Builtins.Base
 import Vectorise.Builtins.Modules
-import Vectorise.Builtins.Prelude
 
 import BasicTypes
 import PrelNames
@@ -30,20 +29,18 @@ import Outputable
 
 import Control.Monad
 import Data.Array
-import Data.List
-
--- | Create the initial map of builtin types and functions.
-initBuiltins 
-       :: PackageId    -- ^ package id the builtins are in, eg dph-common
-       -> DsM Builtins
 
+-- |Create the initial map of builtin types and functions.
+--
+initBuiltins :: PackageId  -- ^ package id the builtins are in, eg dph-common
+             -> DsM Builtins
 initBuiltins pkg
  = do mapM_ load dph_Orphans
 
       -- From dph-common:Data.Array.Parallel.PArray.PData
       --     PData is a type family that maps an element type onto the type
       --     we use to hold an array of those elements.
-      pdataTyCon       <- externalTyCon        dph_PArray_PData  (fsLit "PData")
+      pdataTyCon  <- externalTyCon  dph_PArray_PData  (fsLit "PData")
 
       --     PR is a type class that holds the primitive operators we can 
       --     apply to array data. Its functions take arrays in terms of PData types.
@@ -53,7 +50,7 @@ initBuiltins pkg
 
 
       -- From dph-common:Data.Array.Parallel.PArray.PRepr
-      preprTyCon       <- externalTyCon        dph_PArray_PRepr  (fsLit "PRepr")
+      preprTyCon  <- externalTyCon  dph_PArray_PRepr  (fsLit "PRepr")
       paClass           <- externalClass        dph_PArray_PRepr  (fsLit "PA")
       let paTyCon     = classTyCon paClass
           [paDataCon] = tyConDataCons paTyCon
@@ -62,9 +59,9 @@ initBuiltins pkg
       replicatePDVar    <- externalVar          dph_PArray_PRepr  (fsLit "replicatePD")
       emptyPDVar        <- externalVar          dph_PArray_PRepr  (fsLit "emptyPD")
       packByTagPDVar    <- externalVar          dph_PArray_PRepr  (fsLit "packByTagPD")
-      combines                 <- mapM (externalVar dph_PArray_PRepr)
-                                       [mkFastString ("combine" ++ show i ++ "PD")
-                                       | i <- [2..mAX_DPH_COMBINE]]
+      combines    <- mapM (externalVar dph_PArray_PRepr)
+                          [mkFastString ("combine" ++ show i ++ "PD")
+                              | i <- [2..mAX_DPH_COMBINE]]
 
       let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines
 
@@ -73,45 +70,45 @@ initBuiltins pkg
       --     Scalar is the class of scalar values. 
       --     The dictionary contains functions to coerce U.Arrays of scalars
       --     to and from the PData representation.
-      scalarClass      <- externalClass        dph_PArray_Scalar (fsLit "Scalar")
+      scalarClass   <- externalClass        dph_PArray_Scalar (fsLit "Scalar")
 
 
       -- From dph-common:Data.Array.Parallel.Lifted.PArray
       --   A PArray (Parallel Array) holds the array length and some array elements
       --   represented by the PData type family.
-      parrayTyCon      <- externalTyCon        dph_PArray_Base   (fsLit "PArray")
+      parrayTyCon <- externalTyCon  dph_PArray_Base   (fsLit "PArray")
       let [parrayDataCon] = tyConDataCons parrayTyCon
 
       -- From dph-common:Data.Array.Parallel.PArray.Types
-      voidTyCon                <- externalTyCon        dph_PArray_Types  (fsLit "Void")
+      voidTyCon   <- externalTyCon        dph_PArray_Types  (fsLit "Void")
       voidVar           <- externalVar          dph_PArray_Types  (fsLit "void")
       fromVoidVar       <- externalVar          dph_PArray_Types  (fsLit "fromVoid")
-      wrapTyCon                <- externalTyCon        dph_PArray_Types  (fsLit "Wrap")
-      sum_tcs          <- mapM (externalTyCon  dph_PArray_Types) (numbered "Sum" 2 mAX_DPH_SUM)
+      wrapTyCon   <- externalTyCon        dph_PArray_Types  (fsLit "Wrap")
+      sum_tcs   <- mapM (externalTyCon  dph_PArray_Types) (numbered "Sum" 2 mAX_DPH_SUM)
 
       -- from dph-common:Data.Array.Parallel.PArray.PDataInstances
       pvoidVar          <- externalVar dph_PArray_PDataInstances  (fsLit "pvoid")
       punitVar          <- externalVar dph_PArray_PDataInstances  (fsLit "punit")
 
 
-      closureTyCon     <- externalTyCon dph_Closure             (fsLit ":->")
+      closureTyCon  <- externalTyCon dph_Closure     (fsLit ":->")
 
 
       -- From dph-common:Data.Array.Parallel.Lifted.Unboxed
-      sel_tys          <- mapM (externalType dph_Unboxed)
-                               (numbered "Sel" 2 mAX_DPH_SUM)
+      sel_tys   <- mapM (externalType dph_Unboxed)
+                            (numbered "Sel" 2 mAX_DPH_SUM)
 
-      sel_replicates   <- mapM (externalFun dph_Unboxed)
-                               (numbered_hash "replicateSel" 2 mAX_DPH_SUM)
+      sel_replicates  <- mapM (externalFun dph_Unboxed)
+        (numbered_hash "replicateSel" 2 mAX_DPH_SUM)
 
-      sel_picks        <- mapM (externalFun dph_Unboxed)
-                               (numbered_hash "pickSel" 2 mAX_DPH_SUM)
+      sel_picks   <- mapM (externalFun dph_Unboxed)
+        (numbered_hash "pickSel" 2 mAX_DPH_SUM)
 
-      sel_tags         <- mapM (externalFun dph_Unboxed)
-                               (numbered "tagsSel" 2 mAX_DPH_SUM)
+      sel_tags    <- mapM (externalFun dph_Unboxed)
+        (numbered "tagsSel" 2 mAX_DPH_SUM)
 
-      sel_els          <- mapM mk_elements
-                               [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
+      sel_els   <- mapM mk_elements
+        [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
 
 
       let selTys        = listArray (2, mAX_DPH_SUM) sel_tys
@@ -123,26 +120,26 @@ initBuiltins pkg
 
 
 
-      closureVar       <- externalVar dph_Closure      (fsLit "closure")
-      applyVar         <- externalVar dph_Closure      (fsLit "$:")
-      liftedClosureVar <- externalVar dph_Closure      (fsLit "liftedClosure")
-      liftedApplyVar   <- externalVar dph_Closure      (fsLit "liftedApply")
+      closureVar       <- externalVar dph_Closure (fsLit "closure")
+      applyVar         <- externalVar dph_Closure (fsLit "$:")
+      liftedClosureVar <- externalVar dph_Closure (fsLit "liftedClosure")
+      liftedApplyVar   <- externalVar dph_Closure (fsLit "liftedApply")
 
-      scalar_map       <- externalVar  dph_Scalar      (fsLit "scalar_map")
-      scalar_zip2   <- externalVar     dph_Scalar      (fsLit "scalar_zipWith")
-      scalar_zips      <- mapM (externalVar dph_Scalar)
-                               (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
+      scalar_map  <- externalVar  dph_Scalar  (fsLit "scalar_map")
+      scalar_zip2   <- externalVar  dph_Scalar  (fsLit "scalar_zipWith")
+      scalar_zips <- mapM (externalVar dph_Scalar)
+                            (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
 
-      let scalarZips   = listArray (1, mAX_DPH_SCALAR_ARGS)
+      let scalarZips  = listArray (1, mAX_DPH_SCALAR_ARGS)
                                  (scalar_map : scalar_zip2 : scalar_zips)
 
-      closures                 <- mapM (externalVar dph_Closure)
-                                       (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
+      closures    <- mapM (externalVar dph_Closure)
+                          (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
 
       let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
 
-      liftingContext   <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
-                               newUnique
+      liftingContext  <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
+        newUnique
 
       return   $ Builtins 
                { dphModules       = mods
@@ -221,32 +218,26 @@ initBuiltins pkg
 
 -- | Get the mapping of names in the Prelude to names in the DPH library.
 --
-initBuiltinVars :: Bool   -- FIXME
-                -> Builtins -> DsM [(Var, Var)]
-initBuiltinVars compilingDPH (Builtins { dphModules = mods })
+initBuiltinVars :: Builtins -> DsM [(Var, Var)]
+initBuiltinVars (Builtins { dphModules = mods })
   = do
-      uvars <- zipWithM externalVar umods ufs
-      vvars <- zipWithM externalVar vmods vfs
       cvars <- zipWithM externalVar cmods cfs
       return $ [(v,v) | v <- map dataConWorkId defaultDataConWorkers]
                ++ zip (map dataConWorkId cons) cvars
-               ++ zip uvars vvars
   where
-    (umods, ufs, vmods, vfs) = if compilingDPH then ([], [], [], []) else unzip4 (preludeVars mods)
-    (cons, cmods, cfs)       = unzip3 (preludeDataCons mods)
+    (cons, cmods, cfs) = unzip3 (preludeDataCons mods)
 
     defaultDataConWorkers :: [DataCon]
     defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
 
+    preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
+    preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
+      = [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
+      where
+        mk_tup n mod name = (tupleCon Boxed n, mod, name)
 
-preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
-preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
-  = [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
-  where
-    mk_tup n mod name = (tupleCon Boxed n, mod, name)
-
-
--- | Get a list of names to `TyCon`s in the mock prelude.
+-- |Get a list of names to `TyCon`s in the mock prelude.
+--
 initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
 initBuiltinTyCons bi
   = do
@@ -260,83 +251,82 @@ initBuiltinTyCons bi
 
              : [(tyConName tc, tc) | tc <- dft_tcs]
 
-  where        defaultTyCons :: DsM [TyCon]
-       defaultTyCons
-        = do   word8 <- dsLookupTyCon word8TyConName
-               return [intTyCon, boolTyCon, doubleTyCon, word8]
-
+  where 
+    defaultTyCons :: DsM [TyCon]
+    defaultTyCons
+       = do word8 <- dsLookupTyCon word8TyConName
+            return [intTyCon, boolTyCon, floatTyCon, doubleTyCon, word8]
 
--- | Get a list of names to `DataCon`s in the mock prelude.
+-- |Get a list of names to `DataCon`s in the mock prelude.
+--
 initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
 initBuiltinDataCons _
   = [(dataConName dc, dc)| dc <- defaultDataCons]
-  where        defaultDataCons :: [DataCon]
-       defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
-
+  where 
+    defaultDataCons :: [DataCon]
+    defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
 
--- | Get the names of all buildin instance functions for the PA class.
+-- |Get the names of all buildin instance functions for the PA class.
+--
 initBuiltinPAs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
 initBuiltinPAs (Builtins { dphModules = mods }) insts
   = liftM (initBuiltinDicts insts) (externalClass (dph_PArray_PRepr mods) (fsLit "PA"))
 
-
--- | Get the names of all builtin instance functions for the PR class.
+-- |Get the names of all builtin instance functions for the PR class.
+--
 initBuiltinPRs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
 initBuiltinPRs (Builtins { dphModules = mods }) insts
   = liftM (initBuiltinDicts insts) (externalClass (dph_PArray_PData mods) (fsLit "PR"))
 
-
--- | Get the names of all DPH instance functions for this class.
+-- |Get the names of all DPH instance functions for this class.
+--
 initBuiltinDicts :: (InstEnv, InstEnv) -> Class -> [(Name, Var)]
 initBuiltinDicts insts cls = map find $ classInstances insts cls
   where
-    find i | [Just tc] <- instanceRoughTcs i   = (tc, instanceDFunId i)
-           | otherwise                         = pprPanic "Invalid DPH instance" (ppr i)
-
+    find i | [Just tc] <- instanceRoughTcs i  = (tc, instanceDFunId i)
+           | otherwise        = pprPanic "Invalid DPH instance" (ppr i)
 
--- | Get a list of boxed `TyCons` in the mock prelude. This is Int only.
+-- |Get a list of boxed `TyCons` in the mock prelude. This is Int only.
+--
 initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
 initBuiltinBoxedTyCons 
   = return . builtinBoxedTyCons
-  where        builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
-       builtinBoxedTyCons _ 
-               = [(tyConName intPrimTyCon, intTyCon)]
+  where 
+    builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
+    builtinBoxedTyCons _ 
+      = [(tyConName intPrimTyCon, intTyCon)]
 
--- | Get a list of all scalar functions in the mock prelude.
---
-initBuiltinScalars :: Bool 
-                   -> Builtins -> DsM [Var]
-initBuiltinScalars True  _bi = return []
-initBuiltinScalars False bi  = mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
 
--- | Lookup some variable given its name and the module that contains it.
+-- Auxilliary look up functions ----------------
+
+-- Lookup some variable given its name and the module that contains it.
+--
 externalVar :: Module -> FastString -> DsM Var
 externalVar mod fs
   = dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
 
-
--- | Like `externalVar` but wrap the `Var` in a `CoreExpr`
+-- Like `externalVar` but wrap the `Var` in a `CoreExpr`.
+--
 externalFun :: Module -> FastString -> DsM CoreExpr
 externalFun mod fs
  = do var <- externalVar mod fs
       return $ Var var
 
-
--- | Lookup some `TyCon` given its name and the module that contains it.
+-- Lookup some `TyCon` given its name and the module that contains it.
+--
 externalTyCon :: Module -> FastString -> DsM TyCon
 externalTyCon mod fs
   = dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
 
-
--- | Lookup some `Type` given its name and the module that contains it.
+-- Lookup some `Type` given its name and the module that contains it.
+--
 externalType :: Module -> FastString -> DsM Type
 externalType mod fs
  = do  tycon <- externalTyCon mod fs
        return $ mkTyConApp tycon []
 
-
--- | Lookup some `Class` given its name and the module that contains it.
+-- Lookup some `Class` given its name and the module that contains it.
+--
 externalClass :: Module -> FastString -> DsM Class
 externalClass mod fs
   = dsLookupClass =<< lookupOrig mod (mkClsOccFS fs)
-
index 6ea3595..c750571 100644 (file)
@@ -22,13 +22,8 @@ data Modules
        
   , dph_Closure                        :: Module
   , dph_Unboxed                        :: Module
-  , dph_Combinators             :: Module
   , dph_Scalar                 :: Module
 
-  , dph_Prelude_Int             :: Module
-  , dph_Prelude_Word8           :: Module
-  , dph_Prelude_Double          :: Module
-  , dph_Prelude_Bool            :: Module
   , dph_Prelude_Tuple           :: Module
   }
 
@@ -48,13 +43,8 @@ dph_Modules pkg
        
   , dph_Closure                 = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
   , dph_Unboxed                 = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
-  , dph_Combinators             = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")
   , dph_Scalar                  = mk (fsLit "Data.Array.Parallel.Lifted.Scalar")
 
-  , dph_Prelude_Int             = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
-  , dph_Prelude_Word8           = mk (fsLit "Data.Array.Parallel.Prelude.Base.Word8")
-  , dph_Prelude_Double          = mk (fsLit "Data.Array.Parallel.Prelude.Base.Double")
-  , dph_Prelude_Bool            = mk (fsLit "Data.Array.Parallel.Prelude.Base.Bool")
   , dph_Prelude_Tuple           = mk (fsLit "Data.Array.Parallel.Prelude.Base.Tuple")
   }
   where        mk = mkModule pkg . mkModuleNameFS
diff --git a/compiler/vectorise/Vectorise/Builtins/Prelude.hs b/compiler/vectorise/Vectorise/Builtins/Prelude.hs
deleted file mode 100644 (file)
index a59f936..0000000
+++ /dev/null
@@ -1,209 +0,0 @@
-
--- WARNING: This module is a temporary kludge.  It will soon go away entirely (once 
---   VECTORISE SCALAR pragmas are fully implemented.)
-
--- | Mapping of prelude functions to vectorised versions.
---     Functions like filterP currently have a working but naive version in GHC.PArr
---     During vectorisation we replace these by calls to filterPA, which are
---     defined in dph-common Data.Array.Parallel.Lifted.Combinators
---
---     As renamer only sees the GHC.PArr functions, if you want to add a new function
---     to the vectoriser there has to be a definition for it in GHC.PArr, even though
---     it will never be used at runtime.
---
-module Vectorise.Builtins.Prelude
-       ( preludeVars
-       , preludeScalars)
-where
-import Vectorise.Builtins.Modules
-import PrelNames
-import Module
-import FastString
-
-
-preludeVars :: Modules
-       -> [( Module, FastString        --   Maps the original variable to the one in the DPH 
-           , Module, FastString)]      --   packages that it should be rewritten to.
-preludeVars (Modules { dph_Combinators    = _dph_Combinators
-                     , dph_Prelude_Int    = dph_Prelude_Int
-                     , dph_Prelude_Word8  = dph_Prelude_Word8
-                     -- , dph_Prelude_Double = dph_Prelude_Double
-                     , dph_Prelude_Bool   = dph_Prelude_Bool 
-                     })
-
-  = [ 
-    -- Map scalar functions to versions using closures. 
-      mk' dph_Prelude_Int "div"         "divV"
-    , mk' dph_Prelude_Int "mod"         "modV"
-    , mk' dph_Prelude_Int "sqrt"        "sqrtV"
-    , mk' dph_Prelude_Int "enumFromToP" "enumFromToPA"
-    ]
-    ++ vars_Ord dph_Prelude_Int
-    ++ vars_Num dph_Prelude_Int
-
-    ++ vars_Ord dph_Prelude_Word8
-    ++ vars_Num dph_Prelude_Word8
-    ++
-    [ mk' dph_Prelude_Word8 "div"     "divV"
-    , mk' dph_Prelude_Word8 "mod"     "modV"
-    , mk' dph_Prelude_Word8 "fromInt" "fromIntV"
-    , mk' dph_Prelude_Word8 "toInt"   "toIntV"
-    ]
-
-    -- ++ vars_Ord        dph_Prelude_Double
-    -- ++ vars_Num        dph_Prelude_Double
-    -- ++ vars_Fractional dph_Prelude_Double
-    -- ++ vars_Floating   dph_Prelude_Double
-    -- ++ vars_RealFrac   dph_Prelude_Double
-    ++
-    [ mk dph_Prelude_Bool  (fsLit "andP")  dph_Prelude_Bool (fsLit "andPA")
-    , mk dph_Prelude_Bool  (fsLit "orP")   dph_Prelude_Bool (fsLit "orPA")
-
-    , mk gHC_CLASSES (fsLit "not")         dph_Prelude_Bool (fsLit "notV")
-    , mk gHC_CLASSES (fsLit "&&")          dph_Prelude_Bool (fsLit "andV")
-    , mk gHC_CLASSES (fsLit "||")          dph_Prelude_Bool (fsLit "orV")
-    ]
-  where
-    mk  = (,,,)
-    mk' mod v v' = mk mod (fsLit v) mod (fsLit v')
-
-    vars_Ord mod 
-     = [ mk' mod "=="        "eqV"
-       , mk' mod "/="        "neqV"
-       , mk' mod "<="        "leV"
-       , mk' mod "<"         "ltV"
-       , mk' mod ">="        "geV"
-       , mk' mod ">"         "gtV"
-       , mk' mod "min"       "minV"
-       , mk' mod "max"       "maxV"
-       , mk' mod "minimumP"  "minimumPA"
-       , mk' mod "maximumP"  "maximumPA"
-       , mk' mod "minIndexP" "minIndexPA"
-       , mk' mod "maxIndexP" "maxIndexPA"
-       ]
-
-    vars_Num mod 
-     = [ mk' mod "+"        "plusV"
-       , mk' mod "-"        "minusV"
-       , mk' mod "*"        "multV"
-       , mk' mod "negate"   "negateV"
-       , mk' mod "abs"      "absV"
-       , mk' mod "sumP"     "sumPA"
-       , mk' mod "productP" "productPA"
-       ]
-
-    -- vars_Fractional mod 
-    --  = [ mk' mod "/"     "divideV"
-    --    , mk' mod "recip" "recipV"
-    --    ]
-    -- 
-    -- vars_Floating mod 
-    --  = [ mk' mod "pi"      "pi"
-    --    , mk' mod "exp"     "expV"
-    --    , mk' mod "sqrt"    "sqrtV"
-    --    , mk' mod "log"     "logV"
-    --    , mk' mod "sin"     "sinV"
-    --    , mk' mod "tan"     "tanV"
-    --    , mk' mod "cos"     "cosV"
-    --    , mk' mod "asin"    "asinV"
-    --    , mk' mod "atan"    "atanV"
-    --    , mk' mod "acos"    "acosV"
-    --    , mk' mod "sinh"    "sinhV"
-    --    , mk' mod "tanh"    "tanhV"
-    --    , mk' mod "cosh"    "coshV"
-    --    , mk' mod "asinh"   "asinhV"
-    --    , mk' mod "atanh"   "atanhV"
-    --    , mk' mod "acosh"   "acoshV"
-    --    , mk' mod "**"      "powV"
-    --    , mk' mod "logBase" "logBaseV"
-    --    ]
-    -- 
-    -- vars_RealFrac mod
-    --  = [ mk' mod "fromInt"  "fromIntV"
-    --    , mk' mod "truncate" "truncateV"
-    --    , mk' mod "round"    "roundV"
-    --    , mk' mod "ceiling"  "ceilingV"
-    --    , mk' mod "floor"    "floorV"
-    --    ]
-    -- 
-preludeScalars :: Modules -> [(Module, FastString)]
-preludeScalars (Modules { dph_Prelude_Int    = dph_Prelude_Int
-                        , dph_Prelude_Word8  = dph_Prelude_Word8
-                        , dph_Prelude_Double = dph_Prelude_Double
-                        })
-  = [ mk dph_Prelude_Int "div"
-    , mk dph_Prelude_Int "mod"
-    , mk dph_Prelude_Int "sqrt"
-    ]
-    ++ scalars_Ord dph_Prelude_Int
-    ++ scalars_Num dph_Prelude_Int
-
-    ++ scalars_Ord dph_Prelude_Word8
-    ++ scalars_Num dph_Prelude_Word8
-    ++
-    [ mk dph_Prelude_Word8 "div"
-    , mk dph_Prelude_Word8 "mod"
-    , mk dph_Prelude_Word8 "fromInt"
-    , mk dph_Prelude_Word8 "toInt"
-    ]
-
-    ++ scalars_Ord dph_Prelude_Double
-    ++ scalars_Num dph_Prelude_Double
-    ++ scalars_Fractional dph_Prelude_Double
-    ++ scalars_Floating dph_Prelude_Double
-    ++ scalars_RealFrac dph_Prelude_Double
-  where
-    mk mod s = (mod, fsLit s)
-
-    scalars_Ord mod 
-     = [ mk mod "=="
-       , mk mod "/="
-       , mk mod "<="
-       , mk mod "<"
-       , mk mod ">="
-       , mk mod ">"
-       , mk mod "min"
-       , mk mod "max"
-       ]
-
-    scalars_Num mod 
-     = [ mk mod "+"
-       , mk mod "-"
-       , mk mod "*"
-       , mk mod "negate"
-       , mk mod "abs"
-       ]
-
-    scalars_Fractional mod 
-     = [ mk mod "/"
-       , mk mod "recip"
-       ]
-
-    scalars_Floating mod 
-     = [ mk mod "pi"
-       , mk mod "exp"
-       , mk mod "sqrt"
-       , mk mod "log"
-       , mk mod "sin"
-       , mk mod "tan"
-       , mk mod "cos"
-       , mk mod "asin"
-       , mk mod "atan"
-       , mk mod "acos"
-       , mk mod "sinh"
-       , mk mod "tanh"
-       , mk mod "cosh"
-       , mk mod "asinh"
-       , mk mod "atanh"
-       , mk mod "acosh"
-       , mk mod "**"
-       , mk mod "logBase"
-       ]
-
-    scalars_RealFrac mod 
-     = [ mk mod "fromInt"
-       , mk mod "truncate"
-       , mk mod "round"
-       , mk mod "ceiling"
-       , mk mod "floor"
-       ]
index 97bb5ae..d70f09a 100644 (file)
@@ -10,7 +10,6 @@ module Vectorise.Env (
   GlobalEnv(..),
   initGlobalEnv,
   extendImportedVarsEnv,
-  extendScalars,
   setFamEnv,
   extendFamEnv,
   extendTyConsEnv,
@@ -46,18 +45,18 @@ data Scope a b
 -- LocalEnv -------------------------------------------------------------------
 -- | The local environment.
 data LocalEnv
-       = LocalEnv {
+  = LocalEnv {
         -- Mapping from local variables to their vectorised and lifted versions.
-            local_vars         :: VarEnv (Var, Var)
+            local_vars    :: VarEnv (Var, Var)
 
         -- In-scope type variables.
-        , local_tyvars         :: [TyVar]
+        , local_tyvars    :: [TyVar]
 
         -- Mapping from tyvars to their PA dictionaries.
-        , local_tyvar_pa       :: VarEnv CoreExpr
+        , local_tyvar_pa  :: VarEnv CoreExpr
 
         -- Local binding name.
-        , local_bind_name      :: FastString
+        , local_bind_name :: FastString
         }
 
 
@@ -163,12 +162,6 @@ extendImportedVarsEnv :: [(Var, Var)] -> GlobalEnv -> GlobalEnv
 extendImportedVarsEnv ps genv
   = genv { global_vars = extendVarEnvList (global_vars genv) ps }
 
--- |Extend the set of scalar variables in an environment.
---
-extendScalars :: [Var] -> GlobalEnv -> GlobalEnv
-extendScalars vs genv
-  = genv { global_scalar_vars = extendVarSetList (global_scalar_vars genv) vs }
-
 -- |Set the list of type family instances in an environment.
 --
 setFamEnv :: FamInstEnv -> GlobalEnv -> GlobalEnv
index 73cba88..e690077 100644 (file)
@@ -65,13 +65,11 @@ initV hsc_env guts info thing_inside
                Just pkg -> do {
 
                -- set up tables of builtin entities
-           ; let compilingDPH = dphBackend dflags == DPHThis  -- FIXME: temporary kludge support
            ; builtins        <- initBuiltins pkg
-           ; builtin_vars    <- initBuiltinVars compilingDPH builtins
+           ; builtin_vars    <- initBuiltinVars builtins
            ; builtin_tycons  <- initBuiltinTyCons builtins
            ; let builtin_datacons = initBuiltinDataCons builtins
            ; builtin_boxed   <- initBuiltinBoxedTyCons builtins
-           ; builtin_scalars <- initBuiltinScalars compilingDPH builtins
 
                -- set up class and type family envrionments
            ; eps <- liftIO $ hscEPS hsc_env
@@ -83,7 +81,6 @@ initV hsc_env guts info thing_inside
                -- construct the initial global environment
            ; let thing_inside' = traceVt "VectDecls" (ppr (mg_vect_decls guts)) >> thing_inside
            ; let genv = extendImportedVarsEnv builtin_vars
-                        . extendScalars       builtin_scalars
                         . extendTyConsEnv     builtin_tycons
                         . extendDataConsEnv   builtin_datacons
                         . extendPAFunsEnv     builtin_pas