Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/d1417a283b5e55afa3fbff94aaa7ea18373d4fb8 >--------------------------------------------------------------- commit d1417a283b5e55afa3fbff94aaa7ea18373d4fb8 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Tue Jul 17 14:58:18 2012 +0100 Check for triviality in renaming before returning a type generalisation >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/MSG.hs | 10 +++++++++- 1 files changed, 9 insertions(+), 1 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs index 2779634..7038075 100644 --- a/compiler/supercompile/Supercompile/Drive/MSG.hs +++ b/compiler/supercompile/Supercompile/Drive/MSG.hs @@ -467,12 +467,20 @@ msgMatch inst_mtch ((_, Heap h_l _, rn_l, k_l), (heap@(Heap _ ids), k, qa), (dee -- 2) Do both heaps only contain lambdaBounds? , isPureHeapEmpty h_l , isPureHeapEmpty h_r - = Just (RightGivesTypeGen rn_l (deeds_r, heap, k, qa) rn_r) + -- 3) Are both type substitutions non-trivial? If they are trivial then we risk not making any progress after we generalise away the type info + , let state = (deeds_r, heap, k, qa) + fvs = stateFreeVars state + , isTypeRenamingNonTrivial rn_l fvs + , isTypeRenamingNonTrivial rn_r fvs + = Just (RightGivesTypeGen rn_l state rn_r) -- No information gained in this case :-( | otherwise = Nothing +isTypeRenamingNonTrivial :: Renaming -> FreeVars -> Bool +isTypeRenamingNonTrivial rn fvs = (\f -> foldVarSet f False fvs) $ \x rest -> (isTyVar x && isNothing (getTyVar_maybe (lookupTyVarSubst rn x))) || rest + msg :: MSGMode -> State -> State -> MSG' MSGResult msg mm (deeds_l, heap_l, k_l, qa_l) (deeds_r, heap_r, k_r, qa_r) = -- (\res -> traceRender ("msg", M.keysSet h_l, residualiseDriveState (Heap h_l prettyIdSupply, k_l, in_e_l), M.keysSet h_r, residualiseDriveState (Heap h_r prettyIdSupply, k_r, in_e_r), res) res) $ -- TODO: test for multiple solutions? Attempt to choose best? _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
