Ticket #946: initial_-very-incomplete-tags-generator.dpatch

File initial_-very-incomplete-tags-generator.dpatch, 53.2 KB (added by simonpj, 8 years ago)
Line 
1
2New patches:
3
4[initial, very incomplete tags generator
5Norman Ramsey <nr@eecs.harvard.edu>**20060915235033
6 The ultimate goal is to replace hasktags with
7 a tags generator based on GHC-as-a-library.
8 This file is a very incomplete first cut.
9] {
10adddir ./utils/ghctags
11addfile ./utils/ghctags/GhcTags.hs
12hunk ./utils/ghctags/GhcTags.hs 1
13+module Main where
14+import Bag
15+import Char
16+import DynFlags(GhcMode, defaultDynFlags)
17+import FastString
18+import GHC
19+import HscTypes (msHsFilePath)
20+import List
21+import IO
22+import Name
23+import Outputable
24+import SrcLoc
25+import System.Environment
26+import System.Console.GetOpt
27+import System.Exit
28+
29+
30+-- search for definitions of things
31+-- we do this by parsing the source and grabbing top-level definitions
32+
33+-- We generate both CTAGS and ETAGS format tags files
34+-- The former is for use in most sensible editors, while EMACS uses ETAGS
35+
36+{-
37+placateGhc :: IO ()
38+placateGhc = defaultErrorHandler defaultDynFlags $ do
39+  GHC.init (Just "/usr/local/lib/ghc-6.5")  -- or your build tree!
40+  s <- newSession mode
41+-}
42+
43+main :: IO ()
44+main = do
45+        progName <- getProgName
46+       args <- getArgs
47+        let usageString = "Usage: " ++ progName ++ " [OPTION...] [files...]"
48+       let (modes, filenames, errs) = getOpt Permute options args
49+       if errs /= [] || elem Help modes || filenames == []
50+         then do
51+           putStr $ unlines errs
52+          putStr $ usageInfo usageString options
53+          exitWith (ExitFailure 1)
54+         else return ()
55+        let mode = getMode (Append `delete` modes)
56+        let openFileMode = if elem Append modes
57+                          then AppendMode
58+                          else WriteMode
59+        GHC.init (Just "/usr/local/lib/ghc-6.5")
60+        GHC.defaultErrorHandler defaultDynFlags $ do
61+          session <- newSession JustTypecheck
62+          print "created a session"
63+          flags <- getSessionDynFlags session
64+          (flags, _) <- parseDynamicFlags flags ["-package", "ghc"]
65+          GHC.defaultCleanupHandler flags $ do
66+            flags <- initPackages flags
67+            setSessionDynFlags session flags
68+          filedata <- mapM (findthings session) filenames
69+          if mode == BothTags || mode == CTags
70+           then do
71+             ctagsfile <- openFile "tags" openFileMode
72+             writectagsfile ctagsfile filedata
73+             hClose ctagsfile
74+           else return ()
75+          if mode == BothTags || mode == ETags
76+           then do
77+             etagsfile <- openFile "TAGS" openFileMode
78+             writeetagsfile etagsfile filedata
79+             hClose etagsfile
80+           else return ()
81+
82+-- | getMode takes a list of modes and extract the mode with the
83+--   highest precedence.  These are as follows: Both, CTags, ETags
84+--   The default case is Both.
85+getMode :: [Mode] -> Mode
86+getMode [] = BothTags
87+getMode [x] = x
88+getMode (x:xs) = max x (getMode xs)
89+
90+
91+data Mode = ETags | CTags | BothTags | Append | Help deriving (Ord, Eq, Show)
92+
93+options :: [OptDescr Mode]
94+options = [ Option "c" ["ctags"]
95+           (NoArg CTags) "generate CTAGS file (ctags)"
96+         , Option "e" ["etags"]
97+           (NoArg ETags) "generate ETAGS file (etags)"
98+         , Option "b" ["both"]
99+           (NoArg BothTags) ("generate both CTAGS and ETAGS")
100+         , Option "a" ["append"]
101+           (NoArg Append) ("append to existing CTAGS and/or ETAGS file(s)")
102+         , Option "h" ["help"] (NoArg Help) "This help"
103+         ]
104+
105+type FileName = String
106+
107+type ThingName = String
108+
109+-- The position of a token or definition
110+data Pos = Pos
111+               FileName        -- file name
112+               Int                     -- line number
113+               Int             -- token number
114+               String          -- string that makes up that line
115+       deriving Show
116+
117+srcLocToPos :: SrcLoc -> Pos
118+srcLocToPos loc =
119+    Pos (unpackFS $ srcLocFile loc) (srcLocLine loc) (srcLocCol loc) "bogus"
120+
121+-- A definition we have found
122+data FoundThing = FoundThing ThingName Pos
123+       deriving Show
124+
125+-- Data we have obtained from a file
126+data FileData = FileData FileName [FoundThing]
127+
128+data Token = Token String Pos
129+       deriving Show
130+
131+
132+-- stuff for dealing with ctags output format
133+
134+writectagsfile :: Handle -> [FileData] -> IO ()
135+writectagsfile ctagsfile filedata = do
136+       let things = concat $ map getfoundthings filedata
137+       mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) things
138+
139+getfoundthings :: FileData -> [FoundThing]
140+getfoundthings (FileData filename things) = things
141+
142+dumpthing :: FoundThing -> String
143+dumpthing (FoundThing name (Pos filename line _ _)) =
144+       name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)
145+
146+
147+-- stuff for dealing with etags output format
148+
149+writeetagsfile :: Handle -> [FileData] -> IO ()
150+writeetagsfile etagsfile filedata = do
151+       mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata
152+
153+e_dumpfiledata :: FileData -> String
154+e_dumpfiledata (FileData filename things) =
155+       "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
156+       where
157+               thingsdump = concat $ map e_dumpthing things
158+               thingslength = length thingsdump
159+
160+e_dumpthing :: FoundThing -> String
161+e_dumpthing (FoundThing name (Pos filename line token fullline)) =
162+       ---- (concat $ take (token + 1) $ spacedwords fullline)
163+        name
164+       ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
165+       
166+       
167+-- like "words", but keeping the whitespace, and so letting us build
168+-- accurate prefixes   
169+       
170+spacedwords :: String -> [String]
171+spacedwords [] = []
172+spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
173+       where
174+               (blanks,rest) = span Char.isSpace xs
175+               (wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
176+       
177+       
178+-- Find the definitions in a file     
179+       
180+modsummary :: ModuleGraph -> FileName -> Maybe ModSummary
181+modsummary graph n =
182+  List.find matches graph
183+  where matches ms = n == msHsFilePath ms
184+
185+modname :: ModSummary -> ModuleName
186+modname summary = moduleName $ ms_mod $ summary
187+
188+findthings :: Session -> FileName -> IO FileData
189+findthings session filename = do
190+  setTargets session [Target (TargetFile filename Nothing) Nothing]
191+  print "set targets"
192+  success <- load session LoadAllTargets  --- bring module graph up to date
193+  case success of
194+    Failed -> do { print "load failed"; return emptyFileData }
195+    Succeeded ->
196+      do print "loaded all targets"
197+         graph <- getModuleGraph session
198+         print "got modules graph"
199+         case  modsummary graph filename of
200+           Nothing -> panic "loaded a module from a file but then could not find its summary"
201+           Just ms -> do
202+             mod <- checkModule session (modname ms)
203+             print "got the module"
204+             case mod of
205+               Nothing -> return emptyFileData
206+               Just m -> case renamedSource m of
207+                           Nothing -> return emptyFileData
208+                           Just s -> return $ fileData filename s
209+  where emptyFileData = FileData filename []
210+
211+
212+fileData :: FileName -> RenamedSource -> FileData
213+fileData filename (group, imports, lie) =
214+    -- lie is related to type checking and so is irrelevant
215+    -- imports contains import declarations and no definitions
216+    FileData filename (boundValues group)
217+
218+boundValues :: HsGroup Name -> [FoundThing]   
219+boundValues group =
220+  case hs_valds group of
221+    ValBindsOut nest sigs ->
222+        [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
223+
224+posOfLocated :: Located a -> Pos
225+posOfLocated lHs = srcLocToPos $ srcSpanStart $ getLoc lHs
226+
227+boundThings :: LHsBind Name -> [FoundThing]
228+boundThings lbinding =
229+  let thing id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
230+  in  case unLoc lbinding of
231+        FunBind { fun_id = id } -> [thing id]
232+        PatBind { pat_lhs = lhs } -> patBoundIds lhs
233+--        VarBind { var_id = id } -> [thing id]
234+        _ -> []
235+                                     
236+
237+patBoundIds :: a -> b
238+patBoundIds _ = panic "not on your life"
239+       
240+-- actually pick up definitions
241+
242+findstuff :: [Token] -> [FoundThing]
243+findstuff ((Token "data" _):(Token name pos):xs) =
244+       FoundThing name pos : (getcons xs) ++ (findstuff xs)
245+findstuff ((Token "newtype" _):(Token name pos):xs) =
246+       FoundThing name pos : findstuff xs
247+findstuff ((Token "type" _):(Token name pos):xs) =
248+       FoundThing name pos : findstuff xs
249+findstuff ((Token name pos):(Token "::" _):xs) =
250+       FoundThing name pos : findstuff xs
251+findstuff (x:xs) = findstuff xs
252+findstuff [] = []
253+
254+
255+-- get the constructor definitions, knowing that a datatype has just started
256+
257+getcons :: [Token] -> [FoundThing]
258+getcons ((Token "=" _):(Token name pos):xs) =
259+       FoundThing name pos : getcons2 xs
260+getcons (x:xs) = getcons xs
261+getcons [] = []
262+
263+
264+getcons2 ((Token "=" _):xs) = []
265+getcons2 ((Token "|" _):(Token name pos):xs) =
266+       FoundThing name pos : getcons2 xs
267+getcons2 (x:xs) = getcons2 xs
268+getcons2 [] = []
269+
270addfile ./utils/ghctags/Makefile
271hunk ./utils/ghctags/Makefile 1
272+TOP=../..
273+include $(TOP)/mk/boilerplate.mk
274+
275+HS_PROG = ghctags
276+SRC_HC_OPTS += -package ghc
277+HC=/usr/local/bin/ghc
278+
279+CLEAN_FILES += Main.hi
280+
281+INSTALL_PROGS += $(HS_PROG)
282+
283+include $(TOP)/mk/target.mk
284+
285}
286
287[cover more cases; take GHC options on command line
288Norman Ramsey <nr@eecs.harvard.edu>**20060916232755
289 Bit of a dog's breakfast here:
290   * generate tags for more cases in the syntax
291   * accept -package ghc and other args on command line
292   * scrub away old code for snaffling thru text
293] {
294hunk ./utils/ghctags/GhcTags.hs 34
295+        let usageString =
296+              "Usage: " ++ progName ++ " [OPTION...] [-- GHC OPTION... --] [files...]"
297hunk ./utils/ghctags/GhcTags.hs 37
298-        let usageString = "Usage: " ++ progName ++ " [OPTION...] [files...]"
299-       let (modes, filenames, errs) = getOpt Permute options args
300-       if errs /= [] || elem Help modes || filenames == []
301+        let (ghcArgs, ourArgs, unbalanced) = splitArgs args
302+       let (modes, filenames, errs) = getOpt Permute options ourArgs
303+       if unbalanced || errs /= [] || elem Help modes || filenames == []
304hunk ./utils/ghctags/GhcTags.hs 54
305-          (flags, _) <- parseDynamicFlags flags ["-package", "ghc"]
306+          (flags, _) <- parseDynamicFlags flags ghcArgs
307hunk ./utils/ghctags/GhcTags.hs 81
308+splitArgs :: [String] -> ([String], [String], Bool)
309+-- pull out arguments between -- for GHC
310+splitArgs args = split [] [] False args
311+    where split ghc' tags' unbal ("--" : args) = split tags' ghc' (not unbal) args
312+          split ghc' tags' unbal (arg : args) = split ghc' (arg:tags') unbal args
313+          split ghc' tags' unbal [] = (reverse ghc', reverse tags', unbal)
314+
315hunk ./utils/ghctags/GhcTags.hs 217
316-  case hs_valds group of
317-    ValBindsOut nest sigs ->
318-        [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
319+  let vals = case hs_valds group of
320+               ValBindsOut nest sigs ->
321+                   [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
322+      tys = concat $ map tyBound (hs_tyclds group)
323+            where tyBound ltcd = case unLoc ltcd of
324+                                   ForeignType { tcdLName = n } -> [foundOfLName n]
325+                                   TyData { tcdLName = n } -> [foundOfLName n]
326+                                   TySynonym { tcdLName = n } -> [foundOfLName n]
327+                                   ClassDecl { tcdLName = n } -> [foundOfLName n]
328+      fors = concat $ map forBound (hs_fords group)
329+             where forBound lford = case unLoc lford of
330+                                      ForeignImport n _ _ -> [foundOfLName n]
331+                                      ForeignExport { } -> []
332+  in vals ++ tys ++ fors
333hunk ./utils/ghctags/GhcTags.hs 235
334+foundOfLName :: Located Name -> FoundThing
335+foundOfLName id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
336+
337hunk ./utils/ghctags/GhcTags.hs 240
338-  let thing id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
339+  let thing = foundOfLName
340hunk ./utils/ghctags/GhcTags.hs 243
341-        PatBind { pat_lhs = lhs } -> patBoundIds lhs
342---        VarBind { var_id = id } -> [thing id]
343-        _ -> []
344-                                     
345-
346-patBoundIds :: a -> b
347-patBoundIds _ = panic "not on your life"
348-       
349--- actually pick up definitions
350-
351-findstuff :: [Token] -> [FoundThing]
352-findstuff ((Token "data" _):(Token name pos):xs) =
353-       FoundThing name pos : (getcons xs) ++ (findstuff xs)
354-findstuff ((Token "newtype" _):(Token name pos):xs) =
355-       FoundThing name pos : findstuff xs
356-findstuff ((Token "type" _):(Token name pos):xs) =
357-       FoundThing name pos : findstuff xs
358-findstuff ((Token name pos):(Token "::" _):xs) =
359-       FoundThing name pos : findstuff xs
360-findstuff (x:xs) = findstuff xs
361-findstuff [] = []
362-
363-
364--- get the constructor definitions, knowing that a datatype has just started
365-
366-getcons :: [Token] -> [FoundThing]
367-getcons ((Token "=" _):(Token name pos):xs) =
368-       FoundThing name pos : getcons2 xs
369-getcons (x:xs) = getcons xs
370-getcons [] = []
371-
372-
373-getcons2 ((Token "=" _):xs) = []
374-getcons2 ((Token "|" _):(Token name pos):xs) =
375-       FoundThing name pos : getcons2 xs
376-getcons2 (x:xs) = getcons2 xs
377-getcons2 [] = []
378-
379+        PatBind { pat_lhs = lhs } -> panic "Pattern at top level"
380+        VarBind { var_id = id } -> [FoundThing (getOccString id) (posOfLocated lbinding)]
381+        AbsBinds { } -> [] -- nothing interesting in a type abstraction
382}
383
384[tell GHC not to generate code (thanks Simon M)
385Norman Ramsey <nr@eecs.harvard.edu>**20060917002353] {
386hunk ./utils/ghctags/GhcTags.hs 54
387-          (flags, _) <- parseDynamicFlags flags ghcArgs
388+          (pflags, _) <- parseDynamicFlags flags ghcArgs
389+          let flags = pflags { hscTarget = HscNothing }
390}
391
392[load all files at once and compute tags for all
393Norman Ramsey <nr@eecs.harvard.edu>**20060917002430] {
394hunk ./utils/ghctags/GhcTags.hs 59
395-          filedata <- mapM (findthings session) filenames
396+          setTargets session (map fileTarget filenames)
397+          print "set targets"
398+          success <- load session LoadAllTargets  --- bring module graph up to date
399+          filedata <- case success of
400+                        Failed -> do { putStr "Load failed"; exitWith (ExitFailure 2) }
401+                        Succeeded -> do
402+                                     print "loaded all targets"
403+                                     graph <- getModuleGraph session
404+                                     print "got modules graph"
405+                                     graphData session graph
406hunk ./utils/ghctags/GhcTags.hs 195
407-findthings :: Session -> FileName -> IO FileData
408-findthings session filename = do
409-  setTargets session [Target (TargetFile filename Nothing) Nothing]
410-  print "set targets"
411-  success <- load session LoadAllTargets  --- bring module graph up to date
412-  case success of
413-    Failed -> do { print "load failed"; return emptyFileData }
414-    Succeeded ->
415-      do print "loaded all targets"
416-         graph <- getModuleGraph session
417-         print "got modules graph"
418-         case  modsummary graph filename of
419-           Nothing -> panic "loaded a module from a file but then could not find its summary"
420-           Just ms -> do
421-             mod <- checkModule session (modname ms)
422-             print "got the module"
423-             case mod of
424-               Nothing -> return emptyFileData
425-               Just m -> case renamedSource m of
426-                           Nothing -> return emptyFileData
427-                           Just s -> return $ fileData filename s
428-  where emptyFileData = FileData filename []
429+fileTarget :: FileName -> Target
430+fileTarget filename = Target (TargetFile filename Nothing) Nothing
431+
432+graphData :: Session -> ModuleGraph -> IO [FileData]
433+graphData session graph =
434+    mapM foundthings graph
435+    where foundthings ms =
436+              let filename = msHsFilePath ms
437+              in  do mod <- checkModule session (moduleName $ ms_mod ms)
438+                     return $ case mod of
439+                       Nothing -> FileData filename []
440+                       Just m -> case renamedSource m of
441+                                   Nothing -> FileData filename []
442+                                   Just s -> fileData filename s
443}
444
445[do notation for the Maybe monad
446Norman Ramsey <nr@eecs.harvard.edu>**20060917003410] {
447hunk ./utils/ghctags/GhcTags.hs 204
448-                     return $ case mod of
449-                       Nothing -> FileData filename []
450-                       Just m -> case renamedSource m of
451-                                   Nothing -> FileData filename []
452-                                   Just s -> fileData filename s
453-
454+                     return $ maybe (FileData filename []) id $ do
455+                       m <- mod
456+                       s <- renamedSource m
457+                       return $ fileData filename s
458}
459
460[desperate attempts to handle the GHC build
461Norman Ramsey <nr@eecs.harvard.edu>**20060917011529
462 What's happening here is a series of attempts to successfully swallow
463 what the GHC build process chooses to throw at the tool.  I'm clearly
464 out of my depth and so will revert to trying one module at a time.
465] {
466hunk ./compiler/Makefile 901
467+WRONG_GHCTAGS_HS_SRCS = $(filter-out $(DERIVED_SRCS) main/Config.hs parser/Parser.y, $(sort $(SRCS)))
468+# above is wrong because of the following problem:
469+#      module `main:DataCon' is defined in multiple files: basicTypes/DataCon.lhs
470+#                                                        basicTypes/DataCon.lhs-boot
471+
472+GHCTAGS_HS_SRCS = $(HS_SRCS)
473+
474+#------------------------------------------------------------
475+#                      Tags
476+
477+.PHONY: ghctags
478+
479+ghctags :: $(GHCTAGS_HS_SRCS) $(TAGS_C_SRCS)
480+       @$(RM) TAGS
481+       @touch TAGS
482+       @echo SOURCES ARE "$(GHCTAGS_HS_SRCS)"
483+       : ifneq "$(GHCTAGS_HS_SRCS)" ""
484+       @echo TIME TO ROCK AND ROLL
485+       $(GHCTAGS) -- $(MKDEPENDHS_OPTS) $(filter-out -split-objs, $(MKDEPENDHS_HC_OPTS)) -- $(GHCTAGS_HS_SRCS)
486+       : endif
487+ifneq "$(TAGS_C_SRCS)" ""
488+       etags -a $(TAGS_C_SRCS)
489+endif
490+       @( 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?
491hunk ./utils/ghctags/GhcTags.hs 4
492+import DriverPhases ( isHaskellSrcFilename )
493hunk ./utils/ghctags/GhcTags.hs 40
494-       if unbalanced || errs /= [] || elem Help modes || filenames == []
495+        let (hsfiles, otherfiles) = List.partition isHaskellSrcFilename filenames
496+        mapM_ (\n -> putStr $ "Warning: ignoring non-Haskellish file " ++ n ++ "\n")
497+              otherfiles
498+       if unbalanced || errs /= [] || elem Help modes || hsfiles == []
499hunk ./utils/ghctags/GhcTags.hs 63
500-          setTargets session (map fileTarget filenames)
501+         -- targets <- mapM (\s -> guessTarget s Nothing) hsfiles
502+                --  guessTarget would be more compatible with ghc -M
503+          let targets = map fileTarget hsfiles
504+          setTargets session targets
505hunk ./utils/ghctags/GhcTags.hs 70
506-                        Failed -> do { putStr "Load failed"; exitWith (ExitFailure 2) }
507+                        Failed -> do putStr "Load failed\n"
508+                                     exitWith (ExitFailure 2)
509}
510
511[if the whole group fails, try one file at a time
512Norman Ramsey <nr@eecs.harvard.edu>**20060917015451] {
513hunk ./utils/ghctags/GhcTags.hs 6
514+import ErrUtils ( printBagOfErrors )
515hunk ./utils/ghctags/GhcTags.hs 10
516-import List
517hunk ./utils/ghctags/GhcTags.hs 11
518+import List
519+import Maybe
520hunk ./utils/ghctags/GhcTags.hs 19
521+import Util ( handle, handleDyn )
522hunk ./utils/ghctags/GhcTags.hs 28
523-{-
524-placateGhc :: IO ()
525-placateGhc = defaultErrorHandler defaultDynFlags $ do
526-  GHC.init (Just "/usr/local/lib/ghc-6.5")  -- or your build tree!
527-  s <- newSession mode
528--}
529-
530hunk ./utils/ghctags/GhcTags.hs 61
531-          let targets = map fileTarget hsfiles
532-          setTargets session targets
533-          print "set targets"
534-          success <- load session LoadAllTargets  --- bring module graph up to date
535-          filedata <- case success of
536-                        Failed -> do putStr "Load failed\n"
537-                                     exitWith (ExitFailure 2)
538-                        Succeeded -> do
539-                                     print "loaded all targets"
540-                                     graph <- getModuleGraph session
541-                                     print "got modules graph"
542-                                     graphData session graph
543+          filedata <- targetsAtOneGo session hsfiles
544+          filedata <- case filedata of
545+                        Just fd -> return fd
546+                        Nothing -> targetsOneAtATime session hsfiles
547hunk ./utils/ghctags/GhcTags.hs 78
548+safeLoad :: Session -> LoadHowMuch -> IO SuccessFlag
549+safeLoad session mode = do
550+  dflags <- getSessionDynFlags session
551+  handle (\exception -> return Failed ) $
552+    handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
553+                         return Failed) $ load session mode
554+
555+
556+targetsAtOneGo :: Session -> [FileName] -> IO (Maybe [FileData])
557+targetsAtOneGo session hsfiles = do
558+  let targets = map fileTarget hsfiles
559+  setTargets session targets
560+  print $ targetInfo hsfiles
561+  success <- safeLoad session LoadAllTargets  --- bring module graph up to date
562+  case success of
563+    Failed -> return Nothing
564+    Succeeded -> do
565+                 print "loaded all targets"
566+                 graph <- getModuleGraph session
567+                 print "got modules graph"
568+                 fd <- graphData session graph
569+                 return $ Just fd
570+
571+  where targetInfo [hs] = "trying target " ++ hs
572+        targetInfo hss  = "trying " ++ show (length hss) ++ " targets at one go"
573+
574+targetsOneAtATime :: Session -> [FileName] -> IO ([FileData])
575+targetsOneAtATime session hsfiles = do
576+  print "trying targets one by one"
577+  results <- mapM (targetsAtOneGo session) [[f] | f <- hsfiles]
578+  return $ List.concat $ catMaybes results
579+   
580+
581+
582+
583}
584
585[get names of data constructors
586Norman Ramsey <nr@eecs.harvard.edu>**20060917015539] {
587hunk ./utils/ghctags/GhcTags.hs 254
588-                                   TyData { tcdLName = n } -> [foundOfLName n]
589+                                   TyData { tcdLName = tycon, tcdCons = cons } ->
590+                                       dataNames tycon cons
591hunk ./utils/ghctags/GhcTags.hs 263
592+  where dataNames tycon cons = foundOfLName tycon : map conName cons
593+        conName td = foundOfLName $ con_name $ unLoc td
594hunk ./utils/ghctags/GhcTags.hs 281
595+
596}
597
598[change representation of FoundThing
599Norman Ramsey <nr@eecs.harvard.edu>**20060917050800
600 refactored FoundThing to use GHC's native representation of
601 source-code locations and to carry the module name so that the TAGS
602 file can contain a qualified name as well as the unqualified name
603] {
604hunk ./utils/ghctags/GhcTags.hs 147
605--- The position of a token or definition
606-data Pos = Pos
607-               FileName        -- file name
608-               Int                     -- line number
609-               Int             -- token number
610-               String          -- string that makes up that line
611-       deriving Show
612-
613-srcLocToPos :: SrcLoc -> Pos
614-srcLocToPos loc =
615-    Pos (unpackFS $ srcLocFile loc) (srcLocLine loc) (srcLocCol loc) "bogus"
616-
617hunk ./utils/ghctags/GhcTags.hs 148
618-data FoundThing = FoundThing ThingName Pos
619-       deriving Show
620+data FoundThing = FoundThing ModuleName ThingName SrcLoc
621hunk ./utils/ghctags/GhcTags.hs 153
622-data Token = Token String Pos
623-       deriving Show
624-
625-
626hunk ./utils/ghctags/GhcTags.hs 164
627-dumpthing (FoundThing name (Pos filename line _ _)) =
628+dumpthing (FoundThing modname name loc) =
629hunk ./utils/ghctags/GhcTags.hs 166
630+    where line = srcLocLine loc
631+          filename = unpackFS $ srcLocFile loc
632hunk ./utils/ghctags/GhcTags.hs 184
633-e_dumpthing (FoundThing name (Pos filename line token fullline)) =
634-       ---- (concat $ take (token + 1) $ spacedwords fullline)
635-        name
636-       ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
637+e_dumpthing (FoundThing modname name loc) =
638+    tagline name ++ tagline (moduleNameString modname ++ "." ++ name)
639+    where tagline n = n ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
640+          line = srcLocLine loc
641+       
642hunk ./utils/ghctags/GhcTags.hs 220
643-              in  do mod <- checkModule session (moduleName $ ms_mod ms)
644+                  modname = moduleName $ ms_mod ms
645+              in  do mod <- checkModule session modname
646hunk ./utils/ghctags/GhcTags.hs 225
647-                       return $ fileData filename s
648+                       return $ fileData filename modname s
649hunk ./utils/ghctags/GhcTags.hs 227
650-fileData :: FileName -> RenamedSource -> FileData
651-fileData filename (group, imports, lie) =
652+fileData :: FileName -> ModuleName -> RenamedSource -> FileData
653+fileData filename modname (group, imports, lie) =
654hunk ./utils/ghctags/GhcTags.hs 231
655-    FileData filename (boundValues group)
656+    FileData filename (boundValues modname group)
657hunk ./utils/ghctags/GhcTags.hs 233
658-boundValues :: HsGroup Name -> [FoundThing]   
659-boundValues group =
660+boundValues :: ModuleName -> HsGroup Name -> [FoundThing]   
661+boundValues mod group =
662hunk ./utils/ghctags/GhcTags.hs 237
663-                   [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
664+                   [ x | (_rec, binds) <- nest, bind <- bagToList binds,
665+                              x <- boundThings mod bind ]
666hunk ./utils/ghctags/GhcTags.hs 241
667-                                   ForeignType { tcdLName = n } -> [foundOfLName n]
668+                                   ForeignType { tcdLName = n } -> [found n]
669hunk ./utils/ghctags/GhcTags.hs 244
670-                                   TySynonym { tcdLName = n } -> [foundOfLName n]
671-                                   ClassDecl { tcdLName = n } -> [foundOfLName n]
672+                                   TySynonym { tcdLName = n } -> [found n]
673+                                   ClassDecl { tcdLName = n } -> [found n]
674hunk ./utils/ghctags/GhcTags.hs 248
675-                                      ForeignImport n _ _ -> [foundOfLName n]
676+                                      ForeignImport n _ _ -> [found n]
677hunk ./utils/ghctags/GhcTags.hs 251
678-  where dataNames tycon cons = foundOfLName tycon : map conName cons
679-        conName td = foundOfLName $ con_name $ unLoc td
680+  where dataNames tycon cons = found tycon : map conName cons
681+        conName td = found $ con_name $ unLoc td
682+        found = foundOfLName mod
683hunk ./utils/ghctags/GhcTags.hs 255
684-posOfLocated :: Located a -> Pos
685-posOfLocated lHs = srcLocToPos $ srcSpanStart $ getLoc lHs
686+startOfLocated :: Located a -> SrcLoc
687+startOfLocated lHs = srcSpanStart $ getLoc lHs
688hunk ./utils/ghctags/GhcTags.hs 258
689-foundOfLName :: Located Name -> FoundThing
690-foundOfLName id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
691+foundOfLName :: ModuleName -> Located Name -> FoundThing
692+foundOfLName mod id = FoundThing mod (getOccString $ unLoc id) (startOfLocated id)
693hunk ./utils/ghctags/GhcTags.hs 261
694-boundThings :: LHsBind Name -> [FoundThing]
695-boundThings lbinding =
696-  let thing = foundOfLName
697+boundThings :: ModuleName -> LHsBind Name -> [FoundThing]
698+boundThings modname lbinding =
699+  let thing = foundOfLName modname
700hunk ./utils/ghctags/GhcTags.hs 267
701-        VarBind { var_id = id } -> [FoundThing (getOccString id) (posOfLocated lbinding)]
702+        VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
703}
704
705[refactoring for more readable source code
706Norman Ramsey <nr@eecs.harvard.edu>**20060917053046] {
707hunk ./utils/ghctags/GhcTags.hs 21
708-
709hunk ./utils/ghctags/GhcTags.hs 27
710+---------------------------------
711+--------- CONFIGURATION ---------
712+
713+ghcRootDir = "/usr/local/lib/ghc-6.5" --- root for -package ghc? (passed to GHC.init)
714+
715+
716+----------------------------------
717+---- CENTRAL DATA TYPES ----------
718+
719+type FileName = String
720+type ThingName = String -- name of a defined entity in a Haskell program
721+
722+-- A definition we have found (we know its containing module, name, and location)
723+data FoundThing = FoundThing ModuleName ThingName SrcLoc
724+
725+-- Data we have obtained from a file (list of things we found)
726+data FileData = FileData FileName [FoundThing]
727+--- invariant (not checked): every found thing has a source location in that file?
728+
729+
730+------------------------------
731+-------- MAIN PROGRAM --------
732+
733hunk ./utils/ghctags/GhcTags.hs 67
734-        let mode = getMode (Append `delete` modes)
735-        let openFileMode = if elem Append modes
736-                          then AppendMode
737-                          else WriteMode
738-        GHC.init (Just "/usr/local/lib/ghc-6.5")
739+        GHC.init (Just ghcRootDir)
740hunk ./utils/ghctags/GhcTags.hs 70
741-          print "created a session"
742hunk ./utils/ghctags/GhcTags.hs 72
743-          let flags = pflags { hscTarget = HscNothing }
744+          let flags = pflags { hscTarget = HscNothing } -- don't generate anything
745hunk ./utils/ghctags/GhcTags.hs 82
746-          if mode == BothTags || mode == CTags
747-           then do
748-             ctagsfile <- openFile "tags" openFileMode
749-             writectagsfile ctagsfile filedata
750-             hClose ctagsfile
751-           else return ()
752-          if mode == BothTags || mode == ETags
753-           then do
754-             etagsfile <- openFile "TAGS" openFileMode
755-             writeetagsfile etagsfile filedata
756-             hClose etagsfile
757-           else return ()
758-
759-safeLoad :: Session -> LoadHowMuch -> IO SuccessFlag
760-safeLoad session mode = do
761-  dflags <- getSessionDynFlags session
762-  handle (\exception -> return Failed ) $
763-    handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
764-                         return Failed) $ load session mode
765-
766-
767-targetsAtOneGo :: Session -> [FileName] -> IO (Maybe [FileData])
768-targetsAtOneGo session hsfiles = do
769-  let targets = map fileTarget hsfiles
770-  setTargets session targets
771-  print $ targetInfo hsfiles
772-  success <- safeLoad session LoadAllTargets  --- bring module graph up to date
773-  case success of
774-    Failed -> return Nothing
775-    Succeeded -> do
776-                 print "loaded all targets"
777-                 graph <- getModuleGraph session
778-                 print "got modules graph"
779-                 fd <- graphData session graph
780-                 return $ Just fd
781-
782-  where targetInfo [hs] = "trying target " ++ hs
783-        targetInfo hss  = "trying " ++ show (length hss) ++ " targets at one go"
784+          emitTagsData modes filedata
785hunk ./utils/ghctags/GhcTags.hs 84
786-targetsOneAtATime :: Session -> [FileName] -> IO ([FileData])
787-targetsOneAtATime session hsfiles = do
788-  print "trying targets one by one"
789-  results <- mapM (targetsAtOneGo session) [[f] | f <- hsfiles]
790-  return $ List.concat $ catMaybes results
791-   
792hunk ./utils/ghctags/GhcTags.hs 85
793+----------------------------------------------
794+----------  ARGUMENT PROCESSING --------------
795hunk ./utils/ghctags/GhcTags.hs 88
796+data Mode = ETags | CTags | BothTags | Append | Help deriving (Ord, Eq, Show)
797+  -- ^Represents options passed to the program
798hunk ./utils/ghctags/GhcTags.hs 101
799--- pull out arguments between -- for GHC
800+-- ^Pull out arguments between -- for GHC
801hunk ./utils/ghctags/GhcTags.hs 107
802-data Mode = ETags | CTags | BothTags | Append | Help deriving (Ord, Eq, Show)
803-
804hunk ./utils/ghctags/GhcTags.hs 108
805+-- supports getopt
806hunk ./utils/ghctags/GhcTags.hs 120
807-type FileName = String
808-
809-type ThingName = String
810hunk ./utils/ghctags/GhcTags.hs 121
811--- A definition we have found
812-data FoundThing = FoundThing ModuleName ThingName SrcLoc
813-
814--- Data we have obtained from a file
815-data FileData = FileData FileName [FoundThing]
816+----------------------------------------------------------------
817+--- LOADING HASKELL SOURCE
818+--- (these bits actually run the compiler and produce abstract syntax)
819hunk ./utils/ghctags/GhcTags.hs 125
820--- stuff for dealing with ctags output format
821-
822-writectagsfile :: Handle -> [FileData] -> IO ()
823-writectagsfile ctagsfile filedata = do
824-       let things = concat $ map getfoundthings filedata
825-       mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) things
826-
827-getfoundthings :: FileData -> [FoundThing]
828-getfoundthings (FileData filename things) = things
829-
830-dumpthing :: FoundThing -> String
831-dumpthing (FoundThing modname name loc) =
832-       name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)
833-    where line = srcLocLine loc
834-          filename = unpackFS $ srcLocFile loc
835-
836-
837--- stuff for dealing with etags output format
838-
839-writeetagsfile :: Handle -> [FileData] -> IO ()
840-writeetagsfile etagsfile filedata = do
841-       mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata
842+safeLoad :: Session -> LoadHowMuch -> IO SuccessFlag
843+-- like GHC.load, but does not stop process on exception
844+safeLoad session mode = do
845+  dflags <- getSessionDynFlags session
846+  handle (\exception -> return Failed ) $
847+    handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
848+                         return Failed) $ load session mode
849hunk ./utils/ghctags/GhcTags.hs 133
850-e_dumpfiledata :: FileData -> String
851-e_dumpfiledata (FileData filename things) =
852-       "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
853-       where
854-               thingsdump = concat $ map e_dumpthing things
855-               thingslength = length thingsdump
856hunk ./utils/ghctags/GhcTags.hs 134
857-e_dumpthing :: FoundThing -> String
858-e_dumpthing (FoundThing modname name loc) =
859-    tagline name ++ tagline (moduleNameString modname ++ "." ++ name)
860-    where tagline n = n ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
861-          line = srcLocLine loc
862-       
863-       
864-       
865--- like "words", but keeping the whitespace, and so letting us build
866--- accurate prefixes   
867-       
868-spacedwords :: String -> [String]
869-spacedwords [] = []
870-spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
871-       where
872-               (blanks,rest) = span Char.isSpace xs
873-               (wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
874-       
875-       
876--- Find the definitions in a file     
877-       
878-modsummary :: ModuleGraph -> FileName -> Maybe ModSummary
879-modsummary graph n =
880-  List.find matches graph
881-  where matches ms = n == msHsFilePath ms
882+targetsAtOneGo :: Session -> [FileName] -> IO (Maybe [FileData])
883+-- load a list of targets
884+targetsAtOneGo session hsfiles = do
885+  let targets = map fileTarget hsfiles
886+  setTargets session targets
887+  print $ "trying " ++ targetInfo hsfiles
888+  success <- safeLoad session LoadAllTargets  --- bring module graph up to date
889+  case success of
890+    Failed -> return Nothing
891+    Succeeded -> do
892+                 print $ "loaded " ++ targetInfo hsfiles
893+                 graph <- getModuleGraph session
894+                 print "got modules graph"
895+                 fd <- graphData session graph
896+                 return $ Just fd
897hunk ./utils/ghctags/GhcTags.hs 150
898-modname :: ModSummary -> ModuleName
899-modname summary = moduleName $ ms_mod $ summary
900+  where targetInfo [hs] = "target " ++ hs
901+        targetInfo hss  = show (length hss) ++ " targets at one go"
902hunk ./utils/ghctags/GhcTags.hs 153
903+targetsOneAtATime :: Session -> [FileName] -> IO ([FileData])
904+-- load a list of targets, one at a time (more resilient to errors)
905+targetsOneAtATime session hsfiles = do
906+  print "trying targets one by one"
907+  results <- mapM (targetsAtOneGo session) [[f] | f <- hsfiles]
908+  return $ List.concat $ catMaybes results
909+   
910hunk ./utils/ghctags/GhcTags.hs 163
911+---------------------------------------------------------------
912+----- CRAWLING ABSTRACT SYNTAX TO SNAFFLE THE DEFINITIONS -----
913+
914hunk ./utils/ghctags/GhcTags.hs 185
915+-- ^Finds all the top-level definitions in a module
916hunk ./utils/ghctags/GhcTags.hs 223
917+
918+-----------------------------------------------
919+------- WRITING THE DATA TO TAGS FILES --------
920+
921+emitTagsData :: [Mode] -> [FileData] -> IO ()
922+emitTagsData modes filedata = do
923+  let mode = getMode (Append `delete` modes)
924+  let openFileMode = if elem Append modes
925+                    then AppendMode
926+                    else WriteMode
927+  if mode == BothTags || mode == CTags
928+   then do
929+     ctagsfile <- openFile "tags" openFileMode
930+     writectagsfile ctagsfile filedata
931+     hClose ctagsfile
932+   else return ()
933+  if mode == BothTags || mode == ETags
934+   then do
935+     etagsfile <- openFile "TAGS" openFileMode
936+     writeetagsfile etagsfile filedata
937+     hClose etagsfile
938+   else return ()
939+
940+
941+-- stuff for dealing with ctags output format
942+
943+writectagsfile :: Handle -> [FileData] -> IO ()
944+writectagsfile ctagsfile filedata = do
945+       let things = concat $ map getfoundthings filedata
946+       mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing False x) things
947+       mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing True  x) things
948+
949+getfoundthings :: FileData -> [FoundThing]
950+getfoundthings (FileData filename things) = things
951+
952+dumpthing :: Bool -> FoundThing -> String
953+dumpthing showmod (FoundThing modname name loc) =
954+       fullname ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)
955+    where line = srcLocLine loc
956+          filename = unpackFS $ srcLocFile loc
957+          fullname = if showmod then moduleNameString modname ++ "." ++ name
958+                     else name
959+
960+-- stuff for dealing with etags output format
961+
962+writeetagsfile :: Handle -> [FileData] -> IO ()
963+writeetagsfile etagsfile filedata = do
964+       mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata
965+
966+e_dumpfiledata :: FileData -> String
967+e_dumpfiledata (FileData filename things) =
968+       "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
969+       where
970+               thingsdump = concat $ map e_dumpthing things
971+               thingslength = length thingsdump
972+
973+e_dumpthing :: FoundThing -> String
974+e_dumpthing (FoundThing modname name loc) =
975+    tagline name ++ tagline (moduleNameString modname ++ "." ++ name)
976+    where tagline n = n ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
977+          line = srcLocLine loc
978+
979}
980
981[working 'ghctags' Makefile target (requires stage=2)
982Norman Ramsey <nr@eecs.harvard.edu>**20060920042607] {
983hunk ./compiler/Makefile 907
984+GHCTAGS_HC_OPTS = $(patsubst -i$(odir)/%, -i%, $(HC_OPTS))
985+
986hunk ./compiler/Makefile 916
987+       @if [ "$(stage)" != 2 ]; then echo "Must use 'make stage=2 ghctags'"; exit 1; fi
988hunk ./compiler/Makefile 922
989-       $(GHCTAGS) -- $(MKDEPENDHS_OPTS) $(filter-out -split-objs, $(MKDEPENDHS_HC_OPTS)) -- $(GHCTAGS_HS_SRCS)
990+       # $(GHCTAGS) -- $(MKDEPENDHS_OPTS) $(filter-out -split-objs, $(MKDEPENDHS_HC_OPTS)) -- $(GHCTAGS_HS_SRCS)
991+       $(GHCTAGS) -- $(GHCTAGS_HC_OPTS) -- $(GHCTAGS_HS_SRCS)
992}
993
994[first cut at missing case for ids defined in pattern
995Norman Ramsey <nr@eecs.harvard.edu>**20060920042757] {
996hunk ./utils/ghctags/GhcTags.hs 215
997-  let thing = foundOfLName modname
998-  in  case unLoc lbinding of
999-        FunBind { fun_id = id } -> [thing id]
1000-        PatBind { pat_lhs = lhs } -> panic "Pattern at top level"
1001-        VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
1002-        AbsBinds { } -> [] -- nothing interesting in a type abstraction
1003-
1004+  case unLoc lbinding of
1005+    FunBind { fun_id = id } -> [thing id]
1006+    PatBind { pat_lhs = lhs } -> patThings lhs []
1007+    VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
1008+    AbsBinds { } -> [] -- nothing interesting in a type abstraction
1009+  where thing = foundOfLName modname
1010+        patThings lpat tl =
1011+          let loc = startOfLocated lpat
1012+              lid id = FoundThing modname (getOccString id) loc
1013+          in case unLoc lpat of
1014+               WildPat _ -> tl
1015+               VarPat name -> lid name : tl
1016+               VarPatOut name _ -> lid name : tl -- XXX need help here
1017+               LazyPat p -> patThings p tl
1018+               AsPat id p -> patThings p (thing id : tl)
1019+               ParPat p -> patThings p tl
1020+               BangPat p -> patThings p tl
1021+               ListPat ps _ -> foldr patThings tl ps
1022+               TuplePat ps _ _ -> foldr patThings tl ps
1023+               PArrPat ps _ -> foldr patThings tl ps
1024+               ConPatIn _ conargs -> conArgs conargs tl
1025+               ConPatOut _ _ _ _ conargs _ -> conArgs conargs tl
1026+               LitPat _ -> tl
1027+               NPat _ _ _ _ -> tl -- form of literal pattern?
1028+               NPlusKPat id _ _ _ -> thing id : tl
1029+               TypePat _ -> tl -- XXX need help here
1030+               SigPatIn p _ -> patThings p tl
1031+               SigPatOut p _ -> patThings p tl
1032+               DictPat _ _ -> tl
1033+        conArgs (PrefixCon ps) tl = foldr patThings tl ps
1034+        conArgs (RecCon pairs) tl = foldr (\(_id, p) tl -> patThings p tl) tl pairs
1035+        conArgs (InfixCon p1 p2) tl = patThings p1 $ patThings p2 tl
1036}
1037
1038[proper HC entry for bootstrapping in Makefile
1039Norman Ramsey <nr@eecs.harvard.edu>**20060920042839] {
1040hunk ./utils/ghctags/Makefile 6
1041-HC=/usr/local/bin/ghc
1042+HC=$(GHC_STAGE1)
1043}
1044
1045[correct minor spelling error s/patterng/pattern/
1046Norman Ramsey <nr@eecs.harvard.edu>**20060920042913] {
1047hunk ./compiler/hsSyn/HsPat.lhs 59
1048-  | BangPat    (LPat id)               -- Bang patterng
1049+  | BangPat    (LPat id)               -- Bang pattern
1050}
1051
1052[new README file for utils/ghctags
1053nr@eecs.harvard.edu**20061013202756] {
1054addfile ./utils/ghctags/README
1055hunk ./utils/ghctags/README 1
1056+This program should eventually replace the lexically-based
1057+tags program.  But before this can happen, several problems
1058+must be addressed:
1059+
1060+  * Performance is disastrous: it takes much longer to run ghctags
1061+    than it does to compile GHC
1062+
1063+  * The program does not use the correct source-code locations
1064+
1065+The program accepts both its own arguments and options intended for GHC.
1066+As a quick self-test, you can run
1067+
1068+  ./ghctags -- -package ghc -- GhcTags.hs
1069}
1070
1071[accomodate changes in the GHC API
1072nr@eecs.harvard.edu**20061013202825] {
1073hunk ./utils/ghctags/GhcTags.hs 67
1074-        GHC.init (Just ghcRootDir)
1075hunk ./utils/ghctags/GhcTags.hs 68
1076-          session <- newSession JustTypecheck
1077+          session <- newSession JustTypecheck (Just ghcRootDir)
1078hunk ./utils/ghctags/GhcTags.hs 73
1079-            flags <- initPackages flags
1080hunk ./utils/ghctags/GhcTags.hs 177
1081-fileData filename modname (group, imports, lie) =
1082+fileData filename modname (group, _imports, _lie, _doc, _haddock) =
1083hunk ./utils/ghctags/GhcTags.hs 180
1084+    -- doc and haddock seem haddock-related; let's hope to ignore them
1085hunk ./utils/ghctags/GhcTags.hs 244
1086-        conArgs (RecCon pairs) tl = foldr (\(_id, p) tl -> patThings p tl) tl pairs
1087+        conArgs (RecCon pairs) tl = foldr (\f tl -> patThings (hsRecFieldArg f) tl) tl pairs
1088}
1089
1090[request for documentation of a new argument
1091nr@eecs.harvard.edu**20061013202922] {
1092hunk ./compiler/main/GHC.hs 332
1093+-- ToDo: explain argument [[mb_top_dir]]
1094}
1095
1096Context:
1097
1098[Overlap check for family instances def'd in current module
1099Manuel M T Chakravarty <chak@cse.unsw.edu.au>**20061012203737
1100 - All family instances are checked for overlap when entered into TcGblEnv.
1101   Their are checked against all instances in the EPS and those currently in
1102   the TcGblEnv.
1103]
1104[Comments only
1105simonpj@microsoft.com**20061012160254]
1106[Make Inst into a record type to ease subsequent changes
1107simonpj@microsoft.com**20061011112305]
1108[Improve pretty-printing slightly
1109simonpj@microsoft.com**20061011112242]
1110[Add comments about primop rules
1111simonpj@microsoft.com**20061011112224]
1112[fix definition of fib in example code
1113Simon Marlow <simonmar@microsoft.com>*-20061012110711]
1114[Track changes in source packaging scheme
1115sven.panne@aedion.de**20061012121213]
1116[fix definition of fib in example code
1117Simon Marlow <simonmar@microsoft.com>**20061012110711]
1118[Partially fix GHCi when unregisterised
1119Ian Lynagh <igloo@earth.li>**20061012013901
1120 We were constructing info tables designed for TABLES_NEXT_TO_CODE,
1121 but were building without TABLES_NEXT_TO_CODE.
1122 
1123 This patch also fixes a bug when we are unregisterised on amd64 and
1124 have code with an address above 2^32.
1125]
1126[More import tidying and fixing the stage 2 build
1127Simon Marlow <simonmar@microsoft.com>**20061011200110]
1128[Use relative URLs when referring to libraries; push to 6.6 branch
1129simonpj@microsoft.com**20061011142502]
1130[Improve documentation of concurrent and parallel Haskell; push to branch
1131simonpj@microsoft.com**20061010155834]
1132[Correct id to linkend
1133simonpj@microsoft.com**20061010155814]
1134[Fix trac #921: generate *q instructions for int-float conversions
1135Ian Lynagh <igloo@earth.li>**20061011140007
1136 We need to generate, e.g., cvtsi2sdq rather than cvtsi2sd on amd64 in
1137 order to have int-float conversions work correctly for values not
1138 correctly representable in 32 bits.
1139]
1140[Module header tidyup #2
1141Simon Marlow <simonmar@microsoft.com>**20061011143523
1142 Push this further along, and fix build problems in the first patch.
1143]
1144[remove BitSet, it isn't used
1145Simon Marlow <simonmar@microsoft.com>**20061011131614]
1146[Module header tidyup, phase 1
1147Simon Marlow <simonmar@microsoft.com>**20061011120517
1148 This patch is a start on removing import lists and generally tidying
1149 up the top of each module.  In addition to removing import lists:
1150 
1151    - Change DATA.IOREF -> Data.IORef etc.
1152    - Change List -> Data.List etc.
1153    - Remove $Id$
1154    - Update copyrights
1155    - Re-order imports to put non-GHC imports last
1156    - Remove some unused and duplicate imports
1157]
1158[Interface file optimisation and removal of nameParent
1159Simon Marlow <simonmar@microsoft.com>**20061011120518
1160 
1161 This large commit combines several interrelated changes:
1162 
1163   - IfaceSyn now contains actual Names rather than the special
1164     IfaceExtName type.  The binary interface file contains
1165     a symbol table of Names, where each entry is a (package,
1166     ModuleName, OccName) triple.  Names in the IfaceSyn point
1167     to entries in the symbol table.
1168 
1169     This reduces the size of interface files, which should
1170     hopefully improve performance (not measured yet).
1171 
1172     The toIfaceXXX functions now do not need to pass around
1173     a function from Name -> IfaceExtName, which makes that
1174     code simpler.
1175 
1176   - Names now do not point directly to their parents, and the
1177     nameParent operation has gone away.  It turned out to be hard to
1178     keep this information consistent in practice, and the parent info
1179     was only valid in some Names.  Instead we made the following
1180     changes:
1181 
1182     * ImportAvails contains a new field
1183           imp_parent :: NameEnv AvailInfo
1184       which gives the family info for any Name in scope, and
1185       is used by the renamer when renaming export lists, amongst
1186       other things.  This info is thrown away after renaming.
1187 
1188     * The mi_ver_fn field of ModIface now maps to
1189       (OccName,Version) instead of just Version, where the
1190       OccName is the parent name.  This mapping is used when
1191       constructing the usage info for dependent modules.
1192       There may be entries in mi_ver_fn for things that are not in
1193       scope, whereas imp_parent only deals with in-scope things.
1194 
1195     * The md_exports field of ModDetails now contains
1196       [AvailInfo] rather than NameSet.  This gives us
1197       family info for the exported names of a module.
1198 
1199 Also:
1200 
1201    - ifaceDeclSubBinders moved to IfaceSyn (seems like the
1202      right place for it).
1203 
1204    - heavily refactored renaming of import/export lists.
1205 
1206    - Unfortunately external core is now broken, as it relied on
1207      IfaceSyn.  It requires some attention.
1208]
1209[add extendNameEnvList_C
1210Simon Marlow <simonmar@microsoft.com>**20061010153137]
1211[getMainDeclBinder should return Nothing for a binding with no variables
1212Simon Marlow <simonmar@microsoft.com>**20061010153023
1213 See test rn003
1214 
1215]
1216[Use ":Co", not "Co" to prefix coercion TyCon names
1217Simon Marlow <simonmar@microsoft.com>**20061010134449
1218 Avoid possibility of name clash
1219]
1220[Fix another hi-boot file
1221Ian Lynagh <igloo@earth.li>**20061010235157]
1222[Removed unused unwrapFamInstBody from MkId
1223Manuel M T Chakravarty <chak@cse.unsw.edu.au>**20061010205843]
1224[Rejig the auto-scc wrapping stuff
1225simonpj@microsoft.com**20061010164116]
1226[Do not filter the type envt after each GHCi stmt
1227simonpj@microsoft.com**20061010143225
1228 
1229 Fixes Trac #925
1230 
1231 A new comment in TcRnDriver in tcRnStmt reads thus:
1232 
1233 At one stage I removed any shadowed bindings from the type_env;
1234 they are inaccessible but might, I suppose, cause a space leak if we leave them there.
1235 However, with Template Haskell they aren't necessarily inaccessible.  Consider this
1236 GHCi session
1237         Prelude> let f n = n * 2 :: Int
1238         Prelude> fName <- runQ [| f |]
1239         Prelude> $(return $ AppE fName (LitE (IntegerL 7)))
1240         14
1241         Prelude> let f n = n * 3 :: Int
1242         Prelude> $(return $ AppE fName (LitE (IntegerL 7)))
1243 In the last line we use 'fName', which resolves to the *first* 'f'
1244 in scope. If we delete it from the type env, GHCi crashes because
1245 it doesn't expect that.
1246 
1247 
1248]
1249[Fail more informatively when a global isn't in the type environment
1250simonpj@microsoft.com**20061010143145]
1251[Rough matches for family instances
1252Manuel M T Chakravarty <chak@cse.unsw.edu.au>**20061010044656
1253 - Class and type family instances just got a lot more similar.
1254 - FamInst, like Instance, now has a rough match signature.  The idea is the
1255   same: if the rough match doesn't match, there is no need to pull in the while
1256   tycon describing the instance (from a lazily read iface).
1257 - IfaceFamInst changes in a similar way and the list of all IFaceFamInsts is
1258   now written into the binary iface (as for class instances), as deriving it
1259   from the tycon (as before) would render the whole rough matching useless.
1260 - As a result of this, the plumbing of class instances and type instances
1261   through the various environments, ModIface, ModGuts, and ModDetails is now
1262   almost the same.  (The remaining difference are mostly because the dfun of a
1263   class instance is an Id, but type instance refer to a TyCon, not an Id.)
1264 
1265 *** WARNING: The interface file format changed! ***
1266 ***         Rebuild from scratch.              ***
1267]
1268[Tweaks and missing case in disassembler
1269Ian Lynagh <igloo@earth.li>**20061009230539]
1270[Update hi-boot files to fix building with old GHCs
1271Ian Lynagh <igloo@earth.li>**20061009193218]
1272[STM invariants
1273tharris@microsoft.com**20061007122907]
1274[Fix unregisterised alpha builds
1275Ian Lynagh <igloo@earth.li>**20061004125857]
1276[Comments and an import-trim
1277simonpj@microsoft.com**20061006161403]
1278[Mention that the module sub-directory structure for .o and .hi files is created automatically by GHC
1279simonpj@microsoft.com**20061006151234]
1280[Bale out before renamer errors are duplicated
1281simonpj@microsoft.com**20061006140250
1282 
1283 With the new Haddock patch, renamer errors can be duplicated;
1284 so we want to bale out before doing the Haddock stuff if errors
1285 are found.
1286 
1287 (E.g test mod67 shows this up.)
1288 
1289]
1290[Avoid repeatedly loading GHC.Prim
1291simonpj@microsoft.com**20061006140102
1292 
1293 This patch changes HscTypes.lookupIfaceByModule.  The problem was that
1294 when compiling the 'base' package, we'd repeatedly reload GHC.Prim.
1295 This is easily fixed by looking in the PIT too. A comment with
1296 lookupIfaceByModule explains
1297 
1298]
1299[Print the 'skipping' messages at verbosity level 1
1300simonpj@microsoft.com**20061006140034]
1301[Fix up the typechecking of interface files during --make
1302simonpj@microsoft.com**20061006131932
1303 
1304 This patch fixes Trac #909.  The problem was that when compiling
1305 the base package, the handling of wired-in things wasn't right;
1306 in TcIface.tcWiredInTyCon it repeatedly loaded GHC.Base.hi into the
1307 PIT, even though that was the very module it was compiling.
1308 
1309 The main fix is by introducing TcIface.ifCheckWiredInThing.
1310 
1311 But I did some minor refactoring as well.
1312 
1313]
1314[Import trimming
1315simonpj@microsoft.com**20061006131830]
1316[Figure out where the rest of the repositories are, based on defaultrepo
1317Simon Marlow <simonmar@microsoft.com>**20061006100049
1318 This is a slight improvement over the patch sent by jamey@minilop.net,
1319 we now do it properly if the source repo was a GHC tree on the local
1320 filesystem too.
1321 
1322 Merge post 6.6.
1323]
1324[Yet another fix to mkAtomicArgs (for floating of casts)
1325simonpj@microsoft.com**20061006075213
1326 
1327 Comment Note [Take care] explains.
1328 
1329 mkAtomicArgs is a mess.  A substantial rewrite of Simplify is needed.
1330 
1331]
1332[Improve comments and error tracing
1333simonpj@microsoft.com**20061006075058]
1334[Improve error message
1335simonpj@microsoft.com**20061006072002]
1336[Undo an accidentally-committed  patch by Audrey
1337simonpj@microsoft.com**20061006071925]
1338[Merge Haddock comment support from ghc.haddock -- big patch
1339davve@dtek.chalmers.se**20061005220258]
1340[Remove casts from lvalues to allow compilation under GCC 4.0
1341brianlsmith@gmail.com**20060929185931]
1342[Correct the float-coercions-out-of-let patch
1343simonpj@microsoft.com**20061005161819]
1344[Merge changes
1345Ian Lynagh <igloo@earth.li>**20061005150630]
1346[Improve the correlation betweens documented and existent options
1347Ian Lynagh <igloo@earth.li>**20061003220354]
1348[Document -dfaststring-stats
1349Ian Lynagh <igloo@earth.li>**20061003154147]
1350[Rearrange docs to have all the -ddump-* options together
1351Ian Lynagh <igloo@earth.li>**20061003153422]
1352[Remove unused option -femit-extern-decls
1353Ian Lynagh <igloo@earth.li>**20061003145854]
1354[Documentation updates
1355Ian Lynagh <igloo@earth.li>**20061003142658]
1356[Fix typo
1357Ian Lynagh <igloo@earth.li>**20061003121926]
1358[More bootstrapping updates
1359Ian Lynagh <igloo@earth.li>**20061005145629]
1360[TAG 2006-10-05
1361Lemmih <lemmih@gmail.com>**20061005150234]
1362Patch bundle hash:
1363944cbfe03d84cea7fd79884f9321180375c49ca4