Repository : ssh://[email protected]/ghc On branch : type-nats-simple Link : http://ghc.haskell.org/trac/ghc/changeset/9c458ab0496347836ab7090558ee1dce7ec2c517/ghc
>--------------------------------------------------------------- commit 9c458ab0496347836ab7090558ee1dce7ec2c517 Author: Iavor S. Diatchki <[email protected]> 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} _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
