pass Var.Var for hetmet brak/esc to -fcoqpass code
authorAdam Megacz <adam@megacz.com>
Sat, 19 Mar 2011 19:48:55 +0000 (12:48 -0700)
committerAdam Megacz <adam@megacz.com>
Sat, 19 Mar 2011 19:48:55 +0000 (12:48 -0700)
compiler/deSugar/Desugar.lhs

index cbf64e2..5fb4ebb 100644 (file)
@@ -41,6 +41,8 @@ import MonadUtils
 import OrdList
 import Data.List
 import Data.IORef
+import PrelNames
+import UniqSupply
 \end{code}
 
 %************************************************************************
@@ -90,7 +92,7 @@ deSugar hsc_env
               <- case target of
                   HscNothing ->
                        return (emptyMessages,
-                               Just ([], nilOL, [], [], NoStubs, hpcInfo, emptyModBreaks))
+                               Just ([], nilOL, [], [], NoStubs, hpcInfo, emptyModBreaks, undefined, undefined))
                    _        -> do
                      (binds_cvr,ds_hpc_info, modBreaks)
                         <- if (opt_Hpc
@@ -106,14 +108,16 @@ deSugar hsc_env
                           ; (ds_fords, foreign_prs) <- dsForeigns fords
                           ; ds_rules <- mapMaybeM dsRule rules
                           ; ds_vects <- mapM dsVect vects
+                          ; hetmet_brak <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_brak_name else return undefined
+                          ; hetmet_esc  <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_esc_name  else return undefined
                           ; return ( ds_ev_binds
                                    , foreign_prs `appOL` core_prs `appOL` spec_prs
                                    , spec_rules ++ ds_rules, ds_vects
-                                   , ds_fords, ds_hpc_info, modBreaks) }
+                                   , ds_fords, ds_hpc_info, modBreaks, hetmet_brak, hetmet_esc) }
 
         ; case mb_res of {
            Nothing -> return (msgs, Nothing) ;
-           Just (ds_ev_binds, all_prs, all_rules, ds_vects, ds_fords,ds_hpc_info, modBreaks) -> do
+           Just (ds_ev_binds, all_prs, all_rules, ds_vects, ds_fords,ds_hpc_info, modBreaks, hetmet_brak, hetmet_esc) -> do
 
        {       -- Add export flags to bindings
          keep_alive <- readIORef keep_var
@@ -141,7 +145,9 @@ deSugar hsc_env
         ; dumpIfSet_dyn dflags Opt_D_coqpass "Coq Pass Output" $ text $ coqPassCoreToString ds_binds
 
         ; ds_binds' <- if dopt Opt_F_coqpass dflags
-                       then return $ coqPassCoreToCore ds_binds
+                       then do { us <- mkSplitUniqSupply '~'
+                               ; return $ coqPassCoreToCore hetmet_brak hetmet_esc us ds_binds
+                               }
                        else return ds_binds
 
         ; dumpIfSet_dyn dflags Opt_D_dump_coqpass "After Coq Pass" (text $ showSDoc $ pprCoreBindings ds_binds')
@@ -168,7 +174,7 @@ deSugar hsc_env
                mg_inst_env     = inst_env,
                mg_fam_inst_env = fam_inst_env,
                mg_rules        = ds_rules_for_imps,
-               mg_binds        = ds_binds,
+               mg_binds        = ds_binds',
                mg_foreign      = ds_fords,
                mg_hpc_info     = ds_hpc_info,
                 mg_modBreaks    = modBreaks,