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/compiler/Semant/modules/modules.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Semant/modules/modules.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 419 - (view) (download)

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

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