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 340, Fri Jun 18 05:32:46 1999 UTC revision 348, Tue Jun 22 05:43:46 1999 UTC
# Line 46  Line 46 
46      (* assembling privilege lists *)      (* assembling privilege lists *)
47      val initialPrivilegeSpec : privilegespec      val initialPrivilegeSpec : privilegespec
48      val require : privilegespec * cm_symbol * complainer -> privilegespec      val require : privilegespec * cm_symbol * complainer -> privilegespec
49      val grant : privilegespec * cm_symbol * complainer -> privilegespec      val wrap : privilegespec * cm_symbol * complainer -> privilegespec
50    
51      (* constructing member collections *)      (* constructing member collections *)
52      val emptyMembers : members      val emptyMembers : members
# Line 107  Line 107 
107      type cm_symbol = string      type cm_symbol = string
108    
109      type group = GG.group      type group = GG.group
110      type privilegespec = { required: GG.privileges, granted: GG.privileges }      type privilegespec = { required: GG.privileges, wrapped: GG.privileges }
111    
112      type environment = MemberCollection.collection      type environment = MemberCollection.collection
113    
# Line 137  Line 137 
137    
138      fun emptyGroup path =      fun emptyGroup path =
139          GG.GROUP { exports = SymbolMap.empty,          GG.GROUP { exports = SymbolMap.empty,
140                     islib = false,                     kind = GG.NOLIB,
141                     required = StringSet.empty,                     required = StringSet.empty,
142                     grouppath = path,                     grouppath = path,
143                     sublibs = [],                     sublibs = [] }
                    stableinfo = GG.NONSTABLE StringSet.empty }  
144    
145      fun sgl2sll subgroups = let      fun sgl2sll subgroups = let
146          fun sameSL (_, GG.GROUP g) (_, GG.GROUP g') =          fun sameSL (_, GG.GROUP g) (_, GG.GROUP g') =
147              AbsPath.compare (#grouppath g, #grouppath g') = EQUAL              AbsPath.compare (#grouppath g, #grouppath g') = EQUAL
148          fun add (x, l) =          fun add (x, l) =
149              if List.exists (sameSL x) l then l else x :: l              if List.exists (sameSL x) l then l else x :: l
150          fun oneSG (x as (_, GG.GROUP { islib = true, ... }), l) = add (x, l)          fun oneSG (x as (_, GG.GROUP { kind, sublibs, ... }), l) =
151            | oneSG ((_, GG.GROUP { sublibs, ... }), l) = foldl add l sublibs              case kind of
152                    GG.NOLIB => foldl add l sublibs
153                  | _ => add (x, l)
154      in      in
155          foldl oneSG [] subgroups          foldl oneSG [] subgroups
156      end      end
157    
158      fun group (g, p, e, m, error, gp) = let      fun grouplib (islib, g, p, e, m, error, gp) = let
159          val mc = applyTo MemberCollection.empty m          val mc = applyTo MemberCollection.empty m
160          val filter = Option.map (applyTo mc) e          val filter = Option.map (applyTo mc) e
161          val (exports, rp) = MemberCollection.build (mc, filter, error, gp)          val (exports, rp) = MemberCollection.build (mc, filter, error, gp)
162          val subgroups = MemberCollection.subgroups mc          val subgroups = MemberCollection.subgroups mc
163          val { required = rp', granted = gr } = p          val { required = rp', wrapped = wr } = p
164            val rp'' = StringSet.union (rp', StringSet.union (rp, wr))
165      in      in
166          GG.GROUP { exports = exports, islib = false,          GG.GROUP { exports = exports,
167                     required = StringSet.union (StringSet.union (rp, rp'), gr),                     kind = if islib then GG.LIB wr
168                              else (if StringSet.isEmpty wr then ()
169                                    else EM.impossible
170                                        "group with wrapped privilege";
171                                    GG.NOLIB),
172                       required = rp'',
173                     grouppath = g,                     grouppath = g,
174                     sublibs = sgl2sll subgroups,                     sublibs = sgl2sll subgroups }
                    stableinfo = GG.NONSTABLE gr }  
175      end      end
176    
177      fun library (g, p, e, m, error, gp) = let      fun group (g, p, e, m, error, gp) =
178          val mc = applyTo MemberCollection.empty m          grouplib (false, g, p, e, m, error, gp)
179          val filter = applyTo mc e      fun library (g, p, e, m, error, gp) =
180          val (exports, rp) = MemberCollection.build (mc, SOME filter, error, gp)          grouplib (true, g, p, SOME e, m, error, gp)
         val subgroups = MemberCollection.subgroups mc  
         val { required = rp', granted = gr } = p  
     in  
         GG.GROUP { exports = exports, islib = true,  
                    required = StringSet.union (StringSet.union (rp, rp'), gr),  
                    grouppath = g,  
                    sublibs = sgl2sll subgroups,  
                    stableinfo = GG.NONSTABLE gr }  
     end  
181    
182      local      local
183          val isMember = StringSet.member          val isMember = StringSet.member
184          fun sanity ({ required, granted }, s, error) =          fun sanity ({ required, wrapped }, s, error) =
185              if isMember (required, s) orelse isMember (granted, s) then              if isMember (required, s) orelse isMember (wrapped, s) then
186                  error ("duplicate privilege name: " ^ s)                  error ("duplicate privilege name: " ^ s)
187              else ()              else ()
188      in      in
189          val initialPrivilegeSpec = { required = StringSet.empty,          val initialPrivilegeSpec = { required = StringSet.empty,
190                                       granted = StringSet.empty }                                       wrapped = StringSet.empty }
191          fun require (a as ({ required, granted }, s, _)) =          fun require (a as ({ required, wrapped }, s, _)) =
192              (sanity a;              (sanity a;
193               { required = StringSet.add (required, s), granted = granted })               { required = StringSet.add (required, s), wrapped = wrapped })
194          fun grant (a as ({ required, granted }, s, _)) =          fun wrap (a as ({ required, wrapped }, s, _)) =
195              (sanity a;              (sanity a;
196               { required = required, granted = StringSet.add (granted, s) })               { required = required, wrapped = StringSet.add (wrapped, s) })
197      end      end
198    
199      fun emptyMembers env = env      fun emptyMembers env = env

Legend:
Removed from v.340  
changed lines
  Added in v.348

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