diff options
Diffstat (limited to 'compiler/iface')
| -rw-r--r-- | compiler/iface/BinIface.hs | 15 | ||||
| -rw-r--r-- | compiler/iface/IfaceSyn.lhs | 9 | ||||
| -rw-r--r-- | compiler/iface/MkIface.lhs | 4 | ||||
| -rw-r--r-- | compiler/iface/TcIface.lhs | 10 |
4 files changed, 15 insertions, 23 deletions
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 5a751f7243..9390ee4377 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -24,7 +24,6 @@ import TyCon import DataCon (dataConName, dataConWorkId, dataConTyCon) import PrelInfo (wiredInThings, basicKnownKeyNames) import Id (idName, isDataConWorkId_maybe) -import CoreSyn (DFunArg(..)) import Coercion (LeftOrRight(..)) import TysWiredIn import IfaceEnv @@ -1110,14 +1109,6 @@ instance Binary IfaceIdDetails where 1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) } _ -> do { n <- get bh; return (IfDFunId n) } -instance Binary (DFunArg IfaceExpr) where - put_ bh (DFunPolyArg e) = putByte bh 0 >> put_ bh e - put_ bh (DFunLamArg i) = putByte bh 1 >> put_ bh i - get bh = do { h <- getByte bh - ; case h of - 0 -> do { a <- get bh; return (DFunPolyArg a) } - _ -> do { a <- get bh; return (DFunLamArg a) } } - instance Binary IfaceIdInfo where put_ bh NoInfo = putByte bh 0 put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut @@ -1164,9 +1155,10 @@ instance Binary IfaceUnfolding where putByte bh 3 put_ bh a put_ bh n - put_ bh (IfDFunUnfold as) = do + put_ bh (IfDFunUnfold as bs) = do putByte bh 4 put_ bh as + put_ bh bs put_ bh (IfCompulsory e) = do putByte bh 5 put_ bh e @@ -1188,7 +1180,8 @@ instance Binary IfaceUnfolding where n <- get bh return (IfExtWrapper a n) 4 -> do as <- get bh - return (IfDFunUnfold as) + bs <- get bh + return (IfDFunUnfold as bs) _ -> do e <- get bh return (IfCompulsory e) diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index e20269b35a..7632b38d81 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -38,7 +38,6 @@ module IfaceSyn ( import TyCon( SynTyConRhs(..) ) import IfaceType -import CoreSyn( DFunArg, dfunArgExprs ) import PprCore() -- Printing DFunArgs import Demand import Annotations @@ -255,7 +254,7 @@ data IfaceUnfolding | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in -- another module. - | IfDFunUnfold [DFunArg IfaceExpr] + | IfDFunUnfold [IfaceBndr] [IfaceExpr] -------------------------------- data IfaceExpr @@ -769,8 +768,8 @@ instance Outputable IfaceUnfolding where <+> parens (ptext (sLit "arity") <+> int a) ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext):") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a) - ppr (IfDFunUnfold ns) = ptext (sLit "DFun:") - <+> brackets (pprWithCommas ppr ns) + ppr (IfDFunUnfold bs es) = hang (ptext (sLit "DFun:") <+> sep (map ppr bs) <> dot) + 2 (sep (map pprParendIfaceExpr es)) -- ----------------------------------------------------------------------------- -- | Finding the Names in IfaceSyn @@ -899,7 +898,7 @@ freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet -freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs) +freeNamesIfUnfold (IfDFunUnfold bs es) = fnList freeNamesIfBndr bs &&& fnList freeNamesIfExpr es freeNamesIfExpr :: IfaceExpr -> NameSet freeNamesIfExpr (IfaceExt v) = unitNameSet v diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index e9676aca7f..13b64cdb25 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -1746,8 +1746,8 @@ toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity where if_rhs = toIfaceExpr rhs -toIfUnfolding lb (DFunUnfolding _ar _con ops) - = Just (HsUnfold lb (IfDFunUnfold (map (fmap toIfaceExpr) ops))) +toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args }) + = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args))) -- No need to serialise the data constructor; -- we can recover it from the type of the dfun diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 7f0ad075a3..89d9807a37 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -1244,15 +1244,15 @@ tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr) (UnfWhen unsat_ok boring_ok)) } -tcUnfolding name dfun_ty _ (IfDFunUnfold ops) - = do { mb_ops1 <- forkM_maybe doc $ mapM tc_arg ops +tcUnfolding name dfun_ty _ (IfDFunUnfold bs ops) + = bindIfaceBndrs bs $ \ bs' -> + do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops ; return (case mb_ops1 of Nothing -> noUnfolding - Just ops1 -> mkDFunUnfolding dfun_ty ops1) } + Just ops1 -> mkDFunUnfolding bs' (classDataCon cls) ops1) } where doc = text "Class ops for dfun" <+> ppr name - tc_arg (DFunPolyArg e) = do { e' <- tcIfaceExpr e; return (DFunPolyArg e') } - tc_arg (DFunLamArg i) = return (DFunLamArg i) + (_, _, cls, _) = tcSplitDFunTy dfun_ty tcUnfolding name ty info (IfExtWrapper arity wkr) = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr) |