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/compiler/FLINT/main/literals.sml
ViewVC logotype

Annotation of /sml/trunk/compiler/FLINT/main/literals.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4516 - (view) (download)

1 : monnier 251 (* literals.sml
2 :     *
3 : jhr 4512 * This file implements support for heap-allocated literals. Our approach
4 :     * is to split out the literals from the CPS representation and create a
5 :     * bytecode program that for allocating the literals.
6 :     *
7 :     * The implementation of the bytecode interpreter for the literal language
8 :     * is in base/runtime/gc/build-literals.c.
9 :     *
10 : jhr 4454 * COPYRIGHT (c) 2017 The Fellowship of SML/NJ (http://www.smlnj.org)
11 :     * All rights reserved.
12 :     *
13 : jhr 4512 * TODO:
14 :     * 64BIT: need support for 64-bit integers
15 :     * REAL32: need support for 32-bit floats
16 :     * add support for IntInf.int as type
17 : monnier 251 *)
18 : monnier 98
19 :     signature LITERALS =
20 : jhr 4512 sig
21 : monnier 98
22 : jhr 4512 (** `litsplit f` takes a CPS function and splits out the heap-allocated
23 :     * literal values from it. At runtime, these literals will be accessed via
24 :     * a record of literals that is allocated by the runtime system. This
25 :     * function returns a rewriten version of its argument that accesses
26 :     * literals from the record and a byte-vector that encodes the program
27 :     * for generating the literals.
28 :     *)
29 :     val split : CPS.function -> CPS.function * Word8Vector.vector
30 :    
31 :     end;
32 :    
33 : jhr 4454 structure Literals : LITERALS =
34 : jhr 4512 struct
35 : monnier 98
36 : jhr 4512 structure W8V = Word8Vector
37 :     structure LV = LambdaVar
38 :     structure Intset = struct
39 : monnier 504 type intset = IntRedBlackSet.set ref
40 :     fun new() = ref IntRedBlackSet.empty
41 :     fun add set i = set := IntRedBlackSet.add(!set, i)
42 :     fun mem set i = IntRedBlackSet.member(!set, i)
43 :     fun rmv set i = set := IntRedBlackSet.delete(!set, i)
44 :     end
45 : monnier 98
46 : jhr 4512 open CPS
47 : monnier 98
48 : jhr 4512 fun bug msg = ErrorMsg.impossible ("Literals: "^msg)
49 :     fun mkv _ = LV.mkLvar()
50 : monnier 98
51 : jhr 4512 (****************************************************************************
52 :     * A MINI-LITERAL LANGUAGE *
53 :     ****************************************************************************)
54 :     datatype lit_val
55 :     = LI_INT of word
56 :     | LI_STRING of string
57 :     | LI_VAR of lvar
58 : monnier 251
59 : jhr 4512 datatype block_kind
60 :     = LI_RECORD (* record of tagged ML values *)
61 :     | LI_VECTOR (* vector of tagged ML values *)
62 : monnier 98
63 : jhr 4512 datatype lit_exp
64 :     = LI_TOP of lit_val list
65 :     | LI_BLOCK of (block_kind * lit_val list * lvar * lit_exp)
66 :     | LI_F64BLOCK of (string list * lvar * lit_exp)
67 :     | LI_I32BLOCK of (Word32.word list * lvar * lit_exp)
68 : monnier 98
69 : jhr 4512 fun rk2bk CPS.RK_VECTOR = LI_VECTOR
70 :     | rk2bk CPS.RK_RECORD = LI_RECORD
71 :     | rk2bk _ = bug "rk2bk: unexpected block kind"
72 : monnier 251
73 : jhr 4512 fun val2lit (CPS.VAR v) = LI_VAR v
74 :     | val2lit (CPS.INT i) = LI_INT(Word.fromInt i)
75 :     | val2lit (CPS.STRING s) = LI_STRING s
76 :     | val2lit _ = bug "unexpected case in val2lit"
77 : monnier 98
78 : jhr 4512 (****************************************************************************
79 :     * TRANSLATING THE LITERAL EXP TO BYTES *
80 :     ****************************************************************************)
81 : monnier 98
82 : jhr 4512 (* Literals are encoded as instructions for a "literal machine." The abstract
83 :     * description of these instructions is as follows:
84 :     *
85 :     * INT(i) -- push the int31 literal i on the stack
86 :     * RAW32[i1,...,in] -- form a 32-bit raw data record from the
87 :     * i1..in and push a pointer to it.
88 :     * RAW64[r1,...,rn] -- form a 64-bit raw data record from the
89 :     * r1..rn and push a pointer to it.
90 :     * STR[c1,...,cn] -- form a string from the characters c1..cn
91 :     * and push it on the stack.
92 :     * LIT(k) -- push the contents of the stack element
93 :     * that is k slots from the top of the stack.
94 :     * VECTOR(n) -- pop n elements from the stack, make a vector
95 :     * from them and push a pointer to the vector.
96 :     * RECORD(n) -- pop n elements from the stack, make a record
97 :     * from them and push a pointer.
98 :     * RETURN -- return the literal that is on the top of the
99 :     * stack.
100 : jhr 4516 *
101 :     * Encoding:
102 :     * INT(i) 0x01 <i>
103 :     * RAW32[i] 0x02 <i>
104 :     * RAW32[i1,..,in] 0x03 <n> <i1> ... <in>
105 :     * RAW64[r] 0x04 <r>
106 :     * RAW64[r1,..,rn] 0x05 <n> <r1> ... <rn>
107 :     * STR[c1,..,cn] 0x06 <n> <c1> ... <cn>
108 :     * LIT(k) 0x07 <k>
109 :     * VECTOR(n) 0x08 <n>
110 :     * RECORD(n) 0x09 <n>
111 :     * RETURN 0xff
112 : jhr 4512 *)
113 : monnier 98
114 : jhr 4512 fun w32ToBytes' (w, l) =
115 :     Word8.fromLargeWord(Word32.>>(w, 0w24)) ::
116 :     Word8.fromLargeWord(Word32.>>(w, 0w16)) ::
117 :     Word8.fromLargeWord(Word32.>>(w, 0w8)) ::
118 :     Word8.fromLargeWord w :: l
119 :     fun w32ToBytes w = w32ToBytes' (w, [])
120 :     fun w31ToBytes w = w32ToBytes(Word31.toLargeWordX w)
121 :     fun intToBytes i = w32ToBytes(Word32.fromInt i)
122 :     fun intToBytes' (i, l) = w32ToBytes'(Word32.fromInt i, l)
123 :     fun strToBytes s = map Byte.charToByte (explode s)
124 : monnier 98
125 : jhr 4512 val emit_MAGIC = W8V.fromList[0wx19, 0wx98, 0wx10, 0wx22]
126 :     fun emit_DEPTH n = W8V.fromList(intToBytes n)
127 :     fun emit_INT i = W8V.fromList(0wx01 :: w31ToBytes i)
128 :     fun emit_RAW32 [i] = W8V.fromList(0wx02 :: w32ToBytes i)
129 :     | emit_RAW32 l =
130 :     W8V.fromList(0wx03 :: (intToBytes'(length l, List.foldr w32ToBytes' [] l)))
131 :     fun emit_RAW64 [r] = W8V.fromList(0wx04 :: strToBytes r)
132 :     | emit_RAW64 l = W8V.concat(
133 :     W8V.fromList(0wx05 :: intToBytes(length l)) :: map Byte.stringToBytes l)
134 :     fun emit_STR s = W8V.concat[
135 :     W8V.fromList(0wx06 :: intToBytes(size s)),
136 :     Byte.stringToBytes s
137 :     ]
138 :     fun emit_LIT k = W8V.fromList(0wx07 :: intToBytes k)
139 :     fun emit_VECTOR n = W8V.fromList(0wx08 :: intToBytes n)
140 :     fun emit_RECORD n = W8V.fromList(0wx09 :: intToBytes n)
141 :     val emit_RETURN = W8V.fromList[0wxff]
142 : monnier 98
143 : jhr 4512 fun litToBytes (LI_TOP[]) = W8V.fromList[]
144 :     | litToBytes litExp = let
145 :     fun depth (LI_TOP ls, d, maxDepth) = Int.max(maxDepth, d+length ls)
146 :     | depth (LI_BLOCK(_, ls, _, rest), d, maxDepth) =
147 :     depth (rest, d+1, Int.max(maxDepth, d+length ls))
148 :     | depth (LI_F64BLOCK(ls, _, rest), d, maxDepth) =
149 :     depth (rest, d+1, Int.max(maxDepth, d+length ls))
150 :     | depth (LI_I32BLOCK(ls, _, rest), d, maxDepth) =
151 :     depth (rest, d+1, Int.max(maxDepth, d+length ls))
152 :     fun emitLitExp (env, exp, code) = let
153 :     fun emitLitVals ([], _, code) = code
154 :     | emitLitVals (lit::r, d, code) = let
155 :     val instr = (case lit
156 :     of (LI_INT i) => emit_INT i
157 :     | (LI_STRING s) => emit_STR s
158 :     | (LI_VAR v) => let
159 :     fun f ([], _) = bug "unbound lvar"
160 :     | f (v'::r, d) = if (v = v') then d else f(r, d+1)
161 :     in
162 :     emit_LIT(f (env, d))
163 :     end
164 :     (* end case *))
165 :     in
166 :     emitLitVals (r, d+1, instr::code)
167 :     end
168 :     fun emitBlock (LI_RECORD, ls, code) =
169 :     emit_RECORD(length ls) :: emitLitVals(ls, 0, code)
170 :     | emitBlock (LI_VECTOR, ls, code) =
171 :     emit_VECTOR(length ls) :: emitLitVals(ls, 0, code)
172 :     fun emitF64Block (ls, code) =
173 :     emit_RAW64(map IEEERealConst.realconst ls) :: code
174 :     fun emitI32Block (ls, code) = emit_RAW32 ls :: code
175 :     in
176 :     case exp
177 :     of (LI_TOP ls) => emit_RETURN :: emitBlock(LI_RECORD, ls, code)
178 :     | (LI_BLOCK(bk, ls, v, rest)) =>
179 :     emitLitExp (v::env, rest, emitBlock(bk, ls, code))
180 :     | (LI_F64BLOCK(ls, v, rest)) =>
181 :     emitLitExp (v::env, rest, emitF64Block(ls, code))
182 :     | (LI_I32BLOCK(ls, v, rest)) =>
183 :     emitLitExp (v::env, rest, emitI32Block(ls, code))
184 :     (* end case *)
185 :     end
186 :     val maxDepth = depth (litExp, 0, 1)
187 :     val code = emit_MAGIC
188 :     :: emit_DEPTH maxDepth
189 :     :: List.rev(emitLitExp([], litExp, []))
190 :     in
191 :     W8V.concat code
192 :     end
193 : monnier 98
194 : jhr 4512 (****************************************************************************
195 :     * LIFTING LITERALS ON CPS *
196 :     ****************************************************************************)
197 :     datatype info
198 :     = ZZ_STR of string
199 :     | ZZ_FLT of string
200 :     | ZZ_RCD of record_kind * value list
201 : monnier 251
202 : jhr 4512 exception LitInfo
203 : monnier 98
204 : jhr 4512 datatype rlit = RLIT of string * word
205 :     fun toRlit s = RLIT(s, HashString.hashString s)
206 :     fun fromRlit (RLIT(s, _)) = s
207 :     fun rlitcmp (RLIT(s1,i1), RLIT(s2,i2)) =
208 :     if i1 < i2 then LESS
209 :     else if i1 > i2 then GREATER else String.compare(s1, s2)
210 :     structure RlitDict = RedBlackMapFn(struct type ord_key = rlit
211 :     val compare = rlitcmp
212 :     end)
213 : monnier 98
214 : jhr 4512 (* lifting all literals from a CPS program *)
215 :     fun liftlits (body, root, offset) =
216 :     let (* the list of record, string, or real constants *)
217 :     val m : info IntHashTable.hash_table = IntHashTable.mkTable(32, LitInfo)
218 :     val freevars : lvar list ref = ref []
219 :     fun addv x = (freevars := (x :: (!freevars)))
220 : monnier 98
221 : jhr 4512 (* check if an lvar is used by the main program *)
222 :     val refset : Intset.intset = Intset.new()
223 :     val used : lvar -> unit = Intset.add refset
224 :     val isUsed : lvar -> bool = Intset.mem refset
225 : monnier 98
226 : jhr 4512 (* memoize the information on which corresponds to what *)
227 :     fun enter (v, i) = (IntHashTable.insert m (v, i); addv v)
228 :     fun const (VAR v) = ((IntHashTable.lookup m v; true) handle _ => false)
229 :     | const (INT _ | INT32 _ | REAL _ | STRING _) = true
230 :     | const _ = bug "unexpected case in const"
231 : monnier 98
232 : jhr 4512 fun cstlit (VAR v) = ((IntHashTable.lookup m v; true) handle _ => false)
233 :     | cstlit (REAL _ | STRING _) = true
234 :     | cstlit _ = false
235 : monnier 98
236 : jhr 4512 (* register a string literal *)
237 :     local val strs : string list ref = ref []
238 :     val strsN : int ref = ref 0
239 :     val sdict = ref (RlitDict.empty)
240 :     val srtv = mkv()
241 :     val srtval = VAR srtv
242 :     in
243 :     fun entStr s =
244 :     let val v = mkv() (** should hash to remove duplicates **)
245 :     val sd = !sdict
246 :     val rlit = toRlit s
247 :     val n =
248 :     (case RlitDict.find(sd, rlit)
249 :     of SOME k => k
250 :     | _ => let val _ = (strs := (s :: (!strs)))
251 :     val k = !strsN
252 :     val _ = (strsN := (k+1))
253 :     val _ = (sdict := (RlitDict.insert(sd, rlit, k)))
254 :     in k
255 :     end)
256 :     in (VAR v, fn ce => SELECT(n, srtval, v, BOGt, ce))
257 :     end
258 : monnier 98
259 : jhr 4512 (* old definition of entStr
260 : monnier 98
261 : jhr 4512 let val sd = !sdict
262 :     val rlit = toRlit s
263 :     in (case RlitDict.peek(sd, rlit)
264 :     of SOME v => (VAR v, ident)
265 :     | _ => let val v = mkv()
266 :     val _ = (enter(v, ZZ_STR s); used v)
267 :     val _ = (sdict := RlitDict.insert(sd, rlit, v))
268 :     in (VAR v, ident)
269 :     end)
270 :     end
271 :     *)
272 : monnier 251
273 : jhr 4512 fun appStr () =
274 :     let fun g (a::r, z) = g(r, (STRING a)::z)
275 :     | g ([], z) = z (* reverse to reflecting the correct order *)
276 :     val allStrs = !strs
277 :     in case !strs
278 :     of [] => ()
279 :     | xs => (enter(srtv, ZZ_RCD(RK_RECORD, g(xs,[]))); used srtv)
280 :     end
281 :     end (* local of processing string literals *)
282 : monnier 98
283 : jhr 4512 (** a special treatment of real constants *)
284 :     local val reals : string list ref = ref []
285 :     val realsN : int ref = ref 0
286 :     val rdict = ref (RlitDict.empty)
287 :     val rrtv = mkv()
288 :     val rrtval = VAR rrtv
289 :     in
290 :     fun entReal s =
291 :     let val v = mkv() (** should hash to remove duplicates **)
292 :     val rd = !rdict
293 :     val rlit = toRlit s
294 :     val n =
295 :     (case RlitDict.find(rd, rlit)
296 :     of SOME k => k
297 :     | _ => let val _ = (reals := (s :: (!reals)))
298 :     val k = !realsN
299 :     val _ = (realsN := (k+1))
300 :     val _ = (rdict := (RlitDict.insert(rd, rlit, k)))
301 :     in k
302 :     end)
303 :     in (VAR v, fn ce => SELECT(n, rrtval, v, FLTt 64, ce)) (* REAL32: FIXME *)
304 :     end
305 : jhr 4454
306 : jhr 4512 fun appReal () =
307 :     let fun g (a::r, z) = g(r, (REAL a)::z)
308 :     | g ([], z) = z (* reverse to reflecting the correct order *)
309 :     val allReals = !reals
310 :     in case !reals
311 :     of [] => ()
312 :     | xs => (enter(rrtv, ZZ_RCD(RK_FBLOCK, g(xs,[]))); used rrtv)
313 :     end
314 :     end (* local of special treatment of real constants *)
315 : monnier 98
316 : jhr 4512 (* translation on the CPS values *)
317 :     fun lpsv u =
318 :     (case u
319 :     of REAL s => entReal s
320 :     | STRING s => entStr s
321 :     | VAR v => (used v; (u, Fn.id))
322 :     | _ => (u, Fn.id))
323 : jhr 4454
324 : jhr 4512 fun lpvs vs =
325 :     let fun g (u, (xs, hh)) =
326 :     let val (nu, nh) = lpsv u
327 :     in (nu::xs, nh o hh)
328 :     end
329 :     in foldr g ([], Fn.id) vs
330 :     end
331 : monnier 98
332 : jhr 4512 (* if all fields of a record are "constant", then we lift it *)
333 :     fun field ul =
334 :     let fun h ((x, OFFp 0)::r, z, rsflag) =
335 :     if const x then h(r, x::z, rsflag orelse (cstlit x)) else NONE
336 :     | h ([], z, rsflag) = if rsflag then SOME(rev z) else NONE
337 :     | h _ = bug "unexpected case in field"
338 :     in h (ul, [], false)
339 :     end
340 : monnier 98
341 : jhr 4512 (* register a constant record *)
342 :     fun record (rk, ul, v) =
343 :     (case field ul
344 :     of SOME xl => (enter(v, ZZ_RCD(rk, xl)); Fn.id)
345 :     | NONE =>
346 :     let fun g ((u, p as OFFp 0), (r, hh)) =
347 :     let val (nu, nh) = lpsv u
348 :     in ((nu, p)::r, nh o hh)
349 :     end
350 :     | g _ = bug "unexpected non-zero OFFp in record"
351 :     val (nl, hdr) = foldr g ([], Fn.id) ul
352 :     in fn ce => hdr(RECORD(rk, nl, v, ce))
353 :     end)
354 : monnier 98
355 : jhr 4512 (* register a wrapped float literal *)
356 :     fun wrapfloat (u, v, t) =
357 :     if const u then (enter(v, ZZ_RCD(RK_FBLOCK, [u])); Fn.id)
358 :     else let val (nu, hh) = lpsv u
359 :     in (fn ce => hh(PURE(P.fwrap, [nu], v, t, ce)))
360 :     end
361 : monnier 98
362 : jhr 4512 (* fetch out the literal information *)
363 :     fun getInfo () =
364 :     let val _ = appReal() (* register all Reals as a record *)
365 :     val _ = appStr() (* register all Strings as a record *)
366 :     val allvars = !freevars
367 :     val exports = List.filter isUsed allvars
368 : monnier 98
369 : jhr 4512 val toplit =
370 :     let fun g ([], z) = LI_TOP z
371 :     | g (x::r, z) =
372 :     (case IntHashTable.lookup m x
373 :     of ZZ_STR s => g(r, (LI_STRING s)::z)
374 :     | _ => g(r, (LI_VAR x)::z))
375 :     in g(exports, [])
376 :     end
377 : monnier 98
378 : jhr 4512 fun mklit (v, lit) = let
379 :     fun unREAL (CPS.REAL s) = s
380 :     | unREAL _ = bug "unREAL"
381 :     fun unINT32 (CPS.INT32 w) = w
382 :     | unINT32 _ = bug "unINT32"
383 :     in
384 :     case IntHashTable.lookup m v of
385 :     (ZZ_FLT _) => (* float is wrapped *)
386 :     bug "currently we don't expect ZZ_FLT in mklit"
387 :     (* LI_F64BLOCK([s], v, lit) *)
388 :     | (ZZ_STR s) =>
389 :     bug "currently we don't expect ZZ_STR in mklit"
390 :     (* lit --- or we could inline string *)
391 :     | (ZZ_RCD(CPS.RK_FBLOCK, vs)) =>
392 :     LI_F64BLOCK(map unREAL vs, v, lit)
393 :     | (ZZ_RCD(CPS.RK_I32BLOCK, vs)) =>
394 :     LI_I32BLOCK(map unINT32 vs, v, lit)
395 :     | (ZZ_RCD(rk, vs)) =>
396 :     LI_BLOCK(rk2bk rk, map val2lit vs, v, lit)
397 :     end
398 : monnier 98
399 : jhr 4512 (** build up the literal structure *)
400 :     val lit = foldl mklit toplit allvars
401 : monnier 98
402 : jhr 4512 val n = length exports
403 :     val hdr =
404 :     if n = 0 then Fn.id
405 :     else let val rv = mkv()
406 :     val rval = VAR rv
407 :     val rhdr =
408 :     fn ce => SELECT(offset, root, rv, PTRt(RPT n), ce)
409 : monnier 98
410 : jhr 4512 fun mkhdr (v, (i, hh)) =
411 :     let val nh =
412 :     (case IntHashTable.lookup m v
413 :     of (ZZ_FLT _) => bug "ZZ_FLT in mkhdr"
414 :     (* (fn ce =>
415 :     (SELECT(i, rval, w, PTRt(FPT 1),
416 :     SELECT(0, VAR w, v, FLTt, ce)))) *)
417 :     | (ZZ_STR s) => bug "ZZ_STR in mkhdr"
418 :     (* (fn ce =>
419 :     SELECT(i, rval, v, BOGt, ce)) *)
420 :     | (ZZ_RCD (rk, vs)) =>
421 :     let val n = length vs
422 :     val t =
423 :     case rk
424 :     of RK_FBLOCK => PTRt(FPT n)
425 :     | RK_VECTOR => BOGt
426 :     | _ => PTRt(RPT n)
427 :     in fn ce => SELECT(i, rval, v, t, ce)
428 :     end)
429 :     in (i+1, hh o nh)
430 :     end
431 :     in #2 (foldr mkhdr (0, rhdr) exports)
432 :     end
433 :     in (lit, hdr)
434 :     end (* function getInfo *)
435 : monnier 98
436 : jhr 4512 fun lpfn (fk, f, vl, cl, e) = (fk, f, vl, cl, loop e)
437 : monnier 98
438 : jhr 4512 and loop ce =
439 :     (case ce
440 :     of RECORD (rk, ul, v, e) => record (rk, ul, v) (loop e)
441 :     | SELECT (i, u, v, t, e) =>
442 :     let val (nu, hh) = lpsv u
443 :     in hh(SELECT(i, nu, v, t, loop e))
444 :     end
445 :     | OFFSET _ => bug "unexpected OFFSET in loop"
446 :     | APP (u, ul) =>
447 :     let val (nu, h1) = lpsv u
448 :     val (nl, h2) = lpvs ul
449 :     in h1(h2(APP(nu, nl)))
450 :     end
451 :     | FIX (fns, e) => FIX(map lpfn fns, loop e)
452 :     | SWITCH (u, v, es) =>
453 :     let val (nu, hh) = lpsv u
454 :     in hh(SWITCH(nu, v, map loop es))
455 :     end
456 :     | BRANCH (p, ul, v, e1, e2) =>
457 :     let val (nl, hh) = lpvs ul
458 :     in hh(BRANCH(p, nl, v, loop e1, loop e2))
459 :     end
460 :     | SETTER (p, ul, e) =>
461 :     let val (nl, hh) = lpvs ul
462 :     in hh(SETTER(p, nl, loop e))
463 :     end
464 :     | LOOKER (p, ul, v, t, e) =>
465 :     let val (nl, hh) = lpvs ul
466 :     in hh(LOOKER(p, nl, v, t, loop e))
467 :     end
468 :     | ARITH (p, ul, v, t, e) =>
469 :     let val (nl, hh) = lpvs ul
470 :     in hh(ARITH(p, nl, v, t, loop e))
471 :     end
472 :     | PURE (P.fwrap, [u], v, t, e) => wrapfloat (u, v, t) (loop e)
473 :     | PURE (p, ul, v, t, e) =>
474 :     let val (nl, hh) = lpvs ul
475 :     in hh(PURE(p, nl, v, t, loop e))
476 :     end
477 :     | RCC (k, l, p, ul, vtl, e) =>
478 :     let val (nl, hh) = lpvs ul
479 :     in hh(RCC(k, l, p, nl, vtl, loop e))
480 :     end)
481 : monnier 98
482 : jhr 4512 val newbody = loop body
483 :     val (lit, hdr) = getInfo ()
484 :     in (hdr newbody, lit)
485 :     end
486 : monnier 98
487 : jhr 4512 (* the main function *)
488 :     fun split (fk, f, vl as [_,x], [CNTt, t as PTRt(RPT n)], body) = let
489 :     val nt = PTRt(RPT (n+1))
490 :     val (nbody, lit) = liftlits(body, VAR x, n)
491 :     in
492 :     ((fk, f, vl, [CNTt, nt], nbody), litToBytes lit)
493 :     end
494 :     | split _ = bug "unexpected CPS header in split"
495 : monnier 98
496 : jhr 4512 end (* Literals *)

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