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 268, Mon May 10 07:00:02 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    
10      exception ExplicitError of string      type context = AbsPath.context
     exception ExpressionError of exn  
   
11      type pathname = AbsPath.t      type pathname = AbsPath.t
12      type ml_symbol      type ml_symbol
13      type cm_symbol      type cm_symbol
# Line 17  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 25  Line 24 
24      type complainer = string -> unit      type complainer = string -> unit
25    
26      (* getting elements of primitive types (pathnames and symbols) *)      (* getting elements of primitive types (pathnames and symbols) *)
27      val file_native : string * pathname -> pathname      val file_native : string * context -> pathname
28      val file_standard : string * pathname -> pathname      val file_standard : string * context -> pathname
29      val cm_symbol : string -> cm_symbol      val cm_symbol : string -> cm_symbol
30      val ml_structure : string -> ml_symbol      val ml_structure : string -> ml_symbol
31      val ml_signature : string -> ml_symbol      val ml_signature : string -> ml_symbol
32      val ml_functor : string -> ml_symbol      val ml_functor : string -> ml_symbol
33      val ml_funsig : string -> ml_symbol      val ml_funsig : string -> ml_symbol
34    
35      (* getting the full analysis for a group/library (or an alias thereof) *)      (* getting the full analysis for a group/library *)
36      val alias : pathname -> 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 * cm_symbol option -> members      val member : (pathname -> group)
48            -> { sourcepath: pathname, group: pathname, class: cm_symbol option,
49                 error: string -> (PrettyPrint.ppstream -> unit) -> unit }
50            -> 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 85  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    
95      type pathname = AbsPath.t      type pathname = AbsPath.t
96        type context = AbsPath.context
97      type ml_symbol = Symbol.symbol      type ml_symbol = Symbol.symbol
98      type cm_symbol = string      type cm_symbol = string
99    
100      type group = unit      type group = Dummy.t
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 108  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 121  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 alias (f: pathname) = ()      val emptyGroup = Dummy.v
129      fun group (p: perms, e: exports, m: members) = ()      fun group (p: permspec, e: exports, m: members) =
130      fun library (p: perms, e: exports, m: members) = ()          (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 132  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 142  Line 150 
150               { required = required, granted = StringSet.add (granted, s) })               { required = required, granted = StringSet.add (granted, s) })
151      end      end
152    
153        (* get the export map from a group *)
154        fun getExports (g: group) = (ignore Dummy.v; SymbolMap.empty)
155    
156      fun emptyMembers env = env      fun emptyMembers env = env
157      fun member (f, c) env =      fun member rparse arg env = let
158          MemberCollection.sequential (env, MemberCollection.expandOne (f, c))          val coll = MemberCollection.expandOne (getExports o rparse) arg
159            val error = #error arg
160            fun e0 s = error s GenericVC.ErrorMsg.nullErrorBody
161        in
162            MemberCollection.sequential (env, coll, e0)
163        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.268  
changed lines
  Added in v.277

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