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

On branch  : overlapping-tyfams

http://hackage.haskell.org/trac/ghc/changeset/82e928a2087f5b065e5355f6b25041d1eb6eb823

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

commit 82e928a2087f5b065e5355f6b25041d1eb6eb823
Merge: 021ca7b... 086d7c5...
Author: Richard Eisenberg <e...@cis.upenn.edu>
Date:   Wed Nov 28 11:46:26 2012 -0500

    Merge branch 'master' into overlapping-tyfams
    
    Conflicts:
        compiler/typecheck/TcForeign.lhs

 .gitignore                        |   12 ---
 .gitmodules                       |   36 ++++++++
 aclocal.m4                        |    2 +-
 compiler/ghc.mk                   |    3 +
 compiler/iface/IfaceType.lhs      |    2 +-
 compiler/iface/LoadIface.lhs      |    6 +-
 compiler/iface/MkIface.lhs        |   13 ++-
 compiler/main/DriverPipeline.hs   |    4 +-
 compiler/main/ErrUtils.lhs        |    5 +-
 compiler/main/GHC.hs              |    4 +-
 compiler/main/GhcMake.hs          |   17 +++-
 compiler/prelude/PrimOp.lhs       |   15 +++-
 compiler/prelude/primops.txt.pp   |   24 ++++++
 compiler/rename/RnNames.lhs       |    6 +-
 compiler/rename/RnTypes.lhs       |   15 ++++
 compiler/typecheck/TcForeign.lhs  |  164 +++++++++++++++++++-----------------
 compiler/typecheck/TcHsType.lhs   |   35 ++++++--
 compiler/typecheck/TcRnDriver.lhs |   29 ++++++-
 compiler/typecheck/TcRnTypes.lhs  |   45 +++++++---
 compiler/types/Kind.lhs           |   61 +++++++++-----
 compiler/types/Type.lhs           |   18 ++++-
 compiler/utils/Outputable.lhs     |    8 +-
 docs/users_guide/profiling.xml    |   18 +++-
 libraries/Cabal                   |    1 +
 libraries/Win32                   |    1 +
 libraries/binary                  |    1 +
 libraries/bytestring              |    1 +
 libraries/containers              |    1 +
 libraries/haskeline               |    1 +
 libraries/pretty                  |    1 +
 libraries/primitive               |    1 +
 libraries/terminfo                |    1 +
 libraries/transformers            |    1 +
 libraries/vector                  |    1 +
 libraries/xhtml                   |    1 +
 mk/config.mk.in                   |   28 ++++---
 mk/validate-settings.mk           |   15 +++-
 rts/Linker.c                      |    4 +-
 sync-all                          |   84 ++++++++++++++-----
 utils/genprimopcode/Lexer.x       |    5 +
 utils/genprimopcode/Main.hs       |   29 ++++++-
 utils/genprimopcode/Parser.y      |   13 +++
 utils/genprimopcode/ParserM.hs    |    5 +
 utils/genprimopcode/Syntax.hs     |    9 ++
 utils/hpc/HpcCombine.hs           |  116 +++++++++++++-------------
 utils/hpc/HpcDraft.hs             |   31 ++++----
 utils/hpc/HpcFlags.hs             |  140 ++++++++++++++++---------------
 utils/hpc/HpcLexer.hs             |    6 +-
 utils/hpc/HpcMarkup.hs            |    1 +
 utils/hpc/HpcOverlay.hs           |   41 +++++-----
 utils/hpc/HpcReport.hs            |   41 +++++-----
 utils/hpc/HpcShowTix.hs           |   23 +++---
 utils/hpc/Main.hs                 |  114 +++++++++++++-------------
 utils/hpc/hpc-bin.cabal           |    1 +
 54 files changed, 795 insertions(+), 465 deletions(-)

diff --cc compiler/typecheck/TcForeign.lhs
index b05dee6,40fb3b2..64a89d1
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@@ -89,44 -88,12 +88,12 @@@ normaliseFfiType' env ty0 = go [] ty
          = children_only
  
          | isNewTyCon tc         -- Expand newtypes
-         -- We can't just use isRecursiveTyCon here, as we need to allow
-         -- some recursive types as described below
-         = if tc `elem` rec_nts  -- See Note [Expanding newtypes] in Type.lhs
-           then -- If this is a recursive newtype then it will normally
-                -- be rejected later as not being a valid FFI type.
-                -- Sometimes recursion is OK though, e.g. with
-                --     newtype T = T (Ptr T)
-                -- we don't reject the type for being recursive.
-                return (Refl ty, ty)
-           else do newtypeOK <- do env <- getGblEnv
-                                   case tyConSingleDataCon_maybe tc of
-                                       Just dataCon ->
-                                           case lookupGRE_Name (tcg_rdr_env 
env) $ dataConName dataCon of
-                                               [gre] ->
-                                                   do -- If we look through a 
newtype constructor, then we need it to be in scope.
-                                                      -- But if this is the 
only use if that import then we'll get an unused import
-                                                      -- warning, so we need 
to mark a valid RdrName for it as used.
-                                                      case gre_prov gre of
-                                                          Imported (is : _) ->
-                                                              do let modName = 
is_as (is_decl is)
-                                                                     occName = 
nameOccName (dataConName dataCon)
-                                                                     rdrName = 
mkRdrQual modName occName
-                                                                 
addUsedRdrNames [rdrName]
-                                                          Imported [] ->
-                                                              panic 
"normaliseFfiType': Imported []"
-                                                          LocalDef ->
-                                                              return ()
-                                                      return True
-                                               [] ->
-                                                   return False
-                                               _ ->
-                                                   panic "normaliseFfiType': 
Got more GREs than expected"
-                                       _ ->
-                                           return False
-                   if newtypeOK
-                       then do let nt_co = mkSingletonAxInstCo (newTyConCo tc) 
tys
-                               add_co nt_co rec_nts' nt_rhs
-                       else children_only
+         = do { rdr_env <- getGlobalRdrEnv 
+              ; case checkNewtypeFFI rdr_env rec_nts tc of
+                  Nothing  -> children_only
 -                 Just gre -> do { let nt_co = mkAxInstCo (newTyConCo tc) tys
++                 Just gre -> do { let nt_co = mkSingletonAxInstCo (newTyConCo 
tc) tys
+                                 ; (co', ty', gres) <- go rec_nts' nt_rhs
+                                 ; return (mkTransCo nt_co co', ty', gre 
`consBag` gres) } }
  
          | isFamilyTyCon tc              -- Expand open tycons
          , (co, ty) <- normaliseTcApp env tc tys



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to