Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/semant/semant.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/semant/semant.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 266 - (view) (download)

1 : blume 265 signature CM_SEMANT = sig
2 :    
3 : blume 266 exception ExplicitError of string
4 :    
5 : blume 265 type pathname
6 :     type ml_symbol
7 :     type cm_symbol
8 :    
9 :     type group
10 :    
11 : blume 266 type perms
12 : blume 265 type aexp
13 :     type exp
14 :     type members (* still conditional *)
15 :     type exports (* still conditional *)
16 :    
17 : blume 266 type complainer = string -> unit
18 :    
19 : blume 265 val file_native : string * pathname -> pathname
20 :     val file_standard : string * pathname -> pathname
21 :     val cm_symbol : string -> cm_symbol
22 :     val ml_structure : string -> ml_symbol
23 :     val ml_signature : string -> ml_symbol
24 :     val ml_functor : string -> ml_symbol
25 :     val ml_funsig : string -> ml_symbol
26 :    
27 :     val alias : pathname -> group
28 : blume 266 val group : perms * exports * members -> group
29 :     val library : perms * exports * members -> group
30 : blume 265
31 : blume 266 val initialPerms : perms
32 :     val require : perms * cm_symbol * complainer -> perms
33 :     val grant : perms * cm_symbol * complainer -> perms
34 : blume 265
35 :     val emptyMembers : members
36 :     val member : pathname * cm_symbol option -> members
37 :     val members : members * members -> members
38 :     val guarded_members : exp * (members * members) -> members
39 : blume 266 val error_member : string -> members
40 : blume 265
41 :     val emptyExports : exports
42 :     val export : ml_symbol -> exports
43 :     val exports : exports * exports -> exports
44 :     val guarded_exports : exp * (exports * exports) -> exports
45 : blume 266 val error_export : string -> exports
46 : blume 265
47 :     val number : int -> aexp
48 :     val variable : cm_symbol -> aexp
49 :     val plus : aexp * aexp -> aexp
50 :     val minus : aexp * aexp -> aexp
51 :     val times : aexp * aexp -> aexp
52 :     val divide : aexp * aexp -> aexp
53 :     val modulus : aexp * aexp -> aexp
54 :     val negate : aexp -> aexp
55 :    
56 :     val ml_defined : ml_symbol -> exp
57 :     val cm_defined : cm_symbol -> exp
58 :     val conj : exp * exp -> exp
59 :     val disj : exp * exp -> exp
60 :     val beq : exp * exp -> exp
61 :     val bne : exp * exp -> exp
62 :     val not : exp -> exp
63 :     val lt : aexp * aexp -> exp
64 :     val le : aexp * aexp -> exp
65 :     val gt : aexp * aexp -> exp
66 :     val ge : aexp * aexp -> exp
67 :     val eq : aexp * aexp -> exp
68 :     val ne : aexp * aexp -> exp
69 :    
70 :     end
71 :    
72 :     structure CMSemant :> CM_SEMANT = struct
73 :    
74 : blume 266 exception ExplicitError of string
75 :    
76 : blume 265 type pathname = AbsPath.t
77 : blume 266 type ml_symbol = ModName.t
78 : blume 265 type cm_symbol = string
79 :    
80 :     type group = unit
81 :    
82 :     type environment = unit
83 :     fun num_look () _ = 0
84 :     fun ml_look () _ = false
85 :     fun cm_look () _ = false
86 :    
87 : blume 266 type perms = { required : StringSet.set, granted : StringSet.set }
88 : blume 265
89 :     type aexp = environment -> int
90 :     type exp = environment -> bool
91 :     type members = unit
92 : blume 266 type exports = environment -> ModName.set
93 : blume 265
94 : blume 266 type complainer = string -> unit
95 :    
96 : blume 265 fun file_native (s, d) = AbsPath.native { context = d, spec = s }
97 :     fun file_standard (s, d) = AbsPath.standard { context = d, spec = s }
98 :     fun cm_symbol s = s
99 : blume 266 val ml_structure = ModName.structMN
100 :     val ml_signature = ModName.sigMN
101 :     val ml_functor = ModName.functMN
102 :     val ml_funsig = ModName.funsigMN
103 : blume 265
104 :     fun alias (f: pathname) = ()
105 : blume 266 fun group (p: perms, e: exports, m: members) = ()
106 :     fun library (p: perms, e: exports, m: members) = ()
107 : blume 265
108 : blume 266 local
109 :     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 : blume 265
125 :     val emptyMembers = ()
126 :     fun member (f: pathname, c: cm_symbol option) = ()
127 :     fun members (m1: members, m2: members) = ()
128 :     fun guarded_members (c: exp, (m1: members, m2: members)) = ()
129 : blume 266 fun error_member (m: string) = ()
130 : blume 265
131 : blume 266 fun emptyExports env = ModName.empty
132 :     fun export s env = ModName.singleton s
133 :     fun exports (e1, e2) env = ModName.union (e1 env, e2 env)
134 :     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 : blume 265
137 :     fun number i _ = i
138 :     fun variable v e = num_look e v
139 :     fun plus (e1, e2) e = e1 e + e2 e
140 :     fun minus (e1, e2) e = e1 e - e2 e
141 :     fun times (e1, e2) e = e1 e * e2 e
142 :     fun divide (e1, e2) e = e1 e div e2 e
143 :     fun modulus (e1, e2) e = e1 e mod e2 e
144 :     fun negate ex e = ~(ex e)
145 :    
146 :     fun ml_defined s e = ml_look e s
147 :     fun cm_defined s e = cm_look e s
148 :     fun conj (e1, e2) e = e1 e andalso e2 e
149 :     fun disj (e1, e2) e = e1 e orelse e2 e
150 :     fun beq (e1: exp, e2) e = e1 e = e2 e
151 :     fun bne (e1: exp, e2) e = e1 e <> e2 e
152 :     fun not ex e = Bool.not (ex e)
153 :     fun lt (e1, e2) e = e1 e < e2 e
154 :     fun le (e1, e2) e = e1 e <= e2 e
155 :     fun gt (e1, e2) e = e1 e > e2 e
156 :     fun ge (e1, e2) e = e1 e >= e2 e
157 :     fun eq (e1: aexp, e2) e = e1 e = e2 e
158 :     fun ne (e1: aexp, e2) e = e1 e <> e2 e
159 :     end

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