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

Parent Directory | Revision Log

---

Revision 280 - (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	269
17 :	blume	267	type collection
18 :
19 :	blume	278	type farlooker =
20 :			AbsPath.t ->
21 :			(DependencyGraph.farnode * DependencyGraph.env) SymbolMap.map
22 :
23 :	blume	274	val empty : collection
24 :
25 :	blume	278	val expandOne : farlooker
26 :	blume	275	-> { sourcepath: AbsPath.t, group: AbsPath.t, class: string option,
27 :	blume	277	error : string -> (PrettyPrint.ppstream -> unit) -> unit }
28 :	blume	270	-> collection
29 :	blume	275	val sequential : collection * collection * (string -> unit) -> collection
30 :	blume	267
31 :	blume	280	val build : collection
32 :			-> { nodemap: DependencyGraph.node SymbolMap.map,
33 :			rootset: DependencyGraph.node list }
34 :
35 :
36 :	blume	268	val num_look : collection -> string -> int
37 :	blume	278	val ml_look : collection -> symbol -> bool
38 :	blume	268	val cm_look : collection -> string -> bool
39 :	blume	267	end
40 :
41 :			structure MemberCollection :> MEMBERCOLLECTION = struct
42 :
43 :	blume	269	structure DG = DependencyGraph
44 :	blume	277	structure EM = GenericVC.ErrorMsg
45 :	blume	278	structure CBE = GenericVC.BareEnvironment
46 :	blume	267
47 :	blume	270	type smlinfo = SmlInfo.info
48 :	blume	275	type symbol = Symbol.symbol
49 :	blume	267
50 :	blume	269	datatype collection =
51 :	blume	278	COLLECTION of { subexports: (DG.farnode * DG.env) SymbolMap.map,
52 :	blume	269	smlfiles: smlinfo list,
53 :			localdefs: smlinfo SymbolMap.map }
54 :
55 :	blume	278	type farlooker =
56 :			AbsPath.t ->
57 :			(DependencyGraph.farnode * DependencyGraph.env) SymbolMap.map
58 :
59 :	blume	274	val empty =
60 :			COLLECTION { subexports = SymbolMap.empty,
61 :			smlfiles = [],
62 :			localdefs = SymbolMap.empty }
63 :
64 :	blume	278	fun convertEnv cmenv = let
65 :			fun modulesOnly sl = let
66 :			fun addModule (sy, set) =
67 :			case Symbol.nameSpace sy of
68 :			(Symbol.STRspace | Symbol.SIGspace |
69 :			Symbol.FCTspace | Symbol.FSIGspace) =>
70 :			SymbolSet.add (set, sy)
71 :			| _ => set
72 :			in
73 :			foldl addModule SymbolSet.empty sl
74 :			end
75 :			fun cvt CBE.CM_NONE = NONE
76 :			| cvt (CBE.CM_ENV { look, symbols }) =
77 :			SOME (DG.FCTENV { looker = cvt o look,
78 :			domain = modulesOnly o symbols })
79 :			in
80 :			valOf (cvt cmenv)
81 :			end
82 :
83 :	blume	275	fun sequential (COLLECTION c1, COLLECTION c2, error) = let
84 :			fun describeSymbol (s, r) = let
85 :			val ns = Symbol.nameSpace s
86 :			in
87 :			Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
88 :			end
89 :	blume	279	fun se_error (s, x as (fn1, _), (fn2, _)) =
90 :	blume	275	(error (concat (describeSymbol
91 :	blume	279	(s, [" imported from ", DG.describeFarNode fn1,
92 :			" and also from ", DG.describeFarNode fn2])));
93 :	blume	275	x)
94 :	blume	269	val se_union = SymbolMap.unionWithi se_error
95 :	blume	270	fun ld_error (s, f1, f2) =
96 :	blume	275	(error (concat (describeSymbol
97 :	blume	280	(s, [" defined in ", SmlInfo.spec f1,
98 :			" and also in ", SmlInfo.spec f2])));
99 :	blume	275	f1)
100 :	blume	269	val ld_union = SymbolMap.unionWithi ld_error
101 :			in
102 :			COLLECTION { subexports = se_union (#subexports c1, #subexports c2),
103 :			smlfiles = #smlfiles c1 @ #smlfiles c2,
104 :			localdefs = ld_union (#localdefs c1, #localdefs c2) }
105 :			end
106 :
107 :	blume	275	fun expandOne gexports { sourcepath, group, class, error } = let
108 :	blume	274	fun noPrimitive () = let
109 :	blume	277	fun e0 s = error s EM.nullErrorBody
110 :			val expansions = PrivateTools.expand e0 (sourcepath, class)
111 :	blume	274	fun exp2coll (PrivateTools.GROUP p) =
112 :			COLLECTION { subexports = gexports p,
113 :			smlfiles = [],
114 :			localdefs = SymbolMap.empty }
115 :			| exp2coll (PrivateTools.SMLSOURCE src) = let
116 :			val { sourcepath = p, history = h, share = s } = src
117 :	blume	276	val i = SmlInfo.info
118 :	blume	274	Policy.default
119 :	blume	275	{ sourcepath = p, group = group,
120 :			error = error, history = h,
121 :	blume	277	share = s }
122 :	blume	274	val exports = SmlInfo.exports i
123 :			fun addLD (s, m) = SymbolMap.insert (m, s, i)
124 :			val ld = SymbolSet.foldl addLD SymbolMap.empty exports
125 :			in
126 :			COLLECTION { subexports = SymbolMap.empty,
127 :			smlfiles = [i],
128 :			localdefs = ld }
129 :			end
130 :			val collections = map exp2coll expansions
131 :	blume	277	fun combine (c1, c2) = sequential (c2, c1, e0)
132 :	blume	274	in
133 :			foldl combine empty collections
134 :			end
135 :			in
136 :			if isSome class then noPrimitive ()
137 :			else case Primitive.fromString (AbsPath.spec sourcepath) of
138 :			SOME p => let
139 :	blume	270	val exports = Primitive.exports p
140 :	blume	278	fun addFN (s, m) = let
141 :			val cmenv = Primitive.lookup p s
142 :			val env = convertEnv cmenv
143 :			in
144 :	blume	279	SymbolMap.insert (m, s, (DG.PNODE p, env))
145 :	blume	278	end
146 :	blume	270	val se = SymbolSet.foldl addFN SymbolMap.empty exports
147 :			in
148 :			COLLECTION { subexports = se,
149 :			smlfiles = [],
150 :			localdefs = SymbolMap.empty }
151 :			end
152 :	blume	274	| NONE => noPrimitive ()
153 :	blume	270	end
154 :
155 :	blume	280	fun build (COLLECTION c) = BuildDepend.build c
156 :
157 :	blume	268	fun num_look (c: collection) (s: string) = 0
158 :	blume	269
159 :	blume	268	fun cm_look (c: collection) (s: string) = false
160 :	blume	269
161 :			fun ml_look (COLLECTION { subexports, localdefs, ... }) s =
162 :			isSome (SymbolMap.find (subexports, s)) orelse
163 :			isSome (SymbolMap.find (localdefs, s))
164 :	blume	267	end

---

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