Commit 1fc60ea1 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

When desugaring Use the smart mkCoreConApps and friends

This is actually the bug that triggered Trac #9390.  We had
an unboxed tuple (# writeArray# ..., () #), and that writeArray#
argument isn't ok-for-speculation, so disobeys the invariant.

The desugaring of unboxed tuples was to blame; the fix is easy.
parent 17360821
......@@ -466,8 +466,8 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdIf mb_fun cond then_cmd else_cmd)
left_con <- dsLookupDataCon leftDataConName
right_con <- dsLookupDataCon rightDataConName
let mk_left_expr ty1 ty2 e = mkConApp left_con [Type ty1, Type ty2, e]
mk_right_expr ty1 ty2 e = mkConApp right_con [Type ty1, Type ty2, e]
let mk_left_expr ty1 ty2 e = mkCoreConApps left_con [Type ty1, Type ty2, e]
mk_right_expr ty1 ty2 e = mkCoreConApps right_con [Type ty1, Type ty2, e]
in_ty = envStackType env_ids stack_ty
then_ty = envStackType then_ids stack_ty
......
......@@ -238,9 +238,9 @@ boxResult result_ty
_ -> []
return_result state anss
= mkConApp (tupleCon UnboxedTuple (2 + length extra_result_tys))
(map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
++ (state : anss))
= mkCoreConApps (tupleCon UnboxedTuple (2 + length extra_result_tys))
(map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
++ (state : anss))
; (ccall_res_ty, the_alt) <- mk_alt return_result res
......
......@@ -292,9 +292,9 @@ dsExpr (ExplicitTuple tup_args boxity)
; (lam_vars, args) <- foldM go ([], []) (reverse tup_args)
-- The reverse is because foldM goes left-to-right
; return $ mkCoreLams lam_vars $
mkConApp (tupleCon (boxityNormalTupleSort boxity) (length tup_args))
(map (Type . exprType) args ++ args) }
; return $ mkCoreLams lam_vars $
mkCoreConApps (tupleCon (boxityNormalTupleSort boxity) (length tup_args))
(map (Type . exprType) args ++ args) }
dsExpr (HsSCC cc expr@(L loc _)) = do
mod_name <- getModule
......@@ -435,7 +435,7 @@ dsExpr (RecordCon (L _ data_con_id) con_expr rbinds) = do
then mapM unlabelled_bottom arg_tys
else mapM mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels)
return (mkApps con_expr' con_args)
return (mkCoreApps con_expr' con_args)
\end{code}
Record update is a little harder. Suppose we have the decl:
......
......@@ -1476,7 +1476,7 @@ rep2 n xs = do { id <- dsLookupGlobalId n
dataCon' :: Name -> [CoreExpr] -> DsM (Core a)
dataCon' n args = do { id <- dsLookupDataCon n
; return $ MkC $ mkConApp id args }
; return $ MkC $ mkCoreConApps id args }
dataCon :: Name -> DsM (Core a)
dataCon n = dataCon' n []
......
......@@ -92,7 +92,7 @@ dsLit (HsInt i) = do dflags <- getDynFlags
dsLit (HsRat r ty) = do
num <- mkIntegerExpr (numerator (fl_value r))
denom <- mkIntegerExpr (denominator (fl_value r))
return (mkConApp ratio_data_con [Type integer_ty, num, denom])
return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom])
where
(ratio_data_con, integer_ty)
= case tcSplitTyConApp ty of
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment