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
e12e8c14
Commit
e12e8c14
authored
Aug 07, 2007
by
rl@cse.unsw.edu.au
Browse files
Support for using built-in PA dictionaries for some types
parent
97b95db0
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/vectorise/VectMonad.hs
View file @
e12e8c14
...
...
@@ -21,7 +21,7 @@ module VectMonad (
lookupVar
,
defGlobalVar
,
lookupTyCon
,
defTyCon
,
lookupDataCon
,
defDataCon
,
lookupTyConPA
,
defTyConPA
,
lookupTyConPA
,
defTyConPA
,
defTyConRdrPAs
,
lookupTyVarPA
,
defLocalTyVar
,
defLocalTyVarWithPA
,
localTyVars
,
lookupInst
,
lookupFamInst
...
...
@@ -413,6 +413,16 @@ defTyConPA :: TyCon -> Var -> VM ()
defTyConPA
tc
pa
=
updGEnv
$
\
env
->
env
{
global_pa_funs
=
extendNameEnv
(
global_pa_funs
env
)
(
tyConName
tc
)
pa
}
defTyConRdrPAs
::
[(
Name
,
RdrName
)]
->
VM
()
defTyConRdrPAs
ps
=
do
pas
<-
mapM
lookupRdrVar
rdr_names
updGEnv
$
\
env
->
env
{
global_pa_funs
=
extendNameEnvList
(
global_pa_funs
env
)
(
zip
tcs
pas
)
}
where
(
tcs
,
rdr_names
)
=
unzip
ps
lookupTyVarPA
::
Var
->
VM
(
Maybe
CoreExpr
)
lookupTyVarPA
tv
=
readLEnv
$
\
env
->
lookupVarEnv
(
local_tyvar_pa
env
)
tv
...
...
compiler/vectorise/Vectorise.hs
View file @
e12e8c14
...
...
@@ -25,11 +25,13 @@ import InstEnv ( extendInstEnvList )
import
Var
import
VarEnv
import
VarSet
import
Name
(
mkSysTvName
,
getName
)
import
Name
(
Name
,
mkSysTvName
,
getName
)
import
NameEnv
import
Id
import
MkId
(
unwrapFamInstScrut
)
import
OccName
import
RdrName
(
RdrName
,
mkRdrQual
)
import
Module
(
mkModuleNameFS
)
import
DsMonad
hiding
(
mapAndUnzipM
)
import
DsUtils
(
mkCoreTup
,
mkCoreTupTy
)
...
...
@@ -44,6 +46,12 @@ import Outputable
import
FastString
import
Control.Monad
(
liftM
,
liftM2
,
zipWithM
,
mapAndUnzipM
)
mkNDPVar
::
FastString
->
RdrName
mkNDPVar
fs
=
mkRdrQual
nDP_BUILTIN
(
mkVarOccFS
fs
)
builtin_PAs
::
[(
Name
,
RdrName
)]
builtin_PAs
=
[(
intTyConName
,
mkNDPVar
FSLIT
(
"dPA_Int"
))]
vectorise
::
HscEnv
->
UniqSupply
->
RuleBase
->
ModGuts
->
IO
(
SimplCount
,
ModGuts
)
vectorise
hsc_env
_
_
guts
...
...
@@ -60,6 +68,7 @@ vectorise hsc_env _ _ guts
vectModule
::
ModGuts
->
VM
ModGuts
vectModule
guts
=
do
defTyConRdrPAs
builtin_PAs
(
types'
,
fam_insts
,
pa_insts
)
<-
vectTypeEnv
(
mg_types
guts
)
let
insts
=
map
painstInstance
pa_insts
...
...
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