VectBuiltIn.hs 17.9 KB
Newer Older
1
module VectBuiltIn (
2
  Builtins(..), sumTyCon, prodTyCon,
3
  combinePAVar,
4
  initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
5
  initBuiltinPAs, initBuiltinPRs,
6
  initBuiltinBoxedTyCons,
7

8
  primMethod, primPArray
9
10
11
) where

import DsMonad
12
import IfaceEnv        ( lookupOrig )
13

14
import Module
15
import DataCon         ( DataCon, dataConName, dataConWorkId )
16
import TyCon           ( TyCon, tyConName, tyConDataCons )
17
18
import Var             ( Var )
import Id              ( mkSysLocal )
19
20
21
import Name            ( Name, getOccString )
import NameEnv
import OccName
22

23
import TypeRep         ( funTyCon )
24
import Type            ( Type, mkTyConApp )
25
import TysPrim
26
import TysWiredIn      ( unitTyCon, unitDataCon,
27
                         tupleTyCon, tupleCon,
28
                         intTyCon, intTyConName,
29
                         doubleTyCon, doubleTyConName,
30
                         boolTyCon, boolTyConName, trueDataCon, falseDataCon,
31
                         parrTyConName )
32
import PrelNames       ( gHC_PARR )
33
import BasicTypes      ( Boxity(..) )
34

35
import FastString
36
import Outputable
37

38
import Data.Array
39
import Control.Monad   ( liftM, zipWithM )
40
import Data.List       ( unzip4 )
41

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
42
43
mAX_DPH_PROD :: Int
mAX_DPH_PROD = 5
44

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
45
46
mAX_DPH_SUM :: Int
mAX_DPH_SUM = 3
47

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
48
49
mAX_DPH_COMBINE :: Int
mAX_DPH_COMBINE = 2
50

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
data Modules = Modules {
                   dph_PArray :: Module
                 , dph_Repr :: Module
                 , dph_Closure :: Module
                 , dph_Unboxed :: Module
                 , dph_Instances :: Module
                 , dph_Combinators :: Module
                 , dph_Prelude_PArr :: Module
                 , dph_Prelude_Int :: Module
                 , dph_Prelude_Double :: Module
                 , dph_Prelude_Bool :: Module
                 , dph_Prelude_Tuple :: Module
               }

dph_Modules :: PackageId -> Modules
dph_Modules pkg = Modules {
    dph_PArray         = mk (fsLit "Data.Array.Parallel.Lifted.PArray")
  , dph_Repr           = mk (fsLit "Data.Array.Parallel.Lifted.Repr")
  , dph_Closure        = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
  , dph_Unboxed        = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
  , dph_Instances      = mk (fsLit "Data.Array.Parallel.Lifted.Instances")
  , dph_Combinators    = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")

  , dph_Prelude_PArr   = mk (fsLit "Data.Array.Parallel.Prelude.Base.PArr")
  , dph_Prelude_Int    = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
  , 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

83

84
data Builtins = Builtins {
85
86
                  dphModules       :: Modules
                , parrayTyCon      :: TyCon
87
88
89
90
91
                , paTyCon          :: TyCon
                , paDataCon        :: DataCon
                , preprTyCon       :: TyCon
                , prTyCon          :: TyCon
                , prDataCon        :: DataCon
92
                , intPrimArrayTy   :: Type
93
                , voidTyCon        :: TyCon
94
                , wrapTyCon        :: TyCon
95
                , enumerationTyCon :: TyCon
96
                , sumTyCons        :: Array Int TyCon
97
                , closureTyCon     :: TyCon
98
                , voidVar          :: Var
99
                , mkPRVar          :: Var
100
101
102
103
                , mkClosureVar     :: Var
                , applyClosureVar  :: Var
                , mkClosurePVar    :: Var
                , applyClosurePVar :: Var
104
105
                , replicatePAIntPrimVar :: Var
                , upToPAIntPrimVar :: Var
106
107
                , selectPAIntPrimVar :: Var
                , truesPABoolPrimVar :: Var
108
109
110
                , lengthPAVar      :: Var
                , replicatePAVar   :: Var
                , emptyPAVar       :: Var
111
                , packPAVar        :: Var
112
                , combinePAVars    :: Array Int Var
113
114
115
                , liftingContext   :: Var
                }

116
117
sumTyCon :: Int -> Builtins -> TyCon
sumTyCon n bi
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
118
  | n >= 2 && n <= mAX_DPH_SUM = sumTyCons bi ! n
119
120
121
122
  | otherwise = pprPanic "sumTyCon" (ppr n)

prodTyCon :: Int -> Builtins -> TyCon
prodTyCon n bi
123
  | n == 1                      = wrapTyCon bi
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
124
  | n >= 0 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
125
126
  | otherwise = pprPanic "prodTyCon" (ppr n)

127
128
combinePAVar :: Int -> Builtins -> Var
combinePAVar n bi
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
129
  | n >= 2 && n <= mAX_DPH_COMBINE = combinePAVars bi ! n
130
131
  | otherwise = pprPanic "combinePAVar" (ppr n)

132
133
initBuiltins :: PackageId -> DsM Builtins
initBuiltins pkg
134
  = do
135
136
      parrayTyCon  <- externalTyCon dph_PArray (fsLit "PArray")
      paTyCon      <- externalTyCon dph_PArray (fsLit "PA")
137
      let [paDataCon] = tyConDataCons paTyCon
138
139
      preprTyCon   <- externalTyCon dph_PArray (fsLit "PRepr")
      prTyCon      <- externalTyCon dph_PArray (fsLit "PR")
140
      let [prDataCon] = tyConDataCons prTyCon
141
142
      intPrimArrayTy <- externalType dph_Unboxed (fsLit "PArray_Int#")
      closureTyCon <- externalTyCon dph_Closure (fsLit ":->")
143

144
145
146
147
      voidTyCon    <- externalTyCon dph_Repr (fsLit "Void")
      wrapTyCon    <- externalTyCon dph_Repr (fsLit "Wrap")
      enumerationTyCon <- externalTyCon dph_Repr (fsLit "Enumeration")
      sum_tcs <- mapM (externalTyCon dph_Repr)
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
148
                      [mkFastString ("Sum" ++ show i) | i <- [2..mAX_DPH_SUM]]
149

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
150
      let sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
151

152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
      voidVar          <- externalVar dph_Repr (fsLit "void")
      mkPRVar          <- externalVar dph_PArray (fsLit "mkPR")
      mkClosureVar     <- externalVar dph_Closure (fsLit "mkClosure")
      applyClosureVar  <- externalVar dph_Closure (fsLit "$:")
      mkClosurePVar    <- externalVar dph_Closure (fsLit "mkClosureP")
      applyClosurePVar <- externalVar dph_Closure (fsLit "$:^")
      replicatePAIntPrimVar <- externalVar dph_Unboxed (fsLit "replicatePA_Int#")
      upToPAIntPrimVar <- externalVar dph_Unboxed (fsLit "upToPA_Int#")
      selectPAIntPrimVar <- externalVar dph_Unboxed (fsLit "selectPA_Int#")
      truesPABoolPrimVar <- externalVar dph_Unboxed (fsLit "truesPA_Bool#")
      lengthPAVar      <- externalVar dph_PArray (fsLit "lengthPA#")
      replicatePAVar   <- externalVar dph_PArray (fsLit "replicatePA#")
      emptyPAVar       <- externalVar dph_PArray (fsLit "emptyPA")
      packPAVar        <- externalVar dph_PArray (fsLit "packPA#")

      combines <- mapM (externalVar dph_PArray)
168
                       [mkFastString ("combine" ++ show i ++ "PA#")
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
169
170
                          | i <- [2..mAX_DPH_COMBINE]]
      let combinePAVars = listArray (2, mAX_DPH_COMBINE) combines
171

Ian Lynagh's avatar
Ian Lynagh committed
172
      liftingContext <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
173
174
175
                              newUnique

      return $ Builtins {
176
177
                 dphModules       = modules
               , parrayTyCon      = parrayTyCon
178
179
180
181
182
               , paTyCon          = paTyCon
               , paDataCon        = paDataCon
               , preprTyCon       = preprTyCon
               , prTyCon          = prTyCon
               , prDataCon        = prDataCon
183
               , intPrimArrayTy   = intPrimArrayTy
184
               , voidTyCon        = voidTyCon
185
               , wrapTyCon        = wrapTyCon
186
               , enumerationTyCon = enumerationTyCon
187
               , sumTyCons        = sumTyCons
188
               , closureTyCon     = closureTyCon
189
               , voidVar          = voidVar
190
               , mkPRVar          = mkPRVar
191
192
193
194
               , mkClosureVar     = mkClosureVar
               , applyClosureVar  = applyClosureVar
               , mkClosurePVar    = mkClosurePVar
               , applyClosurePVar = applyClosurePVar
195
196
               , replicatePAIntPrimVar = replicatePAIntPrimVar
               , upToPAIntPrimVar = upToPAIntPrimVar
197
198
               , selectPAIntPrimVar = selectPAIntPrimVar
               , truesPABoolPrimVar = truesPABoolPrimVar
199
200
201
               , lengthPAVar      = lengthPAVar
               , replicatePAVar   = replicatePAVar
               , emptyPAVar       = emptyPAVar
202
               , packPAVar        = packPAVar
203
               , combinePAVars    = combinePAVars
204
205
               , liftingContext   = liftingContext
               }
206
207
208
209
210
211
212
213
214
  where
    modules@(Modules {
               dph_PArray         = dph_PArray
             , dph_Repr           = dph_Repr
             , dph_Closure        = dph_Closure
             , dph_Unboxed        = dph_Unboxed
             })
      = dph_Modules pkg

215

216
initBuiltinVars :: Builtins -> DsM [(Var, Var)]
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
217
initBuiltinVars (Builtins { dphModules = mods })
218
  = do
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
219
220
221
      uvars <- zipWithM externalVar umods ufs
      vvars <- zipWithM externalVar vmods vfs
      cvars <- zipWithM externalVar cmods cfs
222
      return $ [(v,v) | v <- map dataConWorkId defaultDataConWorkers]
223
               ++ zip (map dataConWorkId cons) cvars
224
225
               ++ zip uvars vvars
  where
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
226
    (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
227

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
228
    (cons, cmods, cfs) = unzip3 (preludeDataCons mods)
229

230
defaultDataConWorkers :: [DataCon]
231
defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
232

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
233
234
preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
235
  = [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
236
237
238
  where
    mk_tup n mod name = (tupleCon Boxed n, mod, name)

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
239
240
241
242
243
244
245
246
preludeVars :: Modules -> [(Module, FastString, Module, FastString)]
preludeVars (Modules { dph_Combinators    = dph_Combinators
                     , dph_PArray         = dph_PArray
                     , dph_Prelude_Int    = dph_Prelude_Int
                     , dph_Prelude_Double = dph_Prelude_Double
                     , dph_Prelude_Bool   = dph_Prelude_Bool 
                     , dph_Prelude_PArr   = dph_Prelude_PArr
                     })
247
  = [
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
248
249
250
251
252
253
254
255
256
257
258
259
260
      mk gHC_PARR (fsLit "mapP")       dph_Combinators (fsLit "mapPA")
    , mk gHC_PARR (fsLit "zipWithP")   dph_Combinators (fsLit "zipWithPA")
    , mk gHC_PARR (fsLit "zipP")       dph_Combinators (fsLit "zipPA")
    , mk gHC_PARR (fsLit "unzipP")     dph_Combinators (fsLit "unzipPA")
    , mk gHC_PARR (fsLit "filterP")    dph_Combinators (fsLit "filterPA")
    , mk gHC_PARR (fsLit "lengthP")    dph_Combinators (fsLit "lengthPA")
    , mk gHC_PARR (fsLit "replicateP") dph_Combinators (fsLit "replicatePA")
    , mk gHC_PARR (fsLit "!:")         dph_Combinators (fsLit "indexPA")
    , mk gHC_PARR (fsLit "crossMapP")  dph_Combinators (fsLit "crossMapPA")
    , mk gHC_PARR (fsLit "singletonP") dph_Combinators (fsLit "singletonPA")
    , mk gHC_PARR (fsLit "concatP")    dph_Combinators (fsLit "concatPA")
    , mk gHC_PARR (fsLit "+:+")        dph_Combinators (fsLit "appPA")
    , mk gHC_PARR (fsLit "emptyP")     dph_PArray (fsLit "emptyPA")
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298

    , mk dph_Prelude_Int  (fsLit "plus") dph_Prelude_Int (fsLit "plusV")
    , mk dph_Prelude_Int  (fsLit "minus") dph_Prelude_Int (fsLit "minusV")
    , mk dph_Prelude_Int  (fsLit "mult")  dph_Prelude_Int (fsLit "multV")
    , mk dph_Prelude_Int  (fsLit "intDiv")  dph_Prelude_Int (fsLit "intDivV")
    , mk dph_Prelude_Int  (fsLit "intMod")  dph_Prelude_Int (fsLit "intModV")
    , mk dph_Prelude_Int  (fsLit "intSquareRoot")  dph_Prelude_Int (fsLit "intSquareRootV")
    , mk dph_Prelude_Int  (fsLit "intSumP")  dph_Prelude_Int (fsLit "intSumPA")
    , mk dph_Prelude_Int  (fsLit "enumFromToP")  dph_Prelude_Int (fsLit "enumFromToPA")
    , mk dph_Prelude_Int  (fsLit "upToP") dph_Prelude_Int (fsLit "upToPA")

    , mk dph_Prelude_Int  (fsLit "eq") dph_Prelude_Int (fsLit "eqV")
    , mk dph_Prelude_Int  (fsLit "neq") dph_Prelude_Int (fsLit "neqV")
    , mk dph_Prelude_Int  (fsLit "le")  dph_Prelude_Int (fsLit "leV")
    , mk dph_Prelude_Int  (fsLit "lt") dph_Prelude_Int (fsLit "ltV")
    , mk dph_Prelude_Int  (fsLit "ge") dph_Prelude_Int (fsLit "geV")
    , mk dph_Prelude_Int  (fsLit "gt")  dph_Prelude_Int (fsLit "gtV")

    , mk dph_Prelude_Double  (fsLit "plus") dph_Prelude_Double (fsLit "plusV")
    , mk dph_Prelude_Double  (fsLit "minus") dph_Prelude_Double (fsLit "minusV")
    , mk dph_Prelude_Double  (fsLit "mult")  dph_Prelude_Double (fsLit "multV")
    , mk dph_Prelude_Double  (fsLit "divide")  dph_Prelude_Double (fsLit "divideV")
    , mk dph_Prelude_Double  (fsLit  "squareRoot")  dph_Prelude_Double (fsLit "squareRootV")    
    , mk dph_Prelude_Double  (fsLit "doubleSumP")  dph_Prelude_Double (fsLit "doubleSumPA")
    , mk dph_Prelude_Double  (fsLit "minIndexP") 
         dph_Prelude_Double  (fsLit "minIndexPA")
    , mk dph_Prelude_Double  (fsLit "maxIndexP")
         dph_Prelude_Double  (fsLit "maxIndexPA")

    , mk dph_Prelude_Double  (fsLit "eq") dph_Prelude_Double (fsLit "eqV")
    , mk dph_Prelude_Double  (fsLit "neq") dph_Prelude_Double (fsLit "neqV")
    , mk dph_Prelude_Double  (fsLit "le")  dph_Prelude_Double (fsLit "leV")
    , mk dph_Prelude_Double  (fsLit "lt") dph_Prelude_Double (fsLit "ltV")
    , mk dph_Prelude_Double  (fsLit "ge") dph_Prelude_Double (fsLit "geV")
    , mk dph_Prelude_Double  (fsLit "gt")  dph_Prelude_Double (fsLit "gtV")

    , mk dph_Prelude_Bool  (fsLit "andP")  dph_Prelude_Bool (fsLit "andPA")
    , mk dph_Prelude_Bool  (fsLit "orP")  dph_Prelude_Bool (fsLit "orPA")
299

300
    -- FIXME: temporary
301
302
303
304
    , mk dph_Prelude_PArr (fsLit "fromPArrayP") dph_Prelude_PArr (fsLit "fromPArrayPA")
    , mk dph_Prelude_PArr (fsLit "toPArrayP") dph_Prelude_PArr (fsLit "toPArrayPA")
    , mk dph_Prelude_PArr (fsLit "fromNestedPArrayP") dph_Prelude_PArr (fsLit "fromNestedPArrayPA")
    , mk dph_Prelude_PArr (fsLit "combineP")    dph_Combinators (fsLit "combine2PA")
305
306
307
308
309
310
311
    ]
  where
    mk = (,,,)

initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
initBuiltinTyCons bi
  = do
312
      -- parr <- externalTyCon dph_Prelude_PArr (fsLit "PArr")
313
      return $ (tyConName funTyCon, closureTyCon bi)
314
             : (parrTyConName,      parrayTyCon bi)
315
316
317
318

             -- FIXME: temporary
             : (tyConName $ parrayTyCon bi, parrayTyCon bi)

319
             : [(tyConName tc, tc) | tc <- defaultTyCons]
320
321

defaultTyCons :: [TyCon]
322
defaultTyCons = [intTyCon, boolTyCon, doubleTyCon]
323

324
initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
325
initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
326
327

defaultDataCons :: [DataCon]
328
defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
329

330
331
initBuiltinDicts :: [(Name, Module, FastString)] -> DsM [(Name, Var)]
initBuiltinDicts ps
332
  = do
333
      dicts <- zipWithM externalVar mods fss
334
      return $ zip tcs dicts
335
  where
336
337
    (tcs, mods, fss) = unzip3 ps

338
initBuiltinPAs :: Builtins -> DsM [(Name, Var)]
339
initBuiltinPAs = initBuiltinDicts . builtinPAs
340

341
builtinPAs :: Builtins -> [(Name, Module, FastString)]
342
builtinPAs bi@(Builtins { dphModules = mods })
343
  = [
344
345
346
347
348
349
350
351
      mk (tyConName $ closureTyCon bi)  (dph_Closure   mods) (fsLit "dPA_Clo")
    , mk (tyConName $ voidTyCon bi)     (dph_Repr      mods) (fsLit "dPA_Void")
    , mk (tyConName $ parrayTyCon bi)   (dph_Instances mods) (fsLit "dPA_PArray")
    , mk unitTyConName                  (dph_Instances mods) (fsLit "dPA_Unit")

    , mk intTyConName                   (dph_Instances mods) (fsLit "dPA_Int")
    , mk doubleTyConName                (dph_Instances mods) (fsLit "dPA_Double")
    , mk boolTyConName                  (dph_Instances mods) (fsLit "dPA_Bool")
352
353
    ]
    ++ tups
354
355
356
  where
    mk name mod fs = (name, mod, fs)

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
357
    tups = map mk_tup [2..mAX_DPH_PROD]
358
    mk_tup n = mk (tyConName $ tupleTyCon Boxed n)
359
                  (dph_Instances mods)
360
361
                  (mkFastString $ "dPA_" ++ show n)

362
initBuiltinPRs :: Builtins -> DsM [(Name, Var)]
363
initBuiltinPRs = initBuiltinDicts . builtinPRs
364

365
builtinPRs :: Builtins -> [(Name, Module, FastString)]
366
builtinPRs bi@(Builtins { dphModules = mods }) =
367
  [
368
369
370
371
372
    mk (tyConName   unitTyCon)           (dph_Repr mods)    (fsLit "dPR_Unit")
  , mk (tyConName $ voidTyCon        bi) (dph_Repr mods)    (fsLit "dPR_Void")
  , mk (tyConName $ wrapTyCon        bi) (dph_Repr mods)    (fsLit "dPR_Wrap")
  , mk (tyConName $ enumerationTyCon bi) (dph_Repr mods)    (fsLit "dPR_Enumeration")
  , mk (tyConName $ closureTyCon     bi) (dph_Closure mods) (fsLit "dPR_Clo")
373

374
    -- temporary
375
376
  , mk intTyConName          (dph_Instances mods) (fsLit "dPR_Int")
  , mk doubleTyConName       (dph_Instances mods) (fsLit "dPR_Double")
377
378
  ]

rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
379
380
  ++ map mk_sum  [2..mAX_DPH_SUM]
  ++ map mk_prod [2..mAX_DPH_PROD]
381
382
  where
    mk name mod fs = (name, mod, fs)
383

384
    mk_sum n = (tyConName $ sumTyCon n bi, dph_Repr mods,
385
386
                mkFastString ("dPR_Sum" ++ show n))

387
    mk_prod n = (tyConName $ prodTyCon n bi, dph_Repr mods,
388
389
                 mkFastString ("dPR_" ++ show n))

390
391
392
393
initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
initBuiltinBoxedTyCons = return . builtinBoxedTyCons

builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
394
builtinBoxedTyCons _ =
395
396
  [(tyConName intPrimTyCon, intTyCon)]

397
398
externalVar :: Module -> FastString -> DsM Var
externalVar mod fs
399
  = dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
400

401
402
externalTyCon :: Module -> FastString -> DsM TyCon
externalTyCon mod fs
403
  = dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
404

405
406
407
408
409
410
externalType :: Module -> FastString -> DsM Type
externalType mod fs
  = do
      tycon <- externalTyCon mod fs
      return $ mkTyConApp tycon []

411
unitTyConName :: Name
412
413
unitTyConName = tyConName unitTyCon

414

415
416
primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
primMethod  tycon method (Builtins { dphModules = mods })
417
418
  | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
  = liftM Just
419
420
  $ dsLookupGlobalId =<< lookupOrig (dph_Unboxed mods)
                                    (mkVarOcc $ method ++ suffix)
421
422
423

  | otherwise = return Nothing

424
425
primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
primPArray tycon (Builtins { dphModules = mods })
426
427
  | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
  = liftM Just
428
  $ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
429
                                 (mkTcOcc $ "PArray" ++ suffix)
430
431
432

  | otherwise = return Nothing

433
prim_ty_cons :: NameEnv String
434
435
436
prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
  where
    mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)
437