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 537 - (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 537 val implicit : GroupGraph.group -> collection
24 :    
25 : blume 518 val expandOne :
26 :     GeneralParams.info * (SrcPath.t -> GroupGraph.group) * (string -> bool)
27 : blume 493 -> { name: string, mkpath: string -> SrcPath.t,
28 :     group: SrcPath.t * region, class: string option,
29 :     context: SrcPath.context }
30 : blume 270 -> collection
31 : blume 275 val sequential : collection * collection * (string -> unit) -> collection
32 : blume 267
33 : blume 297 val build :
34 : blume 537 collection * SymbolSet.set option * GeneralParams.info *
35 :     DependencyGraph.farsbnode (* pervasive env *)
36 : blume 301 -> impexp SymbolMap.map * GroupGraph.privileges
37 : blume 280
38 : blume 444 val subgroups : collection -> (SrcPath.t * GroupGraph.group) list
39 : blume 294
40 : blume 336 val num_look : GeneralParams.info -> collection -> string -> int
41 :     val cm_look : GeneralParams.info -> collection -> string -> bool
42 : blume 278 val ml_look : collection -> symbol -> bool
43 : blume 267 end
44 :    
45 :     structure MemberCollection :> MEMBERCOLLECTION = struct
46 :    
47 : blume 269 structure DG = DependencyGraph
48 : blume 277 structure EM = GenericVC.ErrorMsg
49 : blume 278 structure CBE = GenericVC.BareEnvironment
50 : blume 398 structure E = GenericVC.Environment
51 : blume 286 structure SS = SymbolSet
52 : blume 294 structure GG = GroupGraph
53 : blume 267
54 : blume 270 type smlinfo = SmlInfo.info
55 : blume 275 type symbol = Symbol.symbol
56 : blume 283 type impexp = DG.impexp
57 : blume 297 type region = GenericVC.SourceMap.region
58 : blume 267
59 : blume 269 datatype collection =
60 : blume 283 COLLECTION of { imports: impexp SymbolMap.map,
61 :     gimports: impexp SymbolMap.map,
62 : blume 269 smlfiles: smlinfo list,
63 : blume 294 localdefs: smlinfo SymbolMap.map,
64 : blume 444 subgroups: (SrcPath.t * GG.group) list,
65 : blume 301 reqpriv: GG.privileges }
66 : blume 269
67 : blume 274 val empty =
68 : blume 283 COLLECTION { imports = SymbolMap.empty,
69 :     gimports = SymbolMap.empty,
70 : blume 274 smlfiles = [],
71 : blume 294 localdefs = SymbolMap.empty,
72 : blume 301 subgroups = [],
73 :     reqpriv = StringSet.empty }
74 : blume 274
75 : blume 537 fun implicit init_group = let
76 :     val (GG.GROUP { grouppath, ... }) = init_group
77 :     in
78 :     (* This is a collection that is an implicit member of every
79 :     * library -- the "init" group which exports the pervasive env. *)
80 :     COLLECTION { imports = SymbolMap.empty,
81 :     gimports = SymbolMap.empty,
82 :     smlfiles = [],
83 :     localdefs = SymbolMap.empty,
84 :     subgroups = [(grouppath, init_group)],
85 :     reqpriv = StringSet.empty }
86 :     end
87 :    
88 : blume 275 fun sequential (COLLECTION c1, COLLECTION c2, error) = let
89 :     fun describeSymbol (s, r) = let
90 :     val ns = Symbol.nameSpace s
91 :     in
92 :     Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
93 :     end
94 : blume 353 fun i_error (s, x as ((f, sbn), e), ((f', sbn'), e')) = let
95 :     fun complain () =
96 :     error (concat (describeSymbol
97 :     (s, [" imported from ", DG.describeSBN sbn,
98 :     " and also from ", DG.describeSBN sbn'])))
99 :     fun union (NONE, _) = NONE
100 :     | union (_, NONE) = NONE
101 :     | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
102 :     in
103 :     if DG.sbeq (sbn, sbn') then
104 :     ((union (f, f'), sbn), DAEnv.LAYER (e, e'))
105 :     else (complain (); x)
106 :     end
107 : blume 283 val i_union = SymbolMap.unionWithi i_error
108 :     val gi_union = SymbolMap.unionWith #1
109 : blume 270 fun ld_error (s, f1, f2) =
110 : blume 275 (error (concat (describeSymbol
111 : blume 280 (s, [" defined in ", SmlInfo.spec f1,
112 :     " and also in ", SmlInfo.spec f2])));
113 : blume 275 f1)
114 : blume 269 val ld_union = SymbolMap.unionWithi ld_error
115 :     in
116 : blume 283 COLLECTION { imports = i_union (#imports c1, #imports c2),
117 :     gimports = gi_union (#gimports c1, #gimports c2),
118 : blume 269 smlfiles = #smlfiles c1 @ #smlfiles c2,
119 : blume 294 localdefs = ld_union (#localdefs c1, #localdefs c2),
120 : blume 301 subgroups = #subgroups c1 @ #subgroups c2,
121 :     reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
122 : blume 269 end
123 :    
124 : blume 518 fun expandOne (gp, rparse, load_plugin) arg = let
125 : blume 493 val { name, mkpath, group, class, context } = arg
126 : blume 336 val class = Option.map (String.map Char.toLower) class
127 : blume 299 val error = GroupReg.error (#groupreg gp) group
128 : blume 537 fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
129 :     fun w0 s = error EM.WARN s EM.nullErrorBody
130 :     val { smlfiles, cmfiles } =
131 :     PrivateTools.expand { error = e0,
132 :     spec = (name, mkpath, class),
133 :     context = context,
134 :     load_plugin = load_plugin }
135 :     fun g_coll p = let
136 :     val g as GG.GROUP { exports = i, kind, required, ... } = rparse p
137 :     val gi = case kind of GG.NOLIB _ => i | _ => SymbolMap.empty
138 : blume 274 in
139 : blume 537 COLLECTION { imports = i, gimports = gi, smlfiles = [],
140 :     localdefs = SymbolMap.empty,
141 :     subgroups = [(p, g)],
142 :     reqpriv = required }
143 : blume 274 end
144 : blume 537 fun s_coll (p, s) = let
145 :     val i =
146 :     SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }
147 :     val exports =
148 :     case SmlInfo.exports gp i of
149 :     NONE => SS.empty
150 :     | SOME ex => (if SS.isEmpty ex then
151 :     w0 ("no module exports from " ^
152 :     SrcPath.descr p)
153 :     else ();
154 :     ex)
155 :     fun addLD (s, m) = SymbolMap.insert (m, s, i)
156 :     val ld = SS.foldl addLD SymbolMap.empty exports
157 :     in
158 :     COLLECTION { imports = SymbolMap.empty,
159 :     gimports = SymbolMap.empty,
160 :     smlfiles = [i],
161 :     localdefs = ld,
162 :     subgroups = [],
163 :     reqpriv = StringSet.empty }
164 :     end
165 :     val collections = map g_coll cmfiles @ map s_coll smlfiles
166 :     fun combine (c1, c2) = sequential (c2, c1, e0)
167 : blume 274 in
168 : blume 537 foldl combine empty collections
169 : blume 270 end
170 :    
171 : blume 537 fun build (COLLECTION c, fopt, gp, perv_fsbnode) =
172 :     BuildDepend.build (c, fopt, gp, perv_fsbnode)
173 : blume 280
174 : blume 294 fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
175 :    
176 : blume 336 local
177 :     fun symenv_look (gp: GeneralParams.info) (c: collection) s =
178 : blume 433 #get (#symval (#param gp) s) ()
179 : blume 336 in
180 :     fun num_look gp c s = getOpt (symenv_look gp c s, 0)
181 :     fun cm_look gp c s = isSome (symenv_look gp c s)
182 :     end
183 : blume 269
184 : blume 283 fun ml_look (COLLECTION { imports, localdefs, ... }) s =
185 :     isSome (SymbolMap.find (imports, s)) orelse
186 : blume 269 isSome (SymbolMap.find (localdefs, s))
187 : blume 267 end

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