| ... |
... |
@@ -1975,12 +1975,10 @@ generateMainBinding tcg_env main_name = do |
|
1975
|
1975
|
main_expr_rn = L (noAnnSrcSpan loc) (mkHsVar (L (noAnnSrcSpan loc) main_name))
|
|
1976
|
1976
|
-- Solve the constraints arising from checking `main` before deciding how
|
|
1977
|
1977
|
-- to handle its result.
|
|
1978
|
|
- -- ; ((ev_binds, main_expr), main_wanteds) <- captureTopConstraints $
|
|
1979
|
|
- -- setMainCtxt main_name io_ty $ tcCheckMonoExpr main_expr_rn io_ty
|
|
1980
|
|
- -- ; main_ev_binds <- simplifyTop main_wanteds
|
|
1981
|
|
- -- ; main_action <- handleMainReturn main_name res_ty ev_binds main_expr
|
|
1982
|
|
- ; (ev_binds, main_expr) <- setMainCtxt main_name io_ty $
|
|
1983
|
|
- tcCheckMonoExpr main_expr_rn io_ty
|
|
|
1978
|
+ ; ((ev_binds, main_expr), main_wanteds) <- captureTopConstraints $
|
|
|
1979
|
+ setMainCtxt main_name io_ty $ tcCheckMonoExpr main_expr_rn io_ty
|
|
|
1980
|
+ ; main_ev_binds <- simplifyTop main_wanteds
|
|
|
1981
|
+ ; main_action <- handleMainReturn main_name res_ty ev_binds main_expr
|
|
1984
|
1982
|
|
|
1985
|
1983
|
-- See Note [Root-main Id]
|
|
1986
|
1984
|
-- Construct the binding
|
| ... |
... |
@@ -1995,9 +1993,7 @@ generateMainBinding tcg_env main_name = do |
|
1995
|
1993
|
-- type errors when type of `main` is not `IO a`. The `ev_binds`
|
|
1996
|
1994
|
-- must be put inside `runMainIO` to ensure the deferred type
|
|
1997
|
1995
|
-- error can be emitted correctly. See #13838.
|
|
1998
|
|
- -- ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_action
|
|
1999
|
|
- ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) $
|
|
2000
|
|
- mkHsDictLet ev_binds main_expr
|
|
|
1996
|
+ ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_action
|
|
2001
|
1997
|
; main_bind = mkVarBind root_main_id rhs }
|
|
2002
|
1998
|
|
|
2003
|
1999
|
; return (tcg_env { tcg_main = Just main_name
|
| ... |
... |
@@ -2007,12 +2003,9 @@ generateMainBinding tcg_env main_name = do |
|
2007
|
2003
|
`plusDU` usesOnly (unitFN main_name) }
|
|
2008
|
2004
|
-- Record the use of 'main', so that we don't
|
|
2009
|
2005
|
-- complain about it being defined but not used
|
|
2010
|
|
- -- `addEvBinds` main_ev_binds)
|
|
2011
|
|
- )
|
|
|
2006
|
+ `addEvBinds` main_ev_binds)
|
|
2012
|
2007
|
}
|
|
2013
|
2008
|
|
|
2014
|
|
-{-
|
|
2015
|
|
-
|
|
2016
|
2009
|
-- Implement GHC proposal #631
|
|
2017
|
2010
|
-- (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0631-main-return-types.rst).
|
|
2018
|
2011
|
--
|
| ... |
... |
@@ -2048,7 +2041,10 @@ generateMainBinding tcg_env main_name = do |
|
2048
|
2041
|
-- An amendment to the original proposal to this effect has been submitted at
|
|
2049
|
2042
|
-- https://github.com/ghc-proposals/ghc-proposals/pull/771.
|
|
2050
|
2043
|
handleMainReturn :: Name -> TcType -> TcEvBinds -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
|
|
2051
|
|
-handleMainReturn main_name res_ty ev_binds main_expr = do
|
|
|
2044
|
+handleMainReturn _main_name _res_ty ev_binds main_expr = do
|
|
|
2045
|
+ pure (mkHsDictLet ev_binds main_expr)
|
|
|
2046
|
+
|
|
|
2047
|
+{-
|
|
2052
|
2048
|
meaningful_main <- xoptM LangExt.MeaningfulMainReturn
|
|
2053
|
2049
|
void_ty <- mkTyConTy <$> tcLookupKnownOccTyCon voidTyConOcc
|
|
2054
|
2050
|
exit_code_ty <- mkTyConTy <$> tcLookupKnownOccTyCon exitCodeTyConOcc
|