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)
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)
-- 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
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
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
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))
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)