[commit: ghc] master: Merge branch 'master' of darcs.haskell.org:/home/darcs/ghc (1c4e896)

Simon Peyton Jones simonpj at microsoft.com
Tue Jan 29 13:50:32 CET 2013


Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/1c4e896200d142b9b7217218fb555eb7e119d120

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

commit 1c4e896200d142b9b7217218fb555eb7e119d120
Merge: 82219ae... a47ee23...
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Jan 25 13:20:56 2013 +0000

    Merge branch 'master' of darcs.haskell.org:/home/darcs/ghc

 aclocal.m4                                     |    6 ++
 compiler/basicTypes/DataCon.lhs                |   76 +++++++++-------
 compiler/coreSyn/CoreUtils.lhs                 |   24 +++++-
 compiler/iface/BinIface.hs                     |    6 +-
 compiler/iface/BuildTyCl.lhs                   |   16 ----
 compiler/iface/IfaceSyn.lhs                    |   12 ++-
 compiler/iface/MkIface.lhs                     |    1 +
 compiler/iface/TcIface.lhs                     |   10 ++-
 compiler/llvmGen/LlvmCodeGen/Ppr.hs            |    3 +
 compiler/main/DriverPipeline.hs                |   11 ++-
 compiler/main/DynFlags.hs                      |    2 +-
 compiler/prelude/PrelNames.lhs                 |    4 +-
 compiler/prelude/TysWiredIn.lhs                |   48 ++++++-----
 compiler/prelude/TysWiredIn.lhs-boot           |    2 +-
 compiler/simplCore/SimplUtils.lhs              |    2 +-
 compiler/simplCore/Simplify.lhs                |   32 ++++++--
 compiler/typecheck/TcGenGenerics.lhs           |    5 +-
 compiler/typecheck/TcHsType.lhs                |   15 ++--
 compiler/typecheck/TcInstDcls.lhs              |    4 +-
 compiler/typecheck/TcTyClsDecls.lhs            |   36 ++++----
 compiler/typecheck/TcTyDecls.lhs               |  111 +++++++++++++++++++++---
 compiler/types/TyCon.lhs                       |   38 ++++++--
 compiler/types/Type.lhs                        |    4 +-
 compiler/utils/Platform.hs                     |    2 +
 compiler/vectorise/Vectorise/Generic/PData.hs  |    1 +
 compiler/vectorise/Vectorise/Type/TyConDecl.hs |    1 +
 ghc.mk                                         |   17 ++--
 27 files changed, 340 insertions(+), 149 deletions(-)

diff --cc compiler/typecheck/TcTyClsDecls.lhs
index 3a8a1c0,24ca540..8f880e1
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@@ -603,33 -617,28 +603,33 @@@ tcTyClDecl1 _parent rec_inf
  			-- hold of the name of the class TyCon, which we
  			-- need to look up its recursiveness
  		    tycon_name = tyConName (classTyCon clas)
- 		    tc_isrec = calc_isrec tycon_name
+ 		    tc_isrec = rti_is_rec rec_info tycon_name
  
 -            ; at_stuff <- tcClassATs class_name (AssocFamilyTyCon clas) ats at_defs
 -
 -            ; buildClass False {- Must include unfoldings for selectors -}
 -			 class_name tvs' ctxt' fds' at_stuff
 -			 sig_stuff tc_isrec }
 -
 -  ; let gen_dm_ids = [ AnId (mkExportedLocalId gen_dm_name gen_dm_ty)
 -                     | (sel_id, GenDefMeth gen_dm_name) <- classOpItems clas
 -                     , let gen_dm_tau = expectJust "tcTyClDecl1" $
 -                                        lookupNameEnv gen_dm_env (idName sel_id)
 -		     , let gen_dm_ty = mkSigmaTy tvs' 
 -                                                 [mkClassPred clas (mkTyVarTys tvs')] 
 -                                                 gen_dm_tau
 -                     ]
 -        class_ats = map ATyCon (classATs clas)
 -
 -  ; return (ATyCon (classTyCon clas) : gen_dm_ids ++ class_ats )
 -      -- NB: Order is important due to the call to `mkGlobalThings' when
 -      --     tying the the type and class declaration type checking knot.
 -  }
 +               ; ctxt' <- tcHsContext ctxt
 +               ; ctxt' <- zonkTcTypeToTypes emptyZonkEnv ctxt'  
 +                       -- Squeeze out any kind unification variables
 +               ; fds'  <- mapM (addLocM tc_fundep) fundeps
 +               ; (sig_stuff, gen_dm_env) <- tcClassSigs class_name sigs meths
 +               ; at_stuff <- tcClassATs class_name (AssocFamilyTyCon clas) ats at_defs
 +               ; clas <- buildClass False {- Must include unfoldings for selectors -}
 +	                    class_name tvs' ctxt' fds' at_stuff
 +	       		    sig_stuff tc_isrec 
 +               ; traceTc "tcClassDecl" (ppr fundeps $$ ppr tvs' $$ ppr fds')
 +               ; return (clas, tvs', gen_dm_env) }
 +
 +       ; let { gen_dm_ids = [ AnId (mkExportedLocalId gen_dm_name gen_dm_ty)
 +                            | (sel_id, GenDefMeth gen_dm_name) <- classOpItems clas
 +                     	    , let gen_dm_tau = expectJust "tcTyClDecl1" $
 +                     	                       lookupNameEnv gen_dm_env (idName sel_id)
 +		     	    , let gen_dm_ty = mkSigmaTy tvs' 
 +                     	                              [mkClassPred clas (mkTyVarTys tvs')] 
 +                     	                              gen_dm_tau
 +                     	    ]
 +             ; class_ats = map ATyCon (classATs clas) }
 +
 +       ; return (ATyCon (classTyCon clas) : gen_dm_ids ++ class_ats ) }
 +         -- NB: Order is important due to the call to `mkGlobalThings' when
 +         --     tying the the type and class declaration type checking knot.
    where
      tc_fundep (tvs1, tvs2) = do { tvs1' <- mapM tc_fd_tyvar tvs1 ;
  				; tvs2' <- mapM tc_fd_tyvar tvs2 ;





More information about the ghc-commits mailing list