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 632, Sat Apr 29 15:50:42 2000 UTC revision 677, Mon Jun 26 00:56:56 2000 UTC
# Line 15  Line 15 
15      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
16      type impexp = DependencyGraph.impexp      type impexp = DependencyGraph.impexp
17      type region = GenericVC.SourceMap.region      type region = GenericVC.SourceMap.region
18        type subgroups =
19             (SrcPath.file * GroupGraph.group * SrcPath.rebindings) list
20    
21      type collection      type collection
22    
23      val empty : collection      val empty : collection
24    
25      val implicit : GroupGraph.group -> collection      val implicit : GeneralParams.info -> GroupGraph.group -> collection
26    
27      val expandOne :      val expandOne :
28          { gp: GeneralParams.info,          { gp: GeneralParams.info,
29            rparse: SrcPath.t * Version.t option -> GroupGraph.group,            rparse: SrcPath.file * Version.t option * SrcPath.rebindings ->
30            load_plugin: SrcPath.context -> string -> bool }                    GroupGraph.group,
31              load_plugin: SrcPath.dir -> string -> bool }
32          -> { name: string,          -> { name: string,
33               mkpath: string -> SrcPath.t,               mkpath: string -> SrcPath.prefile,
34               group: SrcPath.t * region,               group: SrcPath.file * region,
35               class: string option,               class: string option,
36               tooloptions: PrivateTools.toolopts option,               tooloptions: PrivateTools.toolopts option,
37               context: SrcPath.context }               context: SrcPath.dir }
38          -> collection          -> collection
39      val sequential : collection * collection * (string -> unit) -> collection      val sequential : collection * collection * (string -> unit) -> collection
40    
# Line 40  Line 43 
43          DependencyGraph.farsbnode       (* pervasive env *)          DependencyGraph.farsbnode       (* pervasive env *)
44          -> impexp SymbolMap.map * GroupGraph.privileges          -> impexp SymbolMap.map * GroupGraph.privileges
45    
46      val subgroups : collection -> (SrcPath.t * GroupGraph.group) list      val subgroups : collection -> subgroups
47        val sources : collection ->
48                      { class: string, derived: bool } SrcPathMap.map
49    
50      val num_look : GeneralParams.info -> collection -> string -> int      val num_look : GeneralParams.info -> collection -> string -> int
51      val cm_look : GeneralParams.info -> collection -> string -> bool      val cm_look : GeneralParams.info -> collection -> string -> bool
# Line 60  Line 65 
65      type symbol = Symbol.symbol      type symbol = Symbol.symbol
66      type impexp = DG.impexp      type impexp = DG.impexp
67      type region = GenericVC.SourceMap.region      type region = GenericVC.SourceMap.region
68        type subgroups = (SrcPath.file * GG.group * SrcPath.rebindings) list
69    
70      datatype collection =      datatype collection =
71          COLLECTION of { imports: impexp SymbolMap.map,          COLLECTION of { imports: impexp SymbolMap.map,
72                          gimports: impexp SymbolMap.map,                          gimports: impexp SymbolMap.map,
73                          smlfiles: smlinfo list,                          smlfiles: smlinfo list,
74                          localdefs: smlinfo SymbolMap.map,                          localdefs: smlinfo SymbolMap.map,
75                          subgroups: (SrcPath.t * GG.group) list,                          subgroups: subgroups,
76                            sources:
77                                   { class: string, derived: bool } SrcPathMap.map,
78                          reqpriv: GG.privileges }                          reqpriv: GG.privileges }
79        | ERRORCOLLECTION        | ERRORCOLLECTION
80    
81      val empty =      fun empty' sources =
82          COLLECTION { imports = SymbolMap.empty,          COLLECTION { imports = SymbolMap.empty,
83                       gimports = SymbolMap.empty,                       gimports = SymbolMap.empty,
84                       smlfiles = [],                       smlfiles = [],
85                       localdefs = SymbolMap.empty,                       localdefs = SymbolMap.empty,
86                       subgroups = [],                       subgroups = [],
87                         sources = sources,
88                       reqpriv = StringSet.empty }                       reqpriv = StringSet.empty }
89    
90      fun implicit init_group = let      val empty = empty' SrcPathMap.empty
91    
92        fun implicit (gp: GeneralParams.info) init_group = let
93          val { grouppath, ... } =          val { grouppath, ... } =
94              case init_group of              case init_group of
95                  GG.GROUP x => x                  GG.GROUP x => x
96                | GG.ERRORGROUP =>                | GG.ERRORGROUP =>
97                  EM.impossible "members.sml: implicit: bad init group"                  EM.impossible "members.sml: implicit: bad init group"
98            val sm = SrcPathMap.singleton (grouppath,
99                                           { class = "cm", derived = false })
100      in      in
101          (* This is a collection that is an implicit member of every          (* This is a collection that is an implicit member of every
102           * library -- the "init" group which exports the pervasive env. *)           * library -- the "init" group which exports the pervasive env. *)
# Line 91  Line 104 
104                       gimports = SymbolMap.empty,                       gimports = SymbolMap.empty,
105                       smlfiles = [],                       smlfiles = [],
106                       localdefs = SymbolMap.empty,                       localdefs = SymbolMap.empty,
107                       subgroups = [(grouppath, init_group)],                       subgroups = [(grouppath, init_group, [])],
108                         sources = sm,
109                       reqpriv = StringSet.empty }                       reqpriv = StringSet.empty }
110      end      end
111    
# Line 101  Line 115 
115              in              in
116                  Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r                  Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
117              end              end
118              fun i_error (s, x as ((f, sbn), e), ((f', sbn'), e')) = let              fun i_error (s, x as (nth, e, allsyms), (nth', e', allsyms')) = let
119                    val (f, sbn) = nth ()
120                    val (f', sbn') = nth' ()
121                  fun complain () =                  fun complain () =
122                      error (concat (describeSymbol                      error (concat (describeSymbol
123                                         (s, [" imported from ",                                         (s, [" imported from ",
# Line 113  Line 129 
129                    | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))                    | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
130              in              in
131                  if DG.sbeq (sbn, sbn') then                  if DG.sbeq (sbn, sbn') then
132                      ((union (f, f'), sbn), DAEnv.LAYER (e, e'))                      let val fsbn = (union (f, f'), sbn)
133                        in
134                            (fn () => fsbn, DAEnv.LAYER (e, e'),
135                             SymbolSet.union (allsyms, allsyms'))
136                        end
137                  else (complain (); x)                  else (complain (); x)
138              end              end
139              val i_union = SymbolMap.unionWithi i_error              val i_union = SymbolMap.unionWithi i_error
140              val gi_union = SymbolMap.unionWith #1              val gi_union = SymbolMap.unionWith #1
141              fun ld_error (s, f1, f2) =              fun ld_error (s, f1, f2) =
142                  (error (concat (describeSymbol                  (error (concat (describeSymbol
143                                      (s, [" defined in ", SmlInfo.spec f1,                                      (s, [" defined in ", SmlInfo.descr f1,
144                                           " and also in ", SmlInfo.spec f2])));                                           " and also in ", SmlInfo.descr f2])));
145                   f1)                   f1)
146              val ld_union = SymbolMap.unionWithi ld_error              val ld_union = SymbolMap.unionWithi ld_error
147                val s_union = SrcPathMap.unionWith #1
148          in          in
149              COLLECTION { imports = i_union (#imports c1, #imports c2),              COLLECTION { imports = i_union (#imports c1, #imports c2),
150                           gimports = gi_union (#gimports c1, #gimports c2),                           gimports = gi_union (#gimports c1, #gimports c2),
151                           smlfiles = #smlfiles c1 @ #smlfiles c2,                           smlfiles = #smlfiles c1 @ #smlfiles c2,
152                           localdefs = ld_union (#localdefs c1, #localdefs c2),                           localdefs = ld_union (#localdefs c1, #localdefs c2),
153                           subgroups = #subgroups c1 @ #subgroups c2,                           subgroups = #subgroups c1 @ #subgroups c2,
154                             sources = s_union (#sources c1, #sources c2),
155                           reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }                           reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
156          end          end
157        | sequential _ = ERRORCOLLECTION        | sequential _ = ERRORCOLLECTION
# Line 140  Line 162 
162          val error = GroupReg.error (#groupreg gp) group          val error = GroupReg.error (#groupreg gp) group
163          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
164          fun w0 s = error EM.WARN s EM.nullErrorBody          fun w0 s = error EM.WARN s EM.nullErrorBody
165          val { smlfiles, cmfiles } =          val { smlfiles, cmfiles, sources } =
166              PrivateTools.expand { error = e0,              PrivateTools.expand { error = e0,
167                                    spec = (name, mkpath, class, tooloptions),                                    spec = { name = name,
168                                               mkpath = mkpath,
169                                               class = class,
170                                               opts = tooloptions,
171                                               derived = false },
172                                    context = context,                                    context = context,
173                                    load_plugin = load_plugin }                                    load_plugin = load_plugin }
174          fun g_coll (p, v) =          val msources = foldl SrcPathMap.insert' SrcPathMap.empty sources
175              case rparse (p, v) of          fun g_coll (p, v, rb) =
176                  g as GG.GROUP { exports = i, kind, required,              case rparse (p, v, rb) of
177                    g as GG.GROUP { exports = i, kind, required, sources,
178                                  grouppath, sublibs } => let                                  grouppath, sublibs } => let
179                      val (gi, ver) =                      val (gi, ver) =
180                          case kind of                          case kind of
# Line 169  Line 196 
196                                  | _ => e0 "library is newer than expected"));                                  | _ => e0 "library is newer than expected"));
197                      COLLECTION { imports = i, gimports = gi, smlfiles = [],                      COLLECTION { imports = i, gimports = gi, smlfiles = [],
198                                   localdefs = SymbolMap.empty,                                   localdefs = SymbolMap.empty,
199                                   subgroups = [(p, g)],                                   subgroups = [(p, g, rb)],
200                                     sources = SrcPathMap.empty,
201                                   reqpriv = required }                                   reqpriv = required }
202                  end                  end
203                | GG.ERRORGROUP => ERRORCOLLECTION                | GG.ERRORGROUP => ERRORCOLLECTION
204          fun s_coll (p, s) = let          fun s_coll (p, s, setup) = let
205              val i =              val i =
206                  SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }                  SmlInfo.info gp { sourcepath = p, group = group,
207                                      sh_spec = s, setup = setup }
208              val exports =              val exports =
209                  case SmlInfo.exports gp i of                  case SmlInfo.exports gp i of
210                      NONE => SS.empty                      NONE => SS.empty
# Line 192  Line 221 
221                           smlfiles = [i],                           smlfiles = [i],
222                           localdefs = ld,                           localdefs = ld,
223                           subgroups = [],                           subgroups = [],
224                             sources = SrcPathMap.empty,
225                           reqpriv = StringSet.empty }                           reqpriv = StringSet.empty }
226          end          end
227          val collections = map g_coll cmfiles @ map s_coll smlfiles          val collections = map g_coll cmfiles @ map s_coll smlfiles
228          fun combine (c1, c2) = sequential (c2, c1, e0)          fun combine (c1, c2) = sequential (c2, c1, e0)
229      in      in
230          foldl combine empty collections          foldl combine (empty' msources) collections
231      end      end
232    
233      fun build (COLLECTION c, fopt, gp, perv_fsbnode) =      fun build (COLLECTION c, fopt, gp, perv_fsbnode) =
# Line 208  Line 238 
238      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
239        | subgroups ERRORCOLLECTION = []        | subgroups ERRORCOLLECTION = []
240    
241        fun sources (COLLECTION { sources = s, ... }) = s
242          | sources ERRORCOLLECTION = SrcPathMap.empty
243    
244      local      local
245          fun symenv_look (gp: GeneralParams.info) (c: collection) s =          fun symenv_look (gp: GeneralParams.info) (c: collection) s =
246              #get (#symval (#param gp) s) ()              #get (#symval (#param gp) s) ()

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

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