[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 (file)
--- 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 (file)
--- 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 (file)
--- 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