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/semant.sml
ViewVC logotype

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

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

revision 756, Thu Dec 14 16:01:33 2000 UTC revision 771, Sat Dec 30 13:06:09 2000 UTC
# Line 49  Line 49 
49                    gp: GeneralParams.info,                    gp: GeneralParams.info,
50                    curlib: SrcPath.file option,                    curlib: SrcPath.file option,
51                    owner: SrcPath.file option,                    owner: SrcPath.file option,
                   error: complainer,  
52                    initgroup: group } -> group                    initgroup: group } -> group
53      val library : { path: SrcPath.file,      val library : { path: SrcPath.file,
54                      privileges: privilegespec,                      privileges: privilegespec,
# Line 58  Line 57 
57                      members: members,                      members: members,
58                      gp: GeneralParams.info,                      gp: GeneralParams.info,
59                      initgroup: group } -> group                      initgroup: group } -> group
60        val proxy : { path: SrcPath.file,
61                      privileges: privilegespec,
62                      members: members,
63                      error: complainer } -> group
64    
65      (* assembling privilege lists *)      (* assembling privilege lists *)
66      val initialPrivilegeSpec : privilegespec      val initialPrivilegeSpec : privilegespec
# Line 224  Line 227 
227          foldr add [] sgl          foldr add [] sgl
228      end      end
229    
230        val \/ = StringSet.union
231        infix \/
232    
233      fun group arg = let      fun group arg = let
234          val { path = g, privileges = p, exports = e, members = m,          val { path = g, privileges = p, exports = e, members = m,
235                gp, curlib, owner, error, initgroup } = arg                gp, curlib, owner, initgroup } = arg
236          val mc = applyTo (MemberCollection.implicit gp initgroup, curlib) m          val mc = applyTo (MemberCollection.implicit gp initgroup, curlib) m
237          val filter = Option.map (applyTo mc) e          val filter = Option.map (applyTo mc) e
238          val pfsbn = let          val pfsbn = let
# Line 242  Line 248 
248              MemberCollection.build (mc, filter, gp, pfsbn ())              MemberCollection.build (mc, filter, gp, pfsbn ())
249          val subgroups = filt_th_sgl (MemberCollection.subgroups mc, isl)          val subgroups = filt_th_sgl (MemberCollection.subgroups mc, isl)
250          val { required = rp', wrapped = wr } = p          val { required = rp', wrapped = wr } = p
         val rp'' = StringSet.union (rp', StringSet.union (rp, wr))  
251      in      in
252          if StringSet.isEmpty wr then ()          if StringSet.isEmpty wr then ()
253          else EM.impossible "group with wrapped privileges";          else EM.impossible "group with wrapped privileges";
254          GG.GROUP { exports = exports,          GG.GROUP { exports = exports,
255                     kind = GG.NOLIB { subgroups = subgroups, owner = owner },                     kind = GG.NOLIB { subgroups = subgroups, owner = owner,
256                     required = rp'',                                       explicit = Option.isSome e },
257                       required = rp' \/ rp \/ wr,
258                     grouppath = g,                     grouppath = g,
259                     sources = MemberCollection.sources mc,                     sources = MemberCollection.sources mc,
260                     sublibs = sgl2sll subgroups }                     sublibs = sgl2sll subgroups }
# Line 272  Line 278 
278              MemberCollection.build (mc, filter, gp, pfsbn ())              MemberCollection.build (mc, filter, gp, pfsbn ())
279          val subgroups = filt_th_sgl (MemberCollection.subgroups mc, isl)          val subgroups = filt_th_sgl (MemberCollection.subgroups mc, isl)
280          val { required = rp', wrapped = wr } = p          val { required = rp', wrapped = wr } = p
         val rp'' = StringSet.union (rp', StringSet.union (rp, wr))  
281      in      in
282          GG.GROUP { exports = exports,          GG.GROUP { exports = exports,
283                     kind = GG.LIB { version = version,                     kind = GG.LIB { version = version,
284                                     kind = GG.DEVELOPED { subgroups = subgroups,                                     kind = GG.DEVELOPED { subgroups = subgroups,
285                                                           wrapped = wr } },                                                           wrapped = wr } },
286                     required = rp'',                     required = rp' \/ rp \/ wr,
287                     grouppath = g,                     grouppath = g,
288                     sources = MemberCollection.sources mc,                     sources = MemberCollection.sources mc,
289                     sublibs = sgl2sll subgroups }                     sublibs = sgl2sll subgroups }
290      end      end
291    
292        fun proxy arg = let
293            val { path = g, members = m, error, privileges = p } = arg
294            val { required = rp', wrapped = wr } = p
295            val mc = applyTo (MemberCollection.empty, SOME g) m
296            fun notone () =
297                (error "precisely one sub-group or sub-library required";
298                 GG.ERRORGROUP)
299            fun notexplicit () =
300                (error "proxy for component without explicit export list";
301                 GG.ERRORGROUP)
302        in
303            if MemberCollection.has_smlfiles mc then notone ()
304            else
305                case MemberCollection.subgroups mc of
306                    [(_, GG.ERRORGROUP, _)] => GG.ERRORGROUP
307                  | [(p, sg as GG.GROUP grec, rb)] => let
308                        val { exports, kind, required = rp, ... } = grec
309                        val sgl = [(p, fn () => sg, rb)]
310                        fun doit () = let
311                            val lk = GG.DEVELOPED { subgroups = sgl, wrapped = wr }
312                        in
313                            GG.GROUP { exports = exports,
314                                       kind = GG.LIB { version = NONE, kind = lk },
315                                       required = rp \/ rp' \/ wr,
316                                       grouppath = g,
317                                       sources = MemberCollection.sources mc,
318                                       sublibs = sgl2sll sgl }
319                        end
320                    in
321                        case kind of
322                            GG.LIB _ => doit ()
323                          | GG.NOLIB { explicit = true, ... } => doit ()
324                          | _ => notexplicit ()
325                    end
326                  | l => notone ()
327        end
328    
329      local      local
330          val isMember = StringSet.member          val isMember = StringSet.member
331          fun sanity ({ required, wrapped }, s, error) =          fun sanity ({ required, wrapped }, s, error) =

Legend:
Removed from v.756  
changed lines
  Added in v.771

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