Commit 5cceab60 authored by mnislaih's avatar mnislaih
Browse files

Fix a bug in the closure viewer

parent 9a37b334
......@@ -260,7 +260,6 @@ stripUnknowns :: [Name] -> Id -> Id
stripUnknowns names id = setIdType id . sigmaType . fst . go names . idType
$ id
where
sigmaType ty = mkForAllTys (varSetElems$ tyVarsOfType (dropForAlls ty)) ty
go tyvarsNames@(v:vv) ty
| Just (ty1,ty2) <- splitFunTy_maybe ty = let
(ty1',vv') = go tyvarsNames ty1
......
......@@ -39,6 +39,8 @@ module RtClosureInspect(
isPointed,
isFullyEvaluatedTerm,
-- unsafeDeepSeq,
sigmaType
) where
#include "HsVersions.h"
......@@ -472,7 +474,7 @@ cvObtainTerm1 hsc_env force mb_ty hval
| Nothing <- mb_ty = runTR hsc_env . go argTypeKind $ hval
| Just ty <- mb_ty = runTR hsc_env $ do
term <- go argTypeKind hval
ty' <- instScheme ty
ty' <- instScheme (sigmaType ty)
addConstraint ty' (fromMaybe (error "by definition")
(termType term))
return term
......@@ -539,6 +541,11 @@ zonkTerm = foldTerm idTermFoldM {
,fSuspension = \ct ty v b -> fmapMMaybe zonkTcType ty >>= \ty ->
return (Suspension ct ty v b)}
-- Is this defined elsewhere?
-- Find all free tyvars and insert the appropiate ForAll.
sigmaType ty = mkForAllTys (varSetElems$ tyVarsOfType (dropForAlls ty)) ty
{-
Example of Type Reconstruction
--------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment