Skip to content
Snippets Groups Projects
Commit f6d9b940 authored by Jeff Lewis's avatar Jeff Lewis
Browse files

[project @ 2000-07-14 23:54:06 by lewie]

Functional Dependencies were not getting simplified away when the dictionary
that generated them was simplified by instance resolution.  Fixed.
parent f062b59e
No related merge requests found
...@@ -451,12 +451,15 @@ newOverloadedLit orig lit ty -- The general case ...@@ -451,12 +451,15 @@ newOverloadedLit orig lit ty -- The general case
\begin{code} \begin{code}
newFunDepFromDict dict newFunDepFromDict dict
| isClassDict dict
= tcGetUnique `thenNF_Tc` \ uniq -> = tcGetUnique `thenNF_Tc` \ uniq ->
let (clas, tys) = getDictClassTys dict let (clas, tys) = getDictClassTys dict
fds = instantiateFdClassTys clas tys fds = instantiateFdClassTys clas tys
inst = FunDep uniq clas fds (instLoc dict) inst = FunDep uniq clas fds (instLoc dict)
in in
if null fds then returnNF_Tc Nothing else returnNF_Tc (Just inst) if null fds then returnNF_Tc Nothing else returnNF_Tc (Just inst)
| otherwise
= returnNF_Tc Nothing
\end{code} \end{code}
\begin{code} \begin{code}
......
...@@ -709,7 +709,7 @@ activate avails wanted ...@@ -709,7 +709,7 @@ activate avails wanted
addWanted avails wanted rhs_expr addWanted avails wanted rhs_expr
= ASSERT( not (wanted `elemFM` avails) ) = ASSERT( not (wanted `elemFM` avails) )
returnNF_Tc (addToFM avails wanted avail) addFunDeps (addToFM avails wanted avail) wanted
-- NB: we don't add the thing's superclasses too! -- NB: we don't add the thing's superclasses too!
-- Why not? Because addWanted is used when we've successfully used an -- Why not? Because addWanted is used when we've successfully used an
-- instance decl to reduce something; e.g. -- instance decl to reduce something; e.g.
...@@ -772,7 +772,6 @@ addAvail avails wanted avail ...@@ -772,7 +772,6 @@ addAvail avails wanted avail
addSuperClasses :: Avails s -> Inst -> NF_TcM s (Avails s) addSuperClasses :: Avails s -> Inst -> NF_TcM s (Avails s)
-- Add all the superclasses of the Inst to Avails -- Add all the superclasses of the Inst to Avails
-- JRL - also add in the functional dependencies
-- Invariant: the Inst is already in Avails. -- Invariant: the Inst is already in Avails.
addSuperClasses avails dict addSuperClasses avails dict
...@@ -781,12 +780,7 @@ addSuperClasses avails dict ...@@ -781,12 +780,7 @@ addSuperClasses avails dict
| otherwise -- It is a dictionary | otherwise -- It is a dictionary
= foldlNF_Tc add_sc avails (zipEqual "addSuperClasses" sc_theta' sc_sels) `thenNF_Tc` \ avails' -> = foldlNF_Tc add_sc avails (zipEqual "addSuperClasses" sc_theta' sc_sels) `thenNF_Tc` \ avails' ->
newFunDepFromDict dict `thenNF_Tc` \ fdInst_maybe -> addFunDeps avails' dict
case fdInst_maybe of
Nothing -> returnNF_Tc avails'
Just fdInst ->
let fdAvail = Avail (instToId (fromJust fdInst_maybe)) NoRhs [] in
addAvail avails fdInst fdAvail
where where
(clas, tys) = getDictClassTys dict (clas, tys) = getDictClassTys dict
(tyvars, sc_theta, sc_sels, _) = classBigSig clas (tyvars, sc_theta, sc_sels, _) = classBigSig clas
...@@ -821,6 +815,16 @@ addSuperClasses avails dict ...@@ -821,6 +815,16 @@ addSuperClasses avails dict
avail = Avail (instToId super_dict) avail = Avail (instToId super_dict)
(PassiveScSel sc_sel_rhs [dict]) (PassiveScSel sc_sel_rhs [dict])
[] []
addFunDeps :: Avails s -> Inst -> NF_TcM s (Avails s)
-- Add in the functional dependencies generated by the inst
addFunDeps avails inst
= newFunDepFromDict inst `thenNF_Tc` \ fdInst_maybe ->
case fdInst_maybe of
Nothing -> returnNF_Tc avails
Just fdInst ->
let fdAvail = Avail (instToId (fromJust fdInst_maybe)) NoRhs [] in
addAvail avails fdInst fdAvail
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment