Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/4f3f9f0d7df5eb8dd399562706bd0445791e6e90 >--------------------------------------------------------------- commit 4f3f9f0d7df5eb8dd399562706bd0445791e6e90 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Thu Oct 4 15:08:44 2012 +0100 Remove some tabs the commit hook is complaining about >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/Split2.hs | 7 +++++-- compiler/typecheck/TcInstDcls.lhs | 6 +++--- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Split2.hs b/compiler/supercompile/Supercompile/Drive/Split2.hs index 3af1f52..1fe846c 100644 --- a/compiler/supercompile/Supercompile/Drive/Split2.hs +++ b/compiler/supercompile/Supercompile/Drive/Split2.hs @@ -43,7 +43,7 @@ filterEdges :: Ord node -> LGraph node edge filterEdges keep_edge = M.map (M.mapMaybeWithKey (\n e -> if keep_edge e n then Just e else Nothing)) -trimUnreachable :: Ord node +trimUnreachable :: (Show node, Ord node) => node -> LGraph node edge -> LGraph node edge @@ -51,7 +51,7 @@ trimUnreachable root_n g = go (S.singleton root_n) S.empty where go n_todo n_done | S.null n_todo' = M.filterWithKey (\n _ -> n `S.member` n_done') g -- NB: all outgoing edges of retained nodes will still be present by definition | otherwise = go n_todo' n_done' where n_done' = n_todo `S.union` n_done - n_todo' = S.fold (\n n_todo' -> M.keysSet (M.findWithDefault (error "trimUnreachable") n g) `S.union` n_todo') S.empty n_todo S.\\ n_done' + n_todo' = S.fold (\n n_todo' -> M.keysSet (M.findWithDefault (error $ "trimUnreachable:" ++ show n) n g) `S.union` n_todo') S.empty n_todo S.\\ n_done' shortcutEdges :: forall node edge. Ord node @@ -208,6 +208,9 @@ data Context = HeapContext Var | FocusContext deriving (Eq, Ord) +instance Show Context where + show = showPpr + instance Outputable Context where pprPrec prec (HeapContext x') = pprPrec prec x' pprPrec prec (StackContext i) = pprPrec prec i diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 2106da1..4bb8b6b 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -511,7 +511,7 @@ cyclicDeclErr :: Outputable d => [Located d] -> TcRn () cyclicDeclErr inst_decls = setSrcSpan (getLoc (head sorted_decls)) $ addErr (sep [ptext (sLit "Cycle in type declarations: data constructor used (in a type) before it is defined"), - nest 2 (vcat (map ppr_decl sorted_decls))]) + nest 2 (vcat (map ppr_decl sorted_decls))]) where sorted_decls = sortLocated inst_decls ppr_decl (L loc decl) = ppr loc <> colon <+> ppr decl @@ -585,8 +585,8 @@ tcLocalInstDecl (L loc (ClsInstD { cid_poly_ty = poly_ty, cid_binds = binds -- Dfun location is that of instance *header* ; overlap_flag <- getOverlapFlag - ; let dfun = mkDictFunId dfun_name tyvars theta clas inst_tys - ispec = mkLocalInstance dfun overlap_flag + ; let dfun = mkDictFunId dfun_name tyvars theta clas inst_tys + ispec = mkLocalInstance dfun overlap_flag inst_info = InstInfo { iSpec = ispec, iBinds = VanillaInst binds uprags False } ; return ( [inst_info], fam_insts0 ++ concat fam_insts1) } _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
