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 265, Fri May 7 08:42:54 1999 UTC revision 266, Sat May 8 04:00:44 1999 UTC
# Line 1  Line 1 
1  signature CM_SEMANT = sig  signature CM_SEMANT = sig
2    
3        exception ExplicitError of string
4    
5      type pathname      type pathname
6      type ml_symbol      type ml_symbol
7      type cm_symbol      type cm_symbol
8    
9      type group      type group
10    
11      type perm      type perms
12      type aexp      type aexp
13      type exp      type exp
14      type members                        (* still conditional *)      type members                        (* still conditional *)
15      type exports                        (* still conditional *)      type exports                        (* still conditional *)
16    
17        type complainer = string -> unit
18    
19      val file_native : string * pathname -> pathname      val file_native : string * pathname -> pathname
20      val file_standard : string * pathname -> pathname      val file_standard : string * pathname -> pathname
21      val cm_symbol : string -> cm_symbol      val cm_symbol : string -> cm_symbol
# Line 21  Line 25 
25      val ml_funsig : string -> ml_symbol      val ml_funsig : string -> ml_symbol
26    
27      val alias : pathname -> group      val alias : pathname -> group
28      val group : perm list * exports * members -> group      val group : perms * exports * members -> group
29      val library : perm list * exports * members -> group      val library : perms * exports * members -> group
30    
31      val require : cm_symbol -> perm      val initialPerms : perms
32      val grant : cm_symbol -> perm      val require : perms * cm_symbol * complainer -> perms
33        val grant : perms * cm_symbol * complainer -> perms
34    
35      val emptyMembers : members      val emptyMembers : members
36      val member : pathname * cm_symbol option -> members      val member : pathname * cm_symbol option -> members
37      val members : members * members -> members      val members : members * members -> members
38      val guarded_members : exp * (members * members) -> members      val guarded_members : exp * (members * members) -> members
39        val error_member : string -> members
40    
41      val emptyExports : exports      val emptyExports : exports
42      val export : ml_symbol -> exports      val export : ml_symbol -> exports
43      val exports : exports * exports -> exports      val exports : exports * exports -> exports
44      val guarded_exports : exp * (exports * exports) -> exports      val guarded_exports : exp * (exports * exports) -> exports
45        val error_export : string -> exports
46    
47      val number : int -> aexp      val number : int -> aexp
48      val variable : cm_symbol -> aexp      val variable : cm_symbol -> aexp
# Line 64  Line 71 
71    
72  structure CMSemant :> CM_SEMANT = struct  structure CMSemant :> CM_SEMANT = struct
73    
74        exception ExplicitError of string
75    
76      type pathname = AbsPath.t      type pathname = AbsPath.t
77      type ml_symbol = unit      type ml_symbol = ModName.t
78      type cm_symbol = string      type cm_symbol = string
79    
80      type group = unit      type group = unit
# Line 75  Line 84 
84      fun ml_look () _ = false      fun ml_look () _ = false
85      fun cm_look () _ = false      fun cm_look () _ = false
86    
87      datatype perm =      type perms = { required : StringSet.set, granted : StringSet.set }
         REQUIRE of cm_symbol  
       | GRANT of cm_symbol  
88    
89      type aexp = environment -> int      type aexp = environment -> int
90      type exp = environment -> bool      type exp = environment -> bool
91      type members = unit      type members = unit
92      type exports = unit      type exports = environment -> ModName.set
93    
94        type complainer = string -> unit
95    
96      fun file_native (s, d) = AbsPath.native { context = d, spec = s }      fun file_native (s, d) = AbsPath.native { context = d, spec = s }
97      fun file_standard (s, d) = AbsPath.standard { context = d, spec = s }      fun file_standard (s, d) = AbsPath.standard { context = d, spec = s }
98      fun cm_symbol s = s      fun cm_symbol s = s
99      fun ml_structure (s: string) = ()      val ml_structure = ModName.structMN
100      fun ml_signature (s: string) = ()      val ml_signature = ModName.sigMN
101      fun ml_functor (s: string) = ()      val ml_functor = ModName.functMN
102      fun ml_funsig (s: string) = ()      val ml_funsig = ModName.funsigMN
103    
104      fun alias (f: pathname) = ()      fun alias (f: pathname) = ()
105      fun group (p: perm list, e: exports, m: members) = ()      fun group (p: perms, e: exports, m: members) = ()
106      fun library (p: perm list, e: exports, m: members) = ()      fun library (p: perms, e: exports, m: members) = ()
107    
108      val require = REQUIRE      local
109      val grant = GRANT          val member = StringSet.member
110            fun sanity ({ required, granted }, s, error) =
111                if member (required, s) orelse member (granted, s) then
112                    error ("duplicate permission name: " ^ s)
113                else ()
114        in
115            val initialPerms = { required = StringSet.empty,
116                                 granted = StringSet.empty }
117            fun require (a as ({ required, granted }, s, _)) =
118                (sanity a;
119                 { required = StringSet.add (required, s), granted = granted })
120            fun grant (a as ({ required, granted }, s, _)) =
121                (sanity a;
122                 { required = required, granted = StringSet.add (granted, s) })
123        end
124    
125      val emptyMembers = ()      val emptyMembers = ()
126      fun member (f: pathname, c: cm_symbol option) = ()      fun member (f: pathname, c: cm_symbol option) = ()
127      fun members (m1: members, m2: members) = ()      fun members (m1: members, m2: members) = ()
128      fun guarded_members (c: exp, (m1: members, m2: members)) = ()      fun guarded_members (c: exp, (m1: members, m2: members)) = ()
129        fun error_member (m: string) = ()
130    
131      val emptyExports = ()      fun emptyExports env = ModName.empty
132      fun export (s: ml_symbol) = ()      fun export s env = ModName.singleton s
133      fun exports (e1: exports, e2: exports) = ()      fun exports (e1, e2) env = ModName.union (e1 env, e2 env)
134      fun guarded_exports (c: exp, (e1: exports, e2: exports)) = ()      fun guarded_exports (c, (e1, e2)) env = if c env then e1 env else e2 env
135        fun error_export m env = raise ExplicitError m
136    
137      fun number i _ = i      fun number i _ = i
138      fun variable v e = num_look e v      fun variable v e = num_look e v

Legend:
Removed from v.265  
changed lines
  Added in v.266

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