Using GHC API

[C.M.Brown]

Hi,

I am currently in the process of porting some of the Haskell
Refactorer (HaRe) over to ghc 6.6. Part of HaRe requires the API and until
now I've been content with using th 6.5 API. However, since I've started
the switch I've noticed some strange problems and the latest is I am
getting the following error when trying to find the type of an expression:


<interactive>:1:0:
    Can't find interface-file declaration for Main.main
      Probable cause: bug in .hi-boot file, or inconsistent .hi file
      Use -ddump-if-trace to get an idea of which file caused the error


I have attached the code and would appreciate if someone could point me in
the right direction. Basically I just want to find the type of a
particular expression within a file. This used to work but now seems to
fail.

The code is compiled with:

ghc --make -package ghc-6.6 -o main hasktags.hs

and run with

./main Main.hs

The file main can have anything in it really - I'm just using it to find a
type of some function called main.

Thanks for you help!

Chris Brown.
-------------- next part --------------
module Main where

import System
import Control.Exception
import System.IO.Unsafe
import System.IO
import List

-- Package GHC stuff
import GHC
import DynFlags
import ErrUtils
import PackageConfig
import HsSyn
import Outputable
import SrcLoc
import RdrName
import Name 


main :: IO ()
main = do
  args <- getArgs
  realMain args

realMain :: [String] -> IO ()
realMain [] =
  do
    putErrStrLn "Usage: ghctest files"
realMain args =
  defaultErrorHandler defaultDynFlags $ do
    ses     <- GHC.newSession JustTypecheck (Just "/usr/local/packages/ghc-6.6/lib")
    dflags0  <- GHC.getSessionDynFlags ses
    (dflags1,fileish_args) <- GHC.parseDynamicFlags dflags0 []
    GHC.setSessionDynFlags ses $ dflags1 {verbosity = 1}
    targets <- mapM (\a -> GHC.guessTarget a Nothing ) args
    mapM_ (GHC.addTarget ses) targets
    
    dep <- depanal ses [(mkModuleName "Main")] True
    
    res <- GHC.load ses LoadAllTargets
    case res of
      Failed ->
        do
          putErrStrLn "Load failed."
      Succeeded -> 
        do
          putErrStrLn "Load succeded."
          checked <- GHC.checkModule ses (mkModuleName "Main")
          case checked of
            Nothing   -> putErrStrLn "Failed to check module."
            Just _ ->
              do
                putErrStrLn "Checked module."
                -- Get the complete module graph
                modGraph <- getModuleGraph ses
                taglist <- sequence $ map
                  (\modSum ->
                    do
                      Just cmod <- GHC.checkModule ses (moduleName $ ms_mod modSum)
                     
                      let Just ps = typecheckedSource cmod
                      putErrStrLn "Renamed source: "
                      putErrStrLn $ showSDoc $ ppr ps

                      
                      putErrStrLn "Names: "
                      ty <- exprType ses "Main.main"
                      putStrLn $ showSDoc $ ppr ty 

                  ) modGraph
                  
                  
                  
                
                {- 
                alltags <- return $ concat taglist
                sequence_ $ map (putStrLn . show) $ sort alltags
                -}
                putStrLn "Done."


bindLN :: HsBind a -> Maybe (Located a)
bindLN (FunBind ln _ _ _ _) = Just ln
bindLN _ = Nothing

debugLog :: String -> b -> b
debugLog msg b =
  unsafePerformIO (
    do
      putErrStrLn msg
      return b
    )

logAndDump :: (Outputable a) => String -> a -> b -> b
logAndDump msg a b =
  unsafePerformIO (
    do
      putErrStrLn msg
      putErrStrLn $ showSDoc (ppr a)
      return b
    )

tidyFileName :: String -> String
tidyFileName ('.':'/':str) = str
tidyFileName str           = str

data Tag = Tag TagName TagFile TagLine TagDesc
  deriving (Eq)

instance Ord Tag where
  compare (Tag t1 _ _ _) (Tag t2 _ _ _) = compare t1 t2

instance Show Tag where
  show (Tag t f l d) = makeTagsLine t f l d

type TagName = String
type TagFile = String
type TagLine = Int
type TagDesc = String

makeTagsLine :: String -> String -> Int -> String -> String
makeTagsLine tag file line desc = tag `sep` file `sep` (show line) `sep` ";\t\"" ++ desc ++ "\""
  where a `sep` b = a ++ '\t':b


putErrStrLn = hPutStrLn stderr
putErrStr = hPutStr stderr