Fri Sep 15 19:50:33 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* initial, very incomplete tags generator
The ultimate goal is to replace hasktags with
a tags generator based on GHC-as-a-library.
This file is a very incomplete first cut.
Sat Sep 16 19:27:55 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* cover more cases; take GHC options on command line
Bit of a dog's breakfast here:
* generate tags for more cases in the syntax
* accept -package ghc and other args on command line
* scrub away old code for snaffling thru text
Sat Sep 16 20:23:53 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* tell GHC not to generate code (thanks Simon M)
Sat Sep 16 20:24:30 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* load all files at once and compute tags for all
Sat Sep 16 20:34:10 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* do notation for the Maybe monad
Sat Sep 16 21:15:29 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* desperate attempts to handle the GHC build
What's happening here is a series of attempts to successfully swallow
what the GHC build process chooses to throw at the tool. I'm clearly
out of my depth and so will revert to trying one module at a time.
Sat Sep 16 21:54:51 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* if the whole group fails, try one file at a time
Sat Sep 16 21:55:39 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* get names of data constructors
Sun Sep 17 01:08:00 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* change representation of FoundThing
refactored FoundThing to use GHC's native representation of
source-code locations and to carry the module name so that the TAGS
file can contain a qualified name as well as the unqualified name
Sun Sep 17 01:30:46 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* refactoring for more readable source code
Wed Sep 20 00:26:07 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* working 'ghctags' Makefile target (requires stage=2)
Wed Sep 20 00:27:57 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* first cut at missing case for ids defined in pattern
Wed Sep 20 00:28:39 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* proper HC entry for bootstrapping in Makefile
Wed Sep 20 00:29:13 EDT 2006 Norman Ramsey <[EMAIL PROTECTED]>
* correct minor spelling error s/patterng/pattern/
Fri Oct 13 16:27:56 EDT 2006 [EMAIL PROTECTED]
* new README file for utils/ghctags
Fri Oct 13 16:28:25 EDT 2006 [EMAIL PROTECTED]
* accomodate changes in the GHC API
Fri Oct 13 16:29:22 EDT 2006 [EMAIL PROTECTED]
* request for documentation of a new argument
New patches:
[initial, very incomplete tags generator
Norman Ramsey <[EMAIL PROTECTED]>**20060915235033
The ultimate goal is to replace hasktags with
a tags generator based on GHC-as-a-library.
This file is a very incomplete first cut.
] {
adddir ./utils/ghctags
addfile ./utils/ghctags/GhcTags.hs
hunk ./utils/ghctags/GhcTags.hs 1
+module Main where
+import Bag
+import Char
+import DynFlags(GhcMode, defaultDynFlags)
+import FastString
+import GHC
+import HscTypes (msHsFilePath)
+import List
+import IO
+import Name
+import Outputable
+import SrcLoc
+import System.Environment
+import System.Console.GetOpt
+import System.Exit
+
+
+-- search for definitions of things
+-- we do this by parsing the source and grabbing top-level definitions
+
+-- We generate both CTAGS and ETAGS format tags files
+-- The former is for use in most sensible editors, while EMACS uses ETAGS
+
+{-
+placateGhc :: IO ()
+placateGhc = defaultErrorHandler defaultDynFlags $ do
+ GHC.init (Just "/usr/local/lib/ghc-6.5") -- or your build tree!
+ s <- newSession mode
+-}
+
+main :: IO ()
+main = do
+ progName <- getProgName
+ args <- getArgs
+ let usageString = "Usage: " ++ progName ++ " [OPTION...] [files...]"
+ let (modes, filenames, errs) = getOpt Permute options args
+ if errs /= [] || elem Help modes || filenames == []
+ then do
+ putStr $ unlines errs
+ putStr $ usageInfo usageString options
+ exitWith (ExitFailure 1)
+ else return ()
+ let mode = getMode (Append `delete` modes)
+ let openFileMode = if elem Append modes
+ then AppendMode
+ else WriteMode
+ GHC.init (Just "/usr/local/lib/ghc-6.5")
+ GHC.defaultErrorHandler defaultDynFlags $ do
+ session <- newSession JustTypecheck
+ print "created a session"
+ flags <- getSessionDynFlags session
+ (flags, _) <- parseDynamicFlags flags ["-package", "ghc"]
+ GHC.defaultCleanupHandler flags $ do
+ flags <- initPackages flags
+ setSessionDynFlags session flags
+ filedata <- mapM (findthings session) filenames
+ if mode == BothTags || mode == CTags
+ then do
+ ctagsfile <- openFile "tags" openFileMode
+ writectagsfile ctagsfile filedata
+ hClose ctagsfile
+ else return ()
+ if mode == BothTags || mode == ETags
+ then do
+ etagsfile <- openFile "TAGS" openFileMode
+ writeetagsfile etagsfile filedata
+ hClose etagsfile
+ else return ()
+
+-- | getMode takes a list of modes and extract the mode with the
+-- highest precedence. These are as follows: Both, CTags, ETags
+-- The default case is Both.
+getMode :: [Mode] -> Mode
+getMode [] = BothTags
+getMode [x] = x
+getMode (x:xs) = max x (getMode xs)
+
+
+data Mode = ETags | CTags | BothTags | Append | Help deriving (Ord, Eq, Show)
+
+options :: [OptDescr Mode]
+options = [ Option "c" ["ctags"]
+ (NoArg CTags) "generate CTAGS file (ctags)"
+ , Option "e" ["etags"]
+ (NoArg ETags) "generate ETAGS file (etags)"
+ , Option "b" ["both"]
+ (NoArg BothTags) ("generate both CTAGS and ETAGS")
+ , Option "a" ["append"]
+ (NoArg Append) ("append to existing CTAGS and/or ETAGS file(s)")
+ , Option "h" ["help"] (NoArg Help) "This help"
+ ]
+
+type FileName = String
+
+type ThingName = String
+
+-- The position of a token or definition
+data Pos = Pos
+ FileName -- file name
+ Int -- line number
+ Int -- token number
+ String -- string that makes up that line
+ deriving Show
+
+srcLocToPos :: SrcLoc -> Pos
+srcLocToPos loc =
+ Pos (unpackFS $ srcLocFile loc) (srcLocLine loc) (srcLocCol loc) "bogus"
+
+-- A definition we have found
+data FoundThing = FoundThing ThingName Pos
+ deriving Show
+
+-- Data we have obtained from a file
+data FileData = FileData FileName [FoundThing]
+
+data Token = Token String Pos
+ deriving Show
+
+
+-- stuff for dealing with ctags output format
+
+writectagsfile :: Handle -> [FileData] -> IO ()
+writectagsfile ctagsfile filedata = do
+ let things = concat $ map getfoundthings filedata
+ mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) things
+
+getfoundthings :: FileData -> [FoundThing]
+getfoundthings (FileData filename things) = things
+
+dumpthing :: FoundThing -> String
+dumpthing (FoundThing name (Pos filename line _ _)) =
+ name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)
+
+
+-- stuff for dealing with etags output format
+
+writeetagsfile :: Handle -> [FileData] -> IO ()
+writeetagsfile etagsfile filedata = do
+ mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata
+
+e_dumpfiledata :: FileData -> String
+e_dumpfiledata (FileData filename things) =
+ "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
+ where
+ thingsdump = concat $ map e_dumpthing things
+ thingslength = length thingsdump
+
+e_dumpthing :: FoundThing -> String
+e_dumpthing (FoundThing name (Pos filename line token fullline)) =
+ ---- (concat $ take (token + 1) $ spacedwords fullline)
+ name
+ ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
+
+
+-- like "words", but keeping the whitespace, and so letting us build
+-- accurate prefixes
+
+spacedwords :: String -> [String]
+spacedwords [] = []
+spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
+ where
+ (blanks,rest) = span Char.isSpace xs
+ (wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
+
+
+-- Find the definitions in a file
+
+modsummary :: ModuleGraph -> FileName -> Maybe ModSummary
+modsummary graph n =
+ List.find matches graph
+ where matches ms = n == msHsFilePath ms
+
+modname :: ModSummary -> ModuleName
+modname summary = moduleName $ ms_mod $ summary
+
+findthings :: Session -> FileName -> IO FileData
+findthings session filename = do
+ setTargets session [Target (TargetFile filename Nothing) Nothing]
+ print "set targets"
+ success <- load session LoadAllTargets --- bring module graph up to date
+ case success of
+ Failed -> do { print "load failed"; return emptyFileData }
+ Succeeded ->
+ do print "loaded all targets"
+ graph <- getModuleGraph session
+ print "got modules graph"
+ case modsummary graph filename of
+ Nothing -> panic "loaded a module from a file but then could not find its summary"
+ Just ms -> do
+ mod <- checkModule session (modname ms)
+ print "got the module"
+ case mod of
+ Nothing -> return emptyFileData
+ Just m -> case renamedSource m of
+ Nothing -> return emptyFileData
+ Just s -> return $ fileData filename s
+ where emptyFileData = FileData filename []
+
+
+fileData :: FileName -> RenamedSource -> FileData
+fileData filename (group, imports, lie) =
+ -- lie is related to type checking and so is irrelevant
+ -- imports contains import declarations and no definitions
+ FileData filename (boundValues group)
+
+boundValues :: HsGroup Name -> [FoundThing]
+boundValues group =
+ case hs_valds group of
+ ValBindsOut nest sigs ->
+ [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
+
+posOfLocated :: Located a -> Pos
+posOfLocated lHs = srcLocToPos $ srcSpanStart $ getLoc lHs
+
+boundThings :: LHsBind Name -> [FoundThing]
+boundThings lbinding =
+ let thing id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
+ in case unLoc lbinding of
+ FunBind { fun_id = id } -> [thing id]
+ PatBind { pat_lhs = lhs } -> patBoundIds lhs
+-- VarBind { var_id = id } -> [thing id]
+ _ -> []
+
+
+patBoundIds :: a -> b
+patBoundIds _ = panic "not on your life"
+
+-- actually pick up definitions
+
+findstuff :: [Token] -> [FoundThing]
+findstuff ((Token "data" _):(Token name pos):xs) =
+ FoundThing name pos : (getcons xs) ++ (findstuff xs)
+findstuff ((Token "newtype" _):(Token name pos):xs) =
+ FoundThing name pos : findstuff xs
+findstuff ((Token "type" _):(Token name pos):xs) =
+ FoundThing name pos : findstuff xs
+findstuff ((Token name pos):(Token "::" _):xs) =
+ FoundThing name pos : findstuff xs
+findstuff (x:xs) = findstuff xs
+findstuff [] = []
+
+
+-- get the constructor definitions, knowing that a datatype has just started
+
+getcons :: [Token] -> [FoundThing]
+getcons ((Token "=" _):(Token name pos):xs) =
+ FoundThing name pos : getcons2 xs
+getcons (x:xs) = getcons xs
+getcons [] = []
+
+
+getcons2 ((Token "=" _):xs) = []
+getcons2 ((Token "|" _):(Token name pos):xs) =
+ FoundThing name pos : getcons2 xs
+getcons2 (x:xs) = getcons2 xs
+getcons2 [] = []
+
addfile ./utils/ghctags/Makefile
hunk ./utils/ghctags/Makefile 1
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+
+HS_PROG = ghctags
+SRC_HC_OPTS += -package ghc
+HC=/usr/local/bin/ghc
+
+CLEAN_FILES += Main.hi
+
+INSTALL_PROGS += $(HS_PROG)
+
+include $(TOP)/mk/target.mk
+
}
[cover more cases; take GHC options on command line
Norman Ramsey <[EMAIL PROTECTED]>**20060916232755
Bit of a dog's breakfast here:
* generate tags for more cases in the syntax
* accept -package ghc and other args on command line
* scrub away old code for snaffling thru text
] {
hunk ./utils/ghctags/GhcTags.hs 34
+ let usageString =
+ "Usage: " ++ progName ++ " [OPTION...] [-- GHC OPTION... --] [files...]"
hunk ./utils/ghctags/GhcTags.hs 37
- let usageString = "Usage: " ++ progName ++ " [OPTION...] [files...]"
- let (modes, filenames, errs) = getOpt Permute options args
- if errs /= [] || elem Help modes || filenames == []
+ let (ghcArgs, ourArgs, unbalanced) = splitArgs args
+ let (modes, filenames, errs) = getOpt Permute options ourArgs
+ if unbalanced || errs /= [] || elem Help modes || filenames == []
hunk ./utils/ghctags/GhcTags.hs 54
- (flags, _) <- parseDynamicFlags flags ["-package", "ghc"]
+ (flags, _) <- parseDynamicFlags flags ghcArgs
hunk ./utils/ghctags/GhcTags.hs 81
+splitArgs :: [String] -> ([String], [String], Bool)
+-- pull out arguments between -- for GHC
+splitArgs args = split [] [] False args
+ where split ghc' tags' unbal ("--" : args) = split tags' ghc' (not unbal) args
+ split ghc' tags' unbal (arg : args) = split ghc' (arg:tags') unbal args
+ split ghc' tags' unbal [] = (reverse ghc', reverse tags', unbal)
+
hunk ./utils/ghctags/GhcTags.hs 217
- case hs_valds group of
- ValBindsOut nest sigs ->
- [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
+ let vals = case hs_valds group of
+ ValBindsOut nest sigs ->
+ [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
+ tys = concat $ map tyBound (hs_tyclds group)
+ where tyBound ltcd = case unLoc ltcd of
+ ForeignType { tcdLName = n } -> [foundOfLName n]
+ TyData { tcdLName = n } -> [foundOfLName n]
+ TySynonym { tcdLName = n } -> [foundOfLName n]
+ ClassDecl { tcdLName = n } -> [foundOfLName n]
+ fors = concat $ map forBound (hs_fords group)
+ where forBound lford = case unLoc lford of
+ ForeignImport n _ _ -> [foundOfLName n]
+ ForeignExport { } -> []
+ in vals ++ tys ++ fors
hunk ./utils/ghctags/GhcTags.hs 235
+foundOfLName :: Located Name -> FoundThing
+foundOfLName id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
+
hunk ./utils/ghctags/GhcTags.hs 240
- let thing id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
+ let thing = foundOfLName
hunk ./utils/ghctags/GhcTags.hs 243
- PatBind { pat_lhs = lhs } -> patBoundIds lhs
--- VarBind { var_id = id } -> [thing id]
- _ -> []
-
-
-patBoundIds :: a -> b
-patBoundIds _ = panic "not on your life"
-
--- actually pick up definitions
-
-findstuff :: [Token] -> [FoundThing]
-findstuff ((Token "data" _):(Token name pos):xs) =
- FoundThing name pos : (getcons xs) ++ (findstuff xs)
-findstuff ((Token "newtype" _):(Token name pos):xs) =
- FoundThing name pos : findstuff xs
-findstuff ((Token "type" _):(Token name pos):xs) =
- FoundThing name pos : findstuff xs
-findstuff ((Token name pos):(Token "::" _):xs) =
- FoundThing name pos : findstuff xs
-findstuff (x:xs) = findstuff xs
-findstuff [] = []
-
-
--- get the constructor definitions, knowing that a datatype has just started
-
-getcons :: [Token] -> [FoundThing]
-getcons ((Token "=" _):(Token name pos):xs) =
- FoundThing name pos : getcons2 xs
-getcons (x:xs) = getcons xs
-getcons [] = []
-
-
-getcons2 ((Token "=" _):xs) = []
-getcons2 ((Token "|" _):(Token name pos):xs) =
- FoundThing name pos : getcons2 xs
-getcons2 (x:xs) = getcons2 xs
-getcons2 [] = []
-
+ PatBind { pat_lhs = lhs } -> panic "Pattern at top level"
+ VarBind { var_id = id } -> [FoundThing (getOccString id) (posOfLocated lbinding)]
+ AbsBinds { } -> [] -- nothing interesting in a type abstraction
}
[tell GHC not to generate code (thanks Simon M)
Norman Ramsey <[EMAIL PROTECTED]>**20060917002353] {
hunk ./utils/ghctags/GhcTags.hs 54
- (flags, _) <- parseDynamicFlags flags ghcArgs
+ (pflags, _) <- parseDynamicFlags flags ghcArgs
+ let flags = pflags { hscTarget = HscNothing }
}
[load all files at once and compute tags for all
Norman Ramsey <[EMAIL PROTECTED]>**20060917002430] {
hunk ./utils/ghctags/GhcTags.hs 59
- filedata <- mapM (findthings session) filenames
+ setTargets session (map fileTarget filenames)
+ print "set targets"
+ success <- load session LoadAllTargets --- bring module graph up to date
+ filedata <- case success of
+ Failed -> do { putStr "Load failed"; exitWith (ExitFailure 2) }
+ Succeeded -> do
+ print "loaded all targets"
+ graph <- getModuleGraph session
+ print "got modules graph"
+ graphData session graph
hunk ./utils/ghctags/GhcTags.hs 195
-findthings :: Session -> FileName -> IO FileData
-findthings session filename = do
- setTargets session [Target (TargetFile filename Nothing) Nothing]
- print "set targets"
- success <- load session LoadAllTargets --- bring module graph up to date
- case success of
- Failed -> do { print "load failed"; return emptyFileData }
- Succeeded ->
- do print "loaded all targets"
- graph <- getModuleGraph session
- print "got modules graph"
- case modsummary graph filename of
- Nothing -> panic "loaded a module from a file but then could not find its summary"
- Just ms -> do
- mod <- checkModule session (modname ms)
- print "got the module"
- case mod of
- Nothing -> return emptyFileData
- Just m -> case renamedSource m of
- Nothing -> return emptyFileData
- Just s -> return $ fileData filename s
- where emptyFileData = FileData filename []
+fileTarget :: FileName -> Target
+fileTarget filename = Target (TargetFile filename Nothing) Nothing
+
+graphData :: Session -> ModuleGraph -> IO [FileData]
+graphData session graph =
+ mapM foundthings graph
+ where foundthings ms =
+ let filename = msHsFilePath ms
+ in do mod <- checkModule session (moduleName $ ms_mod ms)
+ return $ case mod of
+ Nothing -> FileData filename []
+ Just m -> case renamedSource m of
+ Nothing -> FileData filename []
+ Just s -> fileData filename s
}
[do notation for the Maybe monad
Norman Ramsey <[EMAIL PROTECTED]>**20060917003410] {
hunk ./utils/ghctags/GhcTags.hs 204
- return $ case mod of
- Nothing -> FileData filename []
- Just m -> case renamedSource m of
- Nothing -> FileData filename []
- Just s -> fileData filename s
-
+ return $ maybe (FileData filename []) id $ do
+ m <- mod
+ s <- renamedSource m
+ return $ fileData filename s
}
[desperate attempts to handle the GHC build
Norman Ramsey <[EMAIL PROTECTED]>**20060917011529
What's happening here is a series of attempts to successfully swallow
what the GHC build process chooses to throw at the tool. I'm clearly
out of my depth and so will revert to trying one module at a time.
] {
hunk ./compiler/Makefile 901
+WRONG_GHCTAGS_HS_SRCS = $(filter-out $(DERIVED_SRCS) main/Config.hs parser/Parser.y, $(sort $(SRCS)))
+# above is wrong because of the following problem:
+# module `main:DataCon' is defined in multiple files: basicTypes/DataCon.lhs
+# basicTypes/DataCon.lhs-boot
+
+GHCTAGS_HS_SRCS = $(HS_SRCS)
+
+#------------------------------------------------------------
+# Tags
+
+.PHONY: ghctags
+
+ghctags :: $(GHCTAGS_HS_SRCS) $(TAGS_C_SRCS)
+ @$(RM) TAGS
+ @touch TAGS
+ @echo SOURCES ARE "$(GHCTAGS_HS_SRCS)"
+ : ifneq "$(GHCTAGS_HS_SRCS)" ""
+ @echo TIME TO ROCK AND ROLL
+ $(GHCTAGS) -- $(MKDEPENDHS_OPTS) $(filter-out -split-objs, $(MKDEPENDHS_HC_OPTS)) -- $(GHCTAGS_HS_SRCS)
+ : endif
+ifneq "$(TAGS_C_SRCS)" ""
+ etags -a $(TAGS_C_SRCS)
+endif
+ @( DEREFFED=`ls -l Makefile | sed -e 's/.*-> \(.*\)/\1/g'` && $(RM) `dirname $$DEREFFED`/TAGS && $(CP) TAGS `dirname $$DEREFFED` ) 2>/dev/null || echo TAGS file generated, perhaps copy over to source tree?
hunk ./utils/ghctags/GhcTags.hs 4
+import DriverPhases ( isHaskellSrcFilename )
hunk ./utils/ghctags/GhcTags.hs 40
- if unbalanced || errs /= [] || elem Help modes || filenames == []
+ let (hsfiles, otherfiles) = List.partition isHaskellSrcFilename filenames
+ mapM_ (\n -> putStr $ "Warning: ignoring non-Haskellish file " ++ n ++ "\n")
+ otherfiles
+ if unbalanced || errs /= [] || elem Help modes || hsfiles == []
hunk ./utils/ghctags/GhcTags.hs 63
- setTargets session (map fileTarget filenames)
+ -- targets <- mapM (\s -> guessTarget s Nothing) hsfiles
+ -- guessTarget would be more compatible with ghc -M
+ let targets = map fileTarget hsfiles
+ setTargets session targets
hunk ./utils/ghctags/GhcTags.hs 70
- Failed -> do { putStr "Load failed"; exitWith (ExitFailure 2) }
+ Failed -> do putStr "Load failed\n"
+ exitWith (ExitFailure 2)
}
[if the whole group fails, try one file at a time
Norman Ramsey <[EMAIL PROTECTED]>**20060917015451] {
hunk ./utils/ghctags/GhcTags.hs 6
+import ErrUtils ( printBagOfErrors )
hunk ./utils/ghctags/GhcTags.hs 10
-import List
hunk ./utils/ghctags/GhcTags.hs 11
+import List
+import Maybe
hunk ./utils/ghctags/GhcTags.hs 19
+import Util ( handle, handleDyn )
hunk ./utils/ghctags/GhcTags.hs 28
-{-
-placateGhc :: IO ()
-placateGhc = defaultErrorHandler defaultDynFlags $ do
- GHC.init (Just "/usr/local/lib/ghc-6.5") -- or your build tree!
- s <- newSession mode
--}
-
hunk ./utils/ghctags/GhcTags.hs 61
- let targets = map fileTarget hsfiles
- setTargets session targets
- print "set targets"
- success <- load session LoadAllTargets --- bring module graph up to date
- filedata <- case success of
- Failed -> do putStr "Load failed\n"
- exitWith (ExitFailure 2)
- Succeeded -> do
- print "loaded all targets"
- graph <- getModuleGraph session
- print "got modules graph"
- graphData session graph
+ filedata <- targetsAtOneGo session hsfiles
+ filedata <- case filedata of
+ Just fd -> return fd
+ Nothing -> targetsOneAtATime session hsfiles
hunk ./utils/ghctags/GhcTags.hs 78
+safeLoad :: Session -> LoadHowMuch -> IO SuccessFlag
+safeLoad session mode = do
+ dflags <- getSessionDynFlags session
+ handle (\exception -> return Failed ) $
+ handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
+ return Failed) $ load session mode
+
+
+targetsAtOneGo :: Session -> [FileName] -> IO (Maybe [FileData])
+targetsAtOneGo session hsfiles = do
+ let targets = map fileTarget hsfiles
+ setTargets session targets
+ print $ targetInfo hsfiles
+ success <- safeLoad session LoadAllTargets --- bring module graph up to date
+ case success of
+ Failed -> return Nothing
+ Succeeded -> do
+ print "loaded all targets"
+ graph <- getModuleGraph session
+ print "got modules graph"
+ fd <- graphData session graph
+ return $ Just fd
+
+ where targetInfo [hs] = "trying target " ++ hs
+ targetInfo hss = "trying " ++ show (length hss) ++ " targets at one go"
+
+targetsOneAtATime :: Session -> [FileName] -> IO ([FileData])
+targetsOneAtATime session hsfiles = do
+ print "trying targets one by one"
+ results <- mapM (targetsAtOneGo session) [[f] | f <- hsfiles]
+ return $ List.concat $ catMaybes results
+
+
+
+
}
[get names of data constructors
Norman Ramsey <[EMAIL PROTECTED]>**20060917015539] {
hunk ./utils/ghctags/GhcTags.hs 254
- TyData { tcdLName = n } -> [foundOfLName n]
+ TyData { tcdLName = tycon, tcdCons = cons } ->
+ dataNames tycon cons
hunk ./utils/ghctags/GhcTags.hs 263
+ where dataNames tycon cons = foundOfLName tycon : map conName cons
+ conName td = foundOfLName $ con_name $ unLoc td
hunk ./utils/ghctags/GhcTags.hs 281
+
}
[change representation of FoundThing
Norman Ramsey <[EMAIL PROTECTED]>**20060917050800
refactored FoundThing to use GHC's native representation of
source-code locations and to carry the module name so that the TAGS
file can contain a qualified name as well as the unqualified name
] {
hunk ./utils/ghctags/GhcTags.hs 147
--- The position of a token or definition
-data Pos = Pos
- FileName -- file name
- Int -- line number
- Int -- token number
- String -- string that makes up that line
- deriving Show
-
-srcLocToPos :: SrcLoc -> Pos
-srcLocToPos loc =
- Pos (unpackFS $ srcLocFile loc) (srcLocLine loc) (srcLocCol loc) "bogus"
-
hunk ./utils/ghctags/GhcTags.hs 148
-data FoundThing = FoundThing ThingName Pos
- deriving Show
+data FoundThing = FoundThing ModuleName ThingName SrcLoc
hunk ./utils/ghctags/GhcTags.hs 153
-data Token = Token String Pos
- deriving Show
-
-
hunk ./utils/ghctags/GhcTags.hs 164
-dumpthing (FoundThing name (Pos filename line _ _)) =
+dumpthing (FoundThing modname name loc) =
hunk ./utils/ghctags/GhcTags.hs 166
+ where line = srcLocLine loc
+ filename = unpackFS $ srcLocFile loc
hunk ./utils/ghctags/GhcTags.hs 184
-e_dumpthing (FoundThing name (Pos filename line token fullline)) =
- ---- (concat $ take (token + 1) $ spacedwords fullline)
- name
- ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
+e_dumpthing (FoundThing modname name loc) =
+ tagline name ++ tagline (moduleNameString modname ++ "." ++ name)
+ where tagline n = n ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
+ line = srcLocLine loc
+
hunk ./utils/ghctags/GhcTags.hs 220
- in do mod <- checkModule session (moduleName $ ms_mod ms)
+ modname = moduleName $ ms_mod ms
+ in do mod <- checkModule session modname
hunk ./utils/ghctags/GhcTags.hs 225
- return $ fileData filename s
+ return $ fileData filename modname s
hunk ./utils/ghctags/GhcTags.hs 227
-fileData :: FileName -> RenamedSource -> FileData
-fileData filename (group, imports, lie) =
+fileData :: FileName -> ModuleName -> RenamedSource -> FileData
+fileData filename modname (group, imports, lie) =
hunk ./utils/ghctags/GhcTags.hs 231
- FileData filename (boundValues group)
+ FileData filename (boundValues modname group)
hunk ./utils/ghctags/GhcTags.hs 233
-boundValues :: HsGroup Name -> [FoundThing]
-boundValues group =
+boundValues :: ModuleName -> HsGroup Name -> [FoundThing]
+boundValues mod group =
hunk ./utils/ghctags/GhcTags.hs 237
- [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
+ [ x | (_rec, binds) <- nest, bind <- bagToList binds,
+ x <- boundThings mod bind ]
hunk ./utils/ghctags/GhcTags.hs 241
- ForeignType { tcdLName = n } -> [foundOfLName n]
+ ForeignType { tcdLName = n } -> [found n]
hunk ./utils/ghctags/GhcTags.hs 244
- TySynonym { tcdLName = n } -> [foundOfLName n]
- ClassDecl { tcdLName = n } -> [foundOfLName n]
+ TySynonym { tcdLName = n } -> [found n]
+ ClassDecl { tcdLName = n } -> [found n]
hunk ./utils/ghctags/GhcTags.hs 248
- ForeignImport n _ _ -> [foundOfLName n]
+ ForeignImport n _ _ -> [found n]
hunk ./utils/ghctags/GhcTags.hs 251
- where dataNames tycon cons = foundOfLName tycon : map conName cons
- conName td = foundOfLName $ con_name $ unLoc td
+ where dataNames tycon cons = found tycon : map conName cons
+ conName td = found $ con_name $ unLoc td
+ found = foundOfLName mod
hunk ./utils/ghctags/GhcTags.hs 255
-posOfLocated :: Located a -> Pos
-posOfLocated lHs = srcLocToPos $ srcSpanStart $ getLoc lHs
+startOfLocated :: Located a -> SrcLoc
+startOfLocated lHs = srcSpanStart $ getLoc lHs
hunk ./utils/ghctags/GhcTags.hs 258
-foundOfLName :: Located Name -> FoundThing
-foundOfLName id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
+foundOfLName :: ModuleName -> Located Name -> FoundThing
+foundOfLName mod id = FoundThing mod (getOccString $ unLoc id) (startOfLocated id)
hunk ./utils/ghctags/GhcTags.hs 261
-boundThings :: LHsBind Name -> [FoundThing]
-boundThings lbinding =
- let thing = foundOfLName
+boundThings :: ModuleName -> LHsBind Name -> [FoundThing]
+boundThings modname lbinding =
+ let thing = foundOfLName modname
hunk ./utils/ghctags/GhcTags.hs 267
- VarBind { var_id = id } -> [FoundThing (getOccString id) (posOfLocated lbinding)]
+ VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
}
[refactoring for more readable source code
Norman Ramsey <[EMAIL PROTECTED]>**20060917053046] {
hunk ./utils/ghctags/GhcTags.hs 21
-
hunk ./utils/ghctags/GhcTags.hs 27
+---------------------------------
+--------- CONFIGURATION ---------
+
+ghcRootDir = "/usr/local/lib/ghc-6.5" --- root for -package ghc? (passed to GHC.init)
+
+
+----------------------------------
+---- CENTRAL DATA TYPES ----------
+
+type FileName = String
+type ThingName = String -- name of a defined entity in a Haskell program
+
+-- A definition we have found (we know its containing module, name, and location)
+data FoundThing = FoundThing ModuleName ThingName SrcLoc
+
+-- Data we have obtained from a file (list of things we found)
+data FileData = FileData FileName [FoundThing]
+--- invariant (not checked): every found thing has a source location in that file?
+
+
+------------------------------
+-------- MAIN PROGRAM --------
+
hunk ./utils/ghctags/GhcTags.hs 67
- let mode = getMode (Append `delete` modes)
- let openFileMode = if elem Append modes
- then AppendMode
- else WriteMode
- GHC.init (Just "/usr/local/lib/ghc-6.5")
+ GHC.init (Just ghcRootDir)
hunk ./utils/ghctags/GhcTags.hs 70
- print "created a session"
hunk ./utils/ghctags/GhcTags.hs 72
- let flags = pflags { hscTarget = HscNothing }
+ let flags = pflags { hscTarget = HscNothing } -- don't generate anything
hunk ./utils/ghctags/GhcTags.hs 82
- if mode == BothTags || mode == CTags
- then do
- ctagsfile <- openFile "tags" openFileMode
- writectagsfile ctagsfile filedata
- hClose ctagsfile
- else return ()
- if mode == BothTags || mode == ETags
- then do
- etagsfile <- openFile "TAGS" openFileMode
- writeetagsfile etagsfile filedata
- hClose etagsfile
- else return ()
-
-safeLoad :: Session -> LoadHowMuch -> IO SuccessFlag
-safeLoad session mode = do
- dflags <- getSessionDynFlags session
- handle (\exception -> return Failed ) $
- handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
- return Failed) $ load session mode
-
-
-targetsAtOneGo :: Session -> [FileName] -> IO (Maybe [FileData])
-targetsAtOneGo session hsfiles = do
- let targets = map fileTarget hsfiles
- setTargets session targets
- print $ targetInfo hsfiles
- success <- safeLoad session LoadAllTargets --- bring module graph up to date
- case success of
- Failed -> return Nothing
- Succeeded -> do
- print "loaded all targets"
- graph <- getModuleGraph session
- print "got modules graph"
- fd <- graphData session graph
- return $ Just fd
-
- where targetInfo [hs] = "trying target " ++ hs
- targetInfo hss = "trying " ++ show (length hss) ++ " targets at one go"
+ emitTagsData modes filedata
hunk ./utils/ghctags/GhcTags.hs 84
-targetsOneAtATime :: Session -> [FileName] -> IO ([FileData])
-targetsOneAtATime session hsfiles = do
- print "trying targets one by one"
- results <- mapM (targetsAtOneGo session) [[f] | f <- hsfiles]
- return $ List.concat $ catMaybes results
-
hunk ./utils/ghctags/GhcTags.hs 85
+----------------------------------------------
+---------- ARGUMENT PROCESSING --------------
hunk ./utils/ghctags/GhcTags.hs 88
+data Mode = ETags | CTags | BothTags | Append | Help deriving (Ord, Eq, Show)
+ -- ^Represents options passed to the program
hunk ./utils/ghctags/GhcTags.hs 101
--- pull out arguments between -- for GHC
+-- ^Pull out arguments between -- for GHC
hunk ./utils/ghctags/GhcTags.hs 107
-data Mode = ETags | CTags | BothTags | Append | Help deriving (Ord, Eq, Show)
-
hunk ./utils/ghctags/GhcTags.hs 108
+-- supports getopt
hunk ./utils/ghctags/GhcTags.hs 120
-type FileName = String
-
-type ThingName = String
hunk ./utils/ghctags/GhcTags.hs 121
--- A definition we have found
-data FoundThing = FoundThing ModuleName ThingName SrcLoc
-
--- Data we have obtained from a file
-data FileData = FileData FileName [FoundThing]
+----------------------------------------------------------------
+--- LOADING HASKELL SOURCE
+--- (these bits actually run the compiler and produce abstract syntax)
hunk ./utils/ghctags/GhcTags.hs 125
--- stuff for dealing with ctags output format
-
-writectagsfile :: Handle -> [FileData] -> IO ()
-writectagsfile ctagsfile filedata = do
- let things = concat $ map getfoundthings filedata
- mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) things
-
-getfoundthings :: FileData -> [FoundThing]
-getfoundthings (FileData filename things) = things
-
-dumpthing :: FoundThing -> String
-dumpthing (FoundThing modname name loc) =
- name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)
- where line = srcLocLine loc
- filename = unpackFS $ srcLocFile loc
-
-
--- stuff for dealing with etags output format
-
-writeetagsfile :: Handle -> [FileData] -> IO ()
-writeetagsfile etagsfile filedata = do
- mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata
+safeLoad :: Session -> LoadHowMuch -> IO SuccessFlag
+-- like GHC.load, but does not stop process on exception
+safeLoad session mode = do
+ dflags <- getSessionDynFlags session
+ handle (\exception -> return Failed ) $
+ handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
+ return Failed) $ load session mode
hunk ./utils/ghctags/GhcTags.hs 133
-e_dumpfiledata :: FileData -> String
-e_dumpfiledata (FileData filename things) =
- "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
- where
- thingsdump = concat $ map e_dumpthing things
- thingslength = length thingsdump
hunk ./utils/ghctags/GhcTags.hs 134
-e_dumpthing :: FoundThing -> String
-e_dumpthing (FoundThing modname name loc) =
- tagline name ++ tagline (moduleNameString modname ++ "." ++ name)
- where tagline n = n ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
- line = srcLocLine loc
-
-
-
--- like "words", but keeping the whitespace, and so letting us build
--- accurate prefixes
-
-spacedwords :: String -> [String]
-spacedwords [] = []
-spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
- where
- (blanks,rest) = span Char.isSpace xs
- (wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
-
-
--- Find the definitions in a file
-
-modsummary :: ModuleGraph -> FileName -> Maybe ModSummary
-modsummary graph n =
- List.find matches graph
- where matches ms = n == msHsFilePath ms
+targetsAtOneGo :: Session -> [FileName] -> IO (Maybe [FileData])
+-- load a list of targets
+targetsAtOneGo session hsfiles = do
+ let targets = map fileTarget hsfiles
+ setTargets session targets
+ print $ "trying " ++ targetInfo hsfiles
+ success <- safeLoad session LoadAllTargets --- bring module graph up to date
+ case success of
+ Failed -> return Nothing
+ Succeeded -> do
+ print $ "loaded " ++ targetInfo hsfiles
+ graph <- getModuleGraph session
+ print "got modules graph"
+ fd <- graphData session graph
+ return $ Just fd
hunk ./utils/ghctags/GhcTags.hs 150
-modname :: ModSummary -> ModuleName
-modname summary = moduleName $ ms_mod $ summary
+ where targetInfo [hs] = "target " ++ hs
+ targetInfo hss = show (length hss) ++ " targets at one go"
hunk ./utils/ghctags/GhcTags.hs 153
+targetsOneAtATime :: Session -> [FileName] -> IO ([FileData])
+-- load a list of targets, one at a time (more resilient to errors)
+targetsOneAtATime session hsfiles = do
+ print "trying targets one by one"
+ results <- mapM (targetsAtOneGo session) [[f] | f <- hsfiles]
+ return $ List.concat $ catMaybes results
+
hunk ./utils/ghctags/GhcTags.hs 163
+---------------------------------------------------------------
+----- CRAWLING ABSTRACT SYNTAX TO SNAFFLE THE DEFINITIONS -----
+
hunk ./utils/ghctags/GhcTags.hs 185
+-- ^Finds all the top-level definitions in a module
hunk ./utils/ghctags/GhcTags.hs 223
+
+-----------------------------------------------
+------- WRITING THE DATA TO TAGS FILES --------
+
+emitTagsData :: [Mode] -> [FileData] -> IO ()
+emitTagsData modes filedata = do
+ let mode = getMode (Append `delete` modes)
+ let openFileMode = if elem Append modes
+ then AppendMode
+ else WriteMode
+ if mode == BothTags || mode == CTags
+ then do
+ ctagsfile <- openFile "tags" openFileMode
+ writectagsfile ctagsfile filedata
+ hClose ctagsfile
+ else return ()
+ if mode == BothTags || mode == ETags
+ then do
+ etagsfile <- openFile "TAGS" openFileMode
+ writeetagsfile etagsfile filedata
+ hClose etagsfile
+ else return ()
+
+
+-- stuff for dealing with ctags output format
+
+writectagsfile :: Handle -> [FileData] -> IO ()
+writectagsfile ctagsfile filedata = do
+ let things = concat $ map getfoundthings filedata
+ mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing False x) things
+ mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing True x) things
+
+getfoundthings :: FileData -> [FoundThing]
+getfoundthings (FileData filename things) = things
+
+dumpthing :: Bool -> FoundThing -> String
+dumpthing showmod (FoundThing modname name loc) =
+ fullname ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)
+ where line = srcLocLine loc
+ filename = unpackFS $ srcLocFile loc
+ fullname = if showmod then moduleNameString modname ++ "." ++ name
+ else name
+
+-- stuff for dealing with etags output format
+
+writeetagsfile :: Handle -> [FileData] -> IO ()
+writeetagsfile etagsfile filedata = do
+ mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata
+
+e_dumpfiledata :: FileData -> String
+e_dumpfiledata (FileData filename things) =
+ "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
+ where
+ thingsdump = concat $ map e_dumpthing things
+ thingslength = length thingsdump
+
+e_dumpthing :: FoundThing -> String
+e_dumpthing (FoundThing modname name loc) =
+ tagline name ++ tagline (moduleNameString modname ++ "." ++ name)
+ where tagline n = n ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
+ line = srcLocLine loc
+
}
[working 'ghctags' Makefile target (requires stage=2)
Norman Ramsey <[EMAIL PROTECTED]>**20060920042607] {
hunk ./compiler/Makefile 907
+GHCTAGS_HC_OPTS = $(patsubst -i$(odir)/%, -i%, $(HC_OPTS))
+
hunk ./compiler/Makefile 916
+ @if [ "$(stage)" != 2 ]; then echo "Must use 'make stage=2 ghctags'"; exit 1; fi
hunk ./compiler/Makefile 922
- $(GHCTAGS) -- $(MKDEPENDHS_OPTS) $(filter-out -split-objs, $(MKDEPENDHS_HC_OPTS)) -- $(GHCTAGS_HS_SRCS)
+ # $(GHCTAGS) -- $(MKDEPENDHS_OPTS) $(filter-out -split-objs, $(MKDEPENDHS_HC_OPTS)) -- $(GHCTAGS_HS_SRCS)
+ $(GHCTAGS) -- $(GHCTAGS_HC_OPTS) -- $(GHCTAGS_HS_SRCS)
}
[first cut at missing case for ids defined in pattern
Norman Ramsey <[EMAIL PROTECTED]>**20060920042757] {
hunk ./utils/ghctags/GhcTags.hs 215
- let thing = foundOfLName modname
- in case unLoc lbinding of
- FunBind { fun_id = id } -> [thing id]
- PatBind { pat_lhs = lhs } -> panic "Pattern at top level"
- VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
- AbsBinds { } -> [] -- nothing interesting in a type abstraction
-
+ case unLoc lbinding of
+ FunBind { fun_id = id } -> [thing id]
+ PatBind { pat_lhs = lhs } -> patThings lhs []
+ VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
+ AbsBinds { } -> [] -- nothing interesting in a type abstraction
+ where thing = foundOfLName modname
+ patThings lpat tl =
+ let loc = startOfLocated lpat
+ lid id = FoundThing modname (getOccString id) loc
+ in case unLoc lpat of
+ WildPat _ -> tl
+ VarPat name -> lid name : tl
+ VarPatOut name _ -> lid name : tl -- XXX need help here
+ LazyPat p -> patThings p tl
+ AsPat id p -> patThings p (thing id : tl)
+ ParPat p -> patThings p tl
+ BangPat p -> patThings p tl
+ ListPat ps _ -> foldr patThings tl ps
+ TuplePat ps _ _ -> foldr patThings tl ps
+ PArrPat ps _ -> foldr patThings tl ps
+ ConPatIn _ conargs -> conArgs conargs tl
+ ConPatOut _ _ _ _ conargs _ -> conArgs conargs tl
+ LitPat _ -> tl
+ NPat _ _ _ _ -> tl -- form of literal pattern?
+ NPlusKPat id _ _ _ -> thing id : tl
+ TypePat _ -> tl -- XXX need help here
+ SigPatIn p _ -> patThings p tl
+ SigPatOut p _ -> patThings p tl
+ DictPat _ _ -> tl
+ conArgs (PrefixCon ps) tl = foldr patThings tl ps
+ conArgs (RecCon pairs) tl = foldr (\(_id, p) tl -> patThings p tl) tl pairs
+ conArgs (InfixCon p1 p2) tl = patThings p1 $ patThings p2 tl
}
[proper HC entry for bootstrapping in Makefile
Norman Ramsey <[EMAIL PROTECTED]>**20060920042839] {
hunk ./utils/ghctags/Makefile 6
-HC=/usr/local/bin/ghc
+HC=$(GHC_STAGE1)
}
[correct minor spelling error s/patterng/pattern/
Norman Ramsey <[EMAIL PROTECTED]>**20060920042913] {
hunk ./compiler/hsSyn/HsPat.lhs 59
- | BangPat (LPat id) -- Bang patterng
+ | BangPat (LPat id) -- Bang pattern
}
[new README file for utils/ghctags
[EMAIL PROTECTED] {
addfile ./utils/ghctags/README
hunk ./utils/ghctags/README 1
+This program should eventually replace the lexically-based
+tags program. But before this can happen, several problems
+must be addressed:
+
+ * Performance is disastrous: it takes much longer to run ghctags
+ than it does to compile GHC
+
+ * The program does not use the correct source-code locations
+
+The program accepts both its own arguments and options intended for GHC.
+As a quick self-test, you can run
+
+ ./ghctags -- -package ghc -- GhcTags.hs
}
[accomodate changes in the GHC API
[EMAIL PROTECTED] {
hunk ./utils/ghctags/GhcTags.hs 67
- GHC.init (Just ghcRootDir)
hunk ./utils/ghctags/GhcTags.hs 68
- session <- newSession JustTypecheck
+ session <- newSession JustTypecheck (Just ghcRootDir)
hunk ./utils/ghctags/GhcTags.hs 73
- flags <- initPackages flags
hunk ./utils/ghctags/GhcTags.hs 177
-fileData filename modname (group, imports, lie) =
+fileData filename modname (group, _imports, _lie, _doc, _haddock) =
hunk ./utils/ghctags/GhcTags.hs 180
+ -- doc and haddock seem haddock-related; let's hope to ignore them
hunk ./utils/ghctags/GhcTags.hs 244
- conArgs (RecCon pairs) tl = foldr (\(_id, p) tl -> patThings p tl) tl pairs
+ conArgs (RecCon pairs) tl = foldr (\f tl -> patThings (hsRecFieldArg f) tl) tl pairs
}
[request for documentation of a new argument
[EMAIL PROTECTED] {
hunk ./compiler/main/GHC.hs 332
+-- ToDo: explain argument [[mb_top_dir]]
}
Context:
[Overlap check for family instances def'd in current module
Manuel M T Chakravarty <[EMAIL PROTECTED]>**20061012203737
- All family instances are checked for overlap when entered into TcGblEnv.
Their are checked against all instances in the EPS and those currently in
the TcGblEnv.
]
[Comments only
[EMAIL PROTECTED]
[Make Inst into a record type to ease subsequent changes
[EMAIL PROTECTED]
[Improve pretty-printing slightly
[EMAIL PROTECTED]
[Add comments about primop rules
[EMAIL PROTECTED]
[fix definition of fib in example code
Simon Marlow <[EMAIL PROTECTED]>*-20061012110711]
[Track changes in source packaging scheme
[EMAIL PROTECTED]
[fix definition of fib in example code
Simon Marlow <[EMAIL PROTECTED]>**20061012110711]
[Partially fix GHCi when unregisterised
Ian Lynagh <[EMAIL PROTECTED]>**20061012013901
We were constructing info tables designed for TABLES_NEXT_TO_CODE,
but were building without TABLES_NEXT_TO_CODE.
This patch also fixes a bug when we are unregisterised on amd64 and
have code with an address above 2^32.
]
[More import tidying and fixing the stage 2 build
Simon Marlow <[EMAIL PROTECTED]>**20061011200110]
[Use relative URLs when referring to libraries; push to 6.6 branch
[EMAIL PROTECTED]
[Improve documentation of concurrent and parallel Haskell; push to branch
[EMAIL PROTECTED]
[Correct id to linkend
[EMAIL PROTECTED]
[Fix trac #921: generate *q instructions for int-float conversions
Ian Lynagh <[EMAIL PROTECTED]>**20061011140007
We need to generate, e.g., cvtsi2sdq rather than cvtsi2sd on amd64 in
order to have int-float conversions work correctly for values not
correctly representable in 32 bits.
]
[Module header tidyup #2
Simon Marlow <[EMAIL PROTECTED]>**20061011143523
Push this further along, and fix build problems in the first patch.
]
[remove BitSet, it isn't used
Simon Marlow <[EMAIL PROTECTED]>**20061011131614]
[Module header tidyup, phase 1
Simon Marlow <[EMAIL PROTECTED]>**20061011120517
This patch is a start on removing import lists and generally tidying
up the top of each module. In addition to removing import lists:
- Change DATA.IOREF -> Data.IORef etc.
- Change List -> Data.List etc.
- Remove $Id$
- Update copyrights
- Re-order imports to put non-GHC imports last
- Remove some unused and duplicate imports
]
[Interface file optimisation and removal of nameParent
Simon Marlow <[EMAIL PROTECTED]>**20061011120518
This large commit combines several interrelated changes:
- IfaceSyn now contains actual Names rather than the special
IfaceExtName type. The binary interface file contains
a symbol table of Names, where each entry is a (package,
ModuleName, OccName) triple. Names in the IfaceSyn point
to entries in the symbol table.
This reduces the size of interface files, which should
hopefully improve performance (not measured yet).
The toIfaceXXX functions now do not need to pass around
a function from Name -> IfaceExtName, which makes that
code simpler.
- Names now do not point directly to their parents, and the
nameParent operation has gone away. It turned out to be hard to
keep this information consistent in practice, and the parent info
was only valid in some Names. Instead we made the following
changes:
* ImportAvails contains a new field
imp_parent :: NameEnv AvailInfo
which gives the family info for any Name in scope, and
is used by the renamer when renaming export lists, amongst
other things. This info is thrown away after renaming.
* The mi_ver_fn field of ModIface now maps to
(OccName,Version) instead of just Version, where the
OccName is the parent name. This mapping is used when
constructing the usage info for dependent modules.
There may be entries in mi_ver_fn for things that are not in
scope, whereas imp_parent only deals with in-scope things.
* The md_exports field of ModDetails now contains
[AvailInfo] rather than NameSet. This gives us
family info for the exported names of a module.
Also:
- ifaceDeclSubBinders moved to IfaceSyn (seems like the
right place for it).
- heavily refactored renaming of import/export lists.
- Unfortunately external core is now broken, as it relied on
IfaceSyn. It requires some attention.
]
[add extendNameEnvList_C
Simon Marlow <[EMAIL PROTECTED]>**20061010153137]
[getMainDeclBinder should return Nothing for a binding with no variables
Simon Marlow <[EMAIL PROTECTED]>**20061010153023
See test rn003
]
[Use ":Co", not "Co" to prefix coercion TyCon names
Simon Marlow <[EMAIL PROTECTED]>**20061010134449
Avoid possibility of name clash
]
[Fix another hi-boot file
Ian Lynagh <[EMAIL PROTECTED]>**20061010235157]
[Removed unused unwrapFamInstBody from MkId
Manuel M T Chakravarty <[EMAIL PROTECTED]>**20061010205843]
[Rejig the auto-scc wrapping stuff
[EMAIL PROTECTED]
[Do not filter the type envt after each GHCi stmt
[EMAIL PROTECTED]
Fixes Trac #925
A new comment in TcRnDriver in tcRnStmt reads thus:
At one stage I removed any shadowed bindings from the type_env;
they are inaccessible but might, I suppose, cause a space leak if we leave them there.
However, with Template Haskell they aren't necessarily inaccessible. Consider this
GHCi session
Prelude> let f n = n * 2 :: Int
Prelude> fName <- runQ [| f |]
Prelude> $(return $ AppE fName (LitE (IntegerL 7)))
14
Prelude> let f n = n * 3 :: Int
Prelude> $(return $ AppE fName (LitE (IntegerL 7)))
In the last line we use 'fName', which resolves to the *first* 'f'
in scope. If we delete it from the type env, GHCi crashes because
it doesn't expect that.
]
[Fail more informatively when a global isn't in the type environment
[EMAIL PROTECTED]
[Rough matches for family instances
Manuel M T Chakravarty <[EMAIL PROTECTED]>**20061010044656
- Class and type family instances just got a lot more similar.
- FamInst, like Instance, now has a rough match signature. The idea is the
same: if the rough match doesn't match, there is no need to pull in the while
tycon describing the instance (from a lazily read iface).
- IfaceFamInst changes in a similar way and the list of all IFaceFamInsts is
now written into the binary iface (as for class instances), as deriving it
from the tycon (as before) would render the whole rough matching useless.
- As a result of this, the plumbing of class instances and type instances
through the various environments, ModIface, ModGuts, and ModDetails is now
almost the same. (The remaining difference are mostly because the dfun of a
class instance is an Id, but type instance refer to a TyCon, not an Id.)
*** WARNING: The interface file format changed! ***
*** Rebuild from scratch. ***
]
[Tweaks and missing case in disassembler
Ian Lynagh <[EMAIL PROTECTED]>**20061009230539]
[Update hi-boot files to fix building with old GHCs
Ian Lynagh <[EMAIL PROTECTED]>**20061009193218]
[STM invariants
[EMAIL PROTECTED]
[Fix unregisterised alpha builds
Ian Lynagh <[EMAIL PROTECTED]>**20061004125857]
[Comments and an import-trim
[EMAIL PROTECTED]
[Mention that the module sub-directory structure for .o and .hi files is created automatically by GHC
[EMAIL PROTECTED]
[Bale out before renamer errors are duplicated
[EMAIL PROTECTED]
With the new Haddock patch, renamer errors can be duplicated;
so we want to bale out before doing the Haddock stuff if errors
are found.
(E.g test mod67 shows this up.)
]
[Avoid repeatedly loading GHC.Prim
[EMAIL PROTECTED]
This patch changes HscTypes.lookupIfaceByModule. The problem was that
when compiling the 'base' package, we'd repeatedly reload GHC.Prim.
This is easily fixed by looking in the PIT too. A comment with
lookupIfaceByModule explains
]
[Print the 'skipping' messages at verbosity level 1
[EMAIL PROTECTED]
[Fix up the typechecking of interface files during --make
[EMAIL PROTECTED]
This patch fixes Trac #909. The problem was that when compiling
the base package, the handling of wired-in things wasn't right;
in TcIface.tcWiredInTyCon it repeatedly loaded GHC.Base.hi into the
PIT, even though that was the very module it was compiling.
The main fix is by introducing TcIface.ifCheckWiredInThing.
But I did some minor refactoring as well.
]
[Import trimming
[EMAIL PROTECTED]
[Figure out where the rest of the repositories are, based on defaultrepo
Simon Marlow <[EMAIL PROTECTED]>**20061006100049
This is a slight improvement over the patch sent by [EMAIL PROTECTED],
we now do it properly if the source repo was a GHC tree on the local
filesystem too.
Merge post 6.6.
]
[Yet another fix to mkAtomicArgs (for floating of casts)
[EMAIL PROTECTED]
Comment Note [Take care] explains.
mkAtomicArgs is a mess. A substantial rewrite of Simplify is needed.
]
[Improve comments and error tracing
[EMAIL PROTECTED]
[Improve error message
[EMAIL PROTECTED]
[Undo an accidentally-committed patch by Audrey
[EMAIL PROTECTED]
[Merge Haddock comment support from ghc.haddock -- big patch
[EMAIL PROTECTED]
[Remove casts from lvalues to allow compilation under GCC 4.0
[EMAIL PROTECTED]
[Correct the float-coercions-out-of-let patch
[EMAIL PROTECTED]
[Merge changes
Ian Lynagh <[EMAIL PROTECTED]>**20061005150630]
[Improve the correlation betweens documented and existent options
Ian Lynagh <[EMAIL PROTECTED]>**20061003220354]
[Document -dfaststring-stats
Ian Lynagh <[EMAIL PROTECTED]>**20061003154147]
[Rearrange docs to have all the -ddump-* options together
Ian Lynagh <[EMAIL PROTECTED]>**20061003153422]
[Remove unused option -femit-extern-decls
Ian Lynagh <[EMAIL PROTECTED]>**20061003145854]
[Documentation updates
Ian Lynagh <[EMAIL PROTECTED]>**20061003142658]
[Fix typo
Ian Lynagh <[EMAIL PROTECTED]>**20061003121926]
[More bootstrapping updates
Ian Lynagh <[EMAIL PROTECTED]>**20061005145629]
[TAG 2006-10-05
Lemmih <[EMAIL PROTECTED]>**20061005150234]
Patch bundle hash:
944cbfe03d84cea7fd79884f9321180375c49ca4
_______________________________________________
Cvs-ghc mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/cvs-ghc
