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
72442526
Commit
72442526
authored
Aug 24, 2007
by
rl@cse.unsw.edu.au
Browse files
Move code
parent
151b1170
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/vectorise/VectType.hs
View file @
72442526
...
...
@@ -26,7 +26,7 @@ import Var ( Var )
import
Id
(
mkWildId
)
import
Name
(
Name
,
getOccName
)
import
NameEnv
import
TysWiredIn
(
unitTy
,
intTy
,
intDataCon
)
import
TysWiredIn
(
unitTy
,
intTy
,
intDataCon
,
unitDataConId
)
import
TysPrim
(
intPrimTy
)
import
Unique
...
...
@@ -212,23 +212,43 @@ buildPReprType :: TyCon -> VM Type
buildPReprType
=
liftM
repr_type
.
mkTyConRepr
buildToPRepr
::
TyConRepr
->
TyCon
->
TyCon
->
TyCon
->
VM
CoreExpr
buildToPRepr
repr
vect_tc
prepr_tc
_
buildToPRepr
(
TyConRepr
{
repr_tys
=
repr_tys
,
repr_prod_tycons
=
prod_tycons
,
repr_prod_tys
=
prod_tys
,
repr_sum_tycon
=
repr_sum_tycon
,
repr_type
=
repr_type
})
vect_tc
prepr_tc
_
=
do
arg
<-
newLocalVar
FSLIT
(
"x"
)
arg_ty
bndrss
<-
mapM
(
mapM
(
newLocalVar
FSLIT
(
"x"
)))
(
repr_tys
repr
)
arg
<-
newLocalVar
FSLIT
(
"x"
)
arg_ty
vars
<-
mapM
(
mapM
(
newLocalVar
FSLIT
(
"x"
)))
repr_tys
return
.
Lam
arg
.
wrapFamInstBody
prepr_tc
var_tys
.
Case
(
Var
arg
)
(
mkWildId
arg_ty
)
(
repr_type
repr
)
.
zipWith3
mk_alt
data_cons
bnd
rs
s
.
mkToPRepr
repr
$
map
(
map
Var
)
bnd
rs
s
.
Case
(
Var
arg
)
(
mkWildId
arg_ty
)
repr_type
.
mk_alt
s
data_cons
va
rs
.
zipWith3
mk_prod
prod_tycons
repr
_tys
$
map
(
map
Var
)
va
rs
where
var_tys
=
mkTyVarTys
$
tyConTyVars
vect_tc
arg_ty
=
mkTyConApp
vect_tc
var_tys
data_cons
=
tyConDataCons
vect_tc
mk_alt
data_con
bndrs
body
=
(
DataAlt
data_con
,
bndrs
,
body
)
Just
sum_tycon
=
repr_sum_tycon
sum_datacons
=
tyConDataCons
sum_tycon
mk_alts
_
_
[]
=
[(
DEFAULT
,
[]
,
Var
unitDataConId
)]
mk_alts
[
dc
]
[
vars
]
[
expr
]
=
[(
DataAlt
dc
,
vars
,
expr
)]
mk_alts
dcs
vars
exprs
=
zipWith4
mk_alt
dcs
vars
sum_datacons
exprs
mk_alt
dc
vars
sum_dc
expr
=
(
DataAlt
dc
,
vars
,
mkConApp
sum_dc
(
map
Type
prod_tys
++
[
expr
]))
mk_prod
_
_
[]
=
Var
unitDataConId
mk_prod
_
_
[
expr
]
=
expr
mk_prod
(
Just
tc
)
tys
exprs
=
mkConApp
dc
(
map
Type
tys
++
exprs
)
where
[
dc
]
=
tyConDataCons
tc
buildToArrPRepr
::
TyConRepr
->
TyCon
->
TyCon
->
TyCon
->
VM
CoreExpr
buildToArrPRepr
_
vect_tc
prepr_tc
arr_tc
...
...
compiler/vectorise/VectUtils.hs
View file @
72442526
...
...
@@ -5,7 +5,7 @@ module VectUtils (
splitClosureTy
,
TyConRepr
(
..
),
mkTyConRepr
,
mkToPRepr
,
mkToArrPRepr
,
mkFromPRepr
,
mkFromArrPRepr
,
mkToArrPRepr
,
mkFromPRepr
,
mkFromArrPRepr
,
mkPADictType
,
mkPArrayType
,
mkPReprType
,
parrayCoerce
,
parrayReprTyCon
,
parrayReprDataCon
,
mkVScrut
,
...
...
@@ -165,31 +165,6 @@ mkTyConRepr vect_tc
mk_tc_app_maybe
Nothing
[
ty
]
=
ty
mk_tc_app_maybe
(
Just
tc
)
tys
=
mkTyConApp
tc
tys
mkToPRepr
::
TyConRepr
->
[[
CoreExpr
]]
->
[
CoreExpr
]
mkToPRepr
(
TyConRepr
{
repr_tys
=
repr_tys
,
repr_prod_tycons
=
prod_tycons
,
repr_prod_tys
=
prod_tys
,
repr_sum_tycon
=
repr_sum_tycon
})
=
mk_sum
.
zipWith3
mk_prod
prod_tycons
repr_tys
where
Just
sum_tycon
=
repr_sum_tycon
mk_sum
[]
=
[
Var
unitDataConId
]
mk_sum
[
expr
]
=
[
expr
]
mk_sum
exprs
=
zipWith
(
mk_alt
prod_tys
)
(
tyConDataCons
sum_tycon
)
exprs
mk_alt
tys
dc
expr
=
mk_con_app
dc
tys
[
expr
]
mk_prod
_
_
[]
=
Var
unitDataConId
mk_prod
_
_
[
expr
]
=
expr
mk_prod
(
Just
tc
)
tys
exprs
=
mk_con_app
dc
tys
exprs
where
[
dc
]
=
tyConDataCons
tc
mk_con_app
dc
tys
exprs
=
mkConApp
dc
(
map
Type
tys
++
exprs
)
mkToArrPRepr
::
CoreExpr
->
CoreExpr
->
[[
CoreExpr
]]
->
VM
CoreExpr
mkToArrPRepr
len
sel
ess
=
do
...
...
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