compiler/vectorise/VectBuiltIn.hs

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