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 537, Fri Feb 18 17:20:16 2000 UTC revision 642, Thu May 11 07:30:29 2000 UTC
# Line 20  Line 20 
20    
21      val empty : collection      val empty : collection
22    
23      val implicit : GroupGraph.group -> collection      val implicit : GeneralParams.info -> GroupGraph.group -> collection
24    
25      val expandOne :      val expandOne :
26          GeneralParams.info * (SrcPath.t -> GroupGraph.group) * (string -> bool)          { gp: GeneralParams.info,
27          -> { name: string, mkpath: string -> SrcPath.t,            rparse: SrcPath.t * Version.t option -> GroupGraph.group,
28               group: SrcPath.t * region, class: string option,            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 }               context: SrcPath.context }
35          -> collection          -> collection
36      val sequential : collection * collection * (string -> unit) -> collection      val sequential : collection * collection * (string -> unit) -> collection
# Line 36  Line 41 
41          -> impexp SymbolMap.map * GroupGraph.privileges          -> impexp SymbolMap.map * GroupGraph.privileges
42    
43      val subgroups : collection -> (SrcPath.t * GroupGraph.group) list      val subgroups : collection -> (SrcPath.t * GroupGraph.group) list
44        val sources : collection ->
45                      { class: string, derived: bool } SrcPathMap.map
46    
47      val num_look : GeneralParams.info -> collection -> string -> int      val num_look : GeneralParams.info -> collection -> string -> int
48      val cm_look : GeneralParams.info -> collection -> string -> bool      val cm_look : GeneralParams.info -> collection -> string -> bool
# Line 46  Line 53 
53    
54      structure DG = DependencyGraph      structure DG = DependencyGraph
55      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
     structure CBE = GenericVC.BareEnvironment  
56      structure E = GenericVC.Environment      structure E = GenericVC.Environment
57      structure SS = SymbolSet      structure SS = SymbolSet
58      structure GG = GroupGraph      structure GG = GroupGraph
59        structure V = Version
60    
61      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
62      type symbol = Symbol.symbol      type symbol = Symbol.symbol
# Line 62  Line 69 
69                          smlfiles: smlinfo list,                          smlfiles: smlinfo list,
70                          localdefs: smlinfo SymbolMap.map,                          localdefs: smlinfo SymbolMap.map,
71                          subgroups: (SrcPath.t * GG.group) list,                          subgroups: (SrcPath.t * GG.group) list,
72                            sources:
73                                   { class: string, derived: bool } SrcPathMap.map,
74                          reqpriv: GG.privileges }                          reqpriv: GG.privileges }
75          | ERRORCOLLECTION
76    
77      val empty =      fun empty' sources =
78          COLLECTION { imports = SymbolMap.empty,          COLLECTION { imports = SymbolMap.empty,
79                       gimports = SymbolMap.empty,                       gimports = SymbolMap.empty,
80                       smlfiles = [],                       smlfiles = [],
81                       localdefs = SymbolMap.empty,                       localdefs = SymbolMap.empty,
82                       subgroups = [],                       subgroups = [],
83                         sources = sources,
84                       reqpriv = StringSet.empty }                       reqpriv = StringSet.empty }
85    
86      fun implicit init_group = let      val empty = empty' SrcPathMap.empty
87          val (GG.GROUP { grouppath, ... }) = init_group  
88        fun implicit (gp: GeneralParams.info) init_group = let
89            val { grouppath, ... } =
90                case init_group of
91                    GG.GROUP x => x
92                  | GG.ERRORGROUP =>
93                    EM.impossible "members.sml: implicit: bad init group"
94            val sm = SrcPathMap.singleton (grouppath,
95                                           { class = "cm", derived = false })
96      in      in
97          (* This is a collection that is an implicit member of every          (* This is a collection that is an implicit member of every
98           * library -- the "init" group which exports the pervasive env. *)           * library -- the "init" group which exports the pervasive env. *)
# Line 82  Line 101 
101                       smlfiles = [],                       smlfiles = [],
102                       localdefs = SymbolMap.empty,                       localdefs = SymbolMap.empty,
103                       subgroups = [(grouppath, init_group)],                       subgroups = [(grouppath, init_group)],
104                         sources = sm,
105                       reqpriv = StringSet.empty }                       reqpriv = StringSet.empty }
106      end      end
107    
108      fun sequential (COLLECTION c1, COLLECTION c2, error) = let      fun sequential (COLLECTION c1, COLLECTION c2, error) =
109          fun describeSymbol (s, r) = let          let fun describeSymbol (s, r) = let
110              val ns = Symbol.nameSpace s              val ns = Symbol.nameSpace s
111          in          in
112              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
# Line 94  Line 114 
114          fun i_error (s, x as ((f, sbn), e), ((f', sbn'), e')) = let          fun i_error (s, x as ((f, sbn), e), ((f', sbn'), e')) = let
115              fun complain () =              fun complain () =
116                  error (concat (describeSymbol                  error (concat (describeSymbol
117                                 (s, [" imported from ", DG.describeSBN sbn,                                         (s, [" imported from ",
118                                      " and also from ", DG.describeSBN sbn'])))                                              DG.describeSBN sbn,
119                                                " and also from ",
120                                                DG.describeSBN sbn'])))
121              fun union (NONE, _) = NONE              fun union (NONE, _) = NONE
122                | union (_, NONE) = NONE                | union (_, NONE) = NONE
123                | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))                | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
# Line 112  Line 134 
134                                   " and also in ", SmlInfo.spec f2])));                                   " and also in ", SmlInfo.spec f2])));
135               f1)               f1)
136          val ld_union = SymbolMap.unionWithi ld_error          val ld_union = SymbolMap.unionWithi ld_error
137                val s_union = SrcPathMap.unionWith #1
138      in      in
139          COLLECTION { imports = i_union (#imports c1, #imports c2),          COLLECTION { imports = i_union (#imports c1, #imports c2),
140                       gimports = gi_union (#gimports c1, #gimports c2),                       gimports = gi_union (#gimports c1, #gimports c2),
141                       smlfiles = #smlfiles c1 @ #smlfiles c2,                       smlfiles = #smlfiles c1 @ #smlfiles c2,
142                       localdefs = ld_union (#localdefs c1, #localdefs c2),                       localdefs = ld_union (#localdefs c1, #localdefs c2),
143                       subgroups = #subgroups c1 @ #subgroups c2,                       subgroups = #subgroups c1 @ #subgroups c2,
144                             sources = s_union (#sources c1, #sources c2),
145                       reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }                       reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
146      end      end
147          | sequential _ = ERRORCOLLECTION
148    
149      fun expandOne (gp, rparse, load_plugin) arg = let      fun expandOne { gp, rparse, load_plugin } arg = let
150          val { name, mkpath, group, class, context } = arg          val { name, mkpath, group, class, tooloptions, context } = arg
151          val class = Option.map (String.map Char.toLower) class          val class = Option.map (String.map Char.toLower) class
152          val error = GroupReg.error (#groupreg gp) group          val error = GroupReg.error (#groupreg gp) group
153          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
154          fun w0 s = error EM.WARN s EM.nullErrorBody          fun w0 s = error EM.WARN s EM.nullErrorBody
155          val { smlfiles, cmfiles } =          val { smlfiles, cmfiles, sources } =
156              PrivateTools.expand { error = e0,              PrivateTools.expand { error = e0,
157                                    spec = (name, mkpath, class),                                    spec = { name = name,
158                                               mkpath = mkpath,
159                                               class = class,
160                                               opts = tooloptions,
161                                               derived = false },
162                                    context = context,                                    context = context,
163                                    load_plugin = load_plugin }                                    load_plugin = load_plugin }
164          fun g_coll p = let          val msources = foldl SrcPathMap.insert' SrcPathMap.empty sources
165              val g as GG.GROUP { exports = i, kind, required, ... } = rparse p          fun g_coll (p, v) =
166              val gi = case kind of GG.NOLIB _ => i | _ => SymbolMap.empty              case rparse (p, v) of
167          in                  g as GG.GROUP { exports = i, kind, required, sources,
168                                    grouppath, sublibs } => let
169                        val (gi, ver) =
170                            case kind of
171                                GG.NOLIB _ => (i, NONE)
172                              | GG.LIB l => (SymbolMap.empty, #version l)
173                    in
174                        case (v, ver) of
175                            (NONE, _) => ()
176                          | (SOME vrq, NONE) =>
177                            e0 "library does not carry a version stamp"
178                          | (SOME vrq, SOME ver) =>
179                            (case V.compare (vrq, ver) of
180                                 GREATER => e0 "library is older than expected"
181                               | EQUAL => ()
182                               | LESS =>
183                                 (case V.compare (V.nextMajor vrq, ver) of
184                                      GREATER =>
185                                       w0 "library is slightly newer than expected"
186                                    | _ => e0 "library is newer than expected"));
187              COLLECTION { imports = i, gimports = gi, smlfiles = [],              COLLECTION { imports = i, gimports = gi, smlfiles = [],
188                           localdefs = SymbolMap.empty,                           localdefs = SymbolMap.empty,
189                           subgroups = [(p, g)],                           subgroups = [(p, g)],
190                                     sources = SrcPathMap.empty,
191                           reqpriv = required }                           reqpriv = required }
192          end          end
193                  | GG.ERRORGROUP => ERRORCOLLECTION
194          fun s_coll (p, s) = let          fun s_coll (p, s) = let
195              val i =              val i =
196                  SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }                  SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }
# Line 160  Line 210 
210                           smlfiles = [i],                           smlfiles = [i],
211                           localdefs = ld,                           localdefs = ld,
212                           subgroups = [],                           subgroups = [],
213                             sources = SrcPathMap.empty,
214                           reqpriv = StringSet.empty }                           reqpriv = StringSet.empty }
215          end          end
216          val collections = map g_coll cmfiles @ map s_coll smlfiles          val collections = map g_coll cmfiles @ map s_coll smlfiles
217          fun combine (c1, c2) = sequential (c2, c1, e0)          fun combine (c1, c2) = sequential (c2, c1, e0)
218      in      in
219          foldl combine empty collections          foldl combine (empty' msources) collections
220      end      end
221    
222      fun build (COLLECTION c, fopt, gp, perv_fsbnode) =      fun build (COLLECTION c, fopt, gp, perv_fsbnode) =
223          BuildDepend.build (c, fopt, gp, perv_fsbnode)          BuildDepend.build (c, fopt, gp, perv_fsbnode)
224          | build (ERRORCOLLECTION, _, _, _) =
225            (SymbolMap.empty, StringSet.empty)
226    
227      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
228          | subgroups ERRORCOLLECTION = []
229    
230        fun sources (COLLECTION { sources = s, ... }) = s
231          | sources ERRORCOLLECTION = SrcPathMap.empty
232    
233      local      local
234          fun symenv_look (gp: GeneralParams.info) (c: collection) s =          fun symenv_look (gp: GeneralParams.info) (c: collection) s =
# Line 184  Line 241 
241      fun ml_look (COLLECTION { imports, localdefs, ... }) s =      fun ml_look (COLLECTION { imports, localdefs, ... }) s =
242          isSome (SymbolMap.find (imports, s)) orelse          isSome (SymbolMap.find (imports, s)) orelse
243          isSome (SymbolMap.find (localdefs, s))          isSome (SymbolMap.find (localdefs, s))
244          | ml_look ERRORCOLLECTON _ = true
245  end  end

Legend:
Removed from v.537  
changed lines
  Added in v.642

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