X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FClosureInfo.lhs;h=27aed3a70e8163bf084e015a042e9e716f681c19;hb=3d8dbba7d24c9139b800f4ccf31c50b11596fc2e;hp=8f62bc7e0e2a3b99db27f9e1a6c4014dc8ba41b8;hpb=41c97fdcffd38949f89af8094a9f60203b189531;p=ghc-hetmet.git diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index 8f62bc7..27aed3a 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -257,12 +257,12 @@ mkLFThunk thunk_ty top fvs upd_flag (might_be_a_function thunk_ty) might_be_a_function :: Type -> Bool +-- Return False only if we are *sure* it's a data type +-- Look through newtypes etc as much as poss might_be_a_function ty - | Just (tc,_) <- splitTyConApp_maybe (repType ty), - not (isFunTyCon tc) && not (isAbstractTyCon tc) = False - -- don't forget to check for abstract types, which might - -- be functions too. - | otherwise = True + = case splitTyConApp_maybe (repType ty) of + Just (tc, _) -> not (isDataTyCon tc) + Nothing -> True \end{code} @mkConLFInfo@ is similar, for constructors. @@ -594,7 +594,13 @@ getCallMethod this_pkg name (LFThunk _ _ updatable std_form_info is_fun) n_args if we enter the same thunk multiple times, so the optimisation of jumping directly to the entry code is still valid. --SDM -} - = ASSERT2( n_args == 0, ppr name ) EnterIt + = EnterIt + -- We used to have ASSERT( n_args == 0 ), but actually it is + -- possible for the optimiser to generate + -- let bot :: Int = error Int "urk" + -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3 + -- This happens as a result of the case-of-error transformation + -- So the right thing to do is just to enter the thing | otherwise -- Jump direct to code for single-entry thunks = ASSERT( n_args == 0 )