Commit fd8400f7 authored by simonpj's avatar simonpj

[project @ 2000-11-27 16:10:29 by simonpj]

Get default methods right
parent 3284bc47
......@@ -226,7 +226,7 @@ tyClDeclName tycl_decl = tcdName tycl_decl
--------------------------------
tyClDeclNames :: Eq name => TyClDecl name pat -> [(name, SrcLoc)]
-- Returns all the binding names of the decl, along with their SrcLocs
-- Returns all the *binding* names of the decl, along with their SrcLocs
-- The first one is guaranteed to be the name of the decl
-- For record fields, the first one counts as the SrcLoc
-- We use the equality to filter out duplicate field names
......@@ -242,7 +242,7 @@ tyClDeclNames (TyData {tcdName = tc_name, tcdCons = cons, tcdLoc = loc})
--------------------------------
-- The "system names" are extra implicit names.
-- The "system names" are extra implicit names *bound* by the decl.
-- They are kept in a list rather than a tuple
-- to make the renamer easier.
......@@ -262,8 +262,7 @@ tyClDeclSysNames :: TyClDecl name pat -> [(name, SrcLoc)]
-- or "system" names of the declaration
tyClDeclSysNames (ClassDecl {tcdSysNames = names, tcdLoc = loc, tcdSigs = sigs})
= [(n,loc) | n <- names] ++
[(n,loc) | ClassOpSig _ (DefMeth n) _ loc <- sigs]
= [(n,loc) | n <- names]
tyClDeclSysNames (TyData {tcdCons = cons, tcdSysNames = names, tcdLoc = loc})
= [(n,loc) | n <- names] ++
[(wkr_name,loc) | ConDecl _ wkr_name _ _ _ loc <- cons]
......
......@@ -142,16 +142,10 @@ tyClDeclFVs (ClassDecl {tcdCtxt = context, tcdTyVars = tyvars, tcdFDs = fds, tcd
----------------
hsSigsFVs sigs = plusFVs (map hsSigFVs sigs)
hsSigFVs (Sig v ty _) = extractHsTyNames ty `addOneFV` v
hsSigFVs (SpecInstSig ty _) = extractHsTyNames ty
hsSigFVs (SpecSig v ty _) = extractHsTyNames ty `addOneFV` v
hsSigFVs (FixSig (FixitySig v _ _)) = unitFV v
hsSigFVs (InlineSig v p _) = unitFV v
hsSigFVs (NoInlineSig v p _) = unitFV v
hsSigFVs (ClassOpSig v dm ty _) = dmFVs dm `plusFV` extractHsTyNames ty `addOneFV` v
dmFVs (DefMeth v) = unitFV v
dmFVs other = emptyFVs
hsSigFVs (Sig v ty _) = extractHsTyNames ty
hsSigFVs (SpecInstSig ty _) = extractHsTyNames ty
hsSigFVs (SpecSig v ty _) = extractHsTyNames ty
hsSigFVs other = emptyFVs
----------------
instDeclFVs (InstDecl inst_ty _ _ maybe_dfun _)
......
......@@ -396,12 +396,18 @@ rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op dm_stuff ty locn)
returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
rnClassBinds :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
-- Rename the mbinds only; the rest is done already
rnClassBinds (ClassDecl {tcdMeths = Nothing}) rn_cls_decl
= returnRn (rn_cls_decl, emptyFVs) -- No meth binds; decl came from interface file
rnClassBinds (ClassDecl {tcdMeths = Just mbinds}) -- Get mbinds from here
rn_cls_decl@(ClassDecl {tcdTyVars = tyvars, tcdLoc = src_loc}) -- Everything else is here
rnClassBinds (ClassDecl {tcdMeths = Nothing})
rn_cls_decl@(ClassDecl {tcdSigs = sigs})
-- No method bindings, so this class decl comes from an interface file,
-- However we want to treat the default-method names as free (they should
-- be defined somewhere else). [In source code this is not so; the class
-- decl will bind whatever default-methods are necessary.]
= returnRn (rn_cls_decl, mkFVs [v | ClassOpSig _ (DefMeth v) _ _ <- sigs])
rnClassBinds (ClassDecl {tcdMeths = Just mbinds}) -- Get mbinds from here
rn_cls_decl@(ClassDecl {tcdTyVars = tyvars, tcdLoc = src_loc}) -- Everything else is here
-- There are some default-method bindings (abeit possibly empty) so
-- this is a source-code class declaration
= -- The newLocals call is tiresome: given a generic class decl
-- class C a where
-- op :: a -> a
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment