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
de6c394e
Commit
de6c394e
authored
Aug 30, 2007
by
rl@cse.unsw.edu.au
Browse files
Find the correct array type for primitive tycons
parent
9f695847
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/vectorise/VectBuiltIn.hs
View file @
de6c394e
...
...
@@ -2,7 +2,7 @@ module VectBuiltIn (
Builtins
(
..
),
sumTyCon
,
prodTyCon
,
initBuiltins
,
initBuiltinTyCons
,
initBuiltinPAs
,
initBuiltinPRs
,
primMethod
primMethod
,
primPArray
)
where
#
include
"HsVersions.h"
...
...
@@ -20,6 +20,7 @@ import NameEnv
import
OccName
import
TypeRep
(
funTyCon
)
import
Type
(
Type
)
import
TysPrim
import
TysWiredIn
(
unitTyCon
,
tupleTyCon
,
intTyConName
)
import
PrelNames
...
...
@@ -203,6 +204,14 @@ primMethod tycon method
|
otherwise
=
return
Nothing
primPArray
::
TyCon
->
DsM
(
Maybe
TyCon
)
primPArray
tycon
|
Just
suffix
<-
lookupNameEnv
prim_ty_cons
(
tyConName
tycon
)
=
liftM
Just
$
dsLookupTyCon
=<<
lookupOrig
nDP_PRIM
(
mkOccName
tcName
$
"PArray"
++
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 @
de6c394e
...
...
@@ -24,7 +24,7 @@ module VectMonad (
lookupDataCon
,
defDataCon
,
lookupTyConPA
,
defTyConPA
,
defTyConPAs
,
lookupTyConPR
,
lookupPrimMethod
,
lookupPrimMethod
,
lookupPrimPArray
,
lookupTyVarPA
,
defLocalTyVar
,
defLocalTyVarWithPA
,
localTyVars
,
{-lookupInst,-}
lookupFamInst
...
...
@@ -355,8 +355,11 @@ defDataCon :: DataCon -> DataCon -> VM ()
defDataCon
dc
dc'
=
updGEnv
$
\
env
->
env
{
global_datacons
=
extendNameEnv
(
global_datacons
env
)
(
dataConName
dc
)
dc'
}
lookupPrimPArray
::
TyCon
->
VM
(
Maybe
TyCon
)
lookupPrimPArray
=
liftDs
.
primPArray
lookupPrimMethod
::
TyCon
->
String
->
VM
(
Maybe
Var
)
lookupPrimMethod
tycon
method
=
liftDs
$
primMethod
tycon
method
lookupPrimMethod
tycon
=
liftDs
.
primMethod
tycon
lookupTyConPA
::
TyCon
->
VM
(
Maybe
Var
)
lookupTyConPA
tc
=
readGEnv
$
\
env
->
lookupNameEnv
(
global_pa_funs
env
)
(
tyConName
tc
)
...
...
compiler/vectorise/VectUtils.hs
View file @
de6c394e
...
...
@@ -100,6 +100,14 @@ splitClosureTy = splitBinTy "splitClosureTy" closureTyConName
splitPArrayTy
::
Type
->
Type
splitPArrayTy
=
splitUnTy
"splitPArrayTy"
parrayTyConName
splitPrimTyCon
::
Type
->
Maybe
TyCon
splitPrimTyCon
ty
|
Just
(
tycon
,
[]
)
<-
splitTyConApp_maybe
ty
,
isPrimTyCon
tycon
=
Just
tycon
|
otherwise
=
Nothing
mkBuiltinTyConApp
::
(
Builtins
->
TyCon
)
->
[
Type
]
->
VM
Type
mkBuiltinTyConApp
get_tc
tys
=
do
...
...
@@ -138,6 +146,12 @@ mkPADictType :: Type -> VM Type
mkPADictType
ty
=
mkBuiltinTyConApp
paTyCon
[
ty
]
mkPArrayType
::
Type
->
VM
Type
mkPArrayType
ty
|
Just
tycon
<-
splitPrimTyCon
ty
=
do
arr
<-
traceMaybeV
"mkPArrayType"
(
ppr
tycon
)
$
lookupPrimPArray
tycon
return
$
mkTyConApp
arr
[]
mkPArrayType
ty
=
mkBuiltinTyConApp
parrayTyCon
[
ty
]
mkBuiltinCo
::
(
Builtins
->
TyCon
)
->
VM
Coercion
...
...
@@ -229,8 +243,7 @@ pa_empty = (emptyPAVar, "emptyPA")
paMethod
::
PAMethod
->
Type
->
VM
CoreExpr
paMethod
(
method
,
name
)
ty
|
Just
(
tycon
,
[]
)
<-
splitTyConApp_maybe
ty
,
isPrimTyCon
tycon
|
Just
tycon
<-
splitPrimTyCon
ty
=
do
fn
<-
traceMaybeV
"paMethod"
(
ppr
tycon
<+>
text
name
)
$
lookupPrimMethod
tycon
name
...
...
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