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/semant/members.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/semant/members.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 879 - (view) (download)

1 : blume 267 (*
2 :     * Collections of members in CM descriptions.
3 :     * Involves:
4 :     * - running tools
5 :     * - fully analyzing sub-groups and sub-libraries
6 :     * - parsing ML files and getting their export lists
7 :     *
8 :     * (C) 1999 Lucent Technologies, Bell Laboratories
9 :     *
10 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
11 :     *)
12 :     signature MEMBERCOLLECTION = sig
13 :    
14 : blume 278 type symbol = Symbol.symbol
15 : blume 270 type smlinfo = SmlInfo.info
16 : blume 283 type impexp = DependencyGraph.impexp
17 : blume 879 type region = SourceMap.region
18 : blume 666 type subgroups =
19 :     (SrcPath.file * GroupGraph.group * SrcPath.rebindings) list
20 : blume 269
21 : blume 267 type collection
22 :    
23 : blume 274 val empty : collection
24 :    
25 : blume 642 val implicit : GeneralParams.info -> GroupGraph.group -> collection
26 : blume 537
27 : blume 518 val expandOne :
28 : blume 632 { gp: GeneralParams.info,
29 : blume 666 rparse: SrcPath.file * Version.t option * SrcPath.rebindings ->
30 :     GroupGraph.group,
31 :     load_plugin: SrcPath.dir -> string -> bool }
32 : blume 587 -> { name: string,
33 : blume 756 mkpath: unit -> SrcPath.prefile,
34 : blume 666 group: SrcPath.file * region,
35 : blume 587 class: string option,
36 : blume 588 tooloptions: PrivateTools.toolopts option,
37 : blume 735 local_registry: PrivateTools.registry,
38 : blume 666 context: SrcPath.dir }
39 : blume 270 -> collection
40 : blume 275 val sequential : collection * collection * (string -> unit) -> collection
41 : blume 267
42 : blume 297 val build :
43 : blume 537 collection * SymbolSet.set option * GeneralParams.info *
44 :     DependencyGraph.farsbnode (* pervasive env *)
45 : blume 733 -> impexp SymbolMap.map * GroupGraph.privileges * SymbolSet.set
46 : blume 280
47 : blume 838 val mkIndex : GeneralParams.info * SrcPath.file * collection -> unit
48 :    
49 : blume 666 val subgroups : collection -> subgroups
50 : blume 642 val sources : collection ->
51 :     { class: string, derived: bool } SrcPathMap.map
52 : blume 294
53 : blume 336 val num_look : GeneralParams.info -> collection -> string -> int
54 :     val cm_look : GeneralParams.info -> collection -> string -> bool
55 : blume 278 val ml_look : collection -> symbol -> bool
56 : blume 771
57 :     val has_smlfiles : collection -> bool
58 : blume 840 val is_errorcollection : collection -> bool
59 : blume 267 end
60 :    
61 :     structure MemberCollection :> MEMBERCOLLECTION = struct
62 :    
63 : blume 269 structure DG = DependencyGraph
64 : blume 879 structure EM = ErrorMsg
65 :     structure E = Environment
66 : blume 286 structure SS = SymbolSet
67 : blume 294 structure GG = GroupGraph
68 : blume 632 structure V = Version
69 : blume 267
70 : blume 270 type smlinfo = SmlInfo.info
71 : blume 275 type symbol = Symbol.symbol
72 : blume 283 type impexp = DG.impexp
73 : blume 879 type region = SourceMap.region
74 : blume 666 type subgroups = (SrcPath.file * GG.group * SrcPath.rebindings) list
75 : blume 267
76 : blume 269 datatype collection =
77 : blume 283 COLLECTION of { imports: impexp SymbolMap.map,
78 :     gimports: impexp SymbolMap.map,
79 : blume 269 smlfiles: smlinfo list,
80 : blume 294 localdefs: smlinfo SymbolMap.map,
81 : blume 666 subgroups: subgroups,
82 : blume 642 sources:
83 :     { class: string, derived: bool } SrcPathMap.map,
84 : blume 301 reqpriv: GG.privileges }
85 : blume 587 | ERRORCOLLECTION
86 : blume 269
87 : blume 642 fun empty' sources =
88 : blume 283 COLLECTION { imports = SymbolMap.empty,
89 :     gimports = SymbolMap.empty,
90 : blume 274 smlfiles = [],
91 : blume 294 localdefs = SymbolMap.empty,
92 : blume 301 subgroups = [],
93 : blume 642 sources = sources,
94 : blume 301 reqpriv = StringSet.empty }
95 : blume 274
96 : blume 642 val empty = empty' SrcPathMap.empty
97 :    
98 :     fun implicit (gp: GeneralParams.info) init_group = let
99 : blume 587 val { grouppath, ... } =
100 :     case init_group of
101 :     GG.GROUP x => x
102 :     | GG.ERRORGROUP =>
103 :     EM.impossible "members.sml: implicit: bad init group"
104 : blume 642 val sm = SrcPathMap.singleton (grouppath,
105 :     { class = "cm", derived = false })
106 : blume 537 in
107 :     (* This is a collection that is an implicit member of every
108 :     * library -- the "init" group which exports the pervasive env. *)
109 :     COLLECTION { imports = SymbolMap.empty,
110 :     gimports = SymbolMap.empty,
111 :     smlfiles = [],
112 :     localdefs = SymbolMap.empty,
113 : blume 666 subgroups = [(grouppath, init_group, [])],
114 : blume 642 sources = sm,
115 : blume 537 reqpriv = StringSet.empty }
116 :     end
117 :    
118 : blume 587 fun sequential (COLLECTION c1, COLLECTION c2, error) =
119 :     let fun describeSymbol (s, r) = let
120 :     val ns = Symbol.nameSpace s
121 :     in
122 :     Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
123 :     end
124 : blume 652 fun i_error (s, x as (nth, e, allsyms), (nth', e', allsyms')) = let
125 :     val (f, sbn) = nth ()
126 :     val (f', sbn') = nth' ()
127 : blume 587 fun complain () =
128 :     error (concat (describeSymbol
129 :     (s, [" imported from ",
130 :     DG.describeSBN sbn,
131 :     " and also from ",
132 :     DG.describeSBN sbn'])))
133 :     fun union (NONE, _) = NONE
134 :     | union (_, NONE) = NONE
135 :     | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
136 :     in
137 :     if DG.sbeq (sbn, sbn') then
138 : blume 652 let val fsbn = (union (f, f'), sbn)
139 :     in
140 :     (fn () => fsbn, DAEnv.LAYER (e, e'),
141 :     SymbolSet.union (allsyms, allsyms'))
142 :     end
143 : blume 587 else (complain (); x)
144 :     end
145 :     val i_union = SymbolMap.unionWithi i_error
146 :     val gi_union = SymbolMap.unionWith #1
147 :     fun ld_error (s, f1, f2) =
148 :     (error (concat (describeSymbol
149 : blume 666 (s, [" defined in ", SmlInfo.descr f1,
150 :     " and also in ", SmlInfo.descr f2])));
151 : blume 587 f1)
152 :     val ld_union = SymbolMap.unionWithi ld_error
153 : blume 642 val s_union = SrcPathMap.unionWith #1
154 : blume 275 in
155 : blume 587 COLLECTION { imports = i_union (#imports c1, #imports c2),
156 :     gimports = gi_union (#gimports c1, #gimports c2),
157 :     smlfiles = #smlfiles c1 @ #smlfiles c2,
158 :     localdefs = ld_union (#localdefs c1, #localdefs c2),
159 :     subgroups = #subgroups c1 @ #subgroups c2,
160 : blume 642 sources = s_union (#sources c1, #sources c2),
161 : blume 587 reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
162 : blume 275 end
163 : blume 587 | sequential _ = ERRORCOLLECTION
164 : blume 269
165 : blume 632 fun expandOne { gp, rparse, load_plugin } arg = let
166 : blume 735 val { name, mkpath, group, class, tooloptions,
167 :     local_registry, context } = arg
168 : blume 336 val class = Option.map (String.map Char.toLower) class
169 : blume 299 val error = GroupReg.error (#groupreg gp) group
170 : blume 537 fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
171 :     fun w0 s = error EM.WARN s EM.nullErrorBody
172 : blume 642 val { smlfiles, cmfiles, sources } =
173 : blume 537 PrivateTools.expand { error = e0,
174 : blume 735 local_registry = local_registry,
175 : blume 642 spec = { name = name,
176 :     mkpath = mkpath,
177 :     class = class,
178 :     opts = tooloptions,
179 :     derived = false },
180 : blume 537 context = context,
181 : blume 873 load_plugin = load_plugin,
182 :     sysinfo = { symval =
183 :     fn s => #get (#symval (#param gp) s) (),
184 :     archos = #archos (#param gp) } }
185 : blume 642 val msources = foldl SrcPathMap.insert' SrcPathMap.empty sources
186 : blume 666 fun g_coll (p, v, rb) =
187 :     case rparse (p, v, rb) of
188 : blume 642 g as GG.GROUP { exports = i, kind, required, sources,
189 : blume 587 grouppath, sublibs } => let
190 : blume 632 val (gi, ver) =
191 :     case kind of
192 :     GG.NOLIB _ => (i, NONE)
193 :     | GG.LIB l => (SymbolMap.empty, #version l)
194 : blume 587 in
195 : blume 632 case (v, ver) of
196 :     (NONE, _) => ()
197 :     | (SOME vrq, NONE) =>
198 :     e0 "library does not carry a version stamp"
199 :     | (SOME vrq, SOME ver) =>
200 :     (case V.compare (vrq, ver) of
201 :     GREATER => e0 "library is older than expected"
202 :     | EQUAL => ()
203 :     | LESS =>
204 :     (case V.compare (V.nextMajor vrq, ver) of
205 :     GREATER =>
206 :     w0 "library is slightly newer than expected"
207 :     | _ => e0 "library is newer than expected"));
208 : blume 587 COLLECTION { imports = i, gimports = gi, smlfiles = [],
209 :     localdefs = SymbolMap.empty,
210 : blume 666 subgroups = [(p, g, rb)],
211 : blume 642 sources = SrcPathMap.empty,
212 : blume 587 reqpriv = required }
213 :     end
214 :     | GG.ERRORGROUP => ERRORCOLLECTION
215 : blume 818 fun s_coll (p, s, setup, split) = let
216 : blume 537 val i =
217 : blume 818 SmlInfo.info split gp { sourcepath = p, group = group,
218 :     sh_spec = s, setup = setup }
219 : blume 537 val exports =
220 :     case SmlInfo.exports gp i of
221 :     NONE => SS.empty
222 :     | SOME ex => (if SS.isEmpty ex then
223 :     w0 ("no module exports from " ^
224 :     SrcPath.descr p)
225 :     else ();
226 :     ex)
227 :     fun addLD (s, m) = SymbolMap.insert (m, s, i)
228 :     val ld = SS.foldl addLD SymbolMap.empty exports
229 :     in
230 :     COLLECTION { imports = SymbolMap.empty,
231 :     gimports = SymbolMap.empty,
232 :     smlfiles = [i],
233 :     localdefs = ld,
234 :     subgroups = [],
235 : blume 642 sources = SrcPathMap.empty,
236 : blume 537 reqpriv = StringSet.empty }
237 :     end
238 :     val collections = map g_coll cmfiles @ map s_coll smlfiles
239 :     fun combine (c1, c2) = sequential (c2, c1, e0)
240 : blume 274 in
241 : blume 642 foldl combine (empty' msources) collections
242 : blume 270 end
243 :    
244 : blume 537 fun build (COLLECTION c, fopt, gp, perv_fsbnode) =
245 :     BuildDepend.build (c, fopt, gp, perv_fsbnode)
246 : blume 587 | build (ERRORCOLLECTION, _, _, _) =
247 : blume 733 (SymbolMap.empty, StringSet.empty, SymbolSet.empty)
248 : blume 280
249 : blume 838 fun mkIndex (gp, g, COLLECTION c) = Index.mkIndex (gp, g, c)
250 :     | mkIndex _ = ()
251 :    
252 : blume 294 fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
253 : blume 587 | subgroups ERRORCOLLECTION = []
254 : blume 294
255 : blume 642 fun sources (COLLECTION { sources = s, ... }) = s
256 :     | sources ERRORCOLLECTION = SrcPathMap.empty
257 :    
258 : blume 336 local
259 :     fun symenv_look (gp: GeneralParams.info) (c: collection) s =
260 : blume 433 #get (#symval (#param gp) s) ()
261 : blume 336 in
262 :     fun num_look gp c s = getOpt (symenv_look gp c s, 0)
263 :     fun cm_look gp c s = isSome (symenv_look gp c s)
264 :     end
265 : blume 269
266 : blume 283 fun ml_look (COLLECTION { imports, localdefs, ... }) s =
267 :     isSome (SymbolMap.find (imports, s)) orelse
268 : blume 269 isSome (SymbolMap.find (localdefs, s))
269 : blume 587 | ml_look ERRORCOLLECTON _ = true
270 : blume 771
271 :     fun has_smlfiles (COLLECTION { smlfiles = [], ... }) = false
272 :     | has_smlfiles ERRORCOLLECTION = false
273 :     | has_smlfiles _ = true
274 : blume 840
275 :     fun is_errorcollection ERRORCOLLECTION = true
276 :     | is_errorcollection (COLLECTION _) = false
277 : blume 267 end

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