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/SMLNJ/src/compiler/FLINT/plambda/flintnm.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/FLINT/plambda/flintnm.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (view) (download)

1 : monnier 16 (* COPYRIGHT (c) 1997 YALE FLINT PROJECT *)
2 :     (* flintnm.sml *)
3 :    
4 :     (* Converting the Standard PLambda.lexp into the FLINT IL *)
5 :     signature FLINTNM =
6 :     sig
7 :     val norm : PLambda.lexp -> FLINT.fundec
8 :     end (* signature FLINTNM *)
9 :    
10 :     structure FlintNM : FLINTNM =
11 :     struct
12 :    
13 :     local structure LT = PLambdaType
14 :     structure FL = PFlatten (* argument flattening *)
15 :     structure LV = LambdaVar
16 :     structure DI = DebIndex
17 :     structure PT = PrimTyc
18 :     structure PO = PrimOp
19 :     structure L = PLambda
20 :     structure F = FLINT
21 :     structure FU = FlintUtil
22 :     structure DA = Access
23 :     in
24 :    
25 :     val say = Control.Print.say
26 :     val mkv = LambdaVar.mkLvar
27 :     val ident = fn le : L.lexp => le
28 :    
29 :     val (iadd_prim, uadd_prim) =
30 :     let val lt_int = LT.ltc_int
31 :     val intOpTy = LT.ltc_parrow(LT.ltc_tuple[lt_int,lt_int],lt_int)
32 :     val addu = PO.ARITH{oper=PO.+, overflow=false, kind=PO.UINT 31}
33 :     in (L.PRIM(PO.IADD,intOpTy,[]), L.PRIM(addu, intOpTy, []))
34 :     end
35 :    
36 :     fun bug msg = ErrorMsg.impossible("FlintNM: "^msg)
37 :    
38 :     fun optmap f (SOME v) = SOME (f v)
39 :     | optmap _ NONE = NONE
40 :    
41 :     (* force_raw freezes the calling conventions of a data constructor;
42 :     strictly used by the CON and DATAcon only
43 :     *)
44 :     fun force_raw (pty) =
45 :     if LT.ltp_ppoly pty then
46 :     let val (ks, body) = LT.ltd_ppoly pty
47 :     val (aty, rty) = LT.ltd_parrow body
48 :     in LT.ltc_ppoly(ks,
49 :     LT.ltc_arrow((true,true), [FL.ltc_raw aty], [FL.ltc_raw rty]))
50 :     end
51 :     else
52 :     let val (aty, rty) = LT.ltd_parrow pty
53 :     in LT.ltc_arrow((true,true), [FL.ltc_raw aty], [FL.ltc_raw rty])
54 :     end (* function force_raw *)
55 :    
56 :     fun tocon con =
57 :     let val _ = 1
58 :     in case con of
59 :     L.INTcon x => F.INTcon x
60 :     | L.INT32con x => F.INT32con x
61 :     | L.WORDcon x => F.WORDcon x
62 :     | L.WORD32con x => F.WORD32con x
63 :     | L.REALcon x => F.REALcon x
64 :     | L.STRINGcon x => F.STRINGcon x
65 :     | L.VLENcon x => F.VLENcon x
66 :     | L.DATAcon x => bug "unexpected case in tocon"
67 :     end
68 :    
69 :     fun tofundec (venv,d,f_lv,arg_lv,arg_lty,body,isrec) =
70 :     let val (body',body_lty) =
71 :     (* first, we translate the body (in the extended env) *)
72 :     tolexp (LT.ltInsert(venv, arg_lv, arg_lty, d), d) body
73 :    
74 :     (* detuple the arg type *)
75 :     val ((arg_raw, arg_ltys, _), unflatten) = FL.v_punflatten arg_lty
76 :    
77 :     (* now, we add tupling code at the beginning of the body *)
78 :     val (arg_lvs, body'') = unflatten(arg_lv, body')
79 :    
80 :     (* construct the return type if necessary *)
81 :     val (body_raw, body_ltys, _) = FL.t_pflatten body_lty
82 :     val rettype = if not isrec then NONE
83 :     else SOME(map FL.ltc_raw body_ltys)
84 :    
85 :     val isfct = not (LT.ltp_tyc arg_lty andalso LT.ltp_tyc body_lty)
86 :     val f_lty = if isfct then LT.ltc_pfct(arg_lty, body_lty)
87 :     else LT.ltc_parrow(arg_lty, body_lty)
88 :    
89 :     val fkind = if isfct then F.FK_FCT
90 :     else F.FK_FUN{isrec=rettype,
91 :     fixed=(arg_raw, body_raw),
92 :     known=false,
93 :     inline=not isrec}
94 :    
95 :     in ((fkind, f_lv, ListPair.zip(arg_lvs, map FL.ltc_raw arg_ltys), body''),
96 :     f_lty)
97 :     end
98 :    
99 :    
100 :     (* used to translate expressions whose structure is the same
101 :     * in Flint as in PLambda (either both binding or both non-binding)
102 :     * a continuation is unnecessary *)
103 :     and tolexp (venv,d) lexp =
104 :     let fun default_tovalues () =
105 :     tovalues(venv, d, lexp,
106 :     fn (vals, lty) =>
107 :     (F.RET vals, lty))
108 :     in case lexp of
109 :     L.APP (L.PRIM _, arg) => default_tovalues()
110 :     | L.APP (L.GENOP _,arg) => default_tovalues()
111 :     | L.APP (L.FN (arg_lv,arg_lty,body), arg_le) =>
112 :     tolexp (venv,d) (L.LET(arg_lv, arg_le, body))
113 :     | L.APP (f,arg) =>
114 :     (* first, evaluate f to a mere value *)
115 :     tovalue(venv, d, f,
116 :     fn (f_val, f_lty) =>
117 :     (* then eval the argument *)
118 :     tovalues(venv, d, arg,
119 :     fn (arg_vals, arg_lty) =>
120 :     (* now find the return type *)
121 :     let val (_, r_lty) = LT.ltd_pfun f_lty
122 :     (* and finally do the call *)
123 :     in (F.APP(f_val,arg_vals), r_lty)
124 :     end))
125 :    
126 :     | L.FIX (lvs,ltys,lexps,lexp) =>
127 :     (* first, let's setup the enriched environment with those funs *)
128 :     let val venv' = foldl (fn ((lv,lty),ve) =>
129 :     LT.ltInsert(ve, lv, lty, d))
130 :     venv (ListPair.zip(lvs, ltys))
131 :    
132 :     (* then translate each function in turn *)
133 :     val funs = map (fn ((f_lv,f_lty),L.FN(arg_lv,arg_lty,body)) =>
134 :     #1(tofundec(venv', d,
135 :     f_lv, arg_lv, arg_lty, body, true)))
136 :     (ListPair.zip(ListPair.zip(lvs,ltys),lexps))
137 :    
138 :     (* finally, translate the lexp *)
139 :     val (lexp',lty) = tolexp (venv',d) lexp
140 :     in (F.FIX(funs,lexp'), lty)
141 :     end
142 :    
143 :     | L.LET (lvar,lexp1,lexp2) =>
144 :     tolvar(venv, d, lvar, lexp1,
145 :     fn lty1 =>
146 :     tolexp (LT.ltInsert(venv,lvar,lty1,d), d) lexp2)
147 :    
148 :     | L.TAPP (f,tycs) =>
149 :     (* similar to APP *)
150 :     tovalue(venv, d, f,
151 :     fn (f_val,f_lty) =>
152 :     let val r_lty = LT.lt_pinst(f_lty, tycs)
153 :     in (F.TAPP(f_val, map FL.tcc_raw tycs), r_lty)
154 :     end)
155 :    
156 :     | L.RAISE (le, r_lty) =>
157 :     tovalue(venv, d, le,
158 :     fn (le_val,le_lty) =>
159 :     let val (_, r_ltys, _) = FL.t_pflatten r_lty
160 :     in (F.RAISE(le_val, map FL.ltc_raw r_ltys), r_lty)
161 :     end)
162 :    
163 :     | L.HANDLE (body, handler) =>
164 :     tovalue(venv, d, handler,
165 :     fn (h_val,h_lty) =>
166 :     let val (body', body_lty) = tolexp (venv, d) body
167 :     in (F.HANDLE(body', h_val), body_lty)
168 :     end)
169 :    
170 :     | L.SWITCH (le,acs,[],NONE) => bug "unexpected case in L.SWITCH"
171 :     (* tovalue(venv, d, le, fn _ => (F.RET[], [])) *)
172 :     | L.SWITCH (le,acs,[],SOME lexp) =>
173 :     tovalue(venv, d, le, fn (v,lty) => tolexp (venv,d) lexp)
174 :     | L.SWITCH (le,acs,conlexps,default) =>
175 :     let fun f (L.DATAcon((s,cr,lty),tycs,lvar),le) =
176 :     let val (lv_lty,_) = LT.ltd_parrow(LT.lt_pinst(lty,tycs))
177 :     val newvenv = LT.ltInsert(venv,lvar,lv_lty,d)
178 :     val (le, le_lty) = tolexp (newvenv,d) le
179 :     in
180 :     ((F.DATAcon((s, cr, force_raw lty),
181 :     map FL.tcc_raw tycs, lvar),
182 :     le),
183 :     le_lty)
184 :     end
185 :     | f (con,le) =
186 :     let val (lexp,lty) = tolexp (venv,d) le
187 :     in ((tocon con, lexp), lty)
188 :     end
189 :     in tovalue(venv, d, le,
190 :     fn (v, lty) =>
191 :     let val default = optmap (#1 o tolexp(venv,d)) default
192 :     val conlexps as ((_,lty)::_) = map f conlexps
193 :     in (F.SWITCH(v, acs, map #1 conlexps, default), lty)
194 :     end)
195 :     end
196 :    
197 :     (* for mere values, use tovalues *)
198 :     | _ => default_tovalues ()
199 :     end
200 :    
201 :     (*
202 :     * tovalue: turns a PLambda lexp into a value+type and then calls
203 :     * the continuation that will turn it into an Flint lexp+type
204 :     * (ltyenv * DebIndex * L.lexp * ((value * lty) -> (F.lexp * lty list))) -> (F.lexp * lty)
205 :     *
206 :     * - venv is the type environment for values
207 :     * - conts is the continuation
208 :     *)
209 :     and tovalue (venv,d,lexp,cont) =
210 :     let val _ = 1
211 :     in case lexp of
212 :     (* for simple values, it's trivial *)
213 :     L.VAR v => cont(F.VAR v, LT.ltLookup(venv, v, d))
214 :     | L.INT i =>
215 :     ((i+i+2; cont(F.INT i, LT.ltc_int)) handle Overflow =>
216 :     (let val z = i div 2
217 :     val ne = L.APP(iadd_prim, L.RECORD [L.INT z, L.INT (i-z)])
218 :     in tovalue(venv, d, ne, cont)
219 :     end))
220 :     | L.WORD i =>
221 :     let val maxWord = 0wx20000000
222 :     in if Word.<(i, maxWord) then cont(F.WORD i, LT.ltc_int)
223 :     else let val x1 = Word.div(i, 0w2)
224 :     val x2 = Word.-(i, x1)
225 :     val ne = L.APP(uadd_prim,
226 :     L.RECORD [L.WORD x1, L.WORD x2])
227 :     in tovalue(venv, d, ne, cont)
228 :     end
229 :     end
230 :     | L.INT32 n => cont(F.INT32 n, LT.ltc_int32)
231 :     | L.WORD32 n => cont(F.WORD32 n, LT.ltc_int32)
232 :     | L.REAL x => cont(F.REAL x, LT.ltc_real)
233 :     | L.STRING s => cont(F.STRING s, LT.ltc_string)
234 :    
235 :     (* for cases where tolvar is more convenient *)
236 :     | _ =>
237 :     let val lv = mkv()
238 :     in tolvar(venv, d, lv, lexp, fn lty => cont(F.VAR lv, lty))
239 :     end
240 :     end
241 :    
242 :    
243 :     (*
244 :     * tovalues: turns a PLambda lexp into a list of values and a list of types
245 :     * and then calls the continuation that will turn it into an Flint lexp+type
246 :     *
247 :     * (ltyenv * DebIndex * L.lexp * ((value list * lty list) -> (F.lexp * lty list))) -> (F.lexp * lty)
248 :     *
249 :     * - venv is the type environment for values
250 :     * - cont is the continuation
251 :     *)
252 :     and tovalues (venv,d,lexp,cont) =
253 :     let val _ = 1
254 :     in case lexp of
255 :     L.RECORD (lexps) =>
256 :     lexps2values(venv,d,lexps,
257 :     fn (vals,ltys) =>
258 :     let val lty = LT.ltc_tuple ltys
259 :     val (_, ltys, _) = FL.t_pflatten lty
260 :     in
261 :     (* detect the case where flattening is trivial *)
262 :     if LT.lt_eqv(lty, LT.ltc_tuple ltys) then
263 :     cont(vals,lty)
264 :     else
265 :     let val lv = mkv()
266 :     val (_, pflatten) = FL.v_pflatten lty
267 :     val (vs,wrap) = pflatten (F.VAR lv)
268 :     val (c_lexp,c_lty) = cont(vs, lty)
269 :     in
270 :     (F.RECORD(FU.rk_tuple,
271 :     vals, lv, wrap c_lexp),
272 :     c_lty)
273 :     end
274 :     end)
275 :    
276 :     | _ => tovalue(venv,d,lexp,
277 :     fn (v, lty) =>
278 :     let val (vs,wrap) = (#2(FL.v_pflatten lty)) v
279 :     val (c_lexp, c_lty) = cont(vs, lty)
280 :     in (wrap c_lexp, c_lty)
281 :     end)
282 :     end
283 :    
284 :     (* eval each lexp to a value *)
285 :     and lexps2values (venv,d,lexps,cont) =
286 :     let val _ = 1
287 :     fun f [] (vals,ltys) = cont (rev vals, rev ltys)
288 :     | f (lexp::lexps) (vals,ltys) =
289 :     tovalue(venv,d,lexp,
290 :     fn (v, lty) =>
291 :     f lexps (v::vals, lty::ltys))
292 :     in
293 :     f lexps ([], [])
294 :     end
295 :    
296 :     (*
297 :     * tolvar: same as tovalue except that it binds the value of the PLambda
298 :     * to the indicated lvar and passes just the type to the continutation
299 :     *)
300 :     and tolvar (venv,d,lvar,lexp,cont) =
301 :     let fun eta_expand (f, f_lty) =
302 :     let val lv = mkv()
303 :     val (arg_lty, ret_lty) = (LT.ltd_parrow f_lty)
304 :     in tolvar(venv, d, lvar,
305 :     L.FN(lv, arg_lty, L.APP(f, L.VAR lv)),
306 :     cont)
307 :     end
308 :    
309 :     (* inbetween tolvar and tovalue: it binds the lexp to a variable but
310 :     * is free to choose the lvar and passes it to the continutation *)
311 :     fun tolvarvalue (venv,d,lexp,cont) =
312 :     tovalue(venv, d, lexp,
313 :     fn (v,lty) =>
314 :     case v of
315 :     F.VAR lv => cont(lv, lty)
316 :     | _ => let val lv = mkv()
317 :     val (lexp',lty) = cont(lv, lty)
318 :     in (F.LET ([lv], F.RET [v], lexp'), lty)
319 :     end)
320 :    
321 :     fun PO_helper (arg,f_lty,tycs,filler) =
322 :     (* invariants: primop's types are always fully closed *)
323 :     let (* pty is the resulting FLINT type of the underlying primop,
324 :     r_lty is the result PLambda type of this primop expression,
325 :     and flat indicates whether we should flatten the arguments
326 :     or not. The results of primops are never flattened.
327 :     *)
328 :     val (pty, r_lty, flat) =
329 :     (case (LT.ltp_ppoly f_lty, tycs)
330 :     of (true, _) =>
331 :     let val (ks, lt) = LT.ltd_ppoly f_lty
332 :     val (aty, rty) = LT.ltd_parrow lt
333 :     val r_lty =
334 :     LT.lt_pinst(LT.ltc_ppoly(ks, rty), tycs)
335 :    
336 :     val (_, atys, flat) = FL.t_pflatten aty
337 :     (*** you really want to have a simpler
338 :     flattening heuristics here; in fact,
339 :     primop can have its own flattening
340 :     strategy. The key is that primop's
341 :     type never escape outside.
342 :     ***)
343 :    
344 :     val atys = map FL.ltc_raw atys
345 :     val nrty = FL.ltc_raw rty
346 :     val pty = LT.ltc_arrow((true,true),atys,[nrty])
347 :     in ( LT.ltc_ppoly(ks, pty), r_lty, flat)
348 :     end
349 :     | (false, []) => (* monomorphic case *)
350 :     let val (aty, rty) = LT.ltd_parrow f_lty
351 :     val (_, atys, flat) = FL.t_pflatten aty
352 :     val atys = map FL.ltc_raw atys
353 :     val nrty = FL.ltc_raw rty
354 :     val pty = LT.ltc_arrow((true,true),atys,[nrty])
355 :     in (pty, rty, flat)
356 :     end
357 :     | _ => bug "unexpected case in PO_helper")
358 :     in if flat then
359 :     (* ZHONG asks: is the following definitely safe ?
360 :     what would happen if ltc_raw is not an identity function ?
361 :     *)
362 :     tovalues(venv, d, arg,
363 :     fn (arg_vals, arg_lty) =>
364 :     let val (c_lexp, c_lty) = cont(r_lty)
365 :     (* put the filling inbetween *)
366 :     in (filler(arg_vals, pty, c_lexp), c_lty)
367 :     end)
368 :     else
369 :     tovalue(venv, d, arg,
370 :     fn (arg_val, arg_lty) =>
371 :     let val (c_lexp, c_lty) = cont(r_lty)
372 :     (* put the filling inbetween *)
373 :     in (filler([arg_val], pty, c_lexp), c_lty)
374 :     end)
375 :     end (* function PO_helper *)
376 :    
377 :     fun default_tolexp () =
378 :     let val (lexp', lty) = tolexp (venv, d) lexp
379 :     val (c_lexp, c_lty) = cont(lty)
380 :     val (_, punflatten) = FL.v_punflatten lty
381 :     val (lvs,c_lexp') = punflatten (lvar, c_lexp)
382 :     in (F.LET(lvs, lexp', c_lexp'), c_lty)
383 :     end
384 :    
385 :     (* fun default_tovalue () = *)
386 :     (* tovalue(venv, d, lexp, *)
387 :     (* fn (v,lty) => *)
388 :     (* let val (lexp', ltys) = cont(lty) *)
389 :     (* in (F.LET([lvar], F.RET[v], lexp'), ltys) *)
390 :     (* end) *)
391 :    
392 :     in case lexp of
393 :     (* primops have to be eta-expanded since they're not valid
394 :     * function values anymore in Flint *)
395 :     L.PRIM (po,lty,tycs) => eta_expand(lexp, LT.lt_pinst(lty, tycs))
396 :     | L.GENOP (dict,po,lty,tycs) => eta_expand(lexp, LT.lt_pinst(lty, tycs))
397 :    
398 :     | L.FN (arg_lv,arg_lty,body) =>
399 :     (* translate the body with the extended env into a fundec *)
400 :     let val (fundec as (fk,f_lv,args,body'), f_lty) =
401 :     tofundec(venv, d, lvar, arg_lv, arg_lty, body, false)
402 :     val (lexp, lty) = cont(f_lty)
403 :     in (F.FIX([fundec], lexp), lty)
404 :     end
405 :    
406 :     (* this is were we really deal with primops *)
407 :     | L.APP (L.PRIM ((po,f_lty,tycs)),arg) =>
408 :     PO_helper(arg, f_lty, tycs,
409 :     fn (arg_vals,pty, c_lexp) =>
410 :     F.PRIMOP((NONE, po, pty, map FL.tcc_raw tycs),
411 :     arg_vals, lvar, c_lexp))
412 :    
413 :     | L.APP (L.GENOP({default,table},po,f_lty,tycs),arg) =>
414 :     let fun f ([],table,cont) = cont (table)
415 :     | f ((tycs,le)::t1,t2,cont) =
416 :     tolvarvalue(venv,d,le,
417 :     fn (le_lv,le_lty) =>
418 :     f(t1, (map FL.tcc_raw tycs,le_lv)::t2, cont))
419 :     (* first, eval default *)
420 :     in tolvarvalue(venv,d,default,
421 :     fn (dflt_lv,dflt_lty) =>
422 :     (* then eval the table *)
423 :     f(table, [],
424 :     fn table' =>
425 :     PO_helper(arg, f_lty, tycs,
426 :     fn (arg_vals,pty,c_lexp) =>
427 :     F.PRIMOP((SOME {default=dflt_lv,
428 :     table=table'},
429 :     po, pty,
430 :     map FL.tcc_raw tycs),
431 :     arg_vals, lvar, c_lexp))))
432 :     end
433 :    
434 :    
435 :     | L.TFN (tks, body) =>
436 :     let val (body', body_lty) = tolexp (venv, DI.next d) body
437 :     val lty = LT.ltc_ppoly(tks, body_lty)
438 :     val (lexp', lty) = cont(lty)
439 :     in (F.TFN((lvar, map (fn tk => (mkv(), tk)) tks, body'), lexp'),
440 :     lty)
441 :     end
442 :    
443 :     | L.ETAG (le,lty) =>
444 :     tovalue(venv, d, le,
445 :     fn (le_lv, le_lty) =>
446 :     let val (c_lexp, c_lty) = cont(LT.ltc_etag lty)
447 :     val mketag = FU.mketag (FL.tcc_raw (LT.ltd_tyc lty))
448 :     in (F.PRIMOP(mketag, [le_lv], lvar, c_lexp), c_lty)
449 :     end)
450 :     | L.CON ((s,cr,lty),tycs,le) =>
451 :     tovalue(venv, d, le,
452 :     fn (v,_) =>
453 :     let val r_lty = LT.lt_pinst(lty, tycs)
454 :     val (_,v_lty) = LT.ltd_parrow r_lty
455 :     val (c_lexp, c_lty) = cont(v_lty)
456 :     in (F.CON((s, cr, force_raw lty),
457 :     map FL.tcc_raw tycs, v, lvar, c_lexp),
458 :     c_lty)
459 :     end)
460 :    
461 :     | L.VECTOR (lexps,tyc) =>
462 :     lexps2values(venv,d,lexps,
463 :     fn (vals, ltys) =>
464 :     let val lty = LT.ltc_tyc(LT.tcc_vector tyc)
465 :     val (c_lexp, c_lty) = cont(lty)
466 :     in (F.RECORD(F.RK_VECTOR (FL.tcc_raw tyc),
467 :     vals, lvar, c_lexp),
468 :     c_lty)
469 :     end)
470 :     | L.RECORD lexps =>
471 :     lexps2values(venv,d,lexps,
472 :     fn (vals, ltys) =>
473 :     let val lty = LT.ltc_tuple ltys
474 :     val (c_lexp, c_lty) = cont(lty)
475 :     in (F.RECORD(FU.rk_tuple,
476 :     vals, lvar, c_lexp), c_lty)
477 :     end)
478 :     | L.SRECORD lexps =>
479 :     lexps2values(venv,d,lexps,
480 :     fn (vals, ltys) =>
481 :     let val lty = LT.ltc_str(ltys)
482 :     val (c_lexp, c_lty) = cont(lty)
483 :     in (F.RECORD(F.RK_STRUCT, vals, lvar, c_lexp), c_lty)
484 :     end)
485 :    
486 :     | L.SELECT (n,lexp) =>
487 :     tovalue(venv, d, lexp,
488 :     fn (v, lty) =>
489 :     let val lty = (LT.lt_select(lty, n))
490 :     val (c_lexp, c_lty) = cont(lty)
491 :     in (F.SELECT(v, n, lvar, c_lexp), c_lty)
492 :     end)
493 :    
494 :     | L.PACK (lty,otycs,ntycs,lexp) =>
495 :     bug "PACK is not currently supported"
496 :     (*
497 :     tovalue(venv, d, lexp,
498 :     fn (v, v_lty) =>
499 :     let val nlty = LT.lt_pinst(lty, ntycs)
500 :     val (c_lexp, c_lty) = cont(nlty)
501 :     in (F.PACK(lty,
502 :     map FL.tcc_raw otycs,
503 :     map FL.tcc_raw ntycs,
504 :     v, lvar, c_lexp),
505 :     c_lty)
506 :     end)
507 :     *)
508 :    
509 :     (* these ones shouldn't matter because they shouldn't appear *)
510 :     (* | L.WRAP _ => bug "unexpected WRAP in plambda" *)
511 :     (* | L.UNWRAP _ => bug "unexpected UNWRAP in plambda" *)
512 :    
513 :     | _ => default_tolexp ()
514 :     end
515 :    
516 :     fun norm (lexp as L.FN(arg_lv,arg_lty,e)) =
517 :     (#1(tofundec(LT.initLtyEnv, DI.top, mkv(), arg_lv, arg_lty, e, false))
518 :     handle x => raise x)
519 :     (* | norm _ = bug "unexpected toplevel lexp" *)
520 :    
521 :     end (* toplevel local *)
522 :     end (* structure FlintNM *)
523 :    

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