<div dir="ltr"><div>Thanks you Daniel, that explains the mystery of the in-memory buffer.</div><div><br></div><div>With regards to findModule / lookupModule, it seems that the semantics have not changed. This is perhaps an artefact of the previous issue: i.e. the lookupModule was likely loading the disk version (not the in-memory) version of a file.</div><div><br></div><div>If I discover anything else, I will create a new thread. I will also let the group know when I cut a release, because this has been very helpful and I would like to get a wider audience looking at the code to give me recommendations for improvements (and especially to avoid reinventing the wheel of what is already inside ghc).</div><div><br></div><div><br></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Thu, 27 Feb 2020 at 23:21, Daniel Gröber <<a href="mailto:dxld@darkboxed.org">dxld@darkboxed.org</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">Hi,<br>
<br>
On Thu, Feb 27, 2020 at 08:37:12PM +0000, Tseen She wrote:<br>
>       setTargets [Target (TargetFile "Main.hs" (Just $ Hsc HsSrcFile))<br>
> False (Just (stringToStringBuffer buffer, t))]<br>
><br>
> i.e. an explicit phase.<br>
><br>
> I will just use Nothing in my TargetFile. Was this an intended change?<br>
<br>
I found the reason for the change, my commit 0f9ec9d1ff ("Allow using<br>
tagetContents for modules needing preprocessing") removes the special<br>
casing in `preprocessFile` for in-memory buffers:<br>
<br>
    -preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))<br>
    -  = do<br>
    -        let dflags = hsc_dflags hsc_env<br>
    -        let local_opts = getOptions dflags buf src_fn<br>
    -<br>
    -        (dflags', leftovers, warns)<br>
    -            <- parseDynamicFilePragma dflags local_opts<br>
<br>
It used to do a `parseDynamicFilePragma` which parses the LANGUAGE and<br>
OPTIONS pragmas.<br>
<br>
I think this change is actually for the better though, as this dflags<br>
modification does not occur with a regular file, so we're actually being<br>
more consistent.<br>
<br>
I just tested this out and when setting the phase but not passing a buffer<br>
8.6 will also fail to get the pragma in the ModSummary. When not giving an<br>
explicit phase it works for 8.6, 8.8, with and without in-memory buffers<br>
though. So I think that is the proper solution here, unless you can think<br>
of a reason running the rest of the pipeline is a problem in this case?<br>
<br>
On Thu, Feb 27, 2020 at 08:49:43PM +0000, Tseen She wrote:<br>
> It is, however, a shame that lookupModule seems to require the entire file<br>
> to parse / typecheck. That also smells like a regression, but not one that<br>
> impacts me anymore.<br>
<br>
I would still like to reproduce your problem but I'm again not sure how<br>
you're triggering it, this is what I have so far:<br>
<br>
    -- $ ghc -package ghc -package ghc-paths FindModule.hs<br>
    module Main where<br>
<br>
    import GHC<br>
    import GHC.Paths (libdir)<br>
    import MonadUtils<br>
    import DynFlags<br>
    import Module<br>
<br>
    main :: IO ()<br>
    main = do<br>
      defaultErrorHandler defaultFatalMessager defaultFlushOut $ do<br>
        runGhc (Just libdir) $ do<br>
          dflags0 <- getSessionDynFlags<br>
          (dflags1, _, _)<br>
              <- parseDynamicFlags dflags0 $ map noLoc ["-package", "base"]<br>
          _ <- setSessionDynFlags dflags1<br>
<br>
          setTargets [Target (TargetFile "Main.hs" Nothing) False Nothing]<br>
<br>
          _ <- load LoadAllTargets<br>
<br>
          m <- findModule (mkModuleName "Main") Nothing<br>
          liftIO $ print $ (unitIdFS (moduleUnitId m), moduleNameFS (moduleName m))<br>
<br>
Running it with 8.8 and 8.4 i get the same results:<br>
<br>
    $ ghc-$ver -package ghc -package ghc-paths FindModule.hs<br>
    $ echo 'main = return()' > Main.hs # a working file<br>
    $ ./FindModule<br>
    ("main","Main")<br>
<br>
    $ echo '=' > Main.hs  # a syntax error<br>
    $ ./FindModule<br>
    Main.hs:1:1: error:<br>
        parse error on input ‘=’<br>
        Perhaps you need a 'let' in a 'do' block?<br>
        e.g. 'let x = 5' instead of 'x = 5'<br>
      |<br>
    1 | =<br>
      | ^<br>
    <command line>: module is not loaded: ‘Main’ (Main.hs)<br>
<br>
so this seems to be consistent?<br>
<br>
--Daniel<br>
</blockquote></div>