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
255f46e1
Commit
255f46e1
authored
Aug 24, 2007
by
rl@cse.unsw.edu.au
Browse files
Remove Embed and related stuff from vectorisation
parent
2e4068a2
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/prelude/PrelNames.lhs
View file @
255f46e1
...
...
@@ -218,7 +218,7 @@ genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName]
ndpNames :: [Name]
ndpNames = [ parrayTyConName, paTyConName, preprTyConName, prTyConName
,
embedTyCon
Name
,
mkPR
Name
, closureTyConName
, mkClosureName, applyClosureName
, mkClosurePName, applyClosurePName
...
...
@@ -698,7 +698,7 @@ parrayTyConName = tcQual nDP_PARRAY FSLIT("PArray") parrayTyConKey
paTyConName = tcQual nDP_PARRAY FSLIT("PA") paTyConKey
preprTyConName = tcQual nDP_PARRAY FSLIT("PRepr") preprTyConKey
prTyConName = clsQual nDP_PARRAY FSLIT("PR") prTyConKey
embedTyCon
Name
= tc
Qual
nDP_
REPR
FSLIT("
Embed") embedTyCon
Key
mkPR
Name
= var
Qual nDP_
PARRAY
FSLIT("
mkPR") mkPRId
Key
lengthPAName = varQual nDP_PARRAY FSLIT("lengthPA") lengthPAIdKey
replicatePAName = varQual nDP_PARRAY FSLIT("replicatePA") replicatePAIdKey
emptyPAName = varQual nDP_PARRAY FSLIT("emptyPA") emptyPAIdKey
...
...
@@ -893,8 +893,7 @@ parrayTyConKey = mkPreludeTyConUnique 135
closureTyConKey = mkPreludeTyConUnique 136
paTyConKey = mkPreludeTyConUnique 137
preprTyConKey = mkPreludeTyConUnique 138
embedTyConKey = mkPreludeTyConUnique 139
prTyConKey = mkPreludeTyConUnique 140
prTyConKey = mkPreludeTyConUnique 139
---------------- Template Haskell -------------------
...
...
@@ -1088,6 +1087,7 @@ emptyPAIdKey = mkPreludeMiscIdUnique 133
packPAIdKey = mkPreludeMiscIdUnique 134
combinePAIdKey = mkPreludeMiscIdUnique 135
intEqPAIdKey = mkPreludeMiscIdUnique 136
mkPRIdKey = mkPreludeMiscIdUnique 137
---------------- Template Haskell -------------------
-- USES IdUniques 200-399
...
...
compiler/vectorise/VectBuiltIn.hs
View file @
255f46e1
...
...
@@ -41,10 +41,9 @@ data Builtins = Builtins {
,
preprTyCon
::
TyCon
,
prTyCon
::
TyCon
,
prDataCon
::
DataCon
,
embedTyCon
::
TyCon
,
embedDataCon
::
DataCon
,
sumTyCons
::
Array
Int
TyCon
,
closureTyCon
::
TyCon
,
mkPRVar
::
Var
,
mkClosureVar
::
Var
,
applyClosureVar
::
Var
,
mkClosurePVar
::
Var
...
...
@@ -78,8 +77,6 @@ initBuiltins
preprTyCon
<-
dsLookupTyCon
preprTyConName
prTyCon
<-
dsLookupTyCon
prTyConName
let
[
prDataCon
]
=
tyConDataCons
prTyCon
embedTyCon
<-
dsLookupTyCon
embedTyConName
let
[
embedDataCon
]
=
tyConDataCons
embedTyCon
closureTyCon
<-
dsLookupTyCon
closureTyConName
sum_tcs
<-
mapM
(
lookupExternalTyCon
nDP_REPR
)
...
...
@@ -87,6 +84,7 @@ initBuiltins
let
sumTyCons
=
listArray
(
2
,
mAX_NDP_SUM
)
sum_tcs
mkPRVar
<-
dsLookupGlobalId
mkPRName
mkClosureVar
<-
dsLookupGlobalId
mkClosureName
applyClosureVar
<-
dsLookupGlobalId
applyClosureName
mkClosurePVar
<-
dsLookupGlobalId
mkClosurePName
...
...
@@ -108,10 +106,9 @@ initBuiltins
,
preprTyCon
=
preprTyCon
,
prTyCon
=
prTyCon
,
prDataCon
=
prDataCon
,
embedTyCon
=
embedTyCon
,
embedDataCon
=
embedDataCon
,
sumTyCons
=
sumTyCons
,
closureTyCon
=
closureTyCon
,
mkPRVar
=
mkPRVar
,
mkClosureVar
=
mkClosureVar
,
applyClosureVar
=
applyClosureVar
,
mkClosurePVar
=
mkClosurePVar
...
...
@@ -168,7 +165,6 @@ builtinPRs :: Builtins -> [(Name, Module, FastString)]
builtinPRs
bi
=
[
mk
(
tyConName
unitTyCon
)
nDP_REPR
FSLIT
(
"dPR_Unit"
)
,
mk
embedTyConName
nDP_REPR
FSLIT
(
"dPR_Embed"
)
,
mk
closureTyConName
nDP_CLOSURE
FSLIT
(
"dPR_Clo"
)
-- temporary
...
...
compiler/vectorise/VectUtils.hs
View file @
255f46e1
...
...
@@ -94,9 +94,6 @@ splitFixedTyConApp tc ty
|
otherwise
=
pprPanic
"splitFixedTyConApp"
(
ppr
tc
<+>
ppr
ty
)
splitEmbedTy
::
Type
->
Type
splitEmbedTy
=
splitUnTy
"splitEmbedTy"
embedTyConName
splitClosureTy
::
Type
->
(
Type
,
Type
)
splitClosureTy
=
splitBinTy
"splitClosureTy"
closureTyConName
...
...
@@ -132,7 +129,6 @@ data TyConRepr = TyConRepr {
repr_tyvars
::
[
TyVar
]
,
repr_tys
::
[[
Type
]]
,
repr_embed_tys
::
[[
Type
]]
,
repr_prod_tycons
::
[
Maybe
TyCon
]
,
repr_prod_tys
::
[
Type
]
,
repr_sum_tycon
::
Maybe
TyCon
...
...
@@ -142,17 +138,15 @@ data TyConRepr = TyConRepr {
mkTyConRepr
::
TyCon
->
VM
TyConRepr
mkTyConRepr
vect_tc
=
do
embed_tys
<-
mapM
(
mapM
mkEmbedType
)
rep_tys
prod_tycons
<-
mapM
(
mk_tycon
prodTyCon
)
rep_tys
sum_tycon
<-
mk_tycon
sumTyCon
rep_tys
let
prod_tys
=
zipWith
mk_tc_app_maybe
prod_tycons
rep_tys
sum_tycon
<-
mk_tycon
sumTyCon
prod_tys
let
prod_tys
=
zipWith
mk_tc_app_maybe
prod_tycons
embed_tys
return
$
TyConRepr
{
repr_tyvars
=
tyvars
,
repr_tys
=
rep_tys
,
repr_embed_tys
=
embed_tys
,
repr_prod_tycons
=
prod_tycons
,
repr_prod_tys
=
prod_tys
,
repr_sum_tycon
=
sum_tycon
...
...
@@ -198,8 +192,6 @@ mkPRepr tys
mkToPRepr
::
[[
CoreExpr
]]
->
VM
([
CoreExpr
],
Type
)
mkToPRepr
ess
=
do
embed_tc
<-
builtin
embedTyCon
embed_dc
<-
builtin
embedDataCon
sum_tcs
<-
builtins
sumTyCon
prod_tcs
<-
builtins
prodTyCon
...
...
@@ -212,28 +204,20 @@ mkToPRepr ess
sum_tc
=
sum_tcs
(
length
es
)
mk_alt
dc
expr
=
mkConApp
dc
(
map
Type
tys
++
[
expr
])
mk_prod
[]
=
(
Var
unitDataConId
,
unitTy
)
mk_prod
[
(
expr
,
ty
)
]
=
(
expr
,
ty
)
mk_prod
e
s
=
(
mkConApp
prod_dc
(
map
Type
tys
++
exprs
),
mkTyConApp
prod_tc
tys
)
mk_prod
[]
=
(
Var
unitDataConId
,
unitTy
)
mk_prod
[
expr
]
=
(
expr
,
exprType
expr
)
mk_prod
e
xprs
=
(
mkConApp
prod_dc
(
map
Type
tys
++
exprs
),
mkTyConApp
prod_tc
tys
)
where
(
exprs
,
tys
)
=
unzip
e
s
prod_tc
=
prod_tcs
(
length
es
)
tys
=
map
exprType
expr
s
prod_tc
=
prod_tcs
(
length
e
xpr
s
)
[
prod_dc
]
=
tyConDataCons
prod_tc
mk_embed
expr
=
(
mkConApp
embed_dc
[
Type
ty
,
expr
],
mkTyConApp
embed_tc
[
ty
])
where
ty
=
exprType
expr
return
.
mk_sum
$
map
(
mk_prod
.
map
mk_embed
)
ess
return
.
mk_sum
.
map
mk_prod
$
ess
mkToArrPRepr
::
CoreExpr
->
CoreExpr
->
[[
CoreExpr
]]
->
VM
CoreExpr
mkToArrPRepr
len
sel
ess
=
do
embed_tc
<-
builtin
embedTyCon
(
embed_rtc
,
_
)
<-
parrayReprTyCon
(
mkTyConApp
embed_tc
[
unitTy
])
let
[
embed_rdc
]
=
tyConDataCons
embed_rtc
let
mk_sum
[(
expr
,
ty
)]
=
return
(
expr
,
ty
)
mk_sum
es
=
do
...
...
@@ -246,28 +230,23 @@ mkToArrPRepr len sel ess
where
(
exprs
,
tys
)
=
unzip
es
mk_prod
[
(
expr
,
ty
)
]
=
return
(
expr
,
ty
)
mk_prod
es
mk_prod
[
expr
]
=
return
(
expr
,
splitPArrayTy
(
exprType
expr
)
)
mk_prod
e
xpr
s
=
do
prod_tc
<-
builtin
.
prodTyCon
$
length
es
prod_tc
<-
builtin
.
prodTyCon
$
length
e
xpr
s
(
prod_rtc
,
_
)
<-
parrayReprTyCon
(
mkTyConApp
prod_tc
tys
)
let
[
prod_rdc
]
=
tyConDataCons
prod_rtc
return
(
mkConApp
prod_rdc
(
map
Type
tys
++
(
len
:
exprs
)),
mkTyConApp
prod_tc
tys
)
where
(
exprs
,
tys
)
=
unzip
es
mk_embed
expr
=
(
mkConApp
embed_rdc
[
Type
ty
,
expr
],
mkTyConApp
embed_tc
[
ty
])
where
ty
=
splitPArrayTy
(
exprType
expr
)
tys
=
map
(
splitPArrayTy
.
exprType
)
exprs
liftM
fst
(
mk_sum
=<<
mapM
(
mk_prod
.
map
mk_embed
)
ess
)
liftM
fst
(
mk_sum
=<<
mapM
mk_prod
ess
)
mkFromPRepr
::
CoreExpr
->
Type
->
[([
Var
],
CoreExpr
)]
->
VM
CoreExpr
mkFromPRepr
scrut
res_ty
alts
=
do
embed_dc
<-
builtin
embedDataCon
sum_tcs
<-
builtins
sumTyCon
prod_tcs
<-
builtins
prodTyCon
...
...
@@ -288,23 +267,14 @@ mkFromPRepr scrut res_ty alts
mk_alt
dc
p
body
=
(
DataAlt
dc
,
[
p
],
body
)
un_prod
expr
ty
[]
r
=
return
r
un_prod
expr
ty
[
var
]
r
=
return
$
un_embed
expr
ty
var
r
un_prod
expr
ty
[
var
]
r
=
return
$
Let
(
NonRec
var
expr
)
r
un_prod
expr
ty
vars
r
=
do
xs
<-
mapM
(
newLocalVar
FSLIT
(
"x"
))
tys
let
body
=
foldr
(
\
(
e
,
t
,
v
)
r
->
un_embed
e
t
v
r
)
r
$
zip3
(
map
Var
xs
)
tys
vars
return
$
Case
expr
(
mkWildId
ty
)
res_ty
[(
DataAlt
prod_dc
,
xs
,
body
)]
=
return
$
Case
expr
(
mkWildId
ty
)
res_ty
[(
DataAlt
prod_dc
,
vars
,
r
)]
where
tys
=
splitFixedTyConApp
prod_tc
ty
prod_tc
=
prod_tcs
$
length
vars
[
prod_dc
]
=
tyConDataCons
prod_tc
un_embed
expr
ty
var
r
=
Case
expr
(
mkWildId
ty
)
res_ty
[(
DataAlt
embed_dc
,
[
var
],
r
)]
un_sum
scrut
(
exprType
scrut
)
alts
mkFromArrPRepr
::
CoreExpr
->
Type
->
Var
->
Var
->
[[
Var
]]
->
CoreExpr
...
...
@@ -312,9 +282,6 @@ mkFromArrPRepr :: CoreExpr -> Type -> Var -> Var -> [[Var]] -> CoreExpr
mkFromArrPRepr
scrut
res_ty
len
sel
vars
res
=
return
(
Var
unitDataConId
)
mkEmbedType
::
Type
->
VM
Type
mkEmbedType
ty
=
mkBuiltinTyConApp
embedTyCon
[
ty
]
mkClosureType
::
Type
->
Type
->
VM
Type
mkClosureType
arg_ty
res_ty
=
mkBuiltinTyConApp
closureTyCon
[
arg_ty
,
res_ty
]
...
...
@@ -460,6 +427,9 @@ paMethod method ty
dict
<-
paDictOfType
ty
return
$
mkApps
(
Var
fn
)
[
Type
ty
,
dict
]
mkPR
::
Type
->
VM
CoreExpr
mkPR
=
paMethod
mkPRVar
lengthPA
::
CoreExpr
->
VM
CoreExpr
lengthPA
x
=
liftM
(`
App
`
x
)
(
paMethod
lengthPAVar
ty
)
where
...
...
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