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

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