From 3a7ac4f6e7c9eaeed0c912124091c0f08efa5252 Mon Sep 17 00:00:00 2001 From: sof Date: Mon, 26 May 1997 04:51:57 +0000 Subject: [PATCH] [project @ 1997-05-26 04:51:57 by sof] Updated imports; common AbsBinds cases optimised --- ghc/compiler/deSugar/DsBinds.lhs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/ghc/compiler/deSugar/DsBinds.lhs b/ghc/compiler/deSugar/DsBinds.lhs index 6a1bc06..901274d 100644 --- a/ghc/compiler/deSugar/DsBinds.lhs +++ b/ghc/compiler/deSugar/DsBinds.lhs @@ -34,12 +34,12 @@ import Id ( idType, SYN_IE(DictVar), GenId, SYN_IE(Id) ) import ListSetOps ( minusList, intersectLists ) import Name ( isExported ) import PprType ( GenType ) -import PprStyle ( PprStyle(..) ) +import Outputable ( PprStyle(..) ) import Type ( mkTyVarTy, isDictTy, instantiateTy ) import TyVar ( tyVarSetToList, GenTyVar{-instance Eq-} ) import TysPrim ( voidTy ) -import Util ( isIn, panic{-, pprTrace ToDo:rm-} ) +import Util ( isIn, panic, assertPanic ) \end{code} %************************************************************************ @@ -106,10 +106,22 @@ dsMonoBinds is_rec (PatMonoBind pat grhss_and_binds locn) dsGuarded grhss_and_binds `thenDs` \ body_expr -> mkSelectorBinds pat body_expr -dsMonoBinds is_rec (AbsBinds [] [] exports binds) -- Common special case + -- Common special case: no type or dictionary abstraction +dsMonoBinds is_rec (AbsBinds [] [] exports binds) = dsMonoBinds is_rec binds `thenDs` \ prs -> returnDs (prs ++ [(global, Var local) | (_, global, local) <- exports]) + -- Another common case: one exported variable + -- All non-recursive bindings come through this way +dsMonoBinds is_rec (AbsBinds all_tyvars dicts [(tyvars, global, local)] binds) + = ASSERT( all (`elem` tyvars) all_tyvars ) + dsMonoBinds is_rec binds `thenDs` \ core_prs -> + let + core_binds | is_rec = [Rec core_prs] + | otherwise = [NonRec b e | (b,e) <- core_prs] + in + returnDs [(global, mkLam tyvars dicts $ mkCoLetsAny core_binds (Var local))] + dsMonoBinds is_rec (AbsBinds all_tyvars dicts exports binds) = dsMonoBinds is_rec binds `thenDs` \ core_prs -> let -- 1.7.10.4