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 2751 - (view) (download)

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 : dbm 2571 * 1. tyc spec should only be GENtyc, with FORMAL or DATATYPE tyckinds, or DEFtyc.
28 : blume 902 * 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 : dbm 2571 = TYCspec of {entVar : EP.entVar, info: tycSpecInfo}
36 : blume 902 | 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 : dbm 2571 (* there are two forms of TYCspec. One for regular, explicitly defined signatures,
43 :     * and the other for inferred signatures, where all the type info is always in the
44 :     * realization. But we need some info for printing in the one case where a
45 :     * realization is not available with the signature, namely an inferred result
46 :     * signature for a functor. *)
47 :     and tycSpecInfo
48 :     = RegTycSpec of {spec : T.tycon, repl: bool, scope: int} (* normal signature *)
49 :     | InfTycSpec of {name: S.symbol, arity: int} (* inferred signature *)
50 :    
51 : blume 902 (*
52 :     * and specEnv
53 :     * = NILsenv
54 :     * | BINDsenv of spec E.env * specEnv
55 :     * | INCLsenv of int * spec E.env * specEnv
56 :     *)
57 :    
58 :     and fctSig
59 :     = FSIG of {kind : S.symbol option,
60 :     paramsig : Signature,
61 :     paramvar : EP.entVar,
62 :     paramsym : S.symbol option,
63 :     bodysig : Signature}
64 :     | ERRORfsig
65 :    
66 :     and extDef
67 :     = TYCdef of
68 :     {path : SymPath.path,
69 :     tyc : T.tycon,
70 :     relative : bool} (* does tyc contain entity paths *)
71 :     | STRdef of SP.path * strDef
72 :    
73 :     and strDef
74 :     = CONSTstrDef of Structure (* constant *)
75 :     | VARstrDef of Signature * EP.entPath (* relative *)
76 :    
77 :     (* ------------------------- structures and functors ---------------------- *)
78 :    
79 :     and Structure
80 :     = STR of strrec
81 :     | STRSIG of {sign: Signature, entPath : EP.entPath}
82 :     | ERRORstr
83 :    
84 :     and Functor
85 :     = FCT of fctrec
86 :     | ERRORfct
87 :    
88 :     (* ----------------------- entity-related definitions -------------------- *)
89 :    
90 :     and entity (* elements of a entityEnv *)
91 :     = TYCent of tycEntity
92 :     | STRent of strEntity
93 :     | FCTent of fctEntity
94 :     | ERRORent
95 :     (* no entities for val, con, exn, but this may change *)
96 :    
97 :     and fctClosure (* realization for functors *)
98 :     = CLOSURE of {param : EP.entVar, body : strExp, env : entityEnv}
99 :    
100 :     and stampExp
101 :     = (* CONST of ST.stamp (* an existing stamp *)
102 :     | *) GETSTAMP of strExp
103 :     | NEW (* generate a new stamp *)
104 :    
105 :     and tycExp (* expression evaluating to a TYCentity *)
106 : dbm 2561 = VARtyc of EP.entPath (* selection from cur-EE *)
107 :     | CONSTtyc of T.tycon (* actual tycon *)
108 :     | FORMtyc of T.tycon (* formal tycon *)
109 : blume 902
110 : dbm 2561 and strExp
111 : blume 902 = VARstr of EP.entPath (* selection from current entityEnv *)
112 :     | CONSTstr of strEntity
113 :     | STRUCTURE of {stamp : stampExp, entDec : entityDec}
114 :     | APPLY of fctExp * strExp
115 :     (* the arg strExp contains coercions to match the fct param sig *)
116 :     | LETstr of entityDec * strExp
117 :     | ABSstr of Signature * strExp (* shortcut for abstraction matching *)
118 :     | FORMstr of fctSig (* formal functor body structure *)
119 :     | CONSTRAINstr of {boundvar : EP.entVar, raw : strExp, coercion: strExp}
120 :     (* similar to LETstr(M.STRdec(boundvar, strExp), coercion),
121 :     * but with special treatment of rpath propagation to support
122 :     * accurate type names in functor results where the functor has
123 :     * a result signature constraint. *)
124 :    
125 :     and fctExp
126 :     = VARfct of EP.entPath (* selection from current entityEnv *)
127 :     | CONSTfct of fctEntity
128 : gkuan 2751 | LAMBDA of {param : EP.entVar, paramEnts : entityEnv, body : strExp}
129 : blume 902 | LAMBDA_TP of {param : EP.entVar, body : strExp, sign : fctSig}
130 :     | LETfct of entityDec * fctExp
131 :    
132 :     and entityExp
133 :     = TYCexp of tycExp
134 :     | STRexp of strExp
135 :     | FCTexp of fctExp
136 :     | DUMMYexp
137 :     | ERRORexp
138 :    
139 :     and entityDec
140 :     = TYCdec of EP.entVar * tycExp
141 :     | STRdec of EP.entVar * strExp * S.symbol
142 :     | FCTdec of EP.entVar * fctExp
143 :     | SEQdec of entityDec list
144 :     | LOCALdec of entityDec * entityDec
145 :     | ERRORdec
146 :     | EMPTYdec
147 :    
148 :     and entityEnv
149 :     = MARKeenv of envrec
150 :     | BINDeenv of entity EP.EvDict.map * entityEnv
151 :     | NILeenv
152 :     | ERReenv
153 :    
154 : dbm 2541 and modtree
155 :     = TYCNODE of Types.gtrec
156 : blume 902 | SIGNODE of sigrec
157 :     | STRNODE of strrec
158 :     | FCTNODE of fctrec
159 :     | ENVNODE of envrec
160 :     | BRANCH of modtree list
161 :    
162 :     withtype stubinfo =
163 :     {owner : PersStamps.persstamp,
164 :     lib : bool,
165 :     tree : modtree}
166 :    
167 : dbm 2532 and elements = (S.symbol * spec) list
168 :    
169 : blume 902 and sigrec =
170 :     {stamp : ST.stamp,
171 :     name : S.symbol option,
172 :     closed : bool,
173 :     fctflag : bool,
174 : dbm 2532 elements : elements,
175 : dbm 2739 properties : PropList.holder, (* FLINE: (entpath * tkind) list option *)
176 : blume 902 typsharing : sharespec list,
177 :     strsharing : sharespec list,
178 :     stub : stubinfo option}
179 :    
180 :     and envrec =
181 :     {stamp : ST.stamp,
182 :     env : entityEnv,
183 :     stub : stubinfo option}
184 :    
185 :     and strEntity =
186 :     {stamp : ST.stamp,
187 :     entities : entityEnv,
188 :     properties: PropList.holder, (* lambdaty *)
189 :     rpath : IP.path,
190 :     stub : stubinfo option}
191 :    
192 :     and strrec =
193 :     {sign : Signature,
194 :     rlzn : strEntity,
195 :     access : A.access,
196 : blume 2222 prim : PrimOpId.strPrimInfo}
197 : blume 902
198 :     and fctEntity =
199 :     {stamp : ST.stamp,
200 : gkuan 2751 paramEnts: entityEnv,
201 : blume 902 closure : fctClosure,
202 :     properties: PropList.holder, (* lambdaty *)
203 :     tycpath : T.tycpath option,
204 :     rpath : IP.path,
205 :     stub : stubinfo option}
206 :    
207 :     and fctrec =
208 :     {sign : fctSig,
209 :     rlzn : fctEntity,
210 :     access : A.access,
211 : blume 2222 prim : PrimOpId.strPrimInfo}
212 : blume 902
213 :     (* the stamp and arith inside T.tycon are critical *)
214 :     and tycEntity = T.tycon
215 :    
216 :     (*
217 :     and constraint
218 :     = {my_path : SP.path, its_ancestor : instrep, its_path : SP.path}
219 :     *)
220 :    
221 :     val bogusStrStamp = ST.special "bogusStr"
222 :     val bogusFctStamp = ST.special "bogusFct"
223 :     val bogusSigStamp = ST.special "bogusSig"
224 :     val bogusRpath = IP.IPATH[S.strSymbol "Bogus"]
225 :    
226 :     val bogusStrEntity : strEntity =
227 :     { stamp = bogusStrStamp,
228 :     entities = ERReenv,
229 :     properties = PropList.newHolder (), (* lambdaty = ref NONE *)
230 :     rpath = bogusRpath,
231 :     stub = NONE}
232 :    
233 :     val bogusSig : Signature =
234 :     SIG {stamp = bogusSigStamp,
235 :     name=NONE, closed=true, fctflag=false,
236 :     elements=[],
237 :     properties = PropList.newHolder (),
238 :     (* boundeps=ref NONE, lambdaty=ref NONE *)
239 :     typsharing=[], strsharing=[],
240 :     stub = NONE}
241 :    
242 :     val bogusFctEntity : fctEntity =
243 :     {stamp = bogusFctStamp,
244 : gkuan 2751 paramEnts = ERReenv,
245 : blume 902 closure = CLOSURE{param=EP.bogusEntVar,
246 :     body= CONSTstr bogusStrEntity,
247 :     env=NILeenv},
248 :     tycpath=NONE,
249 :     properties = PropList.newHolder (), (* lambdaty = ref NONE *)
250 :     rpath = bogusRpath,
251 :     stub = NONE}
252 :    
253 :     end (* local *)
254 :     end (* structure Modules *)

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