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

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