projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
b93b2b5
)
pass Var.Var for hetmet brak/esc to -fcoqpass code
author
Adam Megacz
<adam@megacz.com>
Sat, 19 Mar 2011 19:48:55 +0000
(12:48 -0700)
committer
Adam Megacz
<adam@megacz.com>
Sat, 19 Mar 2011 19:48:55 +0000
(12:48 -0700)
compiler/deSugar/Desugar.lhs
patch
|
blob
|
history
diff --git
a/compiler/deSugar/Desugar.lhs
b/compiler/deSugar/Desugar.lhs
index
cbf64e2
..
5fb4ebb
100644
(file)
--- a/
compiler/deSugar/Desugar.lhs
+++ b/
compiler/deSugar/Desugar.lhs
@@
-41,6
+41,8
@@
import MonadUtils
import OrdList
import Data.List
import Data.IORef
import OrdList
import Data.List
import Data.IORef
+import PrelNames
+import UniqSupply
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-90,7
+92,7
@@
deSugar hsc_env
<- case target of
HscNothing ->
return (emptyMessages,
<- 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
_ -> 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
; (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
; 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) ;
; 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
{ -- 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
; 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')
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_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,
mg_foreign = ds_fords,
mg_hpc_info = ds_hpc_info,
mg_modBreaks = modBreaks,