Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
40052553
Commit
40052553
authored
Apr 25, 2012
by
Simon Peyton Jones
Browse files
Merge branch 'master' of
http://darcs.haskell.org/ghc
parents
a40ee020
61e9a6cc
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/types/Coercion.lhs
View file @
40052553
...
...
@@ -441,7 +441,8 @@ ppr_forall_co p ty
\begin{code}
pprCoAxiom :: CoAxiom -> SDoc
pprCoAxiom ax
= sep [ ptext (sLit "axiom") <+> ppr ax <+> ppr (co_ax_tvs ax)
= sep [ ptext (sLit "axiom") <+>
sep [ ppr ax, nest 2 (pprTvBndrs (co_ax_tvs ax)) ]
, nest 2 (dcolon <+> pprEqPred (Pair (co_ax_lhs ax) (co_ax_rhs ax))) ]
\end{code}
...
...
compiler/vectorise/Vectorise.hs
View file @
40052553
...
...
@@ -361,7 +361,7 @@ vectTopRhs recFs var expr
rhs
_globalScalar
_isDFun
(
Just
(
_
,
expr'
))
-- Case (1)
=
return
(
inlineMe
,
False
,
expr'
)
rhs
True
False
Nothing
-- Case (2)
=
do
{
expr'
<-
vectScalarFun
True
recFs
expr
=
do
{
expr'
<-
vectScalarFun
recFs
expr
;
return
(
inlineMe
,
True
,
vectorised
expr'
)
}
rhs
True
True
Nothing
-- Case (3)
...
...
compiler/vectorise/Vectorise/Exp.hs
View file @
40052553
...
...
@@ -689,14 +689,13 @@ vectDictExpr (Coercion coe)
-- instead they become dictionaries of vectorised methods). We treat them differently, though see
-- "Note [Scalar dfuns]" in 'Vectorise'.
--
vectScalarFun
::
Bool
-- ^ Was the function marked as scalar by the user?
->
[
Var
]
-- ^ Functions names in same recursive binding group
vectScalarFun
::
[
Var
]
-- ^ Functions names in same recursive binding group
->
CoreExpr
-- ^ Expression to be vectorised
->
VM
VExpr
vectScalarFun
forceScalar
recFns
expr
=
vectScalarFunVT
forceScalar
recFns
expr
(
VITNode
VISimple
[]
)
vectScalarFun
recFns
expr
-- this is an external call to vectScalarFun, so we pass a dummy vt tree. The only
-- relevant bit is that the node info is *not* VIEncaps
=
vectScalarFunVT
True
recFns
expr
(
VITNode
VISimple
[]
)
vectScalarFunVT
::
Bool
-- ^ Was the function marked as scalar by the user?
...
...
@@ -715,34 +714,24 @@ vectScalarFunVT forceScalar recFns expr (VITNode vi _)
"
\n\t
result scalar? : "
++
(
show
$
is_scalar_ty
scalarTyCons
res_ty
)
++
"
\n\t
scalar body? : "
++
(
show
$
is_scalar
scalarVars
(
is_scalar_ty
scalarTyCons
)
expr
)
++
"
\n\t
uses vars? : "
++
(
show
$
uses
scalarVars
expr
)
++
"
\n\t
is encaps?
: "
++
(
show
vi
)
"
\n\t
is encaps?
(same as & of all prev cond)
: "
++
(
show
vi
)
)
(
ppr
expr
)
;
onlyIfV
(
ptext
(
sLit
"not a scalar function"
))
(
forceScalar
-- user asserts the functions is scalar
||
(
vi
==
VIEncaps
)
-- should only be true if all the foll. cond are hold
||
(
vi
==
VIEncaps
))
-- should only be true if all the foll. cond are hold
{- ||
all (is_scalar_ty scalarTyCons) arg_tys -- check whether the function is scalar
&& is_scalar_ty scalarTyCons res_ty
&& is_scalar scalarVars (is_scalar_ty scalarTyCons) expr
&& uses scalarVars expr)
-}
$
do
{
traceVt
"vectScalarFun - is scalar"
(
ppr
expr
)
;
mkScalarFun
arg_tys
res_ty
expr
}
}
{-
; onlyIfV (ptext (sLit "not a scalar function"))
(forceScalar -- user asserts the functions is scalar
||
all is_primitive_ty arg_tys -- check whether the function is scalar
&& is_primitive_ty res_ty
&& is_scalar scalarVars (is_scalar_ty scalarTyCons) expr
&& uses scalarVars expr
&& length arg_tys <= mAX_DPH_SCALAR_ARGS)
$ mkScalarFun arg_tys res_ty expr
}
-}
where
{-
-- !!!FIXME: We would like to allow scalar functions with arguments and results that can be
...
...
@@ -912,7 +901,7 @@ vectScalarDFun var recFns
dict
=
Var
var
`
mkTyApps
`
(
mkTyVarTys
tvs
)
`
mkVarApps
`
thetaVars
scsOps
=
map
(
\
selId
->
varToCoreExpr
selId
`
mkTyApps
`
tys
`
mkApps
`
[
dict
])
selIds
;
vScsOps
<-
mapM
(
\
e
->
vectorised
<$>
vectScalarFun
True
recFns
e
)
scsOps
;
vScsOps
<-
mapM
(
\
e
->
vectorised
<$>
vectScalarFun
recFns
e
)
scsOps
-- vectorised applications of the class-dictionary data constructor
;
Just
vDataCon
<-
lookupDataCon
dataCon
...
...
@@ -1181,8 +1170,8 @@ vectAlgCase tycon _ty_args scrut bndr ty alts (VITNode _ (scrutVit : altVits))
vectAlgCase
tycon
_ty_args
_scrut
_bndr
_ty
_alts
(
VITNode
_
[]
)
=
pprPanic
"vectAlgCase (mismatched node information)"
(
ppr
tycon
)
---- Sanity check of the
{-
---- Sanity check of the tree, for debugging only
checkTree :: VITree -> CoreExpr -> Bool
checkTree (VITNode _ []) (Type _ty)
= True
...
...
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