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/FLINT/trans/transtypes.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/FLINT/trans/transtypes.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 94 - (view) (download)

1 : monnier 16 (* COPYRIGHT (c) 1998 YALE FLINT PROJECT *)
2 :     (* transtypes.sml *)
3 :    
4 :     signature TRANSTYPES =
5 :     sig
6 : monnier 45 val genTT : unit -> {tpsKnd : Types.tycpath -> PLambdaType.tkind,
7 :     tpsTyc : DebIndex.depth -> Types.tycpath
8 :     -> PLambdaType.tyc,
9 :     toTyc : DebIndex.depth -> Types.ty -> PLambdaType.tyc,
10 :     toLty : DebIndex.depth -> Types.ty -> PLambdaType.lty,
11 :     strLty : Modules.Structure * DebIndex.depth
12 :     * ElabUtil.compInfo -> PLambdaType.lty,
13 :     fctLty : Modules.Functor * DebIndex.depth
14 :     * ElabUtil.compInfo -> PLambdaType.lty}
15 : monnier 16 end (* signature TRANSTYPES *)
16 :    
17 :     structure TransTypes : TRANSTYPES =
18 :     struct
19 :     local structure BT = BasicTypes
20 : monnier 45 structure DA = Access
21 : monnier 16 structure DI = DebIndex
22 : monnier 45 structure EE = EntityEnv
23 :     structure EM = ErrorMsg
24 :     structure EPC = EntPathContext
25 :     structure EV = EvalEntity
26 :     structure INS = Instantiate
27 :     structure IP = InvPath
28 :     structure LT = PLambdaType
29 : monnier 16 structure PT = PrimTyc
30 : monnier 45 structure MU = ModuleUtil
31 :     structure SE = StaticEnv
32 : monnier 16 structure TU = TypesUtil
33 : monnier 45 open Types Modules ElabDebug
34 : monnier 16 in
35 :    
36 :     fun bug msg = ErrorMsg.impossible ("TransTypes: " ^ msg)
37 :     val say = Control.Print.say
38 : monnier 45 val debugging = Control.CG.tmdebugging
39 :     fun debugmsg (msg: string) =
40 :     if !debugging then (say msg; say "\n") else ()
41 :     val debugPrint = (fn x => debugPrint debugging x)
42 :     val defaultError =
43 :     EM.errorNoFile(EM.defaultConsumer(),ref false) SourceMap.nullRegion
44 : monnier 16
45 :     local
46 :     structure PP = PrettyPrint
47 :     in
48 :     val env = StaticEnv.empty
49 :     fun ppType x =
50 :     ((PP.with_pp (EM.defaultConsumer())
51 :     (fn ppstrm => (PP.add_string ppstrm "find: ";
52 :     PPType.resetPPType();
53 :     PPType.ppType env ppstrm x)))
54 :     handle _ => say "fail to print anything")
55 :    
56 :     fun ppTycon x =
57 :     ((PP.with_pp (EM.defaultConsumer())
58 :     (fn ppstrm => (PP.add_string ppstrm "find: ";
59 :     PPType.resetPPType();
60 :     PPType.ppTycon env ppstrm x)))
61 :     handle _ => say "fail to print anything")
62 :     end
63 :    
64 : monnier 45 (****************************************************************************
65 :     * TRANSLATING ML TYPES INTO FLINT TYPES *
66 :     ****************************************************************************)
67 : monnier 16 local val recTyContext = ref [~1]
68 :     in
69 :     fun enterRecTy (a) = (recTyContext := (a::(!recTyContext)))
70 :     fun exitRecTy () = (recTyContext := tl (!recTyContext))
71 :     fun recTyc (i) =
72 :     let val x = hd(!recTyContext)
73 :     val base = DI.innermost
74 :     in if x = 0 then LT.tcc_var(base, i)
75 :     else if x > 0 then LT.tcc_var(DI.di_inner base, i)
76 :     else bug "unexpected RECtyc"
77 :     end
78 :     fun freeTyc (i) =
79 :     let val x = hd(!recTyContext)
80 :     val base = DI.di_inner (DI.innermost)
81 :     in if x = 0 then LT.tcc_var(base, i)
82 :     else if x > 0 then LT.tcc_var(DI.di_inner base, i)
83 :     else bug "unexpected RECtyc"
84 :     end
85 :     end (* end of recTyc and freeTyc hack *)
86 :    
87 :     fun tpsKnd (TP_VAR {kind, ...}) = kind
88 :     | tpsKnd _ = bug "unexpected tycpath parameters in tpsKnd"
89 :    
90 :     fun tpsTyc d tp =
91 :     let fun h (TP_VAR {depth, num, ...}, cur) =
92 :     LT.tcc_var(DI.calc(cur, depth), num)
93 :     | h (TP_TYC tc, cur) = tycTyc(tc, cur)
94 :     | h (TP_SEL (tp, i), cur) = LT.tcc_proj(h(tp, cur), i)
95 :     | h (TP_APP (tp, ps), cur) =
96 :     LT.tcc_app(h(tp, cur), map (fn x => h(x, cur)) ps)
97 :     | h (TP_FCT (ps, ts), cur) =
98 :     let val ks = map tpsKnd ps
99 :     val cur' = DI.next cur
100 :     val ts' = map (fn x => h(x, cur')) ts
101 :     in LT.tcc_fn(ks, LT.tcc_seq ts')
102 :     end
103 :    
104 :     in h(tp, d)
105 :     end
106 :    
107 :     (*
108 :     and tycTyc x =
109 :     Stats.doPhase(Stats.makePhase "Compiler 043 1-tycTyc") tycTyc0 x
110 :     *)
111 :    
112 :     and tycTyc(tc, d) =
113 :     let fun dtsTyc nd ({dcons: dconDesc list, arity=i, ...} : dtmember) =
114 :     let val nnd = if i=0 then nd else DI.next nd
115 :     fun f ({domain=NONE, rep, name}, r) = (LT.tcc_unit)::r
116 :     | f ({domain=SOME t, rep, name}, r) = (toTyc nnd t)::r
117 :    
118 :     val _ = enterRecTy i
119 :     val core = LT.tcc_sum(foldr f [] dcons)
120 :     val _ = exitRecTy()
121 :    
122 :     val resTyc = if i=0 then core
123 :     else (let val ks = LT.tkc_arg i
124 :     in LT.tcc_fn(ks, core)
125 :     end)
126 :     in (LT.tkc_int i, resTyc)
127 :     end
128 :    
129 :     fun dtsFam (_, {lambdatyc=ref (SOME (tc,od)), ...} : dtypeFamily) =
130 :     LT.tc_adj(tc, od, d) (* invariant: tc contains no free variables
131 :     so tc_adj should have no effects *)
132 :     | dtsFam (freetycs, {members, lambdatyc=x, ...}) =
133 :     let fun ttk (GENtyc{arity=i, ...}) = LT.tkc_int i
134 :     | ttk (DEFtyc{tyfun=TYFUN{arity=i, ...},...}) = LT.tkc_int i
135 :     | ttk _ = bug "unexpected ttk in dtsFam"
136 :     val ks = map ttk freetycs
137 :     val (nd, hdr) =
138 :     case ks of [] => (d, fn t => t)
139 :     | _ => (DI.next d, fn t => LT.tcc_fn(ks, t))
140 :     val mbs = Vector.foldr (op ::) nil members
141 :     val mtcs = map (dtsTyc (DI.next nd)) mbs
142 :     val (fks, fts) = ListPair.unzip mtcs
143 :     val nft = case fts of [x] => x | _ => LT.tcc_seq fts
144 :     val tc = hdr(LT.tcc_fn(fks, nft))
145 :     val _ = (x := SOME(tc, d))
146 :     in tc
147 :     end
148 :    
149 :     fun h (PRIMITIVE pt, _) = LT.tcc_prim(pt)
150 :     | h (DATATYPE {index, family, freetycs, stamps, root}, _) =
151 :     let val tc = dtsFam (freetycs, family)
152 :     val n = Vector.length stamps
153 :     (* invariant: n should be the length of family members *)
154 :     in LT.tcc_fix((n, tc, (map g freetycs)), index)
155 :     end
156 :     | h (ABSTRACT tc, 0) = (g tc)
157 :     (*>>> LT.tcc_abs(g tc) <<<*)
158 :     | h (ABSTRACT tc, n) = (g tc)
159 :     (*>>> we tempoarily turned off the use of abstract tycons in
160 :     the intermediate language; proper support of ML-like
161 :     abstract types in the IL may require changes to the
162 :     ML language. (ZHONG)
163 :     let val ks = LT.tkc_arg n
164 :     fun fromto(i,j) = if i < j then (i::fromto(i+1,j)) else []
165 :     val fs = fromto(0, n)
166 :     val ts = map (fn i => LT.tcc_var(DI.innermost, i)) fs
167 : monnier 45 val b = LT.tcc_app(tycTyc(tc, DI.next d), ts)
168 : monnier 16 in LT.tcc_fn(ks, LT.tcc_abs b)
169 :     end
170 :     <<<*)
171 :     | h (FLEXTYC tp, _) = tpsTyc d tp
172 :     | h (FORMAL, _) = bug "unexpected FORMAL kind in tycTyc-h"
173 :     | h (TEMP, _) = bug "unexpected TEMP kind in tycTyc-h"
174 :    
175 :     and g (tycon as (GENtyc{kind as DATATYPE _, arity, ...})) =
176 :     if TU.eqTycon(tycon, BT.refTycon) then LT.tcc_prim (PT.ptc_ref)
177 :     else h(kind, arity)
178 :     | g (GENtyc{kind, arity, ...}) = h(kind, arity)
179 :     | g (DEFtyc{tyfun, ...}) = tfTyc(tyfun, d)
180 :     | g (RECtyc i) = recTyc i
181 :     | g (FREEtyc i) = freeTyc i
182 :     | g (RECORDtyc _) = bug "unexpected RECORDtyc in tycTyc-g"
183 :     | g (PATHtyc{arity, path=InvPath.IPATH ss, entPath}) =
184 :     ((* say "*** Warning for compiler writers: PATHtyc ";
185 :     app (fn x => (say (Symbol.name x); say ".")) ss;
186 :     say " in translate: ";
187 :     say (EntPath.entPathToString entPath);
188 :     say "\n"; *)
189 :     if arity > 0 then LT.tcc_fn(LT.tkc_arg arity, LT.tcc_void)
190 :     else LT.tcc_void)
191 :     | g (ERRORtyc) = bug "unexpected tycon in tycTyc-g"
192 :    
193 :     in (g tc)
194 :     end
195 :    
196 :     and tfTyc (TYFUN{arity=0, body}, d) = toTyc d body
197 :     | tfTyc (TYFUN{arity, body}, d) =
198 :     let val ks = LT.tkc_arg arity
199 :     in LT.tcc_fn(ks, toTyc (DI.next d) body)
200 :     end
201 :    
202 :     and toTyc d t =
203 :     let val m : (tyvar * LT.tyc) list ref = ref []
204 :     fun lookTv tv =
205 :     let val xxx = !m
206 : monnier 45 fun uu ((z as (a,x))::r, b, n) =
207 :     if a = tv then (x, z::((rev b)@r)) else uu(r, z::b, n+1)
208 :     | uu ([], b, n) = let val zz = h (!tv)
209 :     val nb = if n > 64 then tl b else b
210 :     in (zz, (tv, zz)::(rev b))
211 :     end
212 :     val (res, nxx) = uu(xxx, [], 0)
213 :     in m := nxx; res
214 : monnier 16 end
215 :    
216 :     and h (INSTANTIATED t) = g t
217 :     | h (LBOUND {depth, num}) = LT.tcc_var(DI.calc(d, depth), num)
218 :     | h (OPEN _) = LT.tcc_void
219 :     | h _ = LT.tcc_void (* ZHONG? *)
220 :    
221 :     and g (VARty tv) = (* h(!tv) *) lookTv tv
222 :     | g (CONty(RECORDtyc _, [])) = LT.tcc_unit
223 :     | g (CONty(RECORDtyc _, ts)) = LT.tcc_tuple (map g ts)
224 :     | g (CONty(tyc, [])) = tycTyc(tyc, d)
225 :     | g (CONty(DEFtyc{tyfun,...}, args)) = g(TU.applyTyfun(tyfun,args))
226 :     | g (CONty(tc as GENtyc {kind=ABSTRACT _, ...}, ts)) =
227 : monnier 45 LT.tcc_app(tycTyc(tc, d), map g ts)
228 : monnier 16 | g (CONty(tc as GENtyc _, [t1, t2])) =
229 :     if TU.eqTycon(tc, BT.arrowTycon) then LT.tcc_parrow(g t1, g t2)
230 :     else LT.tcc_app(tycTyc(tc, d), [g t1, g t2])
231 :     | g (CONty(tyc, ts)) = LT.tcc_app(tycTyc(tyc, d), map g ts)
232 :     | g (IBOUND i) = LT.tcc_var(DI.innermost, i)
233 :     | g (POLYty _) = bug "unexpected poly-type in toTyc"
234 :     | g (UNDEFty) = bug "unexpected undef-type in toTyc"
235 :     | g (WILDCARDty) = bug "unexpected wildcard-type in toTyc"
236 :    
237 :     in (g t)
238 :     end
239 :    
240 :     and toLty d (POLYty {tyfun=TYFUN{arity=0, body}, ...}) = toLty d body
241 :     | toLty d (POLYty {tyfun=TYFUN{arity, body},...}) =
242 :     let val ks = LT.tkc_arg arity
243 :     in LT.ltc_poly(ks, [toLty (DI.next d) body])
244 :     end
245 :    
246 :     | toLty d x = LT.ltc_tyc (toTyc d x)
247 :    
248 : monnier 45 (****************************************************************************
249 :     * TRANSLATING ML MODULES INTO FLINT TYPES *
250 :     ****************************************************************************)
251 :    
252 :     fun specLty (elements, entEnv, depth, compInfo) =
253 :     let fun g ([], entEnv, ltys) = rev ltys
254 :     | g ((sym, TYCspec _)::rest, entEnv, ltys) = g(rest, entEnv, ltys)
255 :     | g ((sym, STRspec {sign, entVar, ...})::rest, entEnv, ltys) =
256 :     let val rlzn = EE.lookStrEnt(entEnv,entVar)
257 :     val lt = strRlznLty(sign, rlzn, depth, compInfo)
258 :     in g(rest, entEnv, lt::ltys)
259 :     end
260 :     | g ((sym, FCTspec {sign, entVar, ...})::rest, entEnv, ltys) =
261 :     let val rlzn = EE.lookFctEnt(entEnv,entVar)
262 :     val lt = fctRlznLty(sign, rlzn, depth, compInfo)
263 :     in g(rest, entEnv, lt::ltys)
264 :     end
265 :     | g ((sym, spec)::rest, entEnv, ltys) =
266 :     let val _ = debugmsg ">>specLtyElt"
267 :     fun transty ty =
268 :     ((MU.transType entEnv ty)
269 :     handle EE.Unbound =>
270 :     (debugmsg "$specLty";
271 :     withInternals(fn () =>
272 :     debugPrint("entEnv: ",
273 :     (fn pps => fn ee =>
274 :     PPModules.ppEntityEnv pps (ee,SE.empty,12)),
275 :     entEnv));
276 :     debugmsg ("$specLty: should have printed entEnv");
277 :     raise EE.Unbound))
278 :    
279 :     fun mapty t = toLty depth (transty t)
280 :    
281 :     in case spec
282 :     of VALspec{spec=typ,...} =>
283 :     g(rest, entEnv, (mapty typ)::ltys)
284 :     | CONspec{spec=DATACON{rep=DA.EXN _,
285 :     typ, ...}, ...} =>
286 :     let val argt =
287 :     if BT.isArrowType typ then
288 :     #1(LT.ltd_parrow (mapty typ))
289 :     else LT.ltc_unit
290 :     in g(rest, entEnv, (LT.ltc_etag argt)::ltys)
291 :     end
292 :     | CONspec{spec=DATACON _, ...} =>
293 :     g(rest, entEnv, ltys)
294 :     | _ => bug "unexpected spec in specLty"
295 :     end
296 :    
297 :     in g (elements, entEnv, [])
298 :     end
299 :    
300 : monnier 16 (*
301 : monnier 45 and signLty (sign, depth, compInfo) =
302 :     let fun h (SIG {kind=SOME _, lambdaty=ref (SOME(lt, od)), ...}) = lt
303 :     (* LT.lt_adj(lt, od, depth) *)
304 :     | h (sign as SIG{kind=SOME _, lambdaty as ref NONE, ...}) =
305 :     (* Invariant: we assum that all Named signatures (kind=SOME _) are
306 :     * defined at top-level, outside any functor definitions. (ZHONG)
307 :     *)
308 :     let val {rlzn=rlzn, tycpaths=tycpaths} =
309 :     INS.instParam {sign=sign, entEnv=EE.empty, depth=depth,
310 :     rpath=InvPath.IPATH[], compInfo=compInfo,
311 :     region=SourceMap.nullRegion}
312 :     val nd = DI.next depth
313 :     val nlty = strMetaLty(sign, rlzn, nd, compInfo)
314 : monnier 16
315 : monnier 45 val ks = map tpsKnd tycpaths
316 :     val lt = LT.ltc_poly(ks, nlty)
317 :     in lambdaty := SOME (lt, depth); lt
318 :     end
319 :     | h _ = bug "unexpected sign in signLty"
320 :     in h sign
321 :     end
322 : monnier 16 *)
323 : monnier 45 and strMetaLty (sign, rlzn, depth, compInfo) =
324 :     let fun g (sign, rlzn as {lambdaty = ref (SOME (lt,od)), ...}) =
325 :     LT.lt_adj(lt, od, depth)
326 :     | g (sign as SIG{elements, ...},
327 :     rlzn as {entities, lambdaty, ...} : strEntity) =
328 :     let val ltys = specLty(elements, entities, depth, compInfo)
329 :     val lt = (* case ltys of [] => LT.ltc_int
330 :     | _ => *) LT.ltc_str(ltys)
331 :     in lambdaty := SOME(lt, depth); lt
332 :     end
333 :     | g _ = bug "unexpected sign and rlzn in strMetaLty"
334 : monnier 16
335 : monnier 45 in g(sign, rlzn)
336 :     end
337 :    
338 :     and strRlznLty (sign, rlzn, depth, compInfo) =
339 :     let fun g (sign, rlzn as {lambdaty = ref (SOME (lt,od)), ...} : strEntity) =
340 :     LT.lt_adj(lt, od, depth)
341 :    
342 :     (* Note: the code here is designed to improve the "toLty" translation;
343 :     by translating the signature instead of the structure, this can
344 :     potentially save time on strLty. But it can increase the cost of
345 :     other procedures. Thus we turn it off temporarily. (ZHONG)
346 :    
347 :     | g (sign as SIG{kind=SOME _, ...}, rlzn as {lambdaty, ...}) =
348 :     let val sgt = signLty(sign, depth, compInfo)
349 :     (* Invariant: we assum that all Named signatures
350 :     * (kind=SOME _) are defined at top-level, outside any
351 :     * functor definitions. (ZHONG)
352 :     *)
353 :     val argtycs = INS.getTycPaths{sign=sign, rlzn=rlzn,
354 :     entEnv=EE.empty, compInfo=compInfo}
355 :     val lt = LT.lt_inst(sgt, map (tpsTyc depth) argtycs)
356 :     in lambdaty := SOME(lt, depth); lt
357 :     end
358 :     *)
359 :     | g _ = strMetaLty(sign, rlzn, depth, compInfo)
360 :    
361 :     in g(sign, rlzn)
362 :     end
363 :    
364 :     and fctRlznLty (sign, rlzn, depth, compInfo) =
365 :     let fun g (sign, rlzn as {lambdaty = ref (SOME (lt, od)), ...}) =
366 :     LT.lt_adj(lt, od, depth)
367 :     | g (sign as FSIG{paramsig, bodysig, ...},
368 :     rlzn as {stamp, closure as CLOSURE{env,...}, lambdaty, ...}) =
369 :     let val {rlzn=argRlzn, tycpaths=tycpaths} =
370 :     INS.instParam {sign=paramsig, entEnv=env, depth=depth,
371 :     rpath=InvPath.IPATH[], compInfo=compInfo,
372 :     region=SourceMap.nullRegion}
373 :     val nd = DI.next depth
374 :     val paramLty = strMetaLty(paramsig, argRlzn, nd, compInfo)
375 :     val ks = map tpsKnd tycpaths
376 :     val bodyRlzn =
377 :     EV.evalApp(rlzn, argRlzn, nd, EPC.initContext,
378 :     IP.empty, compInfo)
379 :     val bodyLty = strRlznLty(bodysig, bodyRlzn, nd, compInfo)
380 :    
381 :     val lt = LT.ltc_poly(ks, [LT.ltc_fct([paramLty],[bodyLty])])
382 :     in lambdaty := SOME (lt, depth); lt
383 :     end
384 :    
385 :     | g _ = bug "fctRlznLty"
386 :    
387 :     in g(sign, rlzn)
388 :     end
389 :    
390 :     and strLty (str, depth, compInfo) =
391 :     let fun g (STR{rlzn={lambdaty=ref (SOME (lt, od)), ...}, ...}) =
392 :     LT.lt_adj(lt, od, depth)
393 :     | g (STR{sign, rlzn as {lambdaty as ref NONE, ...}, ...}) =
394 :     let val lt = strRlznLty(sign, rlzn, depth, compInfo)
395 :     in (lambdaty := SOME(lt, depth); lt)
396 :     end
397 :     | g _ = bug "unexpected structure in strLty"
398 :     in g str
399 :     end
400 :    
401 :     and fctLty (fct, depth, compInfo) =
402 :     let fun g (FCT{rlzn={lambdaty=ref(SOME (lt,od)),...}, ...}) =
403 :     LT.lt_adj(lt, od, depth)
404 :     | g (FCT{sign, rlzn as {lambdaty as ref NONE, ...}, ...}) =
405 :     let val lt = fctRlznLty(sign, rlzn, depth, compInfo)
406 :     in (lambdaty := SOME(lt,depth); lt)
407 :     end
408 :     | g _ = bug "unexpected functor in fctLty"
409 :     in g fct
410 :     end
411 :    
412 :     (****************************************************************************
413 :     * A HASH-CONSING VERSION OF THE ABOVE TRANSLATIONS *
414 :     ****************************************************************************)
415 :    
416 :     structure MIDict = BinaryDict(struct type ord_key = ModuleId.modId
417 :     val cmpKey = ModuleId.cmp
418 :     end)
419 :    
420 :     fun genTT() =
421 :     let val _ = ()
422 :     (*
423 :     val m1 = ref (MIDict.mkDict()) (* modid (tycon) -> LT.tyc *)
424 :     val m2 = ref (MIDict.mkDict()) (* modid (str/fct) -> LT.lty *)
425 :    
426 :     fun tycTycLook (t as (GENtyc _ | DEFtyc _), d) =
427 :     let tid = MU.tycId t
428 :     in (case MIDict.peek(!m1, tid)
429 :     of SOME (t', od) => LT.tc_adj(t', od, d)
430 :     | NONE =>
431 :     let val x = tycTyc (t, d)
432 :     val _ = (m1 := TcDict.insert(!m1, tid, (x, d)))
433 :     in x
434 :     end)
435 :     end
436 :     | tycTycLook x = tycTyc tycTycLook x
437 :    
438 :     (*
439 :     val toTyc = toTyc tycTycLook
440 :     val toLty = toTyc tycTycLook
441 :     *)
442 :     val coreDict = (toTyc, toLty)
443 :    
444 :     fun strLtyLook (s as STR _, d) =
445 :     let sid = MU.strId s
446 :     in (case MIDict.peek(!m2, sid)
447 :     of SOME (t', od) => LT.lt_adj(t', od, d)
448 :     | NONE =>
449 :     let val x = strLty (coreDict, strLtyLook,
450 :     fctLtyLook) (s, d)
451 :     val _ = (m2 := TcDict.insert(!m2, sid, (x, d)))
452 :     in x
453 :     end)
454 :     end
455 :     | strLtyLook x = strLty (coreDict, strLtyLook, fctLtyLook)
456 :    
457 :     and fctLtyLook (f as FCT _, d) =
458 :     let fid = fctId f
459 :     in (case MIDict.peek(!m2, fid)
460 :     of SOME (t', od) => LT.lt_adj(t', od, d)
461 :     | NONE =>
462 :     let val x = fctLty (tycTycLook, strLtyLook,
463 :     fctLtyLook) (s, d)
464 :     val _ = (m2 := TcDict.insert(!m2, fid, (x, d)))
465 :     in x
466 :     end)
467 :     end
468 :     | fctLtyLook x = fctLty (coreDict, strLtyLook, fctLtyLook)
469 :     *)
470 :    
471 :     in {tpsKnd=tpsKnd, tpsTyc=tpsTyc,
472 :     toTyc=toTyc, toLty=toLty, strLty=strLty, fctLty=fctLty}
473 :     end (* function genTT *)
474 :    
475 : monnier 16 end (* toplevel local *)
476 :     end (* structure TransTypes *)
477 :    
478 :    
479 : monnier 93
480 :     (*
481 :     * $Log: transtypes.sml,v $
482 :     * Revision 1.1.1.1 1998/04/08 18:39:42 george
483 :     * Version 110.5
484 :     *
485 :     *)

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