| 86 |
in SELECT(u, i, x, RET [VAR x]) |
in SELECT(u, i, x, RET [VAR x]) |
| 87 |
end |
end |
| 88 |
|
|
| 89 |
fun APPg(e1, e2) = |
fun APPg (e1,(v2s,h2)) = |
| 90 |
let val (v1, h1) = split e1 |
let val (v1, h1) = split e1 |
| 91 |
val (v2, h2) = split e2 |
in h1(h2(APP(v1, v2s))) |
|
in h1(h2(APP(v1, [v2]))) |
|
| 92 |
end |
end |
| 93 |
|
|
| 94 |
fun RECORDg es = |
fun RETg es = |
| 95 |
let fun f ([], vs, hdr) = |
let fun f ([], vs, hdr) = (rev vs, hdr) |
|
let val x = mkv() |
|
|
in hdr(RECORD(FU_rk_tuple, rev vs, x, RET[VAR x])) |
|
|
end |
|
|
| f (e::r, vs, hdr) = |
|
|
let val (v, h) = split e |
|
|
in f(r, v::vs, hdr o h) |
|
|
end |
|
|
in f(es, [], ident) |
|
|
end |
|
|
|
|
|
fun SRECORDg es = |
|
|
let fun f ([], vs, hdr) = |
|
|
let val x = mkv() |
|
|
in hdr(RECORD(RK_STRUCT, rev vs, x, RET[VAR x])) |
|
|
end |
|
| 96 |
| f (e::r, vs, hdr) = |
| f (e::r, vs, hdr) = |
| 97 |
let val (v, h) = split e |
let val (v, h) = split e |
| 98 |
in f(r, v::vs, hdr o h) |
in f(r, v::vs, hdr o h) |
| 211 |
(* val tkAbsGen : kenv * lvar list * tkind list * lvar * fkind |
(* val tkAbsGen : kenv * lvar list * tkind list * lvar * fkind |
| 212 |
-> kenv * ((lexp *lexp) -> lexp) *) |
-> kenv * ((lexp *lexp) -> lexp) *) |
| 213 |
fun tkAbsGen (kenv, vs, ks, f, fk) = |
fun tkAbsGen (kenv, vs, ks, f, fk) = |
| 214 |
let val mkArgTy = case fk of {cconv=CC_FUN _,...} => LT.ltc_tuple |
let val args = ListPair.map (fn (tv,k) => (tv, LT.tk_lty k)) (vs,ks) |
| 215 |
| {cconv=CC_FCT,...} => LT.ltc_str |
fun hdr (e1, e2) = FIX([(fk, f, args, e1)], e2) |
|
val argt = mkArgTy (map LT.tk_lty ks) |
|
|
|
|
|
val w = mkv() |
|
|
fun h([], i, base) = base |
|
|
| h(v::r, i, base) = h(r, i+1, SELECT(VAR w, i, v, base)) |
|
|
|
|
|
fun hdr (e1, e2) = FIX([(fk, f, [(w, argt)], h(vs,0,e1))], e2) |
|
| 216 |
in (addKE(kenv, vs, ks), hdr) |
in (addKE(kenv, vs, ks), hdr) |
| 217 |
end |
end |
| 218 |
|
|
| 246 |
of (TC_APP _ | TC_PROJ _ | TC_VAR _) => |
of (TC_APP _ | TC_PROJ _ | TC_VAR _) => |
| 247 |
APPg(loop tx, tcsLexp(kenv, ts)) |
APPg(loop tx, tcsLexp(kenv, ts)) |
| 248 |
| _ => tcode_void) |
| _ => tcode_void) |
| 249 |
| (TC_SEQ ts) => tcsLexp(kenv, ts) |
| (TC_SEQ ts) => |
| 250 |
|
let val (vs,hdr) = tcsLexp(kenv, ts) |
| 251 |
|
val x = mkv() |
| 252 |
|
in hdr(RECORD(FU_rk_tuple, vs, x, RET[VAR x])) |
| 253 |
|
end |
| 254 |
| (TC_PROJ(tx, i)) => SELECTg(i, loop tx) |
| (TC_PROJ(tx, i)) => SELECTg(i, loop tx) |
| 255 |
| (TC_PRIM pt) => |
| (TC_PRIM pt) => |
| 256 |
if (pt = PT.ptc_real) then tcode_real |
if (pt = PT.ptc_real) then tcode_real |
| 305 |
|
|
| 306 |
and tcsLexp (kenv, ts) = |
and tcsLexp (kenv, ts) = |
| 307 |
let fun h tc = rtLexp kenv tc |
let fun h tc = rtLexp kenv tc |
| 308 |
in RECORDg(map h ts) |
in RETg(map h ts) |
| 309 |
end (* function tcsLexp *) |
end (* function tcsLexp *) |
| 310 |
|
|
| 311 |
and tsLexp (kenv, ts) = |
and tsLexp (kenv, ts) = |
| 312 |
let fun h tc = rtLexp kenv tc |
let fun h tc = rtLexp kenv tc |
| 313 |
in SRECORDg(map h ts) |
in RETg(map h ts) |
| 314 |
end (* function tsLexp *) |
end (* function tsLexp *) |
| 315 |
|
|
| 316 |
and isFloat (kenv, tc) = |
and isFloat (kenv, tc) = |
Parent Directory
| 
Revision Log
| 
Patch
