X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDesugar.lhs;h=d16672c4bd1880414076d1dab92bb9bb1bdd3030;hb=376101055fb111ebd52b5ef1fb76e00334b44304;hp=dd2ed6d07b52a63488e3894e0f79a18f87c05776;hpb=d50e93cf95b68bf858be82025b56c9977335ed76;p=ghc-hetmet.git diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index dd2ed6d..d16672c 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -10,6 +10,7 @@ module Desugar ( deSugar, deSugarExpr ) where #include "HsVersions.h" +import Breakpoints import DynFlags import StaticFlags import HscTypes @@ -43,8 +44,9 @@ import Maybes import FastString import Util import Coverage - +import IOEnv import Data.IORef + \end{code} %************************************************************************ @@ -81,9 +83,9 @@ deSugar hsc_env -- Desugar the program ; let export_set = availsToNameSet exports ; let auto_scc = mkAutoScc mod export_set - + ; let noDbgSites = [] ; mb_res <- case ghcMode dflags of - JustTypecheck -> return (Just ([], [], NoStubs, noHpcInfo)) + JustTypecheck -> return (Just ([], [], NoStubs, noHpcInfo, noDbgSites)) _ -> do (binds_cvr,ds_hpc_info) <- if opt_Hpc then addCoverageTicksToBinds dflags mod mod_loc binds @@ -95,10 +97,13 @@ deSugar hsc_env local_bndrs = mkVarSet (map fst all_prs) ; ds_rules <- mappM (dsRule mod local_bndrs) rules ; return (all_prs, catMaybes ds_rules, ds_fords, ds_hpc_info) + ; dbgSites_var <- getBkptSitesDs + ; dbgSites <- ioToIOEnv$ readIORef dbgSites_var + ; return (all_prs, catMaybes ds_rules, ds_fords, ds_hpc_info, dbgSites) } ; case mb_res of { Nothing -> return Nothing ; - Just (all_prs, ds_rules, ds_fords,ds_hpc_info) -> do + Just (all_prs, ds_rules, ds_fords,ds_hpc_info, dbgSites) -> do { -- Add export flags to bindings keep_alive <- readIORef keep_var @@ -167,7 +172,8 @@ deSugar hsc_env mg_rules = ds_rules, mg_binds = ds_binds, mg_foreign = ds_fords, - mg_hpc_info = ds_hpc_info } + mg_hpc_info = ds_hpc_info, + mg_dbg_sites = dbgSites } ; return (Just mod_guts) }}}