Skip to content

Commit

Permalink
Run simplifier before generating ByteCode (haskell/ghcide#410)
Browse files Browse the repository at this point in the history
Running the simplifier is necessary to do things like inline data
constructor wrappers.

Fixes haskell/ghcide#256 and haskell/ghcide#393
  • Loading branch information
mpickering authored Feb 12, 2020
1 parent 31b9cfd commit 815923d
Show file tree
Hide file tree
Showing 2 changed files with 30 additions and 3 deletions.
12 changes: 9 additions & 3 deletions ghcide/src/Development/IDE/Core/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,9 +47,10 @@ import qualified GHC
import GhcMonad
import GhcPlugins as GHC hiding (fst3, (<>))
import qualified HeaderInfo as Hdr
import HscMain (hscInteractive)
import HscMain (hscInteractive, hscSimplify)
import MkIface
import StringBuffer as SB
import TcRnMonad (tcg_th_coreplugins)
import TidyPgm

import Control.Monad.Extra
Expand Down Expand Up @@ -148,9 +149,14 @@ compileModule packageState deps tmr =
let pm' = pm{pm_mod_summary = tweak $ pm_mod_summary pm}
let tm' = tm{tm_parsed_module = pm'}
GHC.dm_core_module <$> GHC.desugarModule tm'

let tc_result = fst (tm_internals_ (tmrModule tmr))
-- Have to call the simplifier on the code even if we are at
-- -O0 as otherwise the code generation fails which leads to
-- errors like #256
plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result)
desugared_guts <- liftIO $ hscSimplify session plugins desugar
-- give variables unique OccNames
(guts, details) <- liftIO $ tidyProgram session desugar
(guts, details) <- liftIO $ tidyProgram session desugared_guts
return (map snd warnings, (mg_safe_haskell desugar, guts, details))

generateByteCode :: HscEnv -> [TcModuleResult] -> TcModuleResult -> CgGuts -> IO (IdeResult Linkable)
Expand Down
21 changes: 21 additions & 0 deletions ghcide/test/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1374,6 +1374,27 @@ thTests =
_ <- openDoc' "A.hs" "haskell" sourceA
_ <- openDoc' "B.hs" "haskell" sourceB
expectDiagnostics [ ( "B.hs", [(DsError, (6, 29), "Variable not in scope: n")] ) ]
, testSessionWait "newtype-closure" $ do
let sourceA =
T.unlines
[ "{-# LANGUAGE DeriveDataTypeable #-}"
,"{-# LANGUAGE TemplateHaskell #-}"
,"module A (a) where"
,"import Data.Data"
,"import Language.Haskell.TH"
,"newtype A = A () deriving (Data)"
,"a :: ExpQ"
,"a = [| 0 |]"]
let sourceB =
T.unlines
[ "{-# LANGUAGE TemplateHaskell #-}"
,"module B where"
,"import A"
,"b :: Int"
,"b = $( a )" ]
_ <- openDoc' "A.hs" "haskell" sourceA
_ <- openDoc' "B.hs" "haskell" sourceB
return ()
]

completionTests :: TestTree
Expand Down

0 comments on commit 815923d

Please sign in to comment.