Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
9f695847
Commit
9f695847
authored
Aug 30, 2007
by
rl@cse.unsw.edu.au
Browse files
Add code for looking up PA methods of primitive TyCons
parent
8e3058a5
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/prelude/PrelNames.lhs
View file @
9f695847
...
...
@@ -279,6 +279,7 @@ gLA_EXTS = mkBaseModule FSLIT("GHC.Exts")
nDP_PARRAY = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.PArray")
nDP_REPR = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Repr")
nDP_CLOSURE = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Closure")
nDP_PRIM = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Prim")
nDP_INSTANCES = mkNDPModule FSLIT("Data.Array.Parallel.Lifted.Instances")
nDP_UARR = mkNDPModule FSLIT("Data.Array.Parallel.Unlifted.Flat.UArr")
...
...
compiler/vectorise/VectBuiltIn.hs
View file @
9f695847
module
VectBuiltIn
(
Builtins
(
..
),
sumTyCon
,
prodTyCon
,
initBuiltins
,
initBuiltinTyCons
,
initBuiltinPAs
,
initBuiltinPRs
initBuiltins
,
initBuiltinTyCons
,
initBuiltinPAs
,
initBuiltinPRs
,
primMethod
)
where
#
include
"HsVersions.h"
...
...
@@ -13,11 +15,12 @@ import DataCon ( DataCon )
import
TyCon
(
TyCon
,
tyConName
,
tyConDataCons
)
import
Var
(
Var
)
import
Id
(
mkSysLocal
)
import
Name
(
Name
)
import
OccName
(
mkVarOccFS
,
mkOccNameFS
,
tcName
)
import
Name
(
Name
,
getOccString
)
import
NameEnv
import
OccName
import
TypeRep
(
funTyCon
)
import
TysPrim
(
intPrimTy
)
import
TysPrim
import
TysWiredIn
(
unitTyCon
,
tupleTyCon
,
intTyConName
)
import
PrelNames
import
BasicTypes
(
Boxity
(
..
)
)
...
...
@@ -191,3 +194,15 @@ lookupExternalTyCon mod fs
unitTyConName
=
tyConName
unitTyCon
primMethod
::
TyCon
->
String
->
DsM
(
Maybe
Var
)
primMethod
tycon
method
|
Just
suffix
<-
lookupNameEnv
prim_ty_cons
(
tyConName
tycon
)
=
liftM
Just
$
dsLookupGlobalId
=<<
lookupOrig
nDP_PRIM
(
mkVarOcc
$
method
++
suffix
)
|
otherwise
=
return
Nothing
prim_ty_cons
=
mkNameEnv
[
mk_prim
intPrimTyCon
]
where
mk_prim
tycon
=
(
tyConName
tycon
,
'_'
:
getOccString
tycon
)
compiler/vectorise/VectMonad.hs
View file @
9f695847
...
...
@@ -24,6 +24,7 @@ module VectMonad (
lookupDataCon
,
defDataCon
,
lookupTyConPA
,
defTyConPA
,
defTyConPAs
,
lookupTyConPR
,
lookupPrimMethod
,
lookupTyVarPA
,
defLocalTyVar
,
defLocalTyVarWithPA
,
localTyVars
,
{-lookupInst,-}
lookupFamInst
...
...
@@ -354,6 +355,9 @@ defDataCon :: DataCon -> DataCon -> VM ()
defDataCon
dc
dc'
=
updGEnv
$
\
env
->
env
{
global_datacons
=
extendNameEnv
(
global_datacons
env
)
(
dataConName
dc
)
dc'
}
lookupPrimMethod
::
TyCon
->
String
->
VM
(
Maybe
Var
)
lookupPrimMethod
tycon
method
=
liftDs
$
primMethod
tycon
method
lookupTyConPA
::
TyCon
->
VM
(
Maybe
Var
)
lookupTyConPA
tc
=
readGEnv
$
\
env
->
lookupNameEnv
(
global_pa_funs
env
)
(
tyConName
tc
)
...
...
compiler/vectorise/VectUtils.hs
View file @
9f695847
...
...
@@ -221,27 +221,45 @@ paDFunApply dfun tys
dicts
<-
mapM
paDictOfType
tys
return
$
mkApps
(
mkTyApps
dfun
tys
)
dicts
paMethod
::
(
Builtins
->
Var
)
->
Type
->
VM
CoreExpr
paMethod
method
ty
type
PAMethod
=
(
Builtins
->
Var
,
String
)
pa_length
=
(
lengthPAVar
,
"lengthPA"
)
pa_replicate
=
(
replicatePAVar
,
"replicatePA"
)
pa_empty
=
(
emptyPAVar
,
"emptyPA"
)
paMethod
::
PAMethod
->
Type
->
VM
CoreExpr
paMethod
(
method
,
name
)
ty
|
Just
(
tycon
,
[]
)
<-
splitTyConApp_maybe
ty
,
isPrimTyCon
tycon
=
do
fn
<-
traceMaybeV
"paMethod"
(
ppr
tycon
<+>
text
name
)
$
lookupPrimMethod
tycon
name
return
(
Var
fn
)
paMethod
(
method
,
name
)
ty
=
do
fn
<-
builtin
method
dict
<-
paDictOfType
ty
return
$
mkApps
(
Var
fn
)
[
Type
ty
,
dict
]
mkPR
::
Type
->
VM
CoreExpr
mkPR
=
paMethod
mkPRVar
mkPR
ty
=
do
fn
<-
builtin
mkPRVar
dict
<-
paDictOfType
ty
return
$
mkApps
(
Var
fn
)
[
Type
ty
,
dict
]
lengthPA
::
CoreExpr
->
VM
CoreExpr
lengthPA
x
=
liftM
(`
App
`
x
)
(
paMethod
length
PAVar
ty
)
lengthPA
x
=
liftM
(`
App
`
x
)
(
paMethod
pa_
length
ty
)
where
ty
=
splitPArrayTy
(
exprType
x
)
replicatePA
::
CoreExpr
->
CoreExpr
->
VM
CoreExpr
replicatePA
len
x
=
liftM
(`
mkApps
`
[
len
,
x
])
(
paMethod
replicate
PAVar
(
exprType
x
))
(
paMethod
pa_
replicate
(
exprType
x
))
emptyPA
::
Type
->
VM
CoreExpr
emptyPA
=
paMethod
empty
PAVar
emptyPA
=
paMethod
pa_
empty
liftPA
::
CoreExpr
->
VM
CoreExpr
liftPA
x
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment