compiler/vectorise/VectBuiltIn.hs

   1 module VectBuiltIn (
   2   Builtins(..), sumTyCon, prodTyCon, prodDataCon,
   3   selTy, selReplicate, selPick, selElements,
   4   combinePDVar, scalarZip, closureCtrFun,
   5   initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
   6   initBuiltinPAs, initBuiltinPRs,
   7   initBuiltinBoxedTyCons, initBuiltinScalars,
   8
   9   primMethod, primPArray
  10 ) where
  11
  12 import DsMonad
  13 import IfaceEnv        ( lookupOrig )
  14
  15 import Module
  16 import DataCon         ( DataCon, dataConName, dataConWorkId )
  17 import TyCon           ( TyCon, tyConName, tyConDataCons )
  18 import Class           ( Class )
  19 import CoreSyn         ( CoreExpr, Expr(..) )
  20 import Var             ( Var )
  21 import Id              ( mkSysLocal )
  22 import Name            ( Name, getOccString )
  23 import NameEnv
  24 import OccName
  25
  26 import TypeRep         ( funTyCon )
  27 import Type            ( Type, mkTyConApp )
  28 import TysPrim
  29 import TysWiredIn      ( unitTyCon, unitDataCon,
  30                          tupleTyCon, tupleCon,
  31                          intTyCon, intTyConName,
  32                          doubleTyCon, doubleTyConName,
  33                          boolTyCon, boolTyConName, trueDataCon, falseDataCon,
  34                          parrTyConName )
  35 import PrelNames       ( word8TyConName, gHC_PARR )
  36 import BasicTypes      ( Boxity(..) )
  37
  38 import FastString
  39 import Outputable
  40
  41 import Data.Array
  42 import Control.Monad   ( liftM, zipWithM )
  43 import Data.List       ( unzip4 )
  44
  45 mAX_DPH_PROD :: Int
  46 mAX_DPH_PROD = 5
  47
  48 mAX_DPH_SUM :: Int
  49 mAX_DPH_SUM = 2
  50
  51 mAX_DPH_COMBINE :: Int
  52 mAX_DPH_COMBINE = 2
  53
  54 mAX_DPH_SCALAR_ARGS :: Int
  55 mAX_DPH_SCALAR_ARGS = 3
  56
  57 data Modules = Modules {
  58                    dph_PArray :: Module
  59                  , dph_Repr :: Module
  60                  , dph_Closure :: Module
  61                  , dph_Unboxed :: Module
  62                  , dph_Instances :: Module
  63                  , dph_Combinators :: Module
  64                  , dph_Scalar :: Module
  65                  , dph_Selector :: Module
  66                  , dph_Prelude_PArr :: Module
  67                  , dph_Prelude_Int :: Module
  68                  , dph_Prelude_Word8 :: Module
  69                  , dph_Prelude_Double :: Module
  70                  , dph_Prelude_Bool :: Module
  71                  , dph_Prelude_Tuple :: Module
  72                }
  73
  74 dph_Modules :: PackageId -> Modules
  75 dph_Modules pkg = Modules {
  76     dph_PArray         = mk (fsLit "Data.Array.Parallel.Lifted.PArray")
  77   , dph_Repr           = mk (fsLit "Data.Array.Parallel.Lifted.Repr")
  78   , dph_Closure        = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
  79   , dph_Unboxed        = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
  80   , dph_Instances      = mk (fsLit "Data.Array.Parallel.Lifted.Instances")
  81   , dph_Combinators    = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")
  82   , dph_Scalar         = mk (fsLit "Data.Array.Parallel.Lifted.Scalar")
  83   , dph_Selector       = mk (fsLit "Data.Array.Parallel.Lifted.Selector")
  84
  85   , dph_Prelude_PArr   = mk (fsLit "Data.Array.Parallel.Prelude.Base.PArr")
  86   , dph_Prelude_Int    = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
  87   , dph_Prelude_Word8  = mk (fsLit "Data.Array.Parallel.Prelude.Base.Word8")
  88   , dph_Prelude_Double = mk (fsLit "Data.Array.Parallel.Prelude.Base.Double")
  89   , dph_Prelude_Bool   = mk (fsLit "Data.Array.Parallel.Prelude.Base.Bool")
  90   , dph_Prelude_Tuple  = mk (fsLit "Data.Array.Parallel.Prelude.Base.Tuple")
  91   }
  92   where
  93     mk = mkModule pkg . mkModuleNameFS
  94
  95
  96 data Builtins = Builtins {
  97                   dphModules       :: Modules
  98                 , parrayTyCon      :: TyCon
  99                 , parrayDataCon    :: DataCon
 100                 , pdataTyCon       :: TyCon
 101                 , paTyCon          :: TyCon
 102                 , paDataCon        :: DataCon
 103                 , preprTyCon       :: TyCon
 104                 , prTyCon          :: TyCon
 105                 , prDataCon        :: DataCon
 106                 , voidTyCon        :: TyCon
 107                 , wrapTyCon        :: TyCon
 108                 , selTys           :: Array Int Type
 109                 , selReplicates    :: Array Int CoreExpr
 110                 , selPicks         :: Array Int CoreExpr
 111                 , selEls           :: Array (Int, Int) CoreExpr
 112                 , sumTyCons        :: Array Int TyCon
 113                 , closureTyCon     :: TyCon
 114                 , voidVar          :: Var
 115                 , pvoidVar         :: Var
 116                 , punitVar         :: Var
 117                 , mkPRVar          :: Var
 118                 , closureVar       :: Var
 119                 , applyVar         :: Var
 120                 , liftedClosureVar :: Var
 121                 , liftedApplyVar   :: Var
 122                 , replicatePDVar   :: Var
 123                 , emptyPDVar       :: Var
 124                 , packPDVar        :: Var
 125                 , combinePDVars    :: Array Int Var
 126                 , scalarClass      :: Class
 127                 , scalarZips       :: Array Int Var
 128                 , closureCtrFuns   :: Array Int Var
 129                 , liftingContext   :: Var
 130                 }
 131
 132 indexBuiltin :: (Ix i, Outputable i) => String -> (Builtins -> Array i a)
 133                                         -> i -> Builtins -> a
 134 indexBuiltin fn f i bi
 135   | inRange (bounds xs) i = xs ! i
 136   | otherwise = pprPanic fn (ppr i)
 137   where
 138     xs = f bi
 139
 140 selTy :: Int -> Builtins -> Type
 141 selTy = indexBuiltin "selTy" selTys
 142
 143 selReplicate :: Int -> Builtins -> CoreExpr
 144 selReplicate = indexBuiltin "selReplicate" selReplicates
 145
 146 selPick :: Int -> Builtins -> CoreExpr
 147 selPick = indexBuiltin "selPick" selPicks
 148
 149 selElements :: Int -> Int -> Builtins -> CoreExpr
 150 selElements i j = indexBuiltin "selElements" selEls (i,j)
 151
 152 sumTyCon :: Int -> Builtins -> TyCon
 153 sumTyCon = indexBuiltin "sumTyCon" sumTyCons
 154
 155 prodTyCon :: Int -> Builtins -> TyCon
 156 prodTyCon n bi
 157   | n == 1                      = wrapTyCon bi
 158   | n >= 0 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
 159   | otherwise = pprPanic "prodTyCon" (ppr n)
 160
 161 prodDataCon :: Int -> Builtins -> DataCon
 162 prodDataCon n bi = case tyConDataCons (prodTyCon n bi) of
 163                      [con] -> con
 164                      _     -> pprPanic "prodDataCon" (ppr n)
 165
 166 combinePDVar :: Int -> Builtins -> Var
 167 combinePDVar = indexBuiltin "combinePDVar" combinePDVars
 168
 169 scalarZip :: Int -> Builtins -> Var
 170 scalarZip = indexBuiltin "scalarZip" scalarZips
 171
 172 closureCtrFun :: Int -> Builtins -> Var
 173 closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
 174
 175 initBuiltins :: PackageId -> DsM Builtins
 176 initBuiltins pkg
 177   = do
 178       parrayTyCon  <- externalTyCon dph_PArray (fsLit "PArray")
 179       let [parrayDataCon] = tyConDataCons parrayTyCon
 180       pdataTyCon   <- externalTyCon dph_PArray (fsLit "PData")
 181       paTyCon      <- externalTyCon dph_PArray (fsLit "PA")
 182       let [paDataCon] = tyConDataCons paTyCon
 183       preprTyCon   <- externalTyCon dph_PArray (fsLit "PRepr")
 184       prTyCon      <- externalTyCon dph_PArray (fsLit "PR")
 185       let [prDataCon] = tyConDataCons prTyCon
 186       closureTyCon <- externalTyCon dph_Closure (fsLit ":->")
 187
 188       voidTyCon    <- externalTyCon dph_Repr (fsLit "Void")
 189       wrapTyCon    <- externalTyCon dph_Repr (fsLit "Wrap")
 190       sel_tys      <- mapM (externalType dph_Selector)
 191                            (numbered "Sel" 2 mAX_DPH_SUM)
 192       sel_replicates <- mapM (externalFun dph_Selector)
 193                              (numbered "replicate" 2 mAX_DPH_SUM)
 194       sel_picks    <- mapM (externalFun dph_Selector)
 195                            (numbered "pick" 2 mAX_DPH_SUM)
 196       sel_els      <- mapM mk_elements
 197                            [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
 198       sum_tcs      <- mapM (externalTyCon dph_Repr)
 199                            (numbered "Sum" 2 mAX_DPH_SUM)
 200
 201       let selTys        = listArray (2, mAX_DPH_SUM) sel_tys
 202           selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
 203           selPicks      = listArray (2, mAX_DPH_SUM) sel_picks
 204           selEls        = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els
 205           sumTyCons     = listArray (2, mAX_DPH_SUM) sum_tcs
 206
 207       voidVar          <- externalVar dph_Repr (fsLit "void")
 208       pvoidVar         <- externalVar dph_Repr (fsLit "pvoid")
 209       punitVar         <- externalVar dph_Repr (fsLit "punit")
 210       mkPRVar          <- externalVar dph_PArray (fsLit "mkPR")
 211       closureVar       <- externalVar dph_Closure (fsLit "closure")
 212       applyVar         <- externalVar dph_Closure (fsLit "$:")
 213       liftedClosureVar <- externalVar dph_Closure (fsLit "liftedClosure")
 214       liftedApplyVar   <- externalVar dph_Closure (fsLit "liftedApply")
 215       replicatePDVar   <- externalVar dph_PArray (fsLit "replicatePD")
 216       emptyPDVar       <- externalVar dph_PArray (fsLit "emptyPD")
 217       packPDVar        <- externalVar dph_PArray (fsLit "packPD")
 218
 219       combines <- mapM (externalVar dph_PArray)
 220                        [mkFastString ("combine" ++ show i ++ "PD")
 221                           | i <- [2..mAX_DPH_COMBINE]]
 222       let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines
 223
 224       scalarClass <- externalClass dph_Scalar (fsLit "Scalar")
 225       scalar_map <- externalVar dph_Scalar (fsLit "scalar_map")
 226       scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith")
 227       scalar_zips <- mapM (externalVar dph_Scalar)
 228                           (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
 229       let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS)
 230                                  (scalar_map : scalar_zip2 : scalar_zips)
 231       closures <- mapM (externalVar dph_Closure)
 232                        (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
 233       let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
 234
 235       liftingContext <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
 236                               newUnique
 237
 238       return $ Builtins {
 239                  dphModules       = modules
 240                , parrayTyCon      = parrayTyCon
 241                , parrayDataCon    = parrayDataCon
 242                , pdataTyCon       = pdataTyCon
 243                , paTyCon          = paTyCon
 244                , paDataCon        = paDataCon
 245                , preprTyCon       = preprTyCon
 246                , prTyCon          = prTyCon
 247                , prDataCon        = prDataCon
 248                , voidTyCon        = voidTyCon
 249                , wrapTyCon        = wrapTyCon
 250                , selTys           = selTys
 251                , selReplicates    = selReplicates
 252                , selPicks         = selPicks
 253                , selEls           = selEls
 254                , sumTyCons        = sumTyCons
 255                , closureTyCon     = closureTyCon
 256                , voidVar          = voidVar
 257                , pvoidVar         = pvoidVar
 258                , punitVar         = punitVar
 259                , mkPRVar          = mkPRVar
 260                , closureVar       = closureVar
 261                , applyVar         = applyVar
 262                , liftedClosureVar = liftedClosureVar
 263                , liftedApplyVar   = liftedApplyVar
 264                , replicatePDVar   = replicatePDVar
 265                , emptyPDVar       = emptyPDVar
 266                , packPDVar        = packPDVar
 267                , combinePDVars    = combinePDVars
 268                , scalarClass      = scalarClass
 269                , scalarZips       = scalarZips
 270                , closureCtrFuns   = closureCtrFuns
 271                , liftingContext   = liftingContext
 272                }
 273   where
 274     modules@(Modules {
 275                dph_PArray         = dph_PArray
 276              , dph_Repr           = dph_Repr
 277              , dph_Closure        = dph_Closure
 278              , dph_Selector       = dph_Selector
 279              , dph_Scalar         = dph_Scalar
 280              })
 281       = dph_Modules pkg
 282
 283     numbered :: String -> Int -> Int -> [FastString]
 284     numbered pfx m n = [mkFastString (pfx ++ show i) | i <- [m..n]]
 285
 286     mk_elements :: (Int, Int) -> DsM ((Int, Int), CoreExpr)
 287     mk_elements (i,j)
 288       = do
 289           v <- externalVar dph_Selector
 290              $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
 291           return ((i,j), Var v)
 292
 293
 294 initBuiltinVars :: Builtins -> DsM [(Var, Var)]
 295 initBuiltinVars (Builtins { dphModules = mods })
 296   = do
 297       uvars <- zipWithM externalVar umods ufs
 298       vvars <- zipWithM externalVar vmods vfs
 299       cvars <- zipWithM externalVar cmods cfs
 300       return $ [(v,v) | v <- map dataConWorkId defaultDataConWorkers]
 301                ++ zip (map dataConWorkId cons) cvars
 302                ++ zip uvars vvars
 303   where
 304     (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
 305
 306     (cons, cmods, cfs) = unzip3 (preludeDataCons mods)
 307
 308 defaultDataConWorkers :: [DataCon]
 309 defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
 310
 311 preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
 312 preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
 313   = [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
 314   where
 315     mk_tup n mod name = (tupleCon Boxed n, mod, name)
 316
 317 preludeVars :: Modules -> [(Module, FastString, Module, FastString)]
 318 preludeVars (Modules { dph_Combinators    = dph_Combinators
 319                      , dph_PArray         = dph_PArray
 320                      , dph_Prelude_Int    = dph_Prelude_Int
 321                      , dph_Prelude_Word8  = dph_Prelude_Word8
 322                      , dph_Prelude_Double = dph_Prelude_Double
 323                      , dph_Prelude_Bool   = dph_Prelude_Bool
 324                      , dph_Prelude_PArr   = dph_Prelude_PArr
 325                      })
 326   = [
 327       mk gHC_PARR (fsLit "mapP")       dph_Combinators (fsLit "mapPA")
 328     , mk gHC_PARR (fsLit "zipWithP")   dph_Combinators (fsLit "zipWithPA")
 329     , mk gHC_PARR (fsLit "zipP")       dph_Combinators (fsLit "zipPA")
 330     , mk gHC_PARR (fsLit "unzipP")     dph_Combinators (fsLit "unzipPA")
 331     , mk gHC_PARR (fsLit "filterP")    dph_Combinators (fsLit "filterPA")
 332     , mk gHC_PARR (fsLit "lengthP")    dph_Combinators (fsLit "lengthPA")
 333     , mk gHC_PARR (fsLit "replicateP") dph_Combinators (fsLit "replicatePA")
 334     , mk gHC_PARR (fsLit "!:")         dph_Combinators (fsLit "indexPA")
 335     , mk gHC_PARR (fsLit "crossMapP")  dph_Combinators (fsLit "crossMapPA")
 336     , mk gHC_PARR (fsLit "singletonP") dph_Combinators (fsLit "singletonPA")
 337     , mk gHC_PARR (fsLit "concatP")    dph_Combinators (fsLit "concatPA")
 338     , mk gHC_PARR (fsLit "+:+")        dph_Combinators (fsLit "appPA")
 339     , mk gHC_PARR (fsLit "emptyP")     dph_PArray (fsLit "emptyPA")
 340
 341     , mk' dph_Prelude_Int "div"  "divV"
 342     , mk' dph_Prelude_Int "mod"  "modV"
 343     , mk' dph_Prelude_Int "sqrt" "sqrtV"
 344     , mk' dph_Prelude_Int "enumFromToP" "enumFromToPA"
 345     -- , mk' dph_Prelude_Int "upToP" "upToPA"
 346     ]
 347     ++ vars_Ord dph_Prelude_Int
 348     ++ vars_Num dph_Prelude_Int
 349
 350     ++ vars_Ord dph_Prelude_Word8
 351     ++ vars_Num dph_Prelude_Word8
 352     ++
 353     [ mk' dph_Prelude_Word8 "div" "divV"
 354     , mk' dph_Prelude_Word8 "mod" "modV"
 355     , mk' dph_Prelude_Word8 "fromInt" "fromIntV"
 356     , mk' dph_Prelude_Word8 "toInt" "toIntV"
 357     ]
 358
 359     ++ vars_Ord dph_Prelude_Double
 360     ++ vars_Num dph_Prelude_Double
 361     ++ vars_Fractional dph_Prelude_Double
 362     ++ vars_Floating dph_Prelude_Double
 363     ++ vars_RealFrac dph_Prelude_Double
 364     ++
 365     [ mk dph_Prelude_Bool  (fsLit "andP")  dph_Prelude_Bool (fsLit "andPA")
 366     , mk dph_Prelude_Bool  (fsLit "orP")  dph_Prelude_Bool (fsLit "orPA")
 367
 368     -- FIXME: temporary
 369     , mk dph_Prelude_PArr (fsLit "fromPArrayP") dph_Prelude_PArr (fsLit "fromPArrayPA")
 370     , mk dph_Prelude_PArr (fsLit "toPArrayP") dph_Prelude_PArr (fsLit "toPArrayPA")
 371     , mk dph_Prelude_PArr (fsLit "fromNestedPArrayP") dph_Prelude_PArr (fsLit "fromNestedPArrayPA")
 372     , mk dph_Prelude_PArr (fsLit "combineP")    dph_Combinators (fsLit "combine2PA")
 373     ]
 374   where
 375     mk  = (,,,)
 376     mk' mod v v' = mk mod (fsLit v) mod (fsLit v')
 377
 378     vars_Ord mod = [mk' mod "=="  "eqV"
 379                    ,mk' mod "/=" "neqV"
 380                    ,mk' mod "<="  "leV"
 381                    ,mk' mod "<"   "ltV"
 382                    ,mk' mod ">="  "geV"
 383                    ,mk' mod ">"   "gtV"
 384                    ,mk' mod "min" "minV"
 385                    ,mk' mod "max" "maxV"
 386                    ,mk' mod "minimumP" "minimumPA"
 387                    ,mk' mod "maximumP" "maximumPA"
 388                    ,mk' mod "minIndexP" "minIndexPA"
 389                    ,mk' mod "maxIndexP" "maxIndexPA"
 390                    ]
 391
 392     vars_Num mod = [mk' mod "+"        "plusV"
 393                    ,mk' mod "-"        "minusV"
 394                    ,mk' mod "*"        "multV"
 395                    ,mk' mod "negate"   "negateV"
 396                    ,mk' mod "abs"      "absV"
 397                    ,mk' mod "sumP"     "sumPA"
 398                    ,mk' mod "productP" "productPA"
 399                    ]
 400
 401     vars_Fractional mod = [mk' mod "/"     "divideV"
 402                           ,mk' mod "recip" "recipV"
 403                           ]
 404
 405     vars_Floating mod = [mk' mod "pi" "pi"
 406                         ,mk' mod "exp" "expV"
 407                         ,mk' mod "sqrt" "sqrtV"
 408                         ,mk' mod "log" "logV"
 409                         ,mk' mod "sin" "sinV"
 410                         ,mk' mod "tan" "tanV"
 411                         ,mk' mod "cos" "cosV"
 412                         ,mk' mod "asin" "asinV"
 413                         ,mk' mod "atan" "atanV"
 414                         ,mk' mod "acos" "acosV"
 415                         ,mk' mod "sinh" "sinhV"
 416                         ,mk' mod "tanh" "tanhV"
 417                         ,mk' mod "cosh" "coshV"
 418                         ,mk' mod "asinh" "asinhV"
 419                         ,mk' mod "atanh" "atanhV"
 420                         ,mk' mod "acosh" "acoshV"
 421                         ,mk' mod "**"    "powV"
 422                         ,mk' mod "logBase" "logBaseV"
 423                         ]
 424
 425     vars_RealFrac mod = [mk' mod "fromInt" "fromIntV"
 426                         ,mk' mod "truncate" "truncateV"
 427                         ,mk' mod "round" "roundV"
 428                         ,mk' mod "ceiling" "ceilingV"
 429                         ,mk' mod "floor" "floorV"
 430                         ]
 431
 432 initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
 433 initBuiltinTyCons bi
 434   = do
 435       -- parr <- externalTyCon dph_Prelude_PArr (fsLit "PArr")
 436       dft_tcs <- defaultTyCons
 437       return $ (tyConName funTyCon, closureTyCon bi)
 438              : (parrTyConName,      parrayTyCon bi)
 439
 440              -- FIXME: temporary
 441              : (tyConName $ parrayTyCon bi, parrayTyCon bi)
 442
 443              : [(tyConName tc, tc) | tc <- dft_tcs]
 444
 445 defaultTyCons :: DsM [TyCon]
 446 defaultTyCons
 447   = do
 448       word8 <- dsLookupTyCon word8TyConName
 449       return [intTyCon, boolTyCon, doubleTyCon, word8]
 450
 451 initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
 452 initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
 453
 454 defaultDataCons :: [DataCon]
 455 defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
 456
 457 initBuiltinDicts :: [(Name, Module, FastString)] -> DsM [(Name, Var)]
 458 initBuiltinDicts ps
 459   = do
 460       dicts <- zipWithM externalVar mods fss
 461       return $ zip tcs dicts
 462   where
 463     (tcs, mods, fss) = unzip3 ps
 464
 465 initBuiltinPAs :: Builtins -> DsM [(Name, Var)]
 466 initBuiltinPAs = initBuiltinDicts . builtinPAs
 467
 468 builtinPAs :: Builtins -> [(Name, Module, FastString)]
 469 builtinPAs bi@(Builtins { dphModules = mods })
 470   = [
 471       mk (tyConName $ closureTyCon bi)  (dph_Closure   mods) (fsLit "dPA_Clo")
 472     , mk (tyConName $ voidTyCon bi)     (dph_Repr      mods) (fsLit "dPA_Void")
 473     , mk (tyConName $ parrayTyCon bi)   (dph_Instances mods) (fsLit "dPA_PArray")
 474     , mk unitTyConName                  (dph_Instances mods) (fsLit "dPA_Unit")
 475
 476     , mk intTyConName                   (dph_Instances mods) (fsLit "dPA_Int")
 477     , mk word8TyConName                 (dph_Instances mods) (fsLit "dPA_Word8")
 478     , mk doubleTyConName                (dph_Instances mods) (fsLit "dPA_Double")
 479     , mk boolTyConName                  (dph_Instances mods) (fsLit "dPA_Bool")
 480     ]
 481     ++ tups
 482   where
 483     mk name mod fs = (name, mod, fs)
 484
 485     tups = map mk_tup [2..mAX_DPH_PROD]
 486     mk_tup n = mk (tyConName $ tupleTyCon Boxed n)
 487                   (dph_Instances mods)
 488                   (mkFastString $ "dPA_" ++ show n)
 489
 490 initBuiltinPRs :: Builtins -> DsM [(Name, Var)]
 491 initBuiltinPRs = initBuiltinDicts . builtinPRs
 492
 493 builtinPRs :: Builtins -> [(Name, Module, FastString)]
 494 builtinPRs bi@(Builtins { dphModules = mods }) =
 495   [
 496     mk (tyConName   unitTyCon)           (dph_Repr mods)    (fsLit "dPR_Unit")
 497   , mk (tyConName $ voidTyCon        bi) (dph_Repr mods)    (fsLit "dPR_Void")
 498   , mk (tyConName $ wrapTyCon        bi) (dph_Repr mods)    (fsLit "dPR_Wrap")
 499   , mk (tyConName $ closureTyCon     bi) (dph_Closure mods) (fsLit "dPR_Clo")
 500
 501     -- temporary
 502   , mk intTyConName          (dph_Instances mods) (fsLit "dPR_Int")
 503   , mk word8TyConName        (dph_Instances mods) (fsLit "dPR_Word8")
 504   , mk doubleTyConName       (dph_Instances mods) (fsLit "dPR_Double")
 505   ]
 506
 507   ++ map mk_sum  [2..mAX_DPH_SUM]
 508   ++ map mk_prod [2..mAX_DPH_PROD]
 509   where
 510     mk name mod fs = (name, mod, fs)
 511
 512     mk_sum n = (tyConName $ sumTyCon n bi, dph_Repr mods,
 513                 mkFastString ("dPR_Sum" ++ show n))
 514
 515     mk_prod n = (tyConName $ prodTyCon n bi, dph_Repr mods,
 516                  mkFastString ("dPR_" ++ show n))
 517
 518 initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
 519 initBuiltinBoxedTyCons = return . builtinBoxedTyCons
 520
 521 builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
 522 builtinBoxedTyCons _ =
 523   [(tyConName intPrimTyCon, intTyCon)]
 524
 525
 526 initBuiltinScalars :: Builtins -> DsM [Var]
 527 initBuiltinScalars bi
 528   = mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
 529
 530
 531 preludeScalars :: Modules -> [(Module, FastString)]
 532 preludeScalars (Modules { dph_Prelude_Int    = dph_Prelude_Int
 533                         , dph_Prelude_Word8  = dph_Prelude_Word8
 534                         , dph_Prelude_Double = dph_Prelude_Double
 535                         })
 536   = [
 537       mk dph_Prelude_Int "div"
 538     , mk dph_Prelude_Int "mod"
 539     , mk dph_Prelude_Int "sqrt"
 540     ]
 541     ++ scalars_Ord dph_Prelude_Int
 542     ++ scalars_Num dph_Prelude_Int
 543
 544     ++ scalars_Ord dph_Prelude_Word8
 545     ++ scalars_Num dph_Prelude_Word8
 546     ++
 547     [ mk dph_Prelude_Word8 "div"
 548     , mk dph_Prelude_Word8 "mod"
 549     , mk dph_Prelude_Word8 "fromInt"
 550     , mk dph_Prelude_Word8 "toInt"
 551     ]
 552
 553     ++ scalars_Ord dph_Prelude_Double
 554     ++ scalars_Num dph_Prelude_Double
 555     ++ scalars_Fractional dph_Prelude_Double
 556     ++ scalars_Floating dph_Prelude_Double
 557     ++ scalars_RealFrac dph_Prelude_Double
 558   where
 559     mk mod s = (mod, fsLit s)
 560
 561     scalars_Ord mod = [mk mod "=="
 562                       ,mk mod "/="
 563                       ,mk mod "<="
 564                       ,mk mod "<"
 565                       ,mk mod ">="
 566                       ,mk mod ">"
 567                       ,mk mod "min"
 568                       ,mk mod "max"
 569                       ]
 570
 571     scalars_Num mod = [mk mod "+"
 572                       ,mk mod "-"
 573                       ,mk mod "*"
 574                       ,mk mod "negate"
 575                       ,mk mod "abs"
 576                       ]
 577
 578     scalars_Fractional mod = [mk mod "/"
 579                              ,mk mod "recip"
 580                              ]
 581
 582     scalars_Floating mod = [mk mod "pi"
 583                            ,mk mod "exp"
 584                            ,mk mod "sqrt"
 585                            ,mk mod "log"
 586                            ,mk mod "sin"
 587                            ,mk mod "tan"
 588                            ,mk mod "cos"
 589                            ,mk mod "asin"
 590                            ,mk mod "atan"
 591                            ,mk mod "acos"
 592                            ,mk mod "sinh"
 593                            ,mk mod "tanh"
 594                            ,mk mod "cosh"
 595                            ,mk mod "asinh"
 596                            ,mk mod "atanh"
 597                            ,mk mod "acosh"
 598                            ,mk mod "**"
 599                            ,mk mod "logBase"
 600                            ]
 601
 602     scalars_RealFrac mod = [mk mod "fromInt"
 603                            ,mk mod "truncate"
 604                            ,mk mod "round"
 605                            ,mk mod "ceiling"
 606                            ,mk mod "floor"
 607                            ]
 608
 609
 610 externalVar :: Module -> FastString -> DsM Var
 611 externalVar mod fs
 612   = dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
 613
 614 externalFun :: Module -> FastString -> DsM CoreExpr
 615 externalFun mod fs
 616   = do
 617       var <- externalVar mod fs
 618       return $ Var var
 619
 620 externalTyCon :: Module -> FastString -> DsM TyCon
 621 externalTyCon mod fs
 622   = dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
 623
 624 externalType :: Module -> FastString -> DsM Type
 625 externalType mod fs
 626   = do
 627       tycon <- externalTyCon mod fs
 628       return $ mkTyConApp tycon []
 629
 630 externalClass :: Module -> FastString -> DsM Class
 631 externalClass mod fs
 632   = dsLookupClass =<< lookupOrig mod (mkTcOccFS fs)
 633
 634 unitTyConName :: Name
 635 unitTyConName = tyConName unitTyCon
 636
 637
 638 primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
 639 primMethod  tycon method (Builtins { dphModules = mods })
 640   | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
 641   = liftM Just
 642   $ dsLookupGlobalId =<< lookupOrig (dph_Unboxed mods)
 643                                     (mkVarOcc $ method ++ suffix)
 644
 645   | otherwise = return Nothing
 646
 647 primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
 648 primPArray tycon (Builtins { dphModules = mods })
 649   | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
 650   = liftM Just
 651   $ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
 652                                  (mkTcOcc $ "PArray" ++ suffix)
 653
 654   | otherwise = return Nothing
 655
 656 prim_ty_cons :: NameEnv String
 657 prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
 658   where
 659     mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)
 660