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
430cdcde
Commit
430cdcde
authored
Aug 24, 2007
by
rl@cse.unsw.edu.au
Browse files
Modify generation of PR dictionaries for new scheme
parent
395e4574
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/vectorise/VectType.hs
View file @
430cdcde
...
...
@@ -26,7 +26,7 @@ import Var ( Var )
import
Id
(
mkWildId
)
import
Name
(
Name
,
getOccName
)
import
NameEnv
import
TysWiredIn
(
unitTy
,
intTy
,
intDataCon
,
unitDataConId
)
import
TysWiredIn
(
unitTy
,
unitTyCon
,
intTy
,
intDataCon
,
unitDataConId
)
import
TysPrim
(
intPrimTy
)
import
Unique
...
...
@@ -337,12 +337,36 @@ buildFromArrPRepr _ vect_tc prepr_tc arr_tc
=
mkFromArrPRepr
undefined
undefined
undefined
undefined
undefined
undefined
buildPRDict
::
TyConRepr
->
TyCon
->
TyCon
->
TyCon
->
VM
CoreExpr
buildPRDict
_
vect_tc
prepr_tc
_
=
prCoerce
prepr_tc
var_tys
=<<
prDictOfType
(
mkTyConApp
prepr_tc
var_tys
)
buildPRDict
(
TyConRepr
{
repr_tys
=
repr_tys
,
repr_prod_tycons
=
prod_tycons
,
repr_prod_tys
=
prod_tys
,
repr_sum_tycon
=
repr_sum_tycon
})
vect_tc
prepr_tc
_
=
do
prs
<-
mapM
(
mapM
mkPR
)
repr_tys
prod_prs
<-
sequence
$
zipWith3
mk_prod_pr
prod_tycons
repr_tys
prs
sum_pr
<-
mk_sum_pr
prod_prs
prCoerce
prepr_tc
var_tys
sum_pr
where
var_tys
=
mkTyVarTys
$
tyConTyVars
vect_tc
Just
sum_tycon
=
repr_sum_tycon
mk_prod_pr
_
_
[]
=
prDFunOfTyCon
unitTyCon
mk_prod_pr
_
_
[
pr
]
=
return
pr
mk_prod_pr
(
Just
tc
)
tys
prs
=
do
dfun
<-
prDFunOfTyCon
tc
return
$
dfun
`
mkTyApps
`
tys
`
mkApps
`
prs
mk_sum_pr
[
pr
]
=
return
pr
mk_sum_pr
prs
=
do
dfun
<-
prDFunOfTyCon
sum_tycon
return
$
dfun
`
mkTyApps
`
prod_tys
`
mkApps
`
prs
buildPArrayTyCon
::
TyCon
->
TyCon
->
VM
TyCon
buildPArrayTyCon
orig_tc
vect_tc
=
fixV
$
\
repr_tc
->
do
...
...
compiler/vectorise/VectUtils.hs
View file @
430cdcde
...
...
@@ -9,9 +9,9 @@ module VectUtils (
mkPADictType
,
mkPArrayType
,
mkPReprType
,
parrayCoerce
,
parrayReprTyCon
,
parrayReprDataCon
,
mkVScrut
,
prD
ict
OfTy
pe
,
prCoerce
,
prD
Fun
OfTy
Con
,
prCoerce
,
paDictArgType
,
paDictOfType
,
paDFunType
,
paMethod
,
lengthPA
,
replicatePA
,
emptyPA
,
liftPA
,
paMethod
,
mkPR
,
lengthPA
,
replicatePA
,
emptyPA
,
liftPA
,
polyAbstract
,
polyApply
,
polyVApply
,
hoistBinding
,
hoistExpr
,
hoistPolyVExpr
,
takeHoisted
,
buildClosure
,
buildClosures
,
...
...
@@ -248,35 +248,9 @@ mkVScrut (ve, le)
(
tc
,
arg_tys
)
<-
parrayReprTyCon
(
exprType
ve
)
return
((
ve
,
unwrapFamInstScrut
tc
arg_tys
le
),
tc
,
arg_tys
)
prDictOfType
::
Type
->
VM
CoreExpr
prDictOfType
orig_ty
|
Just
(
tycon
,
ty_args
)
<-
splitTyConApp_maybe
orig_ty
=
do
dfun
<-
traceMaybeV
"prDictOfType"
(
ppr
tycon
)
(
lookupTyConPR
tycon
)
prDFunApply
(
Var
dfun
)
ty_args
prDFunApply
::
CoreExpr
->
[
Type
]
->
VM
CoreExpr
prDFunApply
dfun
tys
=
do
args
<-
mapM
mkDFunArg
arg_tys
return
$
mkApps
mono_dfun
args
where
mono_dfun
=
mkTyApps
dfun
tys
(
arg_tys
,
_
)
=
splitFunTys
(
exprType
mono_dfun
)
mkDFunArg
::
Type
->
VM
CoreExpr
mkDFunArg
ty
|
Just
(
tycon
,
[
arg
])
<-
splitTyConApp_maybe
ty
=
let
name
=
tyConName
tycon
get_dict
|
name
==
paTyConName
=
paDictOfType
|
name
==
prTyConName
=
prDictOfType
|
otherwise
=
pprPanic
"mkDFunArg"
(
ppr
ty
)
in
get_dict
arg
mkDFunArg
ty
=
pprPanic
"mkDFunArg"
(
ppr
ty
)
prDFunOfTyCon
::
TyCon
->
VM
CoreExpr
prDFunOfTyCon
tycon
=
liftM
Var
(
traceMaybeV
"prDictOfTyCon"
(
ppr
tycon
)
(
lookupTyConPR
tycon
))
prCoerce
::
TyCon
->
[
Type
]
->
CoreExpr
->
VM
CoreExpr
prCoerce
repr_tc
args
expr
...
...
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