Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/depend/index.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/depend/index.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 986 - (view) (download)

1 : blume 986 (* index.sml
2 :     *
3 : blume 838 * Generating indices mapping top-level defined symbols to files
4 :     * where they are defined.
5 :     *
6 :     * Copyright (c) 2001 by Lucent Technologies, Bell Laboratories
7 :     *
8 :     * author: Matthias Blume (blume@research.bell-labs.com)
9 :     *)
10 :     signature INDEX = sig
11 :     val mkIndex :
12 :     GeneralParams.info *
13 :     SrcPath.file *
14 :     { imports: DependencyGraph.impexp SymbolMap.map,
15 :     smlfiles: 'b,
16 :     localdefs: SmlInfo.info SymbolMap.map,
17 :     subgroups:
18 :     (SrcPath.file * GroupGraph.group * SrcPath.rebindings) list,
19 :     sources: 'c,
20 :     reqpriv: 'd }
21 :     -> unit
22 :     end
23 :    
24 :     structure Index :> INDEX = struct
25 :     fun mkIndex (gp: GeneralParams.info, group, coll) =
26 :     if #get StdConfig.generate_index () then
27 : blume 986 let val { imports, smlfiles, localdefs, subgroups,
28 : blume 838 sources, reqpriv } = coll
29 :     val idxfile =
30 :     FilenamePolicy.mkIndexName (#fnpolicy (#param gp)) group
31 :     fun localinfo i =
32 :     (SrcPath.osstring_relative (SmlInfo.sourcepath i), false)
33 :     fun globalinfo (sy, _) = let
34 :     fun find [] =
35 :     ErrorMsg.impossible "index.sml: globalinfo not found"
36 :     | find ((g, GroupGraph.GROUP { exports, ... }, _) :: r) =
37 :     if SymbolMap.inDomain (exports, sy) then
38 :     (SrcPath.descr g, true)
39 :     else find r
40 :     | find (_ :: r) = find r
41 :     in
42 :     find subgroups
43 :     end
44 :     val l_idx = SymbolMap.map localinfo localdefs
45 :     val g_idx = SymbolMap.mapi globalinfo imports
46 :     fun combine ((l, _), (g, _)) =
47 :     (concat [l, " (overrides ", g, ")"], false)
48 :     val idx = SymbolMap.unionWith combine (l_idx, g_idx)
49 :     fun oneline (sy, (s, f), l) =
50 :     (concat [Symbol.nameSpaceToString
51 :     (Symbol.nameSpace sy),
52 :     " ", Symbol.name sy, ": ", s, "\n"], f)
53 :     :: l
54 :     val l = SymbolMap.foldli oneline [] idx
55 :     fun gt ((_, true), (_, false)) = true
56 :     | gt ((_, false), (_, true)) = false
57 :     | gt ((x: string, _), (y, _)) = x > y
58 :     val sorted_l = ListMergeSort.sort gt l
59 :     fun work str = let
60 :     fun out x = TextIO.output (str, x)
61 :     fun bottomhalf [] = ()
62 :     | bottomhalf ((x, _) :: r) = (out x; bottomhalf r)
63 :     fun tophalf [] = ()
64 :     | tophalf ((x, false) :: r) = (out x; tophalf r)
65 :     | tophalf ((x, true) :: r) =
66 :     (out "--------------IMPORTS--------------\n";
67 :     out x;
68 :     bottomhalf r)
69 :     in
70 :     out "---------LOCAL DEFINITIONS---------\n";
71 :     tophalf sorted_l
72 :     end
73 :     in
74 :     SafeIO.perform { openIt = fn () => AutoDir.openTextOut idxfile,
75 :     closeIt = TextIO.closeOut,
76 :     work = work,
77 :     cleanup = fn _ => OS.FileSys.remove idxfile }
78 :     end
79 :     else ()
80 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0