+ -- It is vital for newtype reconstruction that the unification step
+ -- is done right here, _before_ the subterms are RTTI reconstructed
+ let myType = mkFunTys subTtypes tv
+ (signatureType,_) <- instScheme(dataConRepType dc)
+ addConstraint myType signatureType
+ return $ [ appArr (\e->(t,e)) (ptrs clos) i
+ | (i,t) <- drop extra_args $
+ zip [0..] (filter isPointed subTtypes)]
+ _ -> return []
+
+-- Compute the difference between a base type and the type found by RTTI
+-- improveType <base_type> <rtti_type>
+-- The types can contain skolem type variables, which need to be treated as normal vars.
+-- In particular, we want them to unify with things.
+improveRTTIType :: HscEnv -> Type -> Type -> IO (Maybe TvSubst)
+improveRTTIType hsc_env ty rtti_ty = runTR_maybe hsc_env $ do
+ let (_,ty0) = splitForAllTys ty
+ ty_tvs = varSetElems $ tyVarsOfType ty0
+ let (_,rtti_ty0)= splitForAllTys rtti_ty
+ rtti_tvs = varSetElems $ tyVarsOfType rtti_ty0
+ (ty_tvs',_,ty')<- tcInstType (mapM tcInstTyVar) (mkSigmaTy ty_tvs [] ty0)
+ (_,_,rtti_ty') <- tcInstType (mapM tcInstTyVar) (mkSigmaTy rtti_tvs [] rtti_ty0)
+ boxyUnify rtti_ty' ty'
+ tvs1_contents <- zonkTcTyVars ty_tvs'
+ let subst = uncurry zipTopTvSubst
+ (unzip [(tv,ty) | tv <- ty_tvs, ty <- tvs1_contents
+ , getTyVar_maybe ty /= Just tv
+ , not(isTyVarTy ty)])
+-- liftIO $ hPutStrLn stderr $ showSDocDebug $ text "unify " <+> sep [ppr ty, ppr rtti_ty, equals, ppr subst ]
+ return subst
+
+-- Dealing with newtypes
+{-
+ congruenceNewtypes does a parallel fold over two Type values,
+ compensating for missing newtypes on both sides.
+ This is necessary because newtypes are not present
+ in runtime, but sometimes there is evidence available.
+ Evidence can come from DataCon signatures or
+ from compile-time type inference.
+ What we are doing here is an approximation
+ of unification modulo a set of equations derived
+ from newtype definitions. These equations should be the
+ same as the equality coercions generated for newtypes
+ in System Fc. The idea is to perform a sort of rewriting,
+ taking those equations as rules, before launching unification.
+
+ The caller must ensure the following.
+ The 1st type (lhs) comes from the heap structure of ptrs,nptrs.
+ The 2nd type (rhs) comes from a DataCon type signature.
+ Rewriting (i.e. adding/removing a newtype wrapper) can happen
+ in both types, but in the rhs it is restricted to the result type.
+
+ Note that it is very tricky to make this 'rewriting'
+ work with the unification implemented by TcM, where
+ substitutions are operationally inlined. The order in which
+ constraints are unified is vital as we cannot modify
+ anything that has been touched by a previous unification step.
+Therefore, congruenceNewtypes is sound only if the types
+recovered by the RTTI mechanism are unified Top-Down.
+-}
+congruenceNewtypes :: TcType -> TcType -> TR (TcType,TcType)
+congruenceNewtypes lhs rhs
+ -- TyVar lhs inductive case
+ | Just tv <- getTyVar_maybe lhs
+ = recoverTc (return (lhs,rhs)) $ do
+ Indirect ty_v <- readMetaTyVar tv
+ (_lhs1, rhs1) <- congruenceNewtypes ty_v rhs
+ return (lhs, rhs1)
+-- FunTy inductive case
+ | Just (l1,l2) <- splitFunTy_maybe lhs
+ , Just (r1,r2) <- splitFunTy_maybe rhs
+ = do (l2',r2') <- congruenceNewtypes l2 r2
+ (l1',r1') <- congruenceNewtypes l1 r1
+ return (mkFunTy l1' l2', mkFunTy r1' r2')
+-- TyconApp Inductive case; this is the interesting bit.
+ | Just (tycon_l, _) <- splitNewTyConApp_maybe lhs
+ , Just (tycon_r, _) <- splitNewTyConApp_maybe rhs
+ , tycon_l /= tycon_r
+ = do rhs' <- upgrade tycon_l rhs
+ return (lhs, rhs')
+
+ | otherwise = return (lhs,rhs)