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 270, Tue May 11 07:45:42 1999 UTC revision 277, Mon May 17 09:13:26 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 35  Line 33 
33      val ml_funsig : string -> ml_symbol      val ml_funsig : string -> ml_symbol
34    
35      (* getting the full analysis for a group/library *)      (* getting the full analysis for a group/library *)
36      val group : perms * exports * members -> group      val emptyGroup : group
37      val library : perms * exports * members -> group      val group : permspec * exports * members -> group
38        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 87  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 102  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 111  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 124  Line 125 
125      val ml_functor = Symbol.fctSymbol      val ml_functor = Symbol.fctSymbol
126      val ml_funsig = Symbol.fsigSymbol      val ml_funsig = Symbol.fsigSymbol
127    
128      fun group (p: perms, e: exports, m: members) = Dummy.v      val emptyGroup = Dummy.v
129      fun library (p: perms, e: exports, m: members) = Dummy.v      fun group (p: permspec, e: exports, m: members) =
130            (ignore (m MemberCollection.empty);
131             Dummy.v)
132        fun library (p: permspec, e: exports, m: members) =
133            (ignore (m MemberCollection.empty);
134             Dummy.v)
135    
136      local      local
137          val isMember = StringSet.member          val isMember = StringSet.member
# Line 134  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 145  Line 151 
151      end      end
152    
153      (* get the export map from a group *)      (* get the export map from a group *)
154      fun getExports (g: group) =      fun getExports (g: group) = (ignore Dummy.v; SymbolMap.empty)
         (Dummy.f ()) : DependencyGraph.farnode SymbolMap.map  
155    
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            fun e0 s = error s GenericVC.ErrorMsg.nullErrorBody
161      in      in
162          MemberCollection.sequential (env, coll)          MemberCollection.sequential (env, coll, e0)
163      end      end
164      fun members (m1, m2) env = m2 (m1 env)      fun members (m1, m2) env = m2 (m1 env)
165      fun guarded_members (c, (m1, m2)) env =      fun guarded_members (c, (m1, m2), error) env =
166          if saveEval (c, env) then m1 env else m2 env          if saveEval (c, env, error) then m1 env else m2 env
167      fun error_member m env = raise ExplicitError m      fun error_member thunk env = (thunk (); env)
168    
169      fun emptyExports env = SymbolSet.empty      fun emptyExports env = SymbolSet.empty
170      fun export s env = SymbolSet.singleton s      fun export s env = SymbolSet.singleton s
171      fun exports (e1, e2) env = SymbolSet.union (e1 env, e2 env)      fun exports (e1, e2) env = SymbolSet.union (e1 env, e2 env)
172      fun guarded_exports (c, (e1, e2)) env =      fun guarded_exports (c, (e1, e2), error) env =
173          if saveEval (c, env) then e1 env else e2 env          if saveEval (c, env, error) then e1 env else e2 env
174      fun error_export m env = raise ExplicitError m      fun error_export thunk env = (thunk (); SymbolSet.empty)
175    
176      fun number i _ = i      fun number i _ = i
177      fun variable v e = MemberCollection.num_look e v      fun variable v e = MemberCollection.num_look e v

Legend:
Removed from v.270  
changed lines
  Added in v.277

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