projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add a compileToCore function to the GHC API
[ghc-hetmet.git]
/
compiler
/
main
/
HscMain.lhs
diff --git
a/compiler/main/HscMain.lhs
b/compiler/main/HscMain.lhs
index
4da5943
..
282ec0f
100644
(file)
--- a/
compiler/main/HscMain.lhs
+++ b/
compiler/main/HscMain.lhs
@@
-682,9
+682,14
@@
hscFileCheck hsc_env mod_summary = do {
md_insts = tcg_insts tc_result,
md_fam_insts = tcg_fam_insts tc_result,
md_modBreaks = emptyModBreaks,
md_insts = tcg_insts tc_result,
md_fam_insts = tcg_fam_insts tc_result,
md_modBreaks = emptyModBreaks,
- md_rules = [panic "no rules"] }
+ md_rules = [panic "no rules"],
-- Rules are CoreRules, not the
-- RuleDecls we get out of the typechecker
-- Rules are CoreRules, not the
-- RuleDecls we get out of the typechecker
+ md_vect_info =
+ panic "HscMain.hscFileCheck: no VectInfo"
+ -- VectInfo is added by the Core
+ -- vectorisation pass
+ }
rnInfo = do decl <- tcg_rn_decls tc_result
imports <- tcg_rn_imports tc_result
let exports = tcg_rn_exports tc_result
rnInfo = do decl <- tcg_rn_decls tc_result
imports <- tcg_rn_imports tc_result
let exports = tcg_rn_exports tc_result
@@
-797,7
+802,7
@@
A naked expression returns a singleton Name [it].
hscStmt -- Compile a stmt all the way to an HValue, but don't run it
:: HscEnv
-> String -- The statement
hscStmt -- Compile a stmt all the way to an HValue, but don't run it
:: HscEnv
-> String -- The statement
- -> IO (Maybe (InteractiveContext, [Name], HValue))
+ -> IO (Maybe ([Id], HValue))
hscStmt hsc_env stmt
= do { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt
hscStmt hsc_env stmt
= do { maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt
@@
-812,12
+817,11
@@
hscStmt hsc_env stmt
; case maybe_tc_result of {
Nothing -> return Nothing ;
; case maybe_tc_result of {
Nothing -> return Nothing ;
- Just (new_ic, bound_names, tc_expr) -> do {
-
+ Just (ids, tc_expr) -> do {
-- Desugar it
-- Desugar it
- ; let rdr_env = ic_rn_gbl_env new_ic
- type_env = ic_type_env new_ic
+ ; let rdr_env = ic_rn_gbl_env icontext
+ type_env = mkTypeEnv (map AnId (ic_tmp_ids icontext))
; mb_ds_expr <- deSugarExpr hsc_env iNTERACTIVE rdr_env type_env tc_expr
; case mb_ds_expr of {
; mb_ds_expr <- deSugarExpr hsc_env iNTERACTIVE rdr_env type_env tc_expr
; case mb_ds_expr of {
@@
-828,7
+832,7
@@
hscStmt hsc_env stmt
; let src_span = srcLocSpan interactiveSrcLoc
; hval <- compileExpr hsc_env src_span ds_expr
; let src_span = srcLocSpan interactiveSrcLoc
; hval <- compileExpr hsc_env src_span ds_expr
- ; return (Just (new_ic, bound_names, hval))
+ ; return (Just (ids, hval))
}}}}}}}
hscTcExpr -- Typecheck an expression (but don't run it)
}}}}}}}
hscTcExpr -- Typecheck an expression (but don't run it)