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 280, Tue May 18 09:05:13 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 -> (PrettyPrint.ppstream -> unit) -> 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  
   
     structure Symbol = GenericVC.Symbol  
92      structure SymPath = GenericVC.SymPath      structure SymPath = GenericVC.SymPath
93    
94      type pathname = AbsPath.t      type pathname = AbsPath.t
# Line 103  Line 100 
100    
101      type environment = MemberCollection.collection      type environment = MemberCollection.collection
102    
103      type perms = { required : StringSet.set, granted : StringSet.set }      type perms = StringSet.set
104        type permspec = { required : perms, granted : perms }
105    
106      type aexp = environment -> int      type aexp = environment -> int
107      type exp = environment -> bool      type exp = environment -> bool
# Line 112  Line 110 
110    
111      type complainer = string -> unit      type complainer = string -> unit
112    
113      fun saveEval (exp, env) =      fun saveEval (exp, env, error) =
114          exp env          exp env
115          handle exn =>          handle exn =>
116              raise ExpressionError exn              (error ("expression raises exception: " ^ General.exnMessage exn);
117                 false)
118    
119      fun file_native (s, d) = AbsPath.native { context = d, spec = s }      fun file_native (s, d) = AbsPath.native { context = d, spec = s }
120      fun file_standard (s, d) = AbsPath.standard { context = d, spec = s }      fun file_standard (s, d) = AbsPath.standard { context = d, spec = s }
# Line 125  Line 124 
124      val ml_functor = Symbol.fctSymbol      val ml_functor = Symbol.fctSymbol
125      val ml_funsig = Symbol.fsigSymbol      val ml_funsig = Symbol.fsigSymbol
126    
127        fun group0 islib (p: permspec, e: exports, m) = let
128            val mc = m MemberCollection.empty
129            val exports = e mc
130        in
131            ignore (MemberCollection.build mc);
132            if islib then Dummy.v else Dummy.v
133        end
134    
135      val emptyGroup = Dummy.v      val emptyGroup = Dummy.v
136      fun group (p: perms, e: exports, m: members) =      val group = group0 false
137          (ignore (m MemberCollection.empty);      val library = group0 true
          Dummy.v)  
     fun library (p: perms, e: exports, m: members) =  
         (ignore (m MemberCollection.empty);  
          Dummy.v)  
138    
139      local      local
140          val isMember = StringSet.member          val isMember = StringSet.member
# Line 140  Line 143 
143                  error ("duplicate permission name: " ^ s)                  error ("duplicate permission name: " ^ s)
144              else ()              else ()
145      in      in
146          val initialPerms = { required = StringSet.empty,          val initialPermSpec = { required = StringSet.empty,
147                               granted = StringSet.empty }                               granted = StringSet.empty }
148          fun require (a as ({ required, granted }, s, _)) =          fun require (a as ({ required, granted }, s, _)) =
149              (sanity a;              (sanity a;
# Line 156  Line 159 
159      fun emptyMembers env = env      fun emptyMembers env = env
160      fun member rparse arg env = let      fun member rparse arg env = let
161          val coll = MemberCollection.expandOne (getExports o rparse) arg          val coll = MemberCollection.expandOne (getExports o rparse) arg
162            val error = #error arg
163            fun e0 s = error s GenericVC.ErrorMsg.nullErrorBody
164      in      in
165          MemberCollection.sequential (env, coll)          MemberCollection.sequential (env, coll, e0)
166      end      end
167      fun members (m1, m2) env = m2 (m1 env)      fun members (m1, m2) env = m2 (m1 env)
168      fun guarded_members (c, (m1, m2)) env =      fun guarded_members (c, (m1, m2), error) env =
169          if saveEval (c, env) then m1 env else m2 env          if saveEval (c, env, error) then m1 env else m2 env
170      fun error_member m env =      fun error_member thunk env = (thunk (); env)
         (print (m ^ "\n");  
          raise ExplicitError m)  
171    
172      fun emptyExports env = SymbolSet.empty      fun emptyExports env = SymbolSet.empty
173      fun export s env = SymbolSet.singleton s      fun export s env = SymbolSet.singleton s
174      fun exports (e1, e2) env = SymbolSet.union (e1 env, e2 env)      fun exports (e1, e2) env = SymbolSet.union (e1 env, e2 env)
175      fun guarded_exports (c, (e1, e2)) env =      fun guarded_exports (c, (e1, e2), error) env =
176          if saveEval (c, env) then e1 env else e2 env          if saveEval (c, env, error) then e1 env else e2 env
177      fun error_export m env = raise ExplicitError m      fun error_export thunk env = (thunk (); SymbolSet.empty)
178    
179      fun number i _ = i      fun number i _ = i
180      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.280

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