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

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