Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/semant/members.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 270, Tue May 11 07:45:42 1999 UTC revision 632, Sat Apr 29 15:50:42 2000 UTC
# Line 11  Line 11 
11   *)   *)
12  signature MEMBERCOLLECTION = sig  signature MEMBERCOLLECTION = sig
13    
14      type symbol = GenericVC.Symbol.symbol      type symbol = Symbol.symbol
15      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
16        type impexp = DependencyGraph.impexp
17      exception DuplicateImport of symbol * string * string      type region = GenericVC.SourceMap.region
     exception DuplicateDefinition of symbol * string * string  
18    
19      type collection      type collection
20    
21      val expandOne : (AbsPath.t -> DependencyGraph.farnode SymbolMap.map)      val empty : collection
22          -> { sourcepath: AbsPath.t, group: AbsPath.t, class: string option }  
23        val implicit : GroupGraph.group -> collection
24    
25        val expandOne :
26            { gp: GeneralParams.info,
27              rparse: SrcPath.t * Version.t option -> GroupGraph.group,
28              load_plugin: SrcPath.context -> string -> bool }
29            -> { name: string,
30                 mkpath: string -> SrcPath.t,
31                 group: SrcPath.t * region,
32                 class: string option,
33                 tooloptions: PrivateTools.toolopts option,
34                 context: SrcPath.context }
35          -> collection          -> collection
36      val sequential : collection * collection -> collection      val sequential : collection * collection * (string -> unit) -> collection
37    
38      val num_look : collection -> string -> int      val build :
39      val ml_look : collection -> GenericVC.Symbol.symbol -> bool          collection * SymbolSet.set option * GeneralParams.info *
40      val cm_look : collection -> string -> bool          DependencyGraph.farsbnode       (* pervasive env *)
41            -> impexp SymbolMap.map * GroupGraph.privileges
42    
43        val subgroups : collection -> (SrcPath.t * GroupGraph.group) list
44    
45        val num_look : GeneralParams.info -> collection -> string -> int
46        val cm_look : GeneralParams.info -> collection -> string -> bool
47        val ml_look : collection -> symbol -> bool
48  end  end
49    
50  structure MemberCollection :> MEMBERCOLLECTION = struct  structure MemberCollection :> MEMBERCOLLECTION = struct
51    
52      structure DG = DependencyGraph      structure DG = DependencyGraph
53        structure EM = GenericVC.ErrorMsg
54        structure E = GenericVC.Environment
55        structure SS = SymbolSet
56        structure GG = GroupGraph
57        structure V = Version
58    
59      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
60      type symbol = GenericVC.Symbol.symbol      type symbol = Symbol.symbol
61        type impexp = DG.impexp
62      exception DuplicateImport of symbol * string * string      type region = GenericVC.SourceMap.region
     exception DuplicateDefinition of symbol * string * string  
63    
64      datatype collection =      datatype collection =
65          COLLECTION of { subexports: DG.farnode SymbolMap.map,          COLLECTION of { imports: impexp SymbolMap.map,
66                            gimports: impexp SymbolMap.map,
67                          smlfiles: smlinfo list,                          smlfiles: smlinfo list,
68                          localdefs: smlinfo SymbolMap.map }                          localdefs: smlinfo SymbolMap.map,
69                            subgroups: (SrcPath.t * GG.group) list,
70                            reqpriv: GG.privileges }
71          | ERRORCOLLECTION
72    
73        val empty =
74            COLLECTION { imports = SymbolMap.empty,
75                         gimports = SymbolMap.empty,
76                         smlfiles = [],
77                         localdefs = SymbolMap.empty,
78                         subgroups = [],
79                         reqpriv = StringSet.empty }
80    
81        fun implicit init_group = let
82            val { grouppath, ... } =
83                case init_group of
84                    GG.GROUP x => x
85                  | GG.ERRORGROUP =>
86                    EM.impossible "members.sml: implicit: bad init group"
87        in
88            (* This is a collection that is an implicit member of every
89             * library -- the "init" group which exports the pervasive env. *)
90            COLLECTION { imports = SymbolMap.empty,
91                         gimports = SymbolMap.empty,
92                         smlfiles = [],
93                         localdefs = SymbolMap.empty,
94                         subgroups = [(grouppath, init_group)],
95                         reqpriv = StringSet.empty }
96        end
97    
98      fun sequential (COLLECTION c1, COLLECTION c2) = let      fun sequential (COLLECTION c1, COLLECTION c2, error) =
99          fun se_error (s, (_, n1), (_, n2)) =          let fun describeSymbol (s, r) = let
100              raise DuplicateImport (s, DG.describeNode n1, DG.describeNode n2)                  val ns = Symbol.nameSpace s
101          val se_union = SymbolMap.unionWithi se_error              in
102                    Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
103                end
104                fun i_error (s, x as ((f, sbn), e), ((f', sbn'), e')) = let
105                    fun complain () =
106                        error (concat (describeSymbol
107                                           (s, [" imported from ",
108                                                DG.describeSBN sbn,
109                                                " and also from ",
110                                                DG.describeSBN sbn'])))
111                    fun union (NONE, _) = NONE
112                      | union (_, NONE) = NONE
113                      | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
114                in
115                    if DG.sbeq (sbn, sbn') then
116                        ((union (f, f'), sbn), DAEnv.LAYER (e, e'))
117                    else (complain (); x)
118                end
119                val i_union = SymbolMap.unionWithi i_error
120                val gi_union = SymbolMap.unionWith #1
121          fun ld_error (s, f1, f2) =          fun ld_error (s, f1, f2) =
122              raise DuplicateDefinition (s, SmlInfo.describe f1,                  (error (concat (describeSymbol
123                                            SmlInfo.describe f2)                                      (s, [" defined in ", SmlInfo.spec f1,
124                                             " and also in ", SmlInfo.spec f2])));
125                     f1)
126          val ld_union = SymbolMap.unionWithi ld_error          val ld_union = SymbolMap.unionWithi ld_error
   
127      in      in
128          COLLECTION { subexports = se_union (#subexports c1, #subexports c2),              COLLECTION { imports = i_union (#imports c1, #imports c2),
129                             gimports = gi_union (#gimports c1, #gimports c2),
130                       smlfiles = #smlfiles c1 @ #smlfiles c2,                       smlfiles = #smlfiles c1 @ #smlfiles c2,
131                       localdefs = ld_union (#localdefs c1, #localdefs c2) }                           localdefs = ld_union (#localdefs c1, #localdefs c2),
132      end                           subgroups = #subgroups c1 @ #subgroups c2,
133                             reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
134      fun expandOne gexports { sourcepath, group, class } = let          end
135          val expansions = Tools.expand (sourcepath, class)        | sequential _ = ERRORCOLLECTION
136          fun exp2coll (Tools.GROUP p) =  
137              COLLECTION { subexports = gexports p,      fun expandOne { gp, rparse, load_plugin } arg = let
138                           smlfiles = [],          val { name, mkpath, group, class, tooloptions, context } = arg
139                           localdefs = SymbolMap.empty }          val class = Option.map (String.map Char.toLower) class
140            | exp2coll (Tools.PRIMITIVE p) = let          val error = GroupReg.error (#groupreg gp) group
141                  val exports = Primitive.exports p          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
142                  fun addFN (s, m) =          fun w0 s = error EM.WARN s EM.nullErrorBody
143                      SymbolMap.insert (m, s, (NONE, DG.PNODE p))          val { smlfiles, cmfiles } =
144                  val se = SymbolSet.foldl addFN SymbolMap.empty exports              PrivateTools.expand { error = e0,
145                                      spec = (name, mkpath, class, tooloptions),
146                                      context = context,
147                                      load_plugin = load_plugin }
148            fun g_coll (p, v) =
149                case rparse (p, v) of
150                    g as GG.GROUP { exports = i, kind, required,
151                                    grouppath, sublibs } => let
152                        val (gi, ver) =
153                            case kind of
154                                GG.NOLIB _ => (i, NONE)
155                              | GG.LIB l => (SymbolMap.empty, #version l)
156              in              in
157                  COLLECTION { subexports = se,                      case (v, ver) of
158                               smlfiles = [],                          (NONE, _) => ()
159                               localdefs = SymbolMap.empty }                        | (SOME vrq, NONE) =>
160              end                          e0 "library does not carry a version stamp"
161            | exp2coll (Tools.SMLSOURCE src) = let                        | (SOME vrq, SOME ver) =>
162                  val { sourcepath = p, history = h, share = s } = src                          (case V.compare (vrq, ver) of
163                  val i =  SmlInfo.new { sourcepath = p, group = group,                               GREATER => e0 "library is older than expected"
164                                         history = SOME h, share = s,                             | EQUAL => ()
165                                         stableinfo = NONE }                             | LESS =>
166                  val exports = SmlInfo.exports i                               (case V.compare (V.nextMajor vrq, ver) of
167                                      GREATER =>
168                                       w0 "library is slightly newer than expected"
169                                    | _ => e0 "library is newer than expected"));
170                        COLLECTION { imports = i, gimports = gi, smlfiles = [],
171                                     localdefs = SymbolMap.empty,
172                                     subgroups = [(p, g)],
173                                     reqpriv = required }
174                    end
175                  | GG.ERRORGROUP => ERRORCOLLECTION
176            fun s_coll (p, s) = let
177                val i =
178                    SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }
179                val exports =
180                    case SmlInfo.exports gp i of
181                        NONE => SS.empty
182                      | SOME ex => (if SS.isEmpty ex then
183                                        w0 ("no module exports from " ^
184                                            SrcPath.descr p)
185                                    else ();
186                                    ex)
187                  fun addLD (s, m) = SymbolMap.insert (m, s, i)                  fun addLD (s, m) = SymbolMap.insert (m, s, i)
188                  val ld = SymbolSet.foldl addLD SymbolMap.empty exports              val ld = SS.foldl addLD SymbolMap.empty exports
189              in              in
190                  COLLECTION { subexports = SymbolMap.empty,              COLLECTION { imports = SymbolMap.empty,
191                             gimports = SymbolMap.empty,
192                               smlfiles = [i],                               smlfiles = [i],
193                               localdefs = ld }                           localdefs = ld,
194                             subgroups = [],
195                             reqpriv = StringSet.empty }
196              end              end
197            val collections = map g_coll cmfiles @ map s_coll smlfiles
198          val collections = map exp2coll expansions          fun combine (c1, c2) = sequential (c2, c1, e0)
         val empty = COLLECTION { subexports = SymbolMap.empty,  
                                  smlfiles = [],  
                                  localdefs = SymbolMap.empty }  
         fun combine (c1, c2) = sequential (c2, c1)  
199      in      in
200          foldl combine empty collections          foldl combine empty collections
201      end      end
202    
203      fun num_look (c: collection) (s: string) = 0      fun build (COLLECTION c, fopt, gp, perv_fsbnode) =
204            BuildDepend.build (c, fopt, gp, perv_fsbnode)
205      fun cm_look (c: collection) (s: string) = false        | build (ERRORCOLLECTION, _, _, _) =
206            (SymbolMap.empty, StringSet.empty)
207    
208        fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
209          | subgroups ERRORCOLLECTION = []
210    
211        local
212            fun symenv_look (gp: GeneralParams.info) (c: collection) s =
213                #get (#symval (#param gp) s) ()
214        in
215            fun num_look gp c s = getOpt (symenv_look gp c s, 0)
216            fun cm_look gp c s = isSome (symenv_look gp c s)
217        end
218    
219      fun ml_look (COLLECTION { subexports, localdefs, ... }) s =      fun ml_look (COLLECTION { imports, localdefs, ... }) s =
220          isSome (SymbolMap.find (subexports, s)) orelse          isSome (SymbolMap.find (imports, s)) orelse
221          isSome (SymbolMap.find (localdefs, s))          isSome (SymbolMap.find (localdefs, s))
222          | ml_look ERRORCOLLECTON _ = true
223  end  end

Legend:
Removed from v.270  
changed lines
  Added in v.632

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