blob: e60e198c106ec3c279edd26f4c94a4fd96b09f98 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
(define-library (csc cps)
(export
ir1->ir2)
(import (only (csc gensym) gensym)
(only (csc hash-map)
alist->map
insert
merge)
(only (csc ir1)
constant?
define-syntax?
if-alternate
if-consequent
if-test
if?
lexical-ref?
lexical-set-expression
lexical-set-ref
lexical-set?
library-define-expression
library-define-ref
library-define?
library-ref?
make-constant
make-lexical-ref)
(only (csc ir2)
make-atom
make-branch
make-kargs
make-ktail
make-update)
(scheme base))
(begin
(define (make-soup . l)
(alist->map (lambda (x) x) < l))
(define (new-ref)
(make-lexical-ref 'generated-symbol (gensym)))
(define-syntax cps-merge
(syntax-rules ()
((cps-merge new-continuations sub-cps)
(let-values (((expr soup) sub-cps))
(values expr (merge soup new-continuations))))))
(define (to-cps expr continuation next-id)
(cond
((or (constant? expr)
(lexical-ref? expr)
(library-ref? expr))
(values (make-atom expr continuation) (make-soup)))
((lexical-set? expr)
(let ((id (next-id))
(ref (new-ref)))
(cps-merge
(make-soup (cons id (make-kargs (list ref)
(make-update (lexical-set-ref expr) ref continuation))))
(to-cps (lexical-set-expression expr) id next-id))))
((library-define? expr)
(let ((id (next-id))
(ref (new-ref)))
(cps-merge
(make-soup (cons id (make-kargs (list ref)
(make-update (library-define-ref expr) ref continuation))))
(to-cps (library-define-expression expr) id next-id))))
((define-syntax? expr)
; no-op
(values (make-atom (make-constant #f) continuation) (make-soup)))
((if? expr)
(let-values (((id) (next-id))
((test-ref) (new-ref))
((true-id) (next-id))
((false-id) (next-id))
((true-expr true-soup) (to-cps (if-consequent expr) continuation next-id))
((false-expr false-soup) (to-cps (if-alternate expr) continuation next-id)))
(cps-merge
(merge true-soup false-soup
(make-soup (cons id (make-kargs (list test-ref)
(make-branch test-ref true-id false-id)))
(cons true-id (make-kargs '() true-expr))
(cons false-id (make-kargs '() false-expr))))
(to-cps (if-test expr) id next-id))))
(else (error "unexpected type in to-cps" expr))))
; Returns a map from integers to CPS continuations.
; By convention the continuation at key 0 is the entrypoint.
(define (ir1->ir2 program)
(define current-continuation-id 0)
(define (next-id)
(set! current-continuation-id (+ 1 current-continuation-id))
current-continuation-id)
(define ktail (next-id))
(define-values (expr m) (to-cps program ktail next-id))
(set! m (insert m ktail (make-ktail)))
(set! m (insert m 0 (make-kargs '() expr)))
m)))
|
