Annotation of /sml/trunk/src/cm/semant/members.sml

Parent Directory | 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