blob: 94c1d325d881a3e81fae93c470e235b69504c5eb (
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(define-library (csc ir)
(export
*void*
apply-args
apply-func
apply?
call-builtin-args
call-builtin-name
call-builtin?
const-val
const?
label-var
label?
lambda-body
lambda-vars
lambda?
letrec-body
letrec-funcs
letrec?
libvar-lib
libvar-var
libvar?
make-apply
make-call-builtin
make-const
make-label
make-lambda
make-letrec
make-libvar
make-primop
make-sequence
make-set
primop-args
primop-ks
primop-name
primop-vals
primop?
sequence-head
sequence-tail
sequence?
set-body
set-var
set?
void?)
(import (scheme base))
(begin
(define-record-type <libvar>
(make-libvar library var)
libvar?
(library libvar-lib)
(var libvar-var))
;; ---------- IR1
(define-record-type <lambda>
(make-lambda vars body)
lambda?
(vars lambda-vars)
(body lambda-body))
(define-record-type <letrec>
(make-letrec funcs body)
letrec?
(funcs letrec-funcs)
(body letrec-body))
(define-record-type <apply>
(make-apply func args)
apply?
(func apply-func)
(args apply-args))
(define-record-type <sequence>
(make-sequence head tail)
sequence?
(head sequence-head)
(tail sequence-tail))
(define-record-type <set>
(make-set var body)
set?
(var set-var)
(body set-body))
(define-record-type <call-builtin>
(make-call-builtin name args)
call-builtin?
(name call-builtin-name)
(args call-builtin-args))
(define-record-type <const>
(make-const val)
const?
(val const-val))
(define-record-type <void>
(make-void)
void?)
(define *void* (make-void))
;; ------------- CPS
; <apply>, <letrec>, <const>, and <void> are also IR2 forms.
(define-record-type <label>
(make-label var)
label?
(var label-var))
(define-record-type <primop>
(make-primop name arguments values continuations)
primop?
(name primop-name)
(arguments primop-args)
(values primop-vals)
(continuations primop-ks))))
|
