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
b8dbedce
Commit
b8dbedce
authored
Sep 09, 2010
by
benl@ouroborus.net
Browse files
Break out conversion functions to own module
parent
c2beb20b
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/ghc.cabal.in
View file @
b8dbedce
...
...
@@ -457,6 +457,7 @@ Library
VectType
VectUtils
Vectorise.Var
Vectorise.Convert
Vectorise.Env
Vectorise.Vect
Vectorise.Exp
...
...
compiler/vectorise/VectType.hs
View file @
b8dbedce
...
...
@@ -8,6 +8,7 @@ where
import
VectUtils
import
Vectorise.Env
import
Vectorise.Convert
import
Vectorise.Vect
import
Vectorise.Monad
import
Vectorise.Builtins
...
...
@@ -27,7 +28,6 @@ import BuildTyCl
import
DataCon
import
TyCon
import
Type
import
TypeRep
import
Coercion
import
FamInstEnv
(
FamInst
,
mkLocalFamInst
)
import
OccName
...
...
@@ -52,13 +52,14 @@ debug = False
dtrace
s
x
=
if
debug
then
pprTrace
"VectType"
s
x
else
x
-- ----------------------------------------------------------------------------
-- Type definitions
-- | Vectorise a type environment.
-- The type environment contains all the type things defined in a module.
vectTypeEnv
::
TypeEnv
->
VM
(
TypeEnv
,
[
FamInst
],
[(
Var
,
CoreExpr
)])
vectTypeEnv
::
TypeEnv
->
VM
(
TypeEnv
-- Vectorised type environment.
,
[
FamInst
]
-- New type family instances.
,
[(
Var
,
CoreExpr
)])
-- New top level bindings.
vectTypeEnv
env
=
dtrace
(
ppr
env
)
$
do
...
...
@@ -748,76 +749,3 @@ paMethods = [("dictPRepr", buildPRDict),
(
"fromArrPRepr"
,
buildFromArrPRepr
)]
-- ----------------------------------------------------------------------------
-- Conversions
-- | Build an expression that calls the vectorised version of some
-- function from a `Closure`.
--
-- For example
-- @
-- \(x :: Double) ->
-- \(y :: Double) ->
-- ($v_foo $: x) $: y
-- @
--
-- We use the type of the original binding to work out how many
-- outer lambdas to add.
--
fromVect
::
Type
-- ^ The type of the original binding.
->
CoreExpr
-- ^ Expression giving the closure to use, eg @$v_foo@.
->
VM
CoreExpr
-- Convert the type to the core view if it isn't already.
fromVect
ty
expr
|
Just
ty'
<-
coreView
ty
=
fromVect
ty'
expr
-- For each function constructor in the original type we add an outer
-- lambda to bind the parameter variable, and an inner application of it.
fromVect
(
FunTy
arg_ty
res_ty
)
expr
=
do
arg
<-
newLocalVar
(
fsLit
"x"
)
arg_ty
varg
<-
toVect
arg_ty
(
Var
arg
)
varg_ty
<-
vectType
arg_ty
vres_ty
<-
vectType
res_ty
apply
<-
builtin
applyVar
body
<-
fromVect
res_ty
$
Var
apply
`
mkTyApps
`
[
varg_ty
,
vres_ty
]
`
mkApps
`
[
expr
,
varg
]
return
$
Lam
arg
body
-- If the type isn't a function then it's time to call on the closure.
fromVect
ty
expr
=
identityConv
ty
>>
return
expr
-- TODO: What is this really doing?
toVect
::
Type
->
CoreExpr
->
VM
CoreExpr
toVect
ty
expr
=
identityConv
ty
>>
return
expr
-- | Check that we have the vectorised versions of all the
-- type constructors in this type.
identityConv
::
Type
->
VM
()
identityConv
ty
|
Just
ty'
<-
coreView
ty
=
identityConv
ty'
identityConv
(
TyConApp
tycon
tys
)
=
do
mapM_
identityConv
tys
identityConvTyCon
tycon
identityConv
_
=
noV
-- | Check that we have the vectorised version of this type constructor.
identityConvTyCon
::
TyCon
->
VM
()
identityConvTyCon
tc
|
isBoxedTupleTyCon
tc
=
return
()
|
isUnLiftedTyCon
tc
=
return
()
|
otherwise
=
do
tc'
<-
maybeV
(
lookupTyCon
tc
)
if
tc
==
tc'
then
return
()
else
noV
compiler/vectorise/Vectorise/Convert.hs
0 → 100644
View file @
b8dbedce
module
Vectorise.Convert
(
fromVect
)
where
import
Vectorise.Monad
import
Vectorise.Builtins
import
Vectorise.Type.Type
import
CoreSyn
import
TyCon
import
Type
import
TypeRep
import
FastString
-- | Build an expression that calls the vectorised version of some
-- function from a `Closure`.
--
-- For example
-- @
-- \(x :: Double) ->
-- \(y :: Double) ->
-- ($v_foo $: x) $: y
-- @
--
-- We use the type of the original binding to work out how many
-- outer lambdas to add.
--
fromVect
::
Type
-- ^ The type of the original binding.
->
CoreExpr
-- ^ Expression giving the closure to use, eg @$v_foo@.
->
VM
CoreExpr
-- Convert the type to the core view if it isn't already.
fromVect
ty
expr
|
Just
ty'
<-
coreView
ty
=
fromVect
ty'
expr
-- For each function constructor in the original type we add an outer
-- lambda to bind the parameter variable, and an inner application of it.
fromVect
(
FunTy
arg_ty
res_ty
)
expr
=
do
arg
<-
newLocalVar
(
fsLit
"x"
)
arg_ty
varg
<-
toVect
arg_ty
(
Var
arg
)
varg_ty
<-
vectType
arg_ty
vres_ty
<-
vectType
res_ty
apply
<-
builtin
applyVar
body
<-
fromVect
res_ty
$
Var
apply
`
mkTyApps
`
[
varg_ty
,
vres_ty
]
`
mkApps
`
[
expr
,
varg
]
return
$
Lam
arg
body
-- If the type isn't a function then it's time to call on the closure.
fromVect
ty
expr
=
identityConv
ty
>>
return
expr
-- TODO: What is this really doing?
toVect
::
Type
->
CoreExpr
->
VM
CoreExpr
toVect
ty
expr
=
identityConv
ty
>>
return
expr
-- | Check that we have the vectorised versions of all the
-- type constructors in this type.
identityConv
::
Type
->
VM
()
identityConv
ty
|
Just
ty'
<-
coreView
ty
=
identityConv
ty'
identityConv
(
TyConApp
tycon
tys
)
=
do
mapM_
identityConv
tys
identityConvTyCon
tycon
identityConv
_
=
noV
-- | Check that we have the vectorised version of this type constructor.
identityConvTyCon
::
TyCon
->
VM
()
identityConvTyCon
tc
|
isBoxedTupleTyCon
tc
=
return
()
|
isUnLiftedTyCon
tc
=
return
()
|
otherwise
=
do
tc'
<-
maybeV
(
lookupTyCon
tc
)
if
tc
==
tc'
then
return
()
else
noV
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