-#if defined(GHCI) && defined(BREAKPOINT)
-dsExpr (HsApp (L _ (HsApp realFun@(L _ (HsCoerce _ fun)) (L loc arg))) _)
- | HsVar funId <- fun
- , idName funId == breakpointJumpName
- , ids <- filter (not.hasTyVar.idType) (extractIds arg)
- = do dsWarn (text "Extracted ids:" <+> ppr ids <+> ppr (map idType ids))
- stablePtr <- ioToIOEnv $ newStablePtr ids
- -- Yes, I know... I'm gonna burn in hell.
- let Ptr addr# = castStablePtrToPtr stablePtr
- funCore <- dsLExpr realFun
- argCore <- dsLExpr (L loc (HsLit (HsInt (fromIntegral (I# (addr2Int# addr#))))))
- hvalCore <- dsLExpr (L loc (extractHVals ids))
- return ((funCore `App` argCore) `App` hvalCore)
- where extractIds :: HsExpr Id -> [Id]
- extractIds (HsApp fn arg)
- | HsVar argId <- unLoc arg
- = argId:extractIds (unLoc fn)
- | TyApp arg' ts <- unLoc arg
- , HsVar argId <- unLoc arg'
- = error (showSDoc (ppr ts)) -- argId:extractIds (unLoc fn)
- extractIds x = []
- extractHVals ids = ExplicitList unitTy (map (L loc . HsVar) ids)
- hasTyVar (TyVarTy _) = True
- hasTyVar (FunTy a b) = hasTyVar a || hasTyVar b
- hasTyVar (NoteTy _ t) = hasTyVar t
- hasTyVar (AppTy a b) = hasTyVar a || hasTyVar b
- hasTyVar (TyConApp _ ts) = any hasTyVar ts
- hasTyVar _ = False
-#endif
-