[commit: ghc] type-nats-simple: Hook-in built-in interactions with inerts. (9c458ab)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : type-nats-simple
Link       : http://ghc.haskell.org/trac/ghc/changeset/9c458ab0496347836ab7090558ee1dce7ec2c517/ghc

>---------------------------------------------------------------

commit 9c458ab0496347836ab7090558ee1dce7ec2c517
Author: Iavor S. Diatchki <iavor.diatchki at gmail.com>
Date:   Sat Sep 7 17:10:11 2013 -0700

    Hook-in built-in interactions with inerts.
    
    After the solver extracts its relevant constraints
    (i.e., function applications where the head match),
    we check for any additional functional equation constraints for the
    same built-in function.  Then, we call out to the custom
    interaction, to collect some extra derived constraints.


>---------------------------------------------------------------

9c458ab0496347836ab7090558ee1dce7ec2c517
 compiler/typecheck/TcInteract.lhs |   26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index 462c59c..9b970c9 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -565,6 +565,7 @@ interactWithInertsStage wi
   = do { traceTcS "interactWithInerts" $ text "workitem = " <+> ppr wi
        ; rels <- extractRelevantInerts wi 
        ; traceTcS "relevant inerts are:" $ ppr rels
+       ; builtInInteractions
        ; foldlBagM interact_next (ContinueWith wi) rels }
 
   where interact_next Stop atomic_inert 
@@ -593,6 +594,31 @@ interactWithInertsStage wi
                        -> do { insertInertItemTcS atomic_inert
                              ; return (ContinueWith wi) }
                }
+
+        -- See if we can compute some new derived work for built-ins.
+        builtInInteractions
+          | CFunEqCan { cc_fun = tc, cc_tyargs = args, cc_rhs = xi } <- wi
+          , Just ops <- isBuiltInSynFamTyCon_maybe tc =
+            do is <- getInertsFunEqTyCon tc
+               traceTcS "builtInCandidates: " $ ppr is
+               let interact = sfInteractInert ops args xi
+               impMbs <- sequence
+                 [ do mb <- newDerived (mkTcEqPred lhs rhs)
+                      case mb of
+                        Just x -> return $ Just $ mkNonCanonical d x
+                        Nothing -> return Nothing
+                 | CFunEqCan { cc_tyargs = iargs
+                             , cc_rhs = ixi
+                             , cc_loc = d } <- is
+                 , Pair lhs rhs <- interact iargs ixi
+                 ]
+               let imps = catMaybes impMbs
+               unless (null imps) $ updWorkListTcS (extendWorkListEqs imps)
+          | otherwise = return ()
+
+
+
+
 \end{code}
 
 \begin{code}