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 286 - (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 269
18 : blume 267 type collection
19 :    
20 : blume 283 type farlooker = AbsPath.t ->
21 :     { imports: impexp SymbolMap.map, gimports: impexp SymbolMap.map }
22 : blume 278
23 : blume 274 val empty : collection
24 :    
25 : blume 286 val expandOne : GeneralParams.params * 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 283 val build : collection * SymbolSet.set option * (string -> unit)
32 :     -> impexp SymbolMap.map
33 : blume 280
34 : blume 268 val num_look : collection -> string -> int
35 : blume 278 val ml_look : collection -> symbol -> bool
36 : blume 268 val cm_look : collection -> string -> bool
37 : blume 267 end
38 :    
39 :     structure MemberCollection :> MEMBERCOLLECTION = struct
40 :    
41 : blume 269 structure DG = DependencyGraph
42 : blume 277 structure EM = GenericVC.ErrorMsg
43 : blume 278 structure CBE = GenericVC.BareEnvironment
44 : blume 286 structure SS = SymbolSet
45 : blume 267
46 : blume 270 type smlinfo = SmlInfo.info
47 : blume 275 type symbol = Symbol.symbol
48 : blume 283 type impexp = DG.impexp
49 : blume 267
50 : blume 269 datatype collection =
51 : blume 283 COLLECTION of { imports: impexp SymbolMap.map,
52 :     gimports: impexp SymbolMap.map,
53 : blume 269 smlfiles: smlinfo list,
54 :     localdefs: smlinfo SymbolMap.map }
55 :    
56 : blume 283 type farlooker = AbsPath.t ->
57 :     { imports: impexp SymbolMap.map, gimports: impexp SymbolMap.map }
58 : blume 278
59 : blume 274 val empty =
60 : blume 283 COLLECTION { imports = SymbolMap.empty,
61 :     gimports = SymbolMap.empty,
62 : blume 274 smlfiles = [],
63 :     localdefs = SymbolMap.empty }
64 :    
65 : blume 275 fun sequential (COLLECTION c1, COLLECTION c2, error) = let
66 :     fun describeSymbol (s, r) = let
67 :     val ns = Symbol.nameSpace s
68 :     in
69 :     Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
70 :     end
71 : blume 283 fun i_error (s, x as (fn1, _), (fn2, _)) =
72 : blume 275 (error (concat (describeSymbol
73 : blume 282 (s, [" imported from ", DG.describeFarSBN fn1,
74 :     " and also from ", DG.describeFarSBN fn2])));
75 : blume 275 x)
76 : blume 283 val i_union = SymbolMap.unionWithi i_error
77 :     val gi_union = SymbolMap.unionWith #1
78 : blume 270 fun ld_error (s, f1, f2) =
79 : blume 275 (error (concat (describeSymbol
80 : blume 280 (s, [" defined in ", SmlInfo.spec f1,
81 :     " and also in ", SmlInfo.spec f2])));
82 : blume 275 f1)
83 : blume 269 val ld_union = SymbolMap.unionWithi ld_error
84 :     in
85 : blume 283 COLLECTION { imports = i_union (#imports c1, #imports c2),
86 :     gimports = gi_union (#gimports c1, #gimports c2),
87 : blume 269 smlfiles = #smlfiles c1 @ #smlfiles c2,
88 :     localdefs = ld_union (#localdefs c1, #localdefs c2) }
89 :     end
90 :    
91 : blume 286 fun expandOne (params, gexports) arg = let
92 :     val primconf = #primconf params
93 :     val { sourcepath, group, class, error } = arg
94 : blume 274 fun noPrimitive () = let
95 : blume 277 fun e0 s = error s EM.nullErrorBody
96 :     val expansions = PrivateTools.expand e0 (sourcepath, class)
97 : blume 283 fun exp2coll (PrivateTools.GROUP p) = let
98 :     val { imports = i, gimports = gi } = gexports p
99 :     in
100 :     COLLECTION { imports = i, gimports = gi, smlfiles = [],
101 :     localdefs = SymbolMap.empty }
102 :     end
103 : blume 274 | exp2coll (PrivateTools.SMLSOURCE src) = let
104 :     val { sourcepath = p, history = h, share = s } = src
105 : blume 276 val i = SmlInfo.info
106 : blume 286 params
107 : blume 275 { sourcepath = p, group = group,
108 :     error = error, history = h,
109 : blume 277 share = s }
110 : blume 274 val exports = SmlInfo.exports i
111 : blume 286 val _ = if SS.isEmpty exports then e0 "no module exports"
112 :     else ()
113 : blume 274 fun addLD (s, m) = SymbolMap.insert (m, s, i)
114 : blume 286 val ld = SS.foldl addLD SymbolMap.empty exports
115 : blume 274 in
116 : blume 283 COLLECTION { imports = SymbolMap.empty,
117 :     gimports = SymbolMap.empty,
118 : blume 274 smlfiles = [i],
119 :     localdefs = ld }
120 :     end
121 :     val collections = map exp2coll expansions
122 : blume 277 fun combine (c1, c2) = sequential (c2, c1, e0)
123 : blume 274 in
124 :     foldl combine empty collections
125 :     end
126 :     in
127 :     if isSome class then noPrimitive ()
128 :     else case Primitive.fromString (AbsPath.spec sourcepath) of
129 :     SOME p => let
130 : blume 286 val exports = Primitive.exports primconf p
131 :     val plook = Primitive.lookup primconf p
132 : blume 278 fun addFN (s, m) = let
133 : blume 286 val env = plook s
134 : blume 282 val fsbn = (NONE, DG.SB_BNODE (DG.PNODE p))
135 : blume 278 in
136 : blume 282 SymbolMap.insert (m, s, (fsbn, env))
137 : blume 278 end
138 : blume 286 val imp = SS.foldl addFN SymbolMap.empty exports
139 : blume 270 in
140 : blume 283 COLLECTION { imports = imp,
141 :     gimports = SymbolMap.empty,
142 : blume 270 smlfiles = [],
143 :     localdefs = SymbolMap.empty }
144 :     end
145 : blume 274 | NONE => noPrimitive ()
146 : blume 270 end
147 :    
148 : blume 283 fun build (COLLECTION c, fopt, error) = BuildDepend.build (c, fopt, error)
149 : blume 280
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 : blume 283 fun ml_look (COLLECTION { imports, localdefs, ... }) s =
155 :     isSome (SymbolMap.find (imports, s)) orelse
156 : blume 269 isSome (SymbolMap.find (localdefs, s))
157 : blume 267 end

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