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

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