[project @ 1999-01-05 12:22:08 by simonpj]

Fix renamer crash on bootstrap build

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 2fdf11e..205c2c7 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -586,7 +586,7 @@ availNames (AvailTC n ns) = ns
 filterAvail :: RdrNameIE       -- Wanted
            -> AvailInfo        -- Available
            -> AvailInfo        -- Resulting available; 
-                               -- NotAvailable if wanted stuff isn't there
+                               -- NotAvailable if (any of the) wanted stuff isn't there
 
 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
   | sub_names_ok = AvailTC n (filter is_wanted ns)
@@ -603,8 +603,7 @@ filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
 
 filterAvail (IEThingAbs _) (AvailTC n ns)       = ASSERT( n `elem` ns ) 
                                                  AvailTC n [n]
-
-filterAvail (IEThingAbs _) avail@(Avail n)      = avail                -- Type synonyms
+filterAvail (IEThingAll _) avail@(AvailTC _ _)  = avail
 
 filterAvail (IEVar _)      avail@(Avail n)      = avail
 filterAvail (IEVar v)      avail@(AvailTC n ns) = AvailTC n (filter wanted ns)
@@ -615,9 +614,10 @@ filterAvail (IEVar v)      avail@(AvailTC n ns) = AvailTC n (filter wanted ns)
        --      import A( op ) 
        -- where op is a class operation
 
-filterAvail (IEThingAll _) avail@(AvailTC _ _)  = avail
 
-filterAvail ie avail = NotAvailable 
+#ifdef DEBUG
+filterAvail ie avail = pprPanic "filterAvail" (ppr ie $$ pprAvail avail)
+#endif
 
 
 -- In interfaces, pprAvail gets given the OccName of the "host" thing

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 3be854e..9471b3c 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -192,9 +192,7 @@ importsFromImportDecl rec_unqual_fn (ImportDecl mod qual_only as_source as_mod i
 
     if null avails then
        -- If there's an error in getInterfaceExports, (e.g. interface
-       -- file not found) then avail might be NotAvailable, so availName
-       -- in home_modules fails.  Hence the guard here.  Also we get lots
-       -- of spurious errors from 'filterImports' if we don't find the interface file
+       -- file not found) we get lots of spurious errors from 'filterImports'
        returnRn (emptyRdrEnv, mkEmptyExportAvails mod)
     else
 
@@ -207,12 +205,20 @@ importsFromImportDecl rec_unqual_fn (ImportDecl mod qual_only as_source as_mod i
        home_modules = [name | avail <- filtered_avails,
                                -- Doesn't take account of hiding, but that doesn't matter
                
+                               -- Drop NotAvailables.  
+                               -- Happens if filterAvail finds something missing
+                              case avail of
+                                 NotAvailable -> False
+                                 other        -> True,
+                       
                               let name = availName avail,
-                              nameModule name /= mod]
-                               -- This predicate is a bit of a hack.
+                              nameModule (availName avail) /= mod
+                               -- This nameModule predicate is a bit of a hack.
                                -- PrelBase imports error from PrelErr.hi-boot; but error is
                                -- wired in, so its provenance doesn't say it's from an hi-boot
                                -- file. Result: disaster when PrelErr.hi doesn't exist.
+                               --      [Jan 99: I now can't see how the predicate achieves the goal!]
+                       ]
                                
        same_module n1 n2 = nameModule n1 == nameModule n2
        load n            = loadHomeInterface (doc_str n) n

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 0c673e6..b6c6c62 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -153,7 +153,7 @@ rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls derivings pragma
     returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc),
              cxt_fvs `plusFV` plusFVs con_fvs_s `plusFV` deriv_fvs)
   where
-    data_doc = text "the data typecodeGen/ declaration for" <+> ppr tycon
+    data_doc = text "the data type declaration for" <+> ppr tycon
     con_names = map conDeclName condecls
 
 rnDecl (TyClD (TySynonym name tyvars ty src_loc))

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index a1be69a..84fc1d9 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -464,11 +464,12 @@ tcMonoExpr (RecordCon con_name rbinds) res_ty
     let
        bad_fields = badFields rbinds data_con
     in
-    mapNF_Tc (addErrTc . badFieldCon con_name) bad_fields      `thenNF_Tc_`
+    if not (null bad_fields) then
+       mapNF_Tc (addErrTc . badFieldCon con_name) bad_fields   `thenNF_Tc_`
+       failTc  -- Fail now, because tcRecordBinds will crash on a bad field
+    else
 
        -- Typecheck the record bindings
-       -- (Do this after checkRecordFields in case there's a field that
-       --  doesn't match the constructor.)
     tcRecordBinds record_ty rbinds             `thenTc` \ (rbinds', rbinds_lie) ->
 
     returnTc (RecordConOut data_con con_expr rbinds', con_lie `plusLIE` rbinds_lie)