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 578, Tue Mar 14 05:16:29 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 UTC
# Line 26  Line 26 
26          GeneralParams.info *          GeneralParams.info *
27          (SrcPath.t -> GroupGraph.group) *          (SrcPath.t -> GroupGraph.group) *
28          (SrcPath.context -> string -> bool)          (SrcPath.context -> string -> bool)
29          -> { name: string, mkpath: string -> SrcPath.t,          -> { name: string,
30               group: SrcPath.t * region, class: string option,               mkpath: string -> SrcPath.t,
31                 group: SrcPath.t * region,
32                 class: string option,
33                 tooloptions: string list 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 48  Line 51 
51    
52      structure DG = DependencyGraph      structure DG = DependencyGraph
53      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
     structure CBE = GenericVC.BareEnvironment  
54      structure E = GenericVC.Environment      structure E = GenericVC.Environment
55      structure SS = SymbolSet      structure SS = SymbolSet
56      structure GG = GroupGraph      structure GG = GroupGraph
# Line 65  Line 67 
67                          localdefs: smlinfo SymbolMap.map,                          localdefs: smlinfo SymbolMap.map,
68                          subgroups: (SrcPath.t * GG.group) list,                          subgroups: (SrcPath.t * GG.group) list,
69                          reqpriv: GG.privileges }                          reqpriv: GG.privileges }
70          | ERRORCOLLECTION
71    
72      val empty =      val empty =
73          COLLECTION { imports = SymbolMap.empty,          COLLECTION { imports = SymbolMap.empty,
# Line 75  Line 78 
78                       reqpriv = StringSet.empty }                       reqpriv = StringSet.empty }
79    
80      fun implicit init_group = let      fun implicit init_group = let
81          val (GG.GROUP { grouppath, ... }) = init_group          val { grouppath, ... } =
82                case init_group of
83                    GG.GROUP x => x
84                  | GG.ERRORGROUP =>
85                    EM.impossible "members.sml: implicit: bad init group"
86      in      in
87          (* This is a collection that is an implicit member of every          (* This is a collection that is an implicit member of every
88           * library -- the "init" group which exports the pervasive env. *)           * library -- the "init" group which exports the pervasive env. *)
# Line 87  Line 94 
94                       reqpriv = StringSet.empty }                       reqpriv = StringSet.empty }
95      end      end
96    
97      fun sequential (COLLECTION c1, COLLECTION c2, error) = let      fun sequential (COLLECTION c1, COLLECTION c2, error) =
98          fun describeSymbol (s, r) = let          let fun describeSymbol (s, r) = let
99              val ns = Symbol.nameSpace s              val ns = Symbol.nameSpace s
100          in          in
101              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
# Line 96  Line 103 
103          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
104              fun complain () =              fun complain () =
105                  error (concat (describeSymbol                  error (concat (describeSymbol
106                                 (s, [" imported from ", DG.describeSBN sbn,                                         (s, [" imported from ",
107                                      " and also from ", DG.describeSBN sbn'])))                                              DG.describeSBN sbn,
108                                                " and also from ",
109                                                DG.describeSBN sbn'])))
110              fun union (NONE, _) = NONE              fun union (NONE, _) = NONE
111                | union (_, NONE) = NONE                | union (_, NONE) = NONE
112                | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))                | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
# Line 122  Line 131 
131                       subgroups = #subgroups c1 @ #subgroups c2,                       subgroups = #subgroups c1 @ #subgroups c2,
132                       reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }                       reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
133      end      end
134          | sequential _ = ERRORCOLLECTION
135    
136      fun expandOne (gp, rparse, load_plugin) arg = let      fun expandOne (gp, rparse, load_plugin) arg = let
137          val { name, mkpath, group, class, context } = arg          val { name, mkpath, group, class, tooloptions, context } = arg
138          val class = Option.map (String.map Char.toLower) class          val class = Option.map (String.map Char.toLower) class
139          val error = GroupReg.error (#groupreg gp) group          val error = GroupReg.error (#groupreg gp) group
140          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
141          fun w0 s = error EM.WARN s EM.nullErrorBody          fun w0 s = error EM.WARN s EM.nullErrorBody
142          val { smlfiles, cmfiles } =          val { smlfiles, cmfiles } =
143              PrivateTools.expand { error = e0,              PrivateTools.expand { error = e0,
144                                    spec = (name, mkpath, class),                                    spec = (name, mkpath, class, tooloptions),
145                                    context = context,                                    context = context,
146                                    load_plugin = load_plugin }                                    load_plugin = load_plugin }
147          fun g_coll p = let          fun g_coll p =
148              val g as GG.GROUP { exports = i, kind, required, ... } = rparse p              case rparse p of
149              val gi = case kind of GG.NOLIB _ => i | _ => SymbolMap.empty                  g as GG.GROUP { exports = i, kind, required,
150                                    grouppath, sublibs } => let
151                        val gi =
152                            case kind of GG.NOLIB _ => i | _ => SymbolMap.empty
153          in          in
154              COLLECTION { imports = i, gimports = gi, smlfiles = [],              COLLECTION { imports = i, gimports = gi, smlfiles = [],
155                           localdefs = SymbolMap.empty,                           localdefs = SymbolMap.empty,
156                           subgroups = [(p, g)],                           subgroups = [(p, g)],
157                           reqpriv = required }                           reqpriv = required }
158          end          end
159                  | GG.ERRORGROUP => ERRORCOLLECTION
160          fun s_coll (p, s) = let          fun s_coll (p, s) = let
161              val i =              val i =
162                  SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }                  SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }
# Line 172  Line 186 
186    
187      fun build (COLLECTION c, fopt, gp, perv_fsbnode) =      fun build (COLLECTION c, fopt, gp, perv_fsbnode) =
188          BuildDepend.build (c, fopt, gp, perv_fsbnode)          BuildDepend.build (c, fopt, gp, perv_fsbnode)
189          | build (ERRORCOLLECTION, _, _, _) =
190            (SymbolMap.empty, StringSet.empty)
191    
192      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg      fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
193          | subgroups ERRORCOLLECTION = []
194    
195      local      local
196          fun symenv_look (gp: GeneralParams.info) (c: collection) s =          fun symenv_look (gp: GeneralParams.info) (c: collection) s =
# Line 186  Line 203 
203      fun ml_look (COLLECTION { imports, localdefs, ... }) s =      fun ml_look (COLLECTION { imports, localdefs, ... }) s =
204          isSome (SymbolMap.find (imports, s)) orelse          isSome (SymbolMap.find (imports, s)) orelse
205          isSome (SymbolMap.find (localdefs, s))          isSome (SymbolMap.find (localdefs, s))
206          | ml_look ERRORCOLLECTON _ = true
207  end  end

Legend:
Removed from v.578  
changed lines
  Added in v.587

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