from-core.sml 19.7 KB
Newer Older
1
2
3
4
5
6
7
8
9

structure FromCore : sig
   val run:
      Core.Spec.t ->
         CPS.Spec.t CompilationMonad.t
end = struct

   structure CM = CompilationMonad
   structure Exp = CPS.Exp
mb0's avatar
mb0 committed
10
   structure CCTab = CPS.CCTab
mb0's avatar
mb0 committed
11
   structure S = Substring
12
13

   val variable = Atom.atom "x"
mb0's avatar
mb0 committed
14
15
16
   val function = Atom.atom "f"
   val constructor = Atom.atom "cons"
   val continuation = CCTab.kont
17

mb0's avatar
mb0 committed
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
   structure Builtin = struct
      fun fresh v = let
         val (tab, sym) =
            VarInfo.fresh (!SymbolTables.varTable, Atom.atom v)
      in
         sym before SymbolTables.varTable := tab
      end

      fun field f = let
         val (tab, sym) =
            FieldInfo.fresh (!SymbolTables.fieldTable, f)
      in
         sym before SymbolTables.fieldTable := tab
      end
      
      fun get s = VarInfo.lookup (!SymbolTables.varTable, Atom.atom s)

      fun mk () = let
36
         open Core.Exp
mb0's avatar
mb0 committed
37
38
39
         val slice = get "slice"
         val consume = get "consume"
         val unconsume = get "unconsume"
mb0's avatar
mb0 committed
40
41
         val andd = get "and"
         val concat = get "^"
mb0's avatar
mb0 committed
42
43
         val == = get "=="
         val not = get "not"
mb0's avatar
mb0 committed
44
         val raisee = get "raise"
mb0's avatar
mb0 committed
45
         val return = get "return"
mb0's avatar
Foo.    
mb0 committed
46
         val add = get "+"
mb0's avatar
mb0 committed
47
         val sub = get "-"
mb0's avatar
Foo.    
mb0 committed
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
         val sx = get "sx"
         val zx = get "zx"

         val sx = 
            let
               val x = fresh "x"
               val primSx = get "%sx"
               val body = PRI (primSx, [x])
            in
               (sx, [x], body)
            end

         val zx = 
            let
               val x = fresh "x"
               val primZx = get "%zx"
               val body = PRI (primZx, [x])
            in
               (zx, [x], body)
            end

         (* val + a b = %add(a,b) *)
         val add =
            let
               val a = fresh "a"
               val b = fresh "b"
               val primAdd = get "%add"
               val body = PRI (primAdd, [a, b])
                     
            in
               (add, [a, b], body)
            end
mb0's avatar
mb0 committed
80

mb0's avatar
mb0 committed
81
82
83
84
85
86
87
88
89
90
91
92
         (* val - a b = %sub(a,b) *)
         val sub =
            let
               val a = fresh "a"
               val b = fresh "b"
               val primSub = get "%sub"
               val body = PRI (primSub, [a, b])
                     
            in
               (sub, [a, b], body)
            end

93
         (* val and a b = %and(a,b) *)
mb0's avatar
mb0 committed
94
95
96
97
98
         val andd =
            let
               val a = fresh "a"
               val b = fresh "b"
               val primAnd = get "%and"
99
100
               val body = PRI (primAnd, [a, b])
                     
mb0's avatar
mb0 committed
101
            in
102
               (andd, [a, b], body)
mb0's avatar
mb0 committed
103
104
            end

105
         (* val == a b = %equal(a,b) *)
mb0's avatar
mb0 committed
106
107
108
109
110
         val == =
            let
               val a = fresh "a"
               val b = fresh "b"
               val primEqual = get "%equal"
111
               val body = PRI (primEqual, [a, b])
mb0's avatar
mb0 committed
112
            in
113
               (==, [a, b], body)
mb0's avatar
mb0 committed
114
115
            end

116
         (* val not a = %not(a) *)
mb0's avatar
mb0 committed
117
118
119
120
121
         val not =
            let
               val a = fresh "a"
               val x = fresh "x"
               val primNot = get "%not"
122
               val body = PRI (primNot, [a])
mb0's avatar
mb0 committed
123
            in
124
               (not, [a], body)
mb0's avatar
mb0 committed
125
126
            end

mb0's avatar
mb0 committed
127
         (* val ^ k a b = %concat(a,b) *)
mb0's avatar
mb0 committed
128
129
130
131
132
         val concat =
            let
               val a = fresh "a"
               val b = fresh "b"
               val primConcat = get "%concat"
133
               val body = PRI (primConcat, [a, b])
mb0's avatar
mb0 committed
134
            in
135
               (concat, [a, b], body)
mb0's avatar
mb0 committed
136
137
            end

138
         (* val raise a = return(%raise(a)) *)
mb0's avatar
mb0 committed
139
140
141
142
         val raisee =
            let
               val a = fresh "a"
               val primRaise = get "%raise"
mb0's avatar
mb0 committed
143
               val body = APP (ID return, [PRI (primRaise, [a])])
mb0's avatar
mb0 committed
144
            in
145
               (raisee, [a], body)
mb0's avatar
mb0 committed
146
147
            end

mb0's avatar
mb0 committed
148
         (* val slice tok offs sz = return (%slice(tok,offs,sz) *)
mb0's avatar
mb0 committed
149
150
151
152
153
154
         val slice =
            let
               val tok = fresh "tok"
               val offs = fresh "offs"
               val sz = fresh "sz"
               val primSlice = get "%slice"
mb0's avatar
mb0 committed
155
               val body = APP (ID return, [PRI (primSlice, [tok, offs, sz])])
mb0's avatar
mb0 committed
156
            in
mb0's avatar
mb0 committed
157
               (slice, [tok, offs, sz], body) 
mb0's avatar
mb0 committed
158
159
            end

160
         (* val consume s = %consume(s) *)
mb0's avatar
mb0 committed
161
162
163
164
         val consume =
            let
               val s = fresh "s"
               val primConsume = get "%consume"
165
               val body = PRI (primConsume, [s])
mb0's avatar
mb0 committed
166
            in
167
               (consume, [s], body)
mb0's avatar
mb0 committed
168
169
            end

170
         (* val unconsume s = %unconsume(s) *)
mb0's avatar
mb0 committed
171
172
173
174
         val unconsume =
            let
               val s = fresh "s"
               val primUnconsume = get "%unconsume"
175
               val body = PRI (primUnconsume, [s])
mb0's avatar
mb0 committed
176
            in
177
               (unconsume, [s], body)
mb0's avatar
mb0 committed
178
179
            end
      in
mb0's avatar
mb0 committed
180
181
182
183
184
185
186
187
188
189
190
191
         [slice,
          consume,
          unconsume,
          andd,
          not,
          ==,
          concat,
          raisee,
          add,
          sx,
          zx,
          sub]
mb0's avatar
mb0 committed
192
193
194
195
      end

   end

mb0's avatar
mb0 committed
196
   val constructors: (Spec.sym * Spec.ty option) SymMap.map ref = ref SymMap.empty
mb0's avatar
mb0 committed
197

mb0's avatar
mb0 committed
198
199
200
   fun isEnumLike c =
      case SymMap.lookup (!constructors, c) of
         (_, NONE) => true | _ => false
201

mb0's avatar
mb0 committed
202
   fun fresh variable = let
203
      val (tab, sym) =
mb0's avatar
mb0 committed
204
         VarInfo.fresh (!SymbolTables.varTable, variable)
205
206
207
208
209
210
211
212
   in
      sym before SymbolTables.varTable := tab
   end

   fun bind map v t = SymMap.insert (map, v, t) 

   local open Core.Exp in

mb0's avatar
mb0 committed
213
214
215
216
217
218
219
220
221
222
223
224
225
226
   fun field f = let
      val tab = SymbolTables.fieldTable
      val n = VarInfo.getAtom (!SymbolTables.varTable, f)
   in
      case FieldInfo.find (!tab, n) of
         SOME s => s
       | NONE =>
            let
               val (tab, sym) = FieldInfo.fresh (!tab, n)
            in
               sym before SymbolTables.fieldTable := tab
            end
   end

227
228
229
230
   fun translate spec =
      Spec.upd
         (fn cs =>
            let
mb0's avatar
mb0 committed
231
232
233
               val main = fresh function
               val kont = fresh continuation
               val () = constructors := Spec.get#constructors spec
mb0's avatar
mb0 committed
234
235
236
237
238
239
240
241
242
               fun exports cs =
                  rev (foldl
                     (fn ((f, _, _), acc) => 
                        let
                           val fld = field f
                        in
                           (fld, ID f)::acc
                        end)
                     [] cs)
mb0's avatar
mb0 committed
243
244
245
246
247
248
               fun exports spec =
                  let 
                     val es = Spec.get#exports spec
                  in
                     map (fn e => (field e, ID e)) es
                  end
mb0's avatar
mb0 committed
249
250
               val cps =
                  trans0 
251
                     (LETREC (Builtin.mk()@cs, RECORD (exports spec)))
mb0's avatar
mb0 committed
252
                     (fn z => Exp.APP (main, kont, [z]))
253
            in
254
               cps
255
256
257
258
259
260
            end) spec

   and trans0 e kappa = 
      case e of
         LETVAL (v, e, body) =>
            let
mb0's avatar
mb0 committed
261
               val j = fresh continuation
262
263
               val body = trans0 body kappa
            in
264
               Exp.LETCONT ([(j, [v], body)], trans1 e j)
265
            end
mb0's avatar
mb0 committed
266
267
268
269
270
271
272
273
274
275
       | LETREC (ds, body) => Exp.LETREC (map trans0rec ds, trans0 body kappa)
       | IF (iff, thenn, elsee) =>
            trans0
               (CASE
                  (iff,
                   [(Core.Pat.BIT "1", thenn),
                    (Core.Pat.BIT "0", elsee)]))
               kappa
       | CASE (e, ps) =>
            let
mb0's avatar
mb0 committed
276
               val j = fresh continuation
mb0's avatar
mb0 committed
277
278
279
280
               fun trans z ps cps ks =
                  case ps of
                     [] =>
                        let
mb0's avatar
mb0 committed
281
                           val x = fresh variable
mb0's avatar
mb0 committed
282
                        in
mb0's avatar
mb0 committed
283
284
285
286
287
288
289
290
291
292
                           case ks of
                              [([],body)] =>
                                 Exp.LETCONT
                                    ((j, [x], kappa x)::cps,
                                     Exp.CC body)

                            | _ =>
                                 Exp.LETCONT
                                    ((j, [x], kappa x)::cps,
                                     Exp.CASE (z, ks))
mb0's avatar
mb0 committed
293
294
295
                        end
                   | (p, e)::ps =>
                        let
mb0's avatar
mb0 committed
296
                           val k = fresh continuation
mb0's avatar
mb0 committed
297
298
299
300
301
                           val (x, ks) = transPat p k ks
                           fun bindTrans x =
                              case x of
                                 SOME x => Exp.LETDECON (x, z, trans1 e j)
                               | _ => trans1 e j
mb0's avatar
mb0 committed
302
                        in
mb0's avatar
mb0 committed
303
                           trans z ps ((k, [], bindTrans x)::cps) ks
mb0's avatar
mb0 committed
304
305
                        end
            in
306
               trans0 e (fn z => trans z ps [] [])
mb0's avatar
mb0 committed
307
            end
mb0's avatar
mb0 committed
308
       | APP (e1, es) =>
309
            let
mb0's avatar
mb0 committed
310
311
               val k = fresh continuation
               val x = fresh variable
mb0's avatar
mb0 committed
312
313
314
315
               fun trans es xs k =
                  case es of
                     e::es => trans0 e (fn x => trans es (x::xs) k)
                   | [] => k (rev xs)
316
            in
mb0's avatar
mb0 committed
317
318
319
               trans0 e1 (fn x1 =>
                  trans es [] (fn xs =>
                     Exp.LETCONT ([(k, [x], kappa x)], Exp.APP (x1, k, xs))))
320
            end
321
322
323
324
325
326
       | PRI (f, xs) =>
            let
               val x = fresh variable
            in
               Exp.LETVAL (x, Exp.PRI (f, xs), kappa x)
            end
327
328
       | FN (x, e) =>
            let
mb0's avatar
mb0 committed
329
330
               val f = fresh function
               val k = fresh continuation
331
            in
332
               Exp.LETVAL (f, Exp.FN (k, [x], trans1 e k), kappa f) 
333
334
335
336
337
338
339
            end
       | RECORD fs =>
            let
               fun trans fs fvs =
                  case fs of
                     [] =>
                        let
mb0's avatar
mb0 committed
340
                           val x = fresh variable
341
342
343
344
345
346
347
348
349
                        in
                           Exp.LETVAL (x, Exp.REC fvs, kappa x)
                        end
                   | (f, e)::fs =>
                        trans0 e (fn z =>
                           trans fs ((f, z)::fvs))
            in
               trans fs []
            end
mb0's avatar
mb0 committed
350
351
       | UPDATE fs => 
            let
mb0's avatar
mb0 committed
352
353
354
               val f = fresh function
               val k = fresh continuation
               val z = fresh variable
mb0's avatar
mb0 committed
355
356
               val x = fresh variable
               fun trans fs fvs =
mb0's avatar
mb0 committed
357
358
                  case fs of
                     [] =>
mb0's avatar
mb0 committed
359
360
361
362
363
364
                        Exp.LETVAL
                           (f,
                            Exp.FN (k, [x],
                              Exp.LETUPD (z, x, fvs,
                                 Exp.CC (k, [z]))),
                            kappa f)
mb0's avatar
mb0 committed
365
366
                   | (f, e)::fs =>
                        trans0 e (fn z =>
mb0's avatar
mb0 committed
367
                           trans fs ((f, z)::fvs))
mb0's avatar
mb0 committed
368
            in
mb0's avatar
mb0 committed
369
               trans fs []
mb0's avatar
mb0 committed
370
            end
371
372
       | SELECT fld =>
            let
mb0's avatar
mb0 committed
373
374
375
376
               val f = fresh function
               val k = fresh continuation
               val x = fresh variable
               val z = fresh variable
377
            in
mb0's avatar
mb0 committed
378
379
380
381
               Exp.LETVAL
                  (f,
                   Exp.FN
                     (k,
mb0's avatar
mb0 committed
382
383
                      [x],
                      Exp.LETPRJ (z, fld, x, Exp.CC (k, [z]))),
384
385
386
                   kappa f)
            end
       | CON c =>
mb0's avatar
mb0 committed
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
            if isEnumLike c
               then
                  let
                     val x = fresh variable
                     val y = fresh variable
                  in
                     Exp.LETVAL (y, Exp.UNT,
                     Exp.LETVAL (x, Exp.INJ (c, y), kappa x))
                  end
            else
               let
                  val f = fresh constructor
                  val k = fresh continuation
                  val x = fresh variable
                  val y = fresh variable
mb0's avatar
mb0 committed
402
403
                  val j = fresh continuation
                  val z = fresh variable
mb0's avatar
mb0 committed
404
               in
mb0's avatar
mb0 committed
405
406
407
408
                  Exp.LETVAL
                     (f,
                      Exp.FN
                        (k,
mb0's avatar
mb0 committed
409
410
411
                         [x],
                         Exp.LETVAL (y, Exp.INJ (c, x), Exp.CC (k, [y]))),
                      kappa f) 
mb0's avatar
mb0 committed
412
               end
413
414
       | LIT l =>
            let
mb0's avatar
mb0 committed
415
               val x = fresh variable
416
417
418
419
420
            in
               Exp.LETVAL (x, transLit l, kappa x)
            end
       | ID v => kappa v
       | _ => raise CM.CompilationError
mb0's avatar
mb0 committed
421
  
mb0's avatar
mb0 committed
422
423
   and explodePat str =
      let
mb0's avatar
mb0 committed
424
425
426
427
         fun toWord str =
            case StringCvt.scanString (Word.scan StringCvt.BIN) str of
               SOME w => w
             | NONE => raise Fail ("Invalid bit-pattern: " ^ str)
mb0's avatar
mb0 committed
428
429
430
431
432
433
434
435
436
437
         val cvt = toWord o String.implode
         fun lp (s, acc) =
            case S.getc s of
               SOME (#".",s) => lp(s,#"0"::acc)@lp(s,#"1"::acc)
             | SOME (n,s) =>
                  if not (Char.isDigit n)
                     then raise Fail ("Invalid bit-pattern: " ^ str)
                  else lp(s,n::acc)
             | NONE => [cvt (rev acc)]
      in
mb0's avatar
mb0 committed
438
439
440
         if CharVector.all (fn c => c = #".") str then [] else
         case str of
            "" => []
mb0's avatar
mb0 committed
441
442
443
444
445
446
          | _ =>
               case String.tokens (fn c => c = #"|") str of
                  strs =>
                     List.concat
                        (map (fn str =>
                           lp (S.full str, [])) strs)
mb0's avatar
mb0 committed
447
448
      end

mb0's avatar
mb0 committed
449
   and transPat p k ks =
450
      let (* TODO: apply arguments to the branches *)
mb0's avatar
mb0 committed
451
          (* TODO: check size of generated patterns and bail out if to large *)
mb0's avatar
mb0 committed
452
         open Core.Pat
mb0's avatar
mb0 committed
453

mb0's avatar
mb0 committed
454
455
         fun toIdx p =
            case p of
mb0's avatar
mb0 committed
456
               BIT str => explodePat str
457
             | INT i => [Word.fromLargeInt (IntInf.toLarge i)]
mb0's avatar
mb0 committed
458
459
460
461
462
463
464
465
466
             | CON (tag, _) => [Word.fromInt (SymbolTable.toInt tag)]
             | ID _ => []
             | WILD => []

         fun bndVars p =
            case p of
               CON (_,SOME x) => SOME x
             | ID x => SOME x
             | _ => NONE
mb0's avatar
mb0 committed
467
      in
mb0's avatar
mb0 committed
468
         (bndVars p, (toIdx p, (k, []))::ks)
mb0's avatar
mb0 committed
469
470
471
472
      end

   and trans0rec (n, args, e) =
      let
mb0's avatar
mb0 committed
473
         val k = fresh continuation
mb0's avatar
mb0 committed
474
      in
475
         case args of
mb0's avatar
mb0 committed
476
477
478
479
            [] =>
               let
                  val x = fresh variable
               in
mb0's avatar
mb0 committed
480
                  (* TODO: value vs (rec) fun *)
mb0's avatar
mb0 committed
481
                  (n, k, [x], trans1 (APP (e, [ID x])) k)
mb0's avatar
mb0 committed
482
               end
mb0's avatar
mb0 committed
483
          | args => (n, k, args, trans1 e k)
mb0's avatar
mb0 committed
484
485
      end

486
487
   and trans1 e kont =
      case e of
mb0's avatar
mb0 committed
488
489
         LETVAL (v, e, body) =>
            let
mb0's avatar
mb0 committed
490
               val j = fresh continuation
mb0's avatar
mb0 committed
491
492
               val body = trans1 body kont
            in
493
               Exp.LETCONT ([(j, [v], body)], trans1 e j)
mb0's avatar
mb0 committed
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
            end
       | LETREC (ds, body) => Exp.LETREC (map trans0rec ds, trans1 body kont)
       | IF (iff, thenn, elsee) =>
            trans1
               (CASE
                  (iff,
                   [(Core.Pat.BIT "1", thenn),
                    (Core.Pat.BIT "0", elsee)]))
               kont
       | CASE (e, ps) =>
            let
               fun trans z ps cps ks =
                  case ps of
                     (p, e)::ps =>
                        let
mb0's avatar
mb0 committed
509
                           val k = fresh continuation
mb0's avatar
mb0 committed
510
511
512
513
514
                           val (x, ks) = transPat p k ks
                           fun bindTrans x =
                              case x of
                                 SOME x => Exp.LETDECON (x, z, trans1 e kont)
                               | _ => trans1 e kont
mb0's avatar
mb0 committed
515
                        in
mb0's avatar
mb0 committed
516
                           trans z ps ((k, [], bindTrans x)::cps) ks
mb0's avatar
mb0 committed
517
                        end
mb0's avatar
mb0 committed
518
519
520
521
522
523
                   | [] =>
                        case ks of
                           [([],body)] =>
                              Exp.LETCONT (cps, Exp.CC body)
                         | _ =>
                              Exp.LETCONT (cps, Exp.CASE (z, ks))
mb0's avatar
mb0 committed
524
            in
525
               trans0 e (fn z => trans z ps [] [])
mb0's avatar
mb0 committed
526
            end
mb0's avatar
mb0 committed
527
528
529
530
531
532
533
534
535
536
537
       | APP (e1, es) =>
            let
               fun trans es xs k =
                  case es of
                     e::es => trans0 e (fn x => trans es (x::xs) k)
                   | [] => k (rev xs)
            in
               trans0 e1 (fn x1 =>
                  trans es [] (fn xs =>
                     Exp.APP (x1, kont, xs)))
            end
538
539
540
541
542
543
       | PRI (f, xs) =>
            let
               val x = fresh variable
            in
               Exp.LETVAL (x, Exp.PRI (f, xs), Exp.CC (kont, [x]))
            end
mb0's avatar
mb0 committed
544
545
       | FN (x, e) =>
            let
mb0's avatar
mb0 committed
546
547
               val f = fresh function
               val j = fresh continuation
mb0's avatar
mb0 committed
548
            in
549
               Exp.LETVAL (f, Exp.FN (j, [x], trans1 e j), Exp.CC (kont, [f]))
mb0's avatar
mb0 committed
550
551
552
553
554
555
556
            end
       | RECORD fs =>
            let
               fun trans fs fvs =
                  case fs of
                     [] =>
                        let
mb0's avatar
mb0 committed
557
                           val x = fresh variable
mb0's avatar
mb0 committed
558
                        in
mb0's avatar
mb0 committed
559
                           Exp.LETVAL (x, Exp.REC fvs, Exp.CC (kont, [x]))
mb0's avatar
mb0 committed
560
561
562
563
564
565
566
567
568
                        end
                   | (f, e)::fs =>
                        trans0 e (fn z =>
                           trans fs ((f, z)::fvs))
            in
               trans fs []
            end
       | UPDATE fs => 
            let
mb0's avatar
mb0 committed
569
570
571
572
573
               val f = fresh function
               val k = fresh continuation
               val x = fresh variable
               val z = fresh variable
               fun trans y fs fvs =
mb0's avatar
mb0 committed
574
575
576
                  case fs of
                     [] =>
                        let
mb0's avatar
mb0 committed
577
                           val x = fresh variable
mb0's avatar
mb0 committed
578
                        in
mb0's avatar
mb0 committed
579
                           Exp.LETUPD (x, y, fvs, Exp.CC (kont, [x]))
mb0's avatar
mb0 committed
580
581
582
                        end
                   | (f, e)::fs =>
                        trans0 e (fn z =>
mb0's avatar
mb0 committed
583
                           trans y fs ((f, z)::fvs))
mb0's avatar
mb0 committed
584
            in
mb0's avatar
mb0 committed
585
586
               Exp.LETVAL
                  (f,
mb0's avatar
mb0 committed
587
588
                   Exp.FN (k, [x], trans x fs []),
                   Exp.CC (kont, [f]))
mb0's avatar
mb0 committed
589
590
591
            end
       | SELECT fld =>
            let
mb0's avatar
mb0 committed
592
593
594
595
               val f = fresh function
               val k = fresh continuation
               val x = fresh variable
               val z = fresh variable
mb0's avatar
mb0 committed
596
            in
mb0's avatar
mb0 committed
597
598
               Exp.LETVAL
                  (f,
mb0's avatar
mb0 committed
599
600
                   Exp.FN (k, [x], Exp.LETPRJ (z, fld, x, Exp.CC (k, [z]))),
                   Exp.CC (kont, [f]))
mb0's avatar
mb0 committed
601
602
            end
       | CON c =>
mb0's avatar
mb0 committed
603
604
605
606
607
608
609
            if isEnumLike c
               then
                  let
                     val x = fresh variable
                     val y = fresh variable
                  in
                     Exp.LETVAL (y, Exp.UNT,
mb0's avatar
mb0 committed
610
                     Exp.LETVAL (x, Exp.INJ (c, y), Exp.CC (kont, [x])))
mb0's avatar
mb0 committed
611
612
613
614
615
616
617
618
619
620
621
622
                  end
            else
               let
                  val f = fresh constructor
                  val k = fresh continuation
                  val x = fresh variable
                  val y = fresh variable
               in
                  Exp.LETVAL
                     (f,
                      Exp.FN
                        (k,
mb0's avatar
mb0 committed
623
                         [x],
mb0's avatar
mb0 committed
624
                         Exp.LETVAL
mb0's avatar
mb0 committed
625
626
                           (y, Exp.INJ (c, x), Exp.CC (k, [y]))),
                      Exp.CC (kont, [f]))
mb0's avatar
mb0 committed
627
               end
mb0's avatar
mb0 committed
628
629
       | LIT l =>
            let
mb0's avatar
mb0 committed
630
               val x = fresh variable
mb0's avatar
mb0 committed
631
            in
mb0's avatar
mb0 committed
632
               Exp.LETVAL (x, transLit l, Exp.CC (kont, [x]))
mb0's avatar
mb0 committed
633
            end
mb0's avatar
mb0 committed
634
       | ID x => Exp.CC (kont, [x])
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
       | _ => raise CM.CompilationError

   and transLit l =
      case l of
         Core.Lit.INTlit i => Exp.INT i
       | Core.Lit.FLTlit f => Exp.FLT f
       | Core.Lit.VEClit v => Exp.VEC v 
       | Core.Lit.STRlit s => Exp.STR s

   end (* end local *)

   fun dumpPre (os, spec) = Pretty.prettyTo (os, Core.PP.spec spec)
   fun dumpPost (os, spec) = Pretty.prettyTo (os, CPS.PP.spec spec)

   val translate =
      BasicControl.mkKeepPass
mb0's avatar
mb0 committed
651
         {passName="cpsConversion",
652
653
          registry=CPSControl.registry,
          pass=translate,
mb0's avatar
mb0 committed
654
          preExt="core",
655
          preOutput=dumpPre,
mb0's avatar
mb0 committed
656
          postExt="cps",
657
658
659
660
          postOutput=dumpPost}

   fun run spec = CM.return (translate spec)
end