diff options
Diffstat (limited to 'compiler/deSugar/DsUtils.lhs')
| -rw-r--r-- | compiler/deSugar/DsUtils.lhs | 25 |
1 files changed, 12 insertions, 13 deletions
diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs index 2ad70c67d3..c52b917efd 100644 --- a/compiler/deSugar/DsUtils.lhs +++ b/compiler/deSugar/DsUtils.lhs @@ -8,7 +8,8 @@ Utilities for desugaring This module exports some utility functions of no great interest. \begin{code} -{-# OPTIONS -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See @@ -64,7 +65,6 @@ import ConLike import DataCon import PatSyn import Type -import Coercion import TysPrim import TysWiredIn import BasicTypes @@ -638,12 +638,13 @@ mkSelectorBinds ticks pat val_expr -- efficient too. -- For the error message we make one error-app, to avoid duplication. - -- But we need it at different types... so we use coerce for that - ; err_expr <- mkErrorAppDs iRREFUT_PAT_ERROR_ID unitTy (ppr pat) - ; err_var <- newSysLocalDs unitTy - ; binds <- zipWithM (mk_bind val_var err_var) ticks' binders - ; return ( (val_var, val_expr) : - (err_var, err_expr) : + -- But we need it at different types, so we make it polymorphic: + -- err_var = /\a. iRREFUT_PAT_ERR a "blah blah blah" + ; err_app <- mkErrorAppDs iRREFUT_PAT_ERROR_ID alphaTy (ppr pat) + ; err_var <- newSysLocalDs (mkForAllTy alphaTyVar alphaTy) + ; binds <- zipWithM (mk_bind val_var err_var) ticks' binders + ; return ( (val_var, val_expr) : + (err_var, Lam alphaTyVar err_app) : binds ) } | otherwise @@ -665,14 +666,13 @@ mkSelectorBinds ticks pat val_expr mk_bind scrut_var err_var tick bndr_var = do -- (mk_bind sv err_var) generates - -- bv = case sv of { pat -> bv; other -> coerce (type-of-bv) err_var } + -- bv = case sv of { pat -> bv; other -> err_var @ type-of-bv } -- Remember, pat binds bv rhs_expr <- matchSimply (Var scrut_var) PatBindRhs pat (Var bndr_var) error_expr return (bndr_var, mkOptTickBox tick rhs_expr) where - error_expr = mkCast (Var err_var) co - co = mkUnsafeCo (exprType (Var err_var)) (idType bndr_var) + error_expr = Var err_var `App` Type (idType bndr_var) is_simple_lpat p = is_simple_pat (unLoc p) @@ -709,8 +709,7 @@ mkLHsVarPatTup bs = mkLHsPatTup (map nlVarPat bs) mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id -- A vanilla tuple pattern simply gets its type from its sub-patterns -mkVanillaTuplePat pats box - = TuplePat pats box (mkTupleTy (boxityNormalTupleSort box) (map hsLPatType pats)) +mkVanillaTuplePat pats box = TuplePat pats box (map hsLPatType pats) -- The Big equivalents for the source tuple expressions mkBigLHsVarTup :: [Id] -> LHsExpr Id |