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

Parent Directory | Revision Log

---

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

---

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