-
Notifications
You must be signed in to change notification settings - Fork 3
/
compiler.rkt
134 lines (112 loc) · 5.13 KB
/
compiler.rkt
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
132
133
134
#lang at-exp racket
(provide compile-file)
(define (compile-file filename)
(let* ([i (open-input-file filename)]
[f (string-replace filename "rkt" "wat")]
[o (open-output-file f #:exists 'replace)])
(let-values ([(c env) (compile (read i) (list))])
(write-string c o))))
(define (compile d env)
(match d
[`,(? number?) (compile-number d env)]
[`,(? symbol?) (compile-symbol d env)]
[`(+ ,l ,r) (compile-add l r env)]
[`(- ,l ,r) (compile-minus l r env)]
[`(* ,l ,r) (compile-multiply l r env)]
[`(/ ,l ,r) (compile-divide l r env)]
[`(= ,l ,r) (compile-equal l r env)]
[`(!= ,l ,r) (compile-unequal l r env)]
[`(> ,l ,r) (compile-greater l r env)]
[`(>= ,l ,r) (compile-greater-equal l r env)]
[`(< ,l ,r) (compile-less l r env)]
[`(<= ,l ,r) (compile-less-equal l r env)]
[`(define- (,name ,params ...) ,body ...) (compile-define- name params body env)]
[`(define+ (,name ,params ...) ,body ...) (compile-define+ name params body env)]
[`(let [,name ,exp] ,body ...) (compile-let name exp body env)]
[`(if ,cond ,exp1 ,exp2) (compile-if-then-else cond exp1 exp2 env)]
[`(module ,body ...) (compile-module body env)]
[`(,name ,params ...) (compile-call name params env)]))
(define (compile* exps env)
(letrec ([compile* (lambda (exps env result)
(if (empty? exps)
(values result env)
(let-values ([(exp env) (compile (first exps) env)])
(compile* (rest exps) env (append result (list exp))))))])
(compile* exps env '())))
(define (compile-number n env)
(values @~a{(i32.const @n)} env))
(define (compile-symbol s env)
(values @~a{(get_local $@s)} env))
(define (compile-add l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.add @l @r)} env)))
(define (compile-minus l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.sub @l @r)} env)))
(define (compile-multiply l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.mul @l @r)} env)))
(define (compile-divide l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.div @l @r)} env)))
(define (compile-equal l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.eq @l @r)} env)))
(define (compile-unequal l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.ne @l @r)} env)))
(define (compile-greater l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.gt_s @l @r)} env)))
(define (compile-greater-equal l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.ge_s @l @r)}) env))
(define (compile-less l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.lt_s @l @r)} env)))
(define (compile-less-equal l r env)
(let*-values ([(l env) (compile l env)]
[(r env) (compile r env)])
(values @~a{(i32.le_s @l @r)} env)))
(define (compile-let name exp body env)
(let*-values ([(exp env) (compile exp env)]
[(body env) (compile* body env)]
[(body) (string-join body)]
[(env) (cons name env)])
(values @~a{(block (result i32) (set_local $@name @exp) @body)} env)))
(define (compile-define- name params body env)
(let*-values ([(body env) (compile* body env)]
[(body) (string-join body)]
[(params) (string-join (map (lambda (param) @~a{(param $@param i32)}) params))]
[(locals) (string-join (map (lambda (name) @~a{(local $@name i32)}) env))])
(values @~a{(func $@name @params (result i32) @locals (return @body))} env)))
(define (compile-define+ name params body env)
(let*-values ([(body env) (compile* body env)]
[(body) (string-join body)]
[(params) (string-join (map (lambda (param) @~a{(param $@param i32)}) params))]
[(locals) (string-join (map (lambda (name) @~a{(local $@name i32)}) env))])
(values @~a{(func $@name @params (result i32) @locals (return @body)) (export "@name" (func $@name))} env)))
(define (compile-if-then-else cond exp1 exp2 env)
(let*-values ([(cond env) (compile cond env)]
[(exp1 env) (compile exp1 env)]
[(exp2 env) (compile exp2 env)])
(values @~a{(if (result i32) @cond (then @exp1) (else @exp2))} env)))
(define (compile-param name env)
(values @~a{(param $@name i32)} env))
(define (compile-module body env)
(let*-values ([(body env) (compile* body env)]
[(body) (string-join body)])
(values @~a{(module @body)} env)))
(define (compile-call name params env)
(let*-values ([(params env) (compile* params env)]
[(params) (string-join params)])
(values @~a{(call $@name @params)} env)))