blob: 0aead272554085f0c19cdb9282f93da436ddfe65 (
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
|
(import (scheme base)
(only (csc hash-map)
map->alist)
(only (csc ir1)
make-constant
make-define-syntax
make-if
make-lexical-ref
make-lexical-set
make-library-ref)
(only (csc ir2)
ir2=?
make-atom
make-branch
make-kargs
make-ktail
make-update)
(only (csc loop)
loop
return)
(only (csc sort) sort)
(only (csc testing)
assert-equal
test)
(csc cps))
(define (soup->alist s)
(sort (lambda (x y) (< (car x) (car y))) (map->alist s)))
(define (soup=? x y)
(and (= (length x) (length y))
(loop for x* in x
for y* in y
unless (and (= (car x*) (car y*))
(ir2=? (cdr x*) (cdr y*)))
return #f
finally (return #t))))
(test atom-const
(assert-equal soup=?
(list
(cons 0 (make-kargs '()
(make-atom (make-constant 5) 1)))
(cons 1 (make-ktail)))
(soup->alist (ir1->ir2 (make-constant 5)))))
(test atom-lexical-ref
(assert-equal soup=?
(list
(cons 0 (make-kargs '()
(make-atom (make-lexical-ref 'var #f) 1)))
(cons 1 (make-ktail)))
(soup->alist (ir1->ir2 (make-lexical-ref 'var #f)))))
(test atom-library-ref
(assert-equal soup=?
(list
(cons 0 (make-kargs '()
(make-atom (make-library-ref 'var '(csc builtins)) 1)))
(cons 1 (make-ktail)))
(soup->alist (ir1->ir2 (make-library-ref 'var '(csc builtins))))))
(test lexical-set
(assert-equal soup=?
(list
(cons 0 (make-kargs '()
(make-atom (make-constant 5) 2)))
(cons 1 (make-ktail))
(cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
(make-update (make-lexical-ref 'var #f)
(make-lexical-ref 'generated-symbol #f) 1))))
(soup->alist (ir1->ir2 (make-lexical-set (make-lexical-ref 'var #f) (make-constant 5))))))
(test no-op-define-syntax
(assert-equal soup=?
(list
(cons 0 (make-kargs '() (make-atom (make-constant #f) 1)))
(cons 1 (make-ktail)))
(soup->alist (ir1->ir2 (make-define-syntax 'name '(transformer))))))
(test branch
(assert-equal soup=?
(list
(cons 0 (make-kargs '() (make-atom (make-constant #t) 2)))
(cons 1 (make-ktail))
(cons 2 (make-kargs (list (make-lexical-ref 'generated-symbol #f))
(make-branch (make-lexical-ref 'generated-symbol #f)
3 4)))
(cons 3 (make-kargs '() (make-atom (make-constant 1) 1)))
(cons 4 (make-kargs '() (make-atom (make-constant 2) 1))))
(soup->alist (ir1->ir2 (make-if (make-constant #t)
(make-constant 1)
(make-constant 2))))))
|
