Finally fix Trac #3066

This is a fix to
  Tue Mar  3 17:42:58 GMT 2009  simonpj@microsoft.com
    * Fix Trac #3066: checking argument types in foreign calls
which I embarassingly got wrong.

Have to be careful when expanding recursive newtypes.

Pls merge.

diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index d6dbf1c..5fbb055 100644 (file)
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -1262,15 +1262,19 @@ toDNType ty
                 ]
 
 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
-       -- Look through newtypes
-       -- Non-recursive ones are transparent to splitTyConApp,
-       -- but recursive ones aren't.  Manuel had:
-       --      newtype T = MkT (Ptr T)
-       -- and wanted it to work...
-checkRepTyCon check_tc ty 
-  | Just (ty', _) <- splitNewTypeRepCo_maybe ty = checkRepTyCon check_tc ty'
-  | Just (tc,_)   <- splitTyConApp_maybe ty     = check_tc tc
-  | otherwise                                  = False
+-- Look through newtypes, but *not* foralls
+-- Should work even for recursive newtypes
+-- eg Manuel had:      newtype T = MkT (Ptr T)
+checkRepTyCon check_tc ty
+  = go [] ty
+  where
+    go rec_nts ty
+      | Just (tc,tys) <- splitTyConApp_maybe ty
+      = case carefullySplitNewType_maybe rec_nts tc tys of
+          Just (rec_nts', ty') -> go rec_nts' ty'
+          Nothing              -> check_tc tc
+      | otherwise
+      = False
 
 checkRepTyConKey :: [Unique] -> Type -> Bool
 -- Like checkRepTyCon, but just looks at the TyCon key

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 0912a2c..3705914 100644 (file)
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -41,7 +41,7 @@ module Type (
        applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
        
        -- (Newtypes)
-       newTyConInstRhs,
+       newTyConInstRhs, carefullySplitNewType_maybe,
        
        -- (Type families)
         tyFamInsts, predFamInsts,
@@ -596,14 +596,9 @@ newtype at outermost level; and bale out if we see it again.
 -- | Looks through:
 --
 --     1. For-alls
---
 --     2. Synonyms
---
 --     3. Predicates
---
---     4. Usage annotations
---
---     5. All newtypes, including recursive ones, but not newtype families
+--     4. All newtypes, including recursive ones, but not newtype families
 --
 -- It's useful in the back end of the compiler.
 repType :: Type -> Type
@@ -618,19 +613,25 @@ repType ty
     go rec_nts (ForAllTy _ ty)                 -- Look through foralls
        = go rec_nts ty
 
-    go rec_nts ty@(TyConApp tc tys)            -- Expand newtypes
-       | Just _co_con <- newTyConCo_maybe tc   -- See Note [Expanding newtypes]
-       = if tc `elem` rec_nts                  --  in Type.lhs
-         then ty
-         else go rec_nts' nt_rhs
-       where
-         nt_rhs = newTyConInstRhs tc tys
-         rec_nts' | isRecursiveTyCon tc = tc:rec_nts
-                  | otherwise           = rec_nts
+    go rec_nts (TyConApp tc tys)               -- Expand newtypes
+      | Just (rec_nts', ty') <- carefullySplitNewType_maybe rec_nts tc tys
+      = go rec_nts' ty'
 
     go _ ty = ty
 
 
+carefullySplitNewType_maybe :: [TyCon] -> TyCon -> [Type] -> Maybe ([TyCon],Type)
+-- Return the representation of a newtype, unless 
+-- we've seen it already: see Note [Expanding newtypes]
+carefullySplitNewType_maybe rec_nts tc tys
+  | isNewTyCon tc
+  , not (tc `elem` rec_nts)  = Just (rec_nts', newTyConInstRhs tc tys)
+  | otherwise               = Nothing
+  where
+    rec_nts' | isRecursiveTyCon tc = tc:rec_nts
+            | otherwise           = rec_nts
+
+
 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
 -- of inspecting the type directly.