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 267, Sat May 8 13:53:45 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
11      exception ExpressionError of exn      type pathname = AbsPath.t
   
     type pathname  
12      type ml_symbol      type ml_symbol
13      type cm_symbol      type cm_symbol
14    
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.environment      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      fun emptyMembers env = MemberCollection.empty      (* get the export map from a group *)
154      fun member (f, c) env = MemberCollection.expandOne (f, c)      fun getExports (g: group) = (ignore Dummy.v; SymbolMap.empty)
155      fun members (m1, m2) env = let  
156          val c1 = m1 env      fun emptyMembers env = env
157          val c2 = m2 (MemberCollection.envOf c1)      fun member rparse arg env = let
158            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 (c1, c2)          MemberCollection.sequential (env, coll, e0)
163      end      end
164      fun guarded_members (c, (m1, m2)) env =      fun members (m1, m2) env = m2 (m1 env)
165          if saveEval (c, env) then m1 env else m2 env      fun guarded_members (c, (m1, m2), error) env =
166      fun error_member m env = raise ExplicitError m          if saveEval (c, env, error) then m1 env else m2 env
167        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.267  
changed lines
  Added in v.277

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