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 274, Fri May 14 05:23:02 1999 UTC revision 275, Sat May 15 09:54:52 1999 UTC
# Line 7  Line 7 
7   *)   *)
8  signature CM_SEMANT = sig  signature CM_SEMANT = sig
9    
     exception ExplicitError of string  
     exception ExpressionError of exn  
   
10      type context = AbsPath.context      type context = AbsPath.context
11      type pathname = AbsPath.t      type pathname = AbsPath.t
12      type ml_symbol      type ml_symbol
# Line 18  Line 15 
15      type group      type group
16    
17      type perms      type perms
18        type permspec
19      type aexp      type aexp
20      type exp      type exp
21      type members                        (* still conditional *)      type members                        (* still conditional *)
# Line 36  Line 34 
34    
35      (* getting the full analysis for a group/library *)      (* getting the full analysis for a group/library *)
36      val emptyGroup : group      val emptyGroup : group
37      val group : perms * exports * members -> group      val group : permspec * exports * members -> group
38      val library : perms * exports * members -> group      val library : permspec * exports * members -> group
39    
40      (* assembling permission lists *)      (* assembling permission lists *)
41      val initialPerms : perms      val initialPermSpec : permspec
42      val require : perms * cm_symbol * complainer -> perms      val require : permspec * cm_symbol * complainer -> permspec
43      val grant : perms * cm_symbol * complainer -> perms      val grant : permspec * cm_symbol * complainer -> permspec
44    
45      (* constructing member collections *)      (* constructing member collections *)
46      val emptyMembers : members      val emptyMembers : members
47      val member : (pathname -> group)      val member : (pathname -> group)
48          -> { sourcepath: pathname, group: pathname, class: cm_symbol option }          -> { sourcepath: pathname, group: pathname, class: cm_symbol option,
49                 error: string -> unit }
50          -> members          -> members
51      val members : members * members -> members      val members : members * members -> members
52      val guarded_members : exp * (members * members) -> members      val guarded_members :
53      val error_member : string -> members          exp * (members * members) * (string -> unit) -> members
54        val error_member : (unit -> unit) -> members
55    
56      (* constructing export lists *)      (* constructing export lists *)
57      val emptyExports : exports      val emptyExports : exports
58      val export : ml_symbol -> exports      val export : ml_symbol -> exports
59      val exports : exports * exports -> exports      val exports : exports * exports -> exports
60      val guarded_exports : exp * (exports * exports) -> exports      val guarded_exports :
61      val error_export : string -> exports          exp * (exports * exports) * (string -> unit) -> exports
62        val error_export : (unit -> unit) -> exports
63    
64      (* arithmetic (number-valued) expression *)      (* arithmetic (number-valued) expression *)
65      val number : int -> aexp      val number : int -> aexp
# Line 88  Line 89 
89    
90  structure CMSemant :> CM_SEMANT = struct  structure CMSemant :> CM_SEMANT = struct
91    
     exception ExplicitError of string  
     exception ExpressionError of exn  
   
92      structure Symbol = GenericVC.Symbol      structure Symbol = GenericVC.Symbol
93      structure SymPath = GenericVC.SymPath      structure SymPath = GenericVC.SymPath
94    
# Line 103  Line 101 
101    
102      type environment = MemberCollection.collection      type environment = MemberCollection.collection
103    
104      type perms = { required : StringSet.set, granted : StringSet.set }      type perms = StringSet.set
105        type permspec = { required : perms, granted : perms }
106    
107      type aexp = environment -> int      type aexp = environment -> int
108      type exp = environment -> bool      type exp = environment -> bool
# Line 112  Line 111 
111    
112      type complainer = string -> unit      type complainer = string -> unit
113    
114      fun saveEval (exp, env) =      fun saveEval (exp, env, error) =
115          exp env          exp env
116          handle exn =>          handle exn =>
117              raise ExpressionError exn              (error ("expression raises exception: " ^ General.exnMessage exn);
118                 false)
119    
120      fun file_native (s, d) = AbsPath.native { context = d, spec = s }      fun file_native (s, d) = AbsPath.native { context = d, spec = s }
121      fun file_standard (s, d) = AbsPath.standard { context = d, spec = s }      fun file_standard (s, d) = AbsPath.standard { context = d, spec = s }
# Line 126  Line 126 
126      val ml_funsig = Symbol.fsigSymbol      val ml_funsig = Symbol.fsigSymbol
127    
128      val emptyGroup = Dummy.v      val emptyGroup = Dummy.v
129      fun group (p: perms, e: exports, m: members) =      fun group (p: permspec, e: exports, m: members) =
130          (ignore (m MemberCollection.empty);          (ignore (m MemberCollection.empty);
131           Dummy.v)           Dummy.v)
132      fun library (p: perms, e: exports, m: members) =      fun library (p: permspec, e: exports, m: members) =
133          (ignore (m MemberCollection.empty);          (ignore (m MemberCollection.empty);
134           Dummy.v)           Dummy.v)
135    
# Line 140  Line 140 
140                  error ("duplicate permission name: " ^ s)                  error ("duplicate permission name: " ^ s)
141              else ()              else ()
142      in      in
143          val initialPerms = { required = StringSet.empty,          val initialPermSpec = { required = StringSet.empty,
144                               granted = StringSet.empty }                               granted = StringSet.empty }
145          fun require (a as ({ required, granted }, s, _)) =          fun require (a as ({ required, granted }, s, _)) =
146              (sanity a;              (sanity a;
# Line 156  Line 156 
156      fun emptyMembers env = env      fun emptyMembers env = env
157      fun member rparse arg env = let      fun member rparse arg env = let
158          val coll = MemberCollection.expandOne (getExports o rparse) arg          val coll = MemberCollection.expandOne (getExports o rparse) arg
159            val error = #error arg
160      in      in
161          MemberCollection.sequential (env, coll)          MemberCollection.sequential (env, coll, error)
162      end      end
163      fun members (m1, m2) env = m2 (m1 env)      fun members (m1, m2) env = m2 (m1 env)
164      fun guarded_members (c, (m1, m2)) env =      fun guarded_members (c, (m1, m2), error) env =
165          if saveEval (c, env) then m1 env else m2 env          if saveEval (c, env, error) then m1 env else m2 env
166      fun error_member m env =      fun error_member thunk env = (thunk (); env)
         (print (m ^ "\n");  
          raise ExplicitError m)  
167    
168      fun emptyExports env = SymbolSet.empty      fun emptyExports env = SymbolSet.empty
169      fun export s env = SymbolSet.singleton s      fun export s env = SymbolSet.singleton s
170      fun exports (e1, e2) env = SymbolSet.union (e1 env, e2 env)      fun exports (e1, e2) env = SymbolSet.union (e1 env, e2 env)
171      fun guarded_exports (c, (e1, e2)) env =      fun guarded_exports (c, (e1, e2), error) env =
172          if saveEval (c, env) then e1 env else e2 env          if saveEval (c, env, error) then e1 env else e2 env
173      fun error_export m env = raise ExplicitError m      fun error_export thunk env = (thunk (); SymbolSet.empty)
174    
175      fun number i _ = i      fun number i _ = i
176      fun variable v e = MemberCollection.num_look e v      fun variable v e = MemberCollection.num_look e v

Legend:
Removed from v.274  
changed lines
  Added in v.275

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