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/branches/primop-branch-3/compiler/ElabData/modules/modules.sml
ViewVC logotype

Annotation of /sml/branches/primop-branch-3/compiler/ElabData/modules/modules.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2162 - (view) (download)
Original Path: sml/trunk/compiler/ElabData/modules/modules.sml

1 : blume 902 (* modules.sml
2 :     *
3 :     * (C) 2001 Lucent Technologies, Bell Labs
4 :     *)
5 :     structure Modules : MODULES =
6 :     struct
7 :    
8 :     local structure S = Symbol
9 :     structure SP = SymPath
10 :     structure IP = InvPath
11 :     structure EP = EntPath
12 :     structure ST = Stamps
13 :     structure T = Types
14 :     structure A = Access
15 :     structure E = Env
16 :     in
17 :    
18 :     (* -------------------- signature-related definitions -------------------- *)
19 :    
20 :     type sharespec = SP.path list (* only internal sharing *)
21 :    
22 :     datatype Signature
23 :     = SIG of sigrec
24 :     | ERRORsig
25 :    
26 :     (*
27 :     * 1. tycspec should only be GENtyc, with FORMAL or DATATYPE tyckinds, or DEFtyc.
28 :     * 2. the stamp and the path for the GENtyc or DEFtyc should be meaningless
29 :     * (but the stamps are in fact used for relativization of withtype bodies and
30 :     * the datacon domains of datatype repl specs)
31 :     * 3. if VALspec and CONspec are using typspec instead of T.ty, then
32 :     * the whole thing can be further cleaned up.
33 :     *)
34 :     and spec
35 :     = TYCspec of {entVar : EP.entVar, spec : T.tycon, repl: bool, scope: int}
36 :     | STRspec of {entVar : EP.entVar, sign : Signature,
37 :     def : (strDef * int) option, slot : int}
38 :     | FCTspec of {entVar : EP.entVar, sign : fctSig, slot : int}
39 :     | VALspec of {spec : T.ty, slot : int}
40 :     | CONspec of {spec : T.datacon, slot : int option}
41 :    
42 :     (*
43 :     * and specEnv
44 :     * = NILsenv
45 :     * | BINDsenv of spec E.env * specEnv
46 :     * | INCLsenv of int * spec E.env * specEnv
47 :     *)
48 :    
49 :     and fctSig
50 :     = FSIG of {kind : S.symbol option,
51 :     paramsig : Signature,
52 :     paramvar : EP.entVar,
53 :     paramsym : S.symbol option,
54 :     bodysig : Signature}
55 :     | ERRORfsig
56 :    
57 :     and extDef
58 :     = TYCdef of
59 :     {path : SymPath.path,
60 :     tyc : T.tycon,
61 :     relative : bool} (* does tyc contain entity paths *)
62 :     | STRdef of SP.path * strDef
63 :    
64 :     and strDef
65 :     = CONSTstrDef of Structure (* constant *)
66 :     | VARstrDef of Signature * EP.entPath (* relative *)
67 :    
68 :     (* ------------------------- structures and functors ---------------------- *)
69 :    
70 :     and Structure
71 :     = STR of strrec
72 :     | STRSIG of {sign: Signature, entPath : EP.entPath}
73 :     | ERRORstr
74 :    
75 :     and Functor
76 :     = FCT of fctrec
77 :     | ERRORfct
78 :    
79 :     (* ----------------------- entity-related definitions -------------------- *)
80 :    
81 :     and entity (* elements of a entityEnv *)
82 :     = TYCent of tycEntity
83 :     | STRent of strEntity
84 :     | FCTent of fctEntity
85 :     | ERRORent
86 :     (* no entities for val, con, exn, but this may change *)
87 :    
88 :     and fctClosure (* realization for functors *)
89 :     = CLOSURE of {param : EP.entVar, body : strExp, env : entityEnv}
90 :    
91 :     and stampExp
92 :     = (* CONST of ST.stamp (* an existing stamp *)
93 :     | *) GETSTAMP of strExp
94 :     | NEW (* generate a new stamp *)
95 :    
96 :     and tycExp (* expression evaluating to a TYCentity *)
97 :     = VARtyc of EP.entPath (* selection from cur-EE *)
98 :     | CONSTtyc of T.tycon (* actual tycon *)
99 :     | FORMtyc of T.tycon (* formal tycon *)
100 :    
101 :     and strExp
102 :     = VARstr of EP.entPath (* selection from current entityEnv *)
103 :     | CONSTstr of strEntity
104 :     | STRUCTURE of {stamp : stampExp, entDec : entityDec}
105 :     | APPLY of fctExp * strExp
106 :     (* the arg strExp contains coercions to match the fct param sig *)
107 :     | LETstr of entityDec * strExp
108 :     | ABSstr of Signature * strExp (* shortcut for abstraction matching *)
109 :     | FORMstr of fctSig (* formal functor body structure *)
110 :     | CONSTRAINstr of {boundvar : EP.entVar, raw : strExp, coercion: strExp}
111 :     (* similar to LETstr(M.STRdec(boundvar, strExp), coercion),
112 :     * but with special treatment of rpath propagation to support
113 :     * accurate type names in functor results where the functor has
114 :     * a result signature constraint. *)
115 :    
116 :     and fctExp
117 :     = VARfct of EP.entPath (* selection from current entityEnv *)
118 :     | CONSTfct of fctEntity
119 :     | LAMBDA of {param : EP.entVar, body : strExp}
120 :     | LAMBDA_TP of {param : EP.entVar, body : strExp, sign : fctSig}
121 :     | LETfct of entityDec * fctExp
122 :    
123 :     and entityExp
124 :     = TYCexp of tycExp
125 :     | STRexp of strExp
126 :     | FCTexp of fctExp
127 :     | DUMMYexp
128 :     | ERRORexp
129 :    
130 :     and entityDec
131 :     = TYCdec of EP.entVar * tycExp
132 :     | STRdec of EP.entVar * strExp * S.symbol
133 :     | FCTdec of EP.entVar * fctExp
134 :     | SEQdec of entityDec list
135 :     | LOCALdec of entityDec * entityDec
136 :     | ERRORdec
137 :     | EMPTYdec
138 :    
139 :     and entityEnv
140 :     = MARKeenv of envrec
141 :     | BINDeenv of entity EP.EvDict.map * entityEnv
142 :     | NILeenv
143 :     | ERReenv
144 :    
145 :     and modtree =
146 :     TYCNODE of Types.gtrec
147 :     | SIGNODE of sigrec
148 :     | STRNODE of strrec
149 :     | FCTNODE of fctrec
150 :     | ENVNODE of envrec
151 :     | BRANCH of modtree list
152 :    
153 :     withtype stubinfo =
154 :     {owner : PersStamps.persstamp,
155 :     lib : bool,
156 :     tree : modtree}
157 :    
158 :     and sigrec =
159 :     {stamp : ST.stamp,
160 :     name : S.symbol option,
161 :     closed : bool,
162 :     fctflag : bool,
163 :     symbols : S.symbol list,
164 :     elements : (S.symbol * spec) list,
165 :     properties : PropList.holder, (* boundeps, lambdaty *)
166 :     typsharing : sharespec list,
167 :     strsharing : sharespec list,
168 :     stub : stubinfo option}
169 :    
170 :     and envrec =
171 :     {stamp : ST.stamp,
172 :     env : entityEnv,
173 :     stub : stubinfo option}
174 :    
175 :     and strEntity =
176 :     {stamp : ST.stamp,
177 :     entities : entityEnv,
178 :     properties: PropList.holder, (* lambdaty *)
179 :     rpath : IP.path,
180 :     stub : stubinfo option}
181 :    
182 :     and strrec =
183 :     {sign : Signature,
184 :     rlzn : strEntity,
185 :     access : A.access,
186 :     info : II.ii}
187 :    
188 :     and fctEntity =
189 :     {stamp : ST.stamp,
190 :     closure : fctClosure,
191 :     properties: PropList.holder, (* lambdaty *)
192 :     tycpath : T.tycpath option,
193 :     rpath : IP.path,
194 :     stub : stubinfo option}
195 :    
196 :     and fctrec =
197 :     {sign : fctSig,
198 :     rlzn : fctEntity,
199 :     access : A.access,
200 :     info : II.ii}
201 :    
202 :     (* the stamp and arith inside T.tycon are critical *)
203 :     and tycEntity = T.tycon
204 :    
205 :     and elements = (S.symbol * spec) list
206 :    
207 :     (*
208 :     and constraint
209 :     = {my_path : SP.path, its_ancestor : instrep, its_path : SP.path}
210 :     *)
211 :    
212 :     val bogusStrStamp = ST.special "bogusStr"
213 :     val bogusFctStamp = ST.special "bogusFct"
214 :     val bogusSigStamp = ST.special "bogusSig"
215 :     val bogusRpath = IP.IPATH[S.strSymbol "Bogus"]
216 :    
217 :     val bogusStrEntity : strEntity =
218 :     { stamp = bogusStrStamp,
219 :     entities = ERReenv,
220 :     properties = PropList.newHolder (), (* lambdaty = ref NONE *)
221 :     rpath = bogusRpath,
222 :     stub = NONE}
223 :    
224 :     val bogusSig : Signature =
225 :     SIG {stamp = bogusSigStamp,
226 :     name=NONE, closed=true, fctflag=false,
227 :     symbols=[],
228 :     elements=[],
229 :     properties = PropList.newHolder (),
230 :     (* boundeps=ref NONE, lambdaty=ref NONE *)
231 :     typsharing=[], strsharing=[],
232 :     stub = NONE}
233 :    
234 :     val bogusFctEntity : fctEntity =
235 :     {stamp = bogusFctStamp,
236 :     closure = CLOSURE{param=EP.bogusEntVar,
237 :     body= CONSTstr bogusStrEntity,
238 :     env=NILeenv},
239 :     tycpath=NONE,
240 :     properties = PropList.newHolder (), (* lambdaty = ref NONE *)
241 :     rpath = bogusRpath,
242 :     stub = NONE}
243 :    
244 :     end (* local *)
245 :     end (* structure Modules *)

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