From: sof <unknown>
Date: Mon, 26 May 1997 04:51:57 +0000 (+0000)
Subject: [project @ 1997-05-26 04:51:57 by sof]
X-Git-Tag: Approximately_1000_patches_recorded~483
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3a7ac4f6e7c9eaeed0c912124091c0f08efa5252;p=ghc-hetmet.git

[project @ 1997-05-26 04:51:57 by sof]
Updated imports; common AbsBinds cases optimised
---

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