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 282, Wed May 19 05:14:03 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 option * 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 applyTo mc e = e mc
128    
129      val emptyGroup = Dummy.v      val emptyGroup = Dummy.v
130      fun group (p: perms, e: exports, m: members) =  
131          (ignore (m MemberCollection.empty);      fun group (p: permspec, e: exports option, m) = let
132           Dummy.v)          val mc = applyTo MemberCollection.empty m
133      fun library (p: perms, e: exports, m: members) =          val exports = Option.map (applyTo mc) e
134          (ignore (m MemberCollection.empty);      in
135           Dummy.v)          ignore (MemberCollection.build mc);
136            Dummy.v
137        end
138    
139        fun library (p: permspec, e: exports, m) = let
140            val mc = applyTo MemberCollection.empty m
141            val exports = applyTo mc e
142        in
143            ignore (MemberCollection.build mc);
144            Dummy.v
145        end
146    
147      local      local
148          val isMember = StringSet.member          val isMember = StringSet.member
# Line 140  Line 151 
151                  error ("duplicate permission name: " ^ s)                  error ("duplicate permission name: " ^ s)
152              else ()              else ()
153      in      in
154          val initialPerms = { required = StringSet.empty,          val initialPermSpec = { required = StringSet.empty,
155                               granted = StringSet.empty }                               granted = StringSet.empty }
156          fun require (a as ({ required, granted }, s, _)) =          fun require (a as ({ required, granted }, s, _)) =
157              (sanity a;              (sanity a;
# Line 156  Line 167 
167      fun emptyMembers env = env      fun emptyMembers env = env
168      fun member rparse arg env = let      fun member rparse arg env = let
169          val coll = MemberCollection.expandOne (getExports o rparse) arg          val coll = MemberCollection.expandOne (getExports o rparse) arg
170            val error = #error arg
171            fun e0 s = error s GenericVC.ErrorMsg.nullErrorBody
172      in      in
173          MemberCollection.sequential (env, coll)          MemberCollection.sequential (env, coll, e0)
174      end      end
175      fun members (m1, m2) env = m2 (m1 env)      fun members (m1, m2) env = m2 (m1 env)
176      fun guarded_members (c, (m1, m2)) env =      fun guarded_members (c, (m1, m2), error) env =
177          if saveEval (c, env) then m1 env else m2 env          if saveEval (c, env, error) then m1 env else m2 env
178      fun error_member m env =      fun error_member thunk env = (thunk (); env)
         (print (m ^ "\n");  
          raise ExplicitError m)  
179    
180      fun emptyExports env = SymbolSet.empty      fun emptyExports env = SymbolSet.empty
181      fun export s env = SymbolSet.singleton s      fun export s env = SymbolSet.singleton s
182      fun exports (e1, e2) env = SymbolSet.union (e1 env, e2 env)      fun exports (e1, e2) env = SymbolSet.union (e1 env, e2 env)
183      fun guarded_exports (c, (e1, e2)) env =      fun guarded_exports (c, (e1, e2), error) env =
184          if saveEval (c, env) then e1 env else e2 env          if saveEval (c, env, error) then e1 env else e2 env
185      fun error_export m env = raise ExplicitError m      fun error_export thunk env = (thunk (); SymbolSet.empty)
186    
187      fun number i _ = i      fun number i _ = i
188      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.282

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