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 366, Fri Jul 2 14:13:29 1999 UTC revision 367, Sat Jul 3 04:59:01 1999 UTC
# Line 36  Line 36 
36      val emptyGroup : pathname -> group      val emptyGroup : pathname -> group
37      val group :      val group :
38          pathname * privilegespec * exports option * members *          pathname * privilegespec * exports option * members *
39          GeneralParams.info          GeneralParams.info * pathname option * pathname option * complainer
40          -> group          -> group
41      val library :      val library :
42          pathname * privilegespec * exports * members *          pathname * privilegespec * exports * members *
# Line 51  Line 51 
51      (* constructing member collections *)      (* constructing member collections *)
52      val emptyMembers : members      val emptyMembers : members
53      val member :      val member :
54          GeneralParams.info * (pathname -> group)          GeneralParams.info * (pathname option -> pathname -> group)
55          -> { sourcepath: pathname, group: pathname * region,          -> { sourcepath: pathname, group: pathname * region,
56               class: cm_symbol option }               class: cm_symbol option }
57          -> members          -> members
# Line 113  Line 113 
113    
114      type aexp = environment -> int      type aexp = environment -> int
115      type exp = environment -> bool      type exp = environment -> bool
116      type members = environment -> MemberCollection.collection      type members = environment * pathname option -> MemberCollection.collection
117      type exports = environment -> SymbolSet.set      type exports = environment -> SymbolSet.set
118    
119      type complainer = string -> unit      type complainer = string -> unit
# Line 155  Line 155 
155          foldl oneSG [] subgroups          foldl oneSG [] subgroups
156      end      end
157    
158      fun grouplib (islib, g, p, e, m, gp) = let      fun grouplib (islib, g, p, e, m, gp, curlib) = let
159          val mc = applyTo MemberCollection.empty m          val mc = applyTo (MemberCollection.empty, curlib) m
160          val filter = Option.map (applyTo mc) e          val filter = Option.map (applyTo mc) e
161          val (exports, rp) = MemberCollection.build (mc, filter, gp)          val (exports, rp) = MemberCollection.build (mc, filter, gp)
162          val subgroups = MemberCollection.subgroups mc          val subgroups = MemberCollection.subgroups mc
# Line 174  Line 174 
174                     sublibs = sgl2sll subgroups }                     sublibs = sgl2sll subgroups }
175      end      end
176    
177      fun group (g, p, e, m, gp) =      fun group (g, p, e, m, gp, curlib, owner, error) = let
178          grouplib (false, g, p, e, m, gp)          fun libname NONE = "<toplevel>"
179              | libname (SOME p) = SrcPath.descr p
180            fun eq (NONE, NONE) = true
181              | eq (SOME p, SOME p') = SrcPath.compare (p, p') = EQUAL
182              | eq _ = false
183            fun checkowner () =
184                if eq (curlib, owner) then ()
185                else error (concat ["owner specified as ",
186                                    libname owner, " but found to be ",
187                                    libname curlib])
188        in
189            checkowner ();
190            grouplib (false, g, p, e, m, gp, curlib)
191        end
192      fun library (g, p, e, m, gp) =      fun library (g, p, e, m, gp) =
193          grouplib (true, g, p, SOME e, m, gp)          grouplib (true, g, p, SOME e, m, gp, SOME g)
194    
195      local      local
196          val isMember = StringSet.member          val isMember = StringSet.member
# Line 196  Line 209 
209               { required = required, wrapped = StringSet.add (wrapped, s) })               { required = required, wrapped = StringSet.add (wrapped, s) })
210      end      end
211    
212      fun emptyMembers env = env      fun emptyMembers (env, _) = env
213      fun member (gp, rparse) arg env = let      fun member (gp, rparse) arg (env, curlib) = let
214          val coll = MemberCollection.expandOne (gp, rparse) arg          val coll = MemberCollection.expandOne (gp, rparse curlib) arg
215          val group = #group arg          val group = #group arg
216          val error = GroupReg.error (#groupreg gp) group          val error = GroupReg.error (#groupreg gp) group
217          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody          fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
218      in      in
219          MemberCollection.sequential (env, coll, e0)          MemberCollection.sequential (env, coll, e0)
220      end      end
221      fun members (m1, m2) env = m2 (m1 env)      fun members (m1, m2) (env, curlib) = m2 (m1 (env, curlib), curlib)
222      fun guarded_members (c, (m1, m2), error) env =      fun guarded_members (c, (m1, m2), error) (env, curlib) =
223          if saveEval (c, env, error) then m1 env else m2 env          if saveEval (c, env, error) then m1 (env, curlib) else m2 (env, curlib)
224      fun error_member thunk env = (thunk (); env)      fun error_member thunk (env, _) = (thunk (); env)
225    
226      fun emptyExports env = SymbolSet.empty      fun emptyExports env = SymbolSet.empty
227      fun export (s, error) env =      fun export (s, error) env =

Legend:
Removed from v.366  
changed lines
  Added in v.367

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