[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.

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index f3b13c8..d4d8b48 100644 (file)
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -451,12 +451,15 @@ newOverloadedLit orig lit ty              -- The general case
 
 \begin{code}
 newFunDepFromDict dict
+  | isClassDict dict
   = tcGetUnique                `thenNF_Tc` \ uniq ->
     let (clas, tys) = getDictClassTys dict
        fds = instantiateFdClassTys clas tys
        inst = FunDep uniq clas fds (instLoc dict)
     in
        if null fds then returnNF_Tc Nothing else returnNF_Tc (Just inst)
+  | otherwise
+  = returnNF_Tc Nothing
 \end{code}
 
 \begin{code}

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index f51ae48..acb0827 100644 (file)
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -709,7 +709,7 @@ activate avails wanted
     
 addWanted avails wanted rhs_expr
   = 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!
        -- Why not?  Because addWanted is used when we've successfully used an
        -- instance decl to reduce something; e.g.
@@ -772,7 +772,6 @@ addAvail avails wanted avail
 
 addSuperClasses :: Avails s -> Inst -> NF_TcM s (Avails s)
                -- Add all the superclasses of the Inst to Avails
-               -- JRL - also add in the functional dependencies
                -- Invariant: the Inst is already in Avails.
 
 addSuperClasses avails dict
@@ -781,12 +780,7 @@ addSuperClasses avails dict
 
   | otherwise  -- It is a dictionary
   = foldlNF_Tc add_sc avails (zipEqual "addSuperClasses" sc_theta' sc_sels) `thenNF_Tc` \ avails' ->
-    newFunDepFromDict dict     `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
+    addFunDeps avails' dict
   where
     (clas, tys) = getDictClassTys dict
     (tyvars, sc_theta, sc_sels, _) = classBigSig clas
@@ -821,6 +815,16 @@ addSuperClasses avails dict
                  avail   = Avail (instToId super_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}
 
 %************************************************************************