[Haskell-cafe] GHC Api typechecking

Phyx lonetiger at gmail.com
Sun Apr 18 13:55:19 EDT 2010


Ah, That's a shame :( I guess for now I'll just write the buffer out to disc
first and switch it later on if the feature gets added.

Thanks,
Phyx

-----Original Message-----
From: Thomas Schilling [mailto:nominolo at googlemail.com] 
Sent: Sunday, April 18, 2010 18:21
To: Phyx
Cc: Gwern Branwen; haskell-cafe at haskell.org
Subject: Re: [Haskell-cafe] GHC Api typechecking

Looking at the code for GHC, it turns out that your use case is not
supported.  It is not allowed to have in-memory-only files.  If you specify
a buffer it will still try to find the module file on the disk, but it will
(or at least should) use the contents from the specified string buffer.

I've been thinking about changing the Finder (the part that maps module
names to source files and .hi files) to use a notion of a virtual file.
This way, the API client could define how and where data is stored.

On 18 April 2010 11:01, Phyx <lonetiger at gmail.com> wrote:
> Hi,
>
> I checked out how Hint is doing it, but unfortunately they're calling 
> a function in the GHC api's interactive part to typecheck a single
statement, much like :t in ghci, So I can't use it to typecheck whole
modules.
> I've tried working around not being able to construct a TargetId but ran
into another wall.
> I can't find anyway to do dependency analysis on the in-memory target, so
the dependency graph would be empty which is ofcourse a big problem.
>
> Does anyone know if Leksah uses the GHC api for typechecking? And if it
only gives type errors after you save a file?
>
> The code I've been trying is
>
> typeCheckStringOnly :: String -> IO (ApiResults Bool) 
> typeCheckStringOnly contents = handleSourceError processErrors $
>  runGhc (Just libdir) $ do
>    buffer <- liftIO $ stringToStringBuffer contents
>    clock  <- liftIO getClockTime
>    dflags <- getSessionDynFlags
>    setSessionDynFlags dflags
>    let srcLoc   = mkSrcLoc (mkFastString "internal:string") 1 1
>        dynFlag  = defaultDynFlags
>        state    = mkPState buffer srcLoc dynFlag
>        parsed   = unP Parser.parseModule state
>        pkgId    = stringToPackageId "internal"
>        name     = mkModuleName "Unknown"
>        mod'     = mkModule pkgId name
>        location = ModLocation Nothing "" ""
>        summary  = ModSummary mod' HsSrcFile location clock Nothing [] 
> [] "" dynFlag Nothing
>    (\a->setSession $ a { hsc_mod_graph = [summary] }) =<< getSession
>    case parsed of
>       PFailed _ _        -> return $ ApiOk False
>       POk newstate mdata -> do let module' = ParsedModule summary 
> mdata
>                                check <- typecheckModule module'
>                                return $ ApiOk True
>
> this fails with a ghc panic
>
> : panic! (the 'impossible' happened)
>  (GHC version 6.12.1 for i386-unknown-mingw32):
>        no package state yet: call GHC.setSessionDynFlags
>
> Please report this as a GHC bug:  
> http://www.haskell.org/ghc/reportabug
>
> :(
>
> Cheers,
> Phyx
>
> -----Original Message-----
> From: Gwern Branwen [mailto:gwern0 at gmail.com]
> Sent: Saturday, April 17, 2010 20:59
> To: Phyx
> Subject: Re: [Haskell-cafe] GHC Api typechecking
>
> On Sat, Apr 17, 2010 at 1:49 PM, Phyx <lonetiger at gmail.com> wrote:
>> Hi all, I was wondering if someone knows how to do the following:
>>
>>
>>
>> I’m looking to typecheck a string using the GHC Api, where I run into 
>> problems is that I need to construct a Target, but the TargetId only 
>> seem to reference physical files.
>>
>>
>>
>> Ofcourse I can write the string to a file and typecheck that file, 
>> but I would like to do it all in memory and avoid IO if possible.
>>
>>
>>
>> Does anyone know if this is possible?
>>
>>
>>
>> For the record I’m trying to create the target as follows
>>
>>
>>
>> createTarget :: String -> IO Target
>>
>> createTarget content =
>>
>>  do clock  <- getClockTime
>>
>>     buffer <- stringToStringBuffer content
>>
>>     return $ Target { targetId           = TargetModule (mkModuleName
>> "string:internal") ß problem
>>
>>                     , targetAllowObjCode = True
>>
>>                     , targetContents     = Just (buffer,clock)
>>
>>                     }
>>
>>
>>
>> typeCheckStringOnly :: String -> IO (ApiResults Bool)
>>
>> typeCheckStringOnly contents = handleSourceError processErrors $
>>
>> runGhc (Just libdir) $ do
>>
>>     dflags <- getSessionDynFlags
>>
>>     setSessionDynFlags dflags
>>
>>     target <- liftIO $ createTarget contents
>>
>>     addTarget target
>>
>>     load LoadAllTargets
>>
>>     let modName = mkModuleName "string:internal" ß problem again, 
>> don’t know how to create the dependency graph then.
>>
>>     graph <- depanal [modName] True
>>
>>     (\a->setSession $ a { hsc_mod_graph = graph }) =<< getSession
>>
>>     value <- fmap typecheckedSource (typeCheck modName)
>>
>>     return $ ApiOk True
>>
>>
>>
>> Cheers,
>>
>> Phyx
>
> Have you looked at how the Hint package does things?
>
> --
> gwern
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>



--
Push the envelope.  Watch it bend.



More information about the Haskell-Cafe mailing list