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 282 - (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 : blume 282 (DependencyGraph.farsbnode * DependencyGraph.env) SymbolMap.map
22 : blume 278
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 : blume 282 -> { nodemap: DependencyGraph.snode SymbolMap.map,
33 :     rootset: DependencyGraph.snode list }
34 : blume 280
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 282 COLLECTION of { subexports: (DG.farsbnode * 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 : blume 282 (DependencyGraph.farsbnode * DependencyGraph.env) SymbolMap.map
58 : blume 278
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 282 (s, [" imported from ", DG.describeFarSBN fn1,
92 :     " and also from ", DG.describeFarSBN 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 : blume 282 val fsbn = (NONE, DG.SB_BNODE (DG.PNODE p))
144 : blume 278 in
145 : blume 282 SymbolMap.insert (m, s, (fsbn, env))
146 : blume 278 end
147 : blume 270 val se = SymbolSet.foldl addFN SymbolMap.empty exports
148 :     in
149 :     COLLECTION { subexports = se,
150 :     smlfiles = [],
151 :     localdefs = SymbolMap.empty }
152 :     end
153 : blume 274 | NONE => noPrimitive ()
154 : blume 270 end
155 :    
156 : blume 280 fun build (COLLECTION c) = BuildDepend.build c
157 :    
158 : blume 268 fun num_look (c: collection) (s: string) = 0
159 : blume 269
160 : blume 268 fun cm_look (c: collection) (s: string) = false
161 : blume 269
162 :     fun ml_look (COLLECTION { subexports, localdefs, ... }) s =
163 :     isSome (SymbolMap.find (subexports, s)) orelse
164 :     isSome (SymbolMap.find (localdefs, s))
165 : blume 267 end

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