Skip to content
GitLab
Menu
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
df62b50d
Commit
df62b50d
authored
Jul 17, 2007
by
rl@cse.unsw.edu.au
Browse files
Move type vectorisation code to a separate module
parent
13ae8118
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/package.conf.in
View file @
df62b50d
...
...
@@ -260,6 +260,7 @@ exposed-modules:
VarEnv
VarSet
VectMonad
VectType
VectUtils
Vectorise
WorkWrap
...
...
compiler/vectorise/VectType.hs
0 → 100644
View file @
df62b50d
module
VectType
(
vectTyCon
,
vectType
)
where
#
include
"HsVersions.h"
import
VectMonad
import
VectUtils
import
TyCon
import
Type
import
TypeRep
import
Outputable
import
Control.Monad
(
liftM2
)
vectTyCon
::
TyCon
->
VM
TyCon
vectTyCon
tc
|
isFunTyCon
tc
=
builtin
closureTyCon
|
isBoxedTupleTyCon
tc
=
return
tc
|
isUnLiftedTyCon
tc
=
return
tc
|
otherwise
=
do
r
<-
lookupTyCon
tc
case
r
of
Just
tc'
->
return
tc'
-- FIXME: just for now
Nothing
->
pprTrace
"ccTyCon:"
(
ppr
tc
)
$
return
tc
vectType
::
Type
->
VM
Type
vectType
ty
|
Just
ty'
<-
coreView
ty
=
vectType
ty'
vectType
(
TyVarTy
tv
)
=
return
$
TyVarTy
tv
vectType
(
AppTy
ty1
ty2
)
=
liftM2
AppTy
(
vectType
ty1
)
(
vectType
ty2
)
vectType
(
TyConApp
tc
tys
)
=
liftM2
TyConApp
(
vectTyCon
tc
)
(
mapM
vectType
tys
)
vectType
(
FunTy
ty1
ty2
)
=
liftM2
TyConApp
(
builtin
closureTyCon
)
(
mapM
vectType
[
ty1
,
ty2
])
vectType
ty
@
(
ForAllTy
_
_
)
=
do
mdicts
<-
mapM
paDictArgType
tyvars
mono_ty'
<-
vectType
mono_ty
return
$
tyvars
`
mkForAllTys
`
([
dict
|
Just
dict
<-
mdicts
]
`
mkFunTys
`
mono_ty'
)
where
(
tyvars
,
mono_ty
)
=
splitForAllTys
ty
vectType
ty
=
pprPanic
"vectType:"
(
ppr
ty
)
compiler/vectorise/Vectorise.hs
View file @
df62b50d
...
...
@@ -5,6 +5,7 @@ where
import
VectMonad
import
VectUtils
import
VectType
import
DynFlags
import
HscTypes
...
...
@@ -18,7 +19,6 @@ import Rules ( RuleBase )
import
DataCon
import
TyCon
import
Type
import
TypeRep
import
Var
import
VarEnv
import
VarSet
...
...
@@ -39,7 +39,6 @@ import BasicTypes ( Boxity(..) )
import
Outputable
import
FastString
import
Control.Monad
(
liftM
,
liftM2
,
mapAndUnzipM
,
zipWithM_
)
import
Data.Maybe
(
maybeToList
)
vectorise
::
HscEnv
->
UniqSupply
->
RuleBase
->
ModGuts
->
IO
(
SimplCount
,
ModGuts
)
...
...
@@ -279,8 +278,8 @@ vectExpr lc (fvs, AnnLam bndr body)
res_ty
<-
vectType
(
exprType
$
deAnnotate
body
)
-- FIXME: move the functions to the top level
mono_vfn
<-
applyToTypes
(
Var
vfn_var
)
(
m
ap
TyVarTy
tyvars
)
mono_lfn
<-
applyToTypes
(
Var
lfn_var
)
(
m
ap
TyVarTy
tyvars
)
mono_vfn
<-
applyToTypes
(
Var
vfn_var
)
(
m
k
TyVarTy
s
tyvars
)
mono_lfn
<-
applyToTypes
(
Var
lfn_var
)
(
m
k
TyVarTy
s
tyvars
)
mk_clo
<-
builtin
mkClosureVar
mk_cloP
<-
builtin
mkClosurePVar
...
...
@@ -425,33 +424,4 @@ vectTyAppExpr lc e tys = pprPanic "vectTyAppExpr" (ppr $ deAnnotate e)
-- ----------------------------------------------------------------------------
-- Types
vectTyCon
::
TyCon
->
VM
TyCon
vectTyCon
tc
|
isFunTyCon
tc
=
builtin
closureTyCon
|
isBoxedTupleTyCon
tc
=
return
tc
|
isUnLiftedTyCon
tc
=
return
tc
|
otherwise
=
do
r
<-
lookupTyCon
tc
case
r
of
Just
tc'
->
return
tc'
-- FIXME: just for now
Nothing
->
pprTrace
"ccTyCon:"
(
ppr
tc
)
$
return
tc
vectType
::
Type
->
VM
Type
vectType
ty
|
Just
ty'
<-
coreView
ty
=
vectType
ty'
vectType
(
TyVarTy
tv
)
=
return
$
TyVarTy
tv
vectType
(
AppTy
ty1
ty2
)
=
liftM2
AppTy
(
vectType
ty1
)
(
vectType
ty2
)
vectType
(
TyConApp
tc
tys
)
=
liftM2
TyConApp
(
vectTyCon
tc
)
(
mapM
vectType
tys
)
vectType
(
FunTy
ty1
ty2
)
=
liftM2
TyConApp
(
builtin
closureTyCon
)
(
mapM
vectType
[
ty1
,
ty2
])
vectType
ty
@
(
ForAllTy
_
_
)
=
do
mdicts
<-
mapM
paDictArgType
tyvars
mono_ty'
<-
vectType
mono_ty
return
$
tyvars
`
mkForAllTys
`
([
dict
|
Just
dict
<-
mdicts
]
`
mkFunTys
`
mono_ty'
)
where
(
tyvars
,
mono_ty
)
=
splitForAllTys
ty
vectType
ty
=
pprPanic
"vectType:"
(
ppr
ty
)
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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