From: sof <unknown>
Date: Fri, 20 Mar 1998 13:58:28 +0000 (+0000)
Subject: [project @ 1998-03-20 13:58:20 by sof]
X-Git-Tag: Approx_2487_patches~845
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=564c3082c4ed4d52680e397258aa8a5a2025f5a3;p=ghc-hetmet.git

[project @ 1998-03-20 13:58:20 by sof]
Misc minor bug fixes
---

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index cb8b1a1..ffa3272 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -112,7 +112,7 @@ import CmdLineOpts      ( opt_PprStyle_All )
 import Bag
 import IdInfo
 import Name	 	( nameUnique, isLocalName, mkSysLocalName,
-			  isWiredInName, setNameVisibility,
+			  isWiredInName, setNameVisibility, changeUnique,
 			  ExportFlag(..), Provenance,
 			  OccName(..), Name, Module,
 			  NamedThing(..)
diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
index 489d2e3..431e356 100644
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ b/ghc/compiler/coreSyn/PprCore.lhs
@@ -197,7 +197,7 @@ ppr_expr pe expr@(Lam _ _)
   where
     pp_vars lam pp [] = empty
     pp_vars lam pp vs
-      = hsep [ptext lam, hsep (map pp vs), ptext SLIT("->")]
+      = hsep [ptext lam, vcat (map pp vs), ptext SLIT("->")]
 
 ppr_expr pe expr@(App fun arg)
   = let
@@ -276,7 +276,7 @@ ppr_expr pe (Note (SCC cc) expr)
 	 ppr_parend_expr pe expr ]
 
 ppr_expr pe (Note (Coerce to_ty from_ty) expr)
-  = sep [hsep [ptext SLIT("_coerce_"), pTy pe to_ty, pTy pe from_ty],
+  = sep [hsep [ptext SLIT("_coerce_"), pTy pe to_ty],
 	 ppr_parend_expr pe expr]
 
 ppr_expr pe (Note InlineCall expr)
diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index 94e42b7..675a792 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -225,6 +225,11 @@ tcCoreExpr (UfPrim prim args)
     mapTc tcCoreArg args	`thenTc` \ args' ->
     returnTc (Prim primop args')
 
+tcCoreExpr (UfLam bndr body)
+  = tcCoreLamBndr bndr 		$ \ bndr' ->
+    tcCoreExpr body		`thenTc` \ body' ->
+    returnTc (Lam bndr' body')
+
 tcCoreExpr (UfApp fun arg)
   = tcCoreExpr fun		`thenTc` \ fun' ->
     tcCoreArg arg		`thenTc` \ arg' ->
@@ -235,6 +240,20 @@ tcCoreExpr (UfCase scrut alts)
     tcCoreAlts (coreExprType scrut') alts	`thenTc` \ alts' ->
     returnTc (Case scrut' alts')
 
+tcCoreExpr (UfLet (UfNonRec bndr rhs) body)
+  = tcCoreExpr rhs		`thenTc` \ rhs' ->
+    tcCoreValBndr bndr 		$ \ bndr' ->
+    tcCoreExpr body		`thenTc` \ body' ->
+    returnTc (Let (NonRec bndr' rhs') body')
+
+tcCoreExpr (UfLet (UfRec pairs) body)
+  = tcCoreValBndrs bndrs	$ \ bndrs' ->
+    mapTc tcCoreExpr rhss	`thenTc` \ rhss' ->
+    tcCoreExpr body		`thenTc` \ body' ->
+    returnTc (Let (Rec (bndrs' `zip` rhss')) body')
+  where
+    (bndrs, rhss) = unzip pairs
+
 tcCoreExpr (UfNote note expr) 
   = tcCoreExpr expr		`thenTc` \ expr' ->
     case note of