Skip to content

Commit c2cc34e

Browse files
dvanhorndvanhorn
committed
Substantial progress on Outlaw compiler self-hosting.
1 parent 6c9b2bd commit c2cc34e

15 files changed

Lines changed: 1886 additions & 82 deletions

‎langs/outlaw/Makefile‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ objs = \
1414
symbol.o \
1515
string.o \
1616
io.o \
17+
error.o \
1718
stdlib.o
1819

1920
default: runtime.o

‎langs/outlaw/ast.rkt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
;; | (Prim Op (Listof Expr))
1616
;; | (If Expr Expr Expr)
1717
;; | (Begin Expr Expr)
18-
;; | (Let Id Expr Expr)
18+
;; | (Let (Listof Id) (Listof Expr) Expr)
1919
;; | (Var Id)
2020
;; | (Match Expr (Listof Pat) (Listof Expr))
2121
;; | (App Expr (Listof Expr))
@@ -72,7 +72,7 @@
7272
(struct Prim (p es) #:prefab)
7373
(struct If (e1 e2 e3) #:prefab)
7474
(struct Begin (e1 e2) #:prefab)
75-
(struct Let (x e1 e2) #:prefab)
75+
(struct Let (xs es e) #:prefab)
7676
(struct Var (x) #:prefab)
7777
(struct App (e es) #:prefab)
7878
(struct Lam (f xs e) #:prefab)

‎langs/outlaw/compile-expr.rkt‎

Lines changed: 28 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@
2424
[(Prim p es) (compile-prim p es c g)]
2525
[(If e1 e2 e3) (compile-if e1 e2 e3 c g t?)]
2626
[(Begin e1 e2) (compile-begin e1 e2 c g t?)]
27-
[(Let x e1 e2) (compile-let x e1 e2 c g t?)]
27+
[(Let xs es e) (compile-let xs es e c g t?)]
2828
[(App e es) (compile-app e es c g t?)]
2929
[(Apply e es el) (compile-apply e es el c g t?)]
3030
[(Lam _ _ _) (compile-lam e c g)]
@@ -37,7 +37,7 @@
3737
(match (lookup x c)
3838
[#f (if (memq x g)
3939
(seq (Mov rax (Offset (symbol->label x) 0)))
40-
(error "unbound variable"))]
40+
(error "unbound variable" x))]
4141
[i (seq (Mov rax (Offset rsp i)))]))
4242

4343
;; Op (Listof Expr) CEnv GEnv -> Asm
@@ -65,12 +65,11 @@
6565
(seq (compile-e e1 c g #f)
6666
(compile-e e2 c g t?)))
6767

68-
;; Id Expr Expr CEnv GEnv Bool -> Asm
69-
(define (compile-let x e1 e2 c g t?)
70-
(seq (compile-e e1 c g #f)
71-
(Push rax)
72-
(compile-e e2 (cons x c) g t?)
73-
(Add rsp 8)))
68+
;; [Listof Id] [Listof Expr] Expr CEnv GEnv Bool -> Asm
69+
(define (compile-let xs es e c g t?)
70+
(seq (compile-es es c g)
71+
(compile-e e (append (reverse xs) c) g t?)
72+
(Add rsp (*8 (length xs)))))
7473

7574
;; Id [Listof Expr] CEnv GEnv Bool -> Asm
7675
(define (compile-app f es c g t?)
@@ -84,8 +83,8 @@
8483
(define (compile-app-tail e es c g)
8584
(seq (compile-es (cons e es) c g)
8685
(move-args (add1 (length es)) (length c))
87-
(Add rsp (* 8 (length c)))
88-
(Mov rax (Offset rsp (* 8 (length es))))
86+
(Add rsp (*8 (length c)))
87+
(Mov rax (Offset rsp (*8 (length es))))
8988
(assert-proc rax)
9089
(Xor rax type-proc)
9190
(Mov rax (Offset rax 0))
@@ -96,16 +95,16 @@
9695
(cond [(zero? off) (seq)]
9796
[(zero? i) (seq)]
9897
[else
99-
(seq (Mov r8 (Offset rsp (* 8 (sub1 i))))
100-
(Mov (Offset rsp (* 8 (+ off (sub1 i)))) r8)
98+
(seq (Mov r8 (Offset rsp (*8 (sub1 i))))
99+
(Mov (Offset rsp (*8 (+ off (sub1 i)))) r8)
101100
(move-args (sub1 i) off))]))
102101

103102
;; Expr [Listof Expr] CEnv GEnv -> Asm
104103
;; The return address is placed above the arguments, so callee pops
105104
;; arguments and return address is next frame
106105
(define (compile-app-nontail e es c g)
107106
(let ((r (gensym 'ret))
108-
(i (* 8 (length es))))
107+
(i (*8 (length es))))
109108
(seq (Lea rax r)
110109
(Push rax)
111110
(compile-es (cons e es) (cons #f c) g)
@@ -126,7 +125,7 @@
126125
(compile-es (cons e es) (cons #f c) g)
127126
(compile-e el (append (make-list (add1 (length es)) #f) (cons #f c)) g #f)
128127

129-
(Mov r10 (Offset rsp (* 8 (length es))))
128+
(Mov r10 (Offset rsp (*8 (length es))))
130129

131130
(Mov r15 (length es))
132131
(let ((loop (gensym))
@@ -159,7 +158,7 @@
159158
(free-vars-to-heap fvs c 8)
160159
(Mov rax rbx) ; return value
161160
(Or rax type-proc)
162-
(Add rbx (* 8 (add1 (length fvs)))))))
161+
(Add rbx (*8 (add1 (length fvs)))))))
163162

164163
;; Lambda -> Id
165164
(define (lambda-name l)
@@ -224,9 +223,9 @@
224223

225224
;; [Listof Pat] [Listof Expr] CEnv GEnv Symbol Bool -> Asm
226225
(define (compile-match-clauses ps es c g done t?)
227-
(match* (ps es)
228-
[('() '()) (seq)]
229-
[((cons p ps) (cons e es))
226+
(match (cons ps es)
227+
[(cons '() '()) (seq)]
228+
[(cons (cons p ps) (cons e es))
230229
(seq (compile-match-clause p e c g done t?)
231230
(compile-match-clauses ps es c g done t?))]))
232231

@@ -238,7 +237,7 @@
238237
(seq (Mov rax (Offset rsp 0)) ; restore value being matched
239238
i
240239
(compile-e e (append cm c) g t?)
241-
(Add rsp (* 8 (length cm)))
240+
(Add rsp (*8 (length cm)))
242241
(Jmp done)
243242
f
244243
(Label next))])))
@@ -267,7 +266,7 @@
267266
(Cmp rax 0)
268267
(Jne fail))
269268
(seq (Label fail)
270-
(Add rsp (* 8 (length cm)))
269+
(Add rsp (*8 (length cm)))
271270
(Jmp next))
272271
cm))]
273272
[(PSymb s)
@@ -276,15 +275,15 @@
276275
(Cmp rax r9)
277276
(Jne fail))
278277
(seq (Label fail)
279-
(Add rsp (* 8 (length cm)))
278+
(Add rsp (*8 (length cm)))
280279
(Jmp next))
281280
cm))]
282281
[(PLit l)
283282
(let ((fail (gensym)))
284283
(list (seq (Cmp rax (imm->bits l))
285284
(Jne fail))
286285
(seq (Label fail)
287-
(Add rsp (* 8 (length cm)))
286+
(Add rsp (*8 (length cm)))
288287
(Jmp next))
289288
cm))]
290289
[(PAnd p1 p2)
@@ -295,7 +294,7 @@
295294
(list
296295
(seq (Push rax)
297296
i1
298-
(Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
297+
(Mov rax (Offset rsp (*8 (- (sub1 (length cm1)) (length cm)))))
299298
i2)
300299
(seq f1 f2)
301300
cm2)])])]
@@ -313,7 +312,7 @@
313312
i1)
314313
(seq f1
315314
(Label fail)
316-
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
315+
(Add rsp (*8 (length cm))) ; haven't pushed anything yet
317316
(Jmp next))
318317
cm1))])]
319318
[(PCons p1 p2)
@@ -332,12 +331,12 @@
332331
(Push r8) ; push cdr
333332
(Mov rax (Offset rax 8)) ; mov rax car
334333
i1
335-
(Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
334+
(Mov rax (Offset rsp (*8 (- (sub1 (length cm1)) (length cm)))))
336335
i2)
337336
(seq f1
338337
f2
339338
(Label fail)
340-
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
339+
(Add rsp (*8 (length cm))) ; haven't pushed anything yet
341340
(Jmp next))
342341
cm2))])])]
343342
[(PStruct n ps)
@@ -358,7 +357,7 @@
358357
i)
359358
(seq f
360359
(Label fail)
361-
(Add rsp (* 8 (length cm)))
360+
(Add rsp (*8 (length cm)))
362361
(Jmp next))
363362
cm))])]))
364363

@@ -372,9 +371,9 @@
372371
(match (compile-struct-patterns ps cm1 next (add1 i))
373372
[(list is fs cmn)
374373
(list
375-
(seq (Mov rax (Offset rax (* 8 i)))
374+
(seq (Mov rax (Offset rax (*8 i)))
376375
i1
377-
(Mov rax (Offset rsp (* 8 (sub1 (length cm1)))))
376+
(Mov rax (Offset rsp (*8 (sub1 (length cm1)))))
378377
is)
379378
(seq f1 fs)
380379
cmn)])])]))

‎langs/outlaw/compile-literals.rkt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -71,8 +71,8 @@
7171
(append (literals-e e1) (literals-e e2) (literals-e e3))]
7272
[(Begin e1 e2)
7373
(append (literals-e e1) (literals-e e2))]
74-
[(Let x e1 e2)
75-
(append (literals-e e1) (literals-e e2))]
74+
[(Let xs es e)
75+
(append (append-map literals-e es) (literals-e e))]
7676
[(App e1 es)
7777
(append (literals-e e1) (append-map literals-e es))]
7878
[(Lam f xs e)

‎langs/outlaw/compile-ops.rkt‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -139,6 +139,15 @@
139139
pad-stack
140140
(Call 'read_byte_port)
141141
unpad-stack)]
142+
['error
143+
(seq (assert-string rax)
144+
(Mov rdi rax)
145+
pad-stack
146+
(Call 'raise_error))]
147+
['integer?
148+
(type-pred mask-int type-int)]
149+
['eq-hash-code
150+
(seq (Sal rax int-shift))]
142151

143152
;; Op2
144153
['+
@@ -363,6 +372,17 @@
363372
(assert-integer r8)
364373
(assert-integer rax)
365374
(And rax r8))]
375+
['bitwise-ior
376+
(seq (Pop r8)
377+
(assert-integer r8)
378+
(assert-integer rax)
379+
(Or rax r8))]
380+
['bitwise-xor
381+
(seq (Pop r8)
382+
(assert-integer r8)
383+
(assert-integer rax)
384+
(Xor rax r8)
385+
(Or rax type-int))]
366386
['arithmetic-shift
367387
(seq (Pop r8)
368388
(assert-integer r8)

‎langs/outlaw/compile.rkt‎

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@
3636
(Global 'raise_error_align)
3737
(Label 'raise_error_align)
3838
pad-stack
39+
(Mov rdi 0) ; null arg
3940
(Call 'raise_error)
4041

4142
;; one way to make `cons' a function instead of a primitive
@@ -53,25 +54,32 @@
5354
(Label r))))
5455

5556
(define stdlib-ids
56-
'(list map length append memq append-map vector->list
57+
'(list make-list list? foldr map length append
58+
memq member append-map vector->list
59+
reverse
5760
number->string gensym read read-char
5861
> <= >=
62+
void?
63+
list->string string->list
64+
char<=?
65+
remove-duplicates remq* remove* remove
5966
;; Op0
6067
read-byte peek-byte void
6168
;; Op1
6269
add1 sub1 zero? char? write-byte eof-object?
6370
integer->char char->integer
64-
box unbox empty? cons? box? car cdr
71+
box unbox box? empty? cons? car cdr
6572
vector? vector-length string? string-length
6673
symbol->string string->symbol symbol?
6774
string->uninterned-symbol
6875
open-input-file
69-
write-char
76+
write-char error integer?
77+
eq-hash-code
7078
;; Op2
7179
+ - < = cons eq? make-vector vector-ref
7280
make-string string-ref string-append
7381
quotient remainder set-box!
74-
bitwise-and arithmetic-shift
82+
bitwise-and bitwise-ior bitwise-xor arithmetic-shift
7583
;; Op3
7684
vector-set!))
7785

‎langs/outlaw/fv.rkt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@
1717
[(Prim p es) (append-map fv* es)]
1818
[(If e1 e2 e3) (append (fv* e1) (fv* e2) (fv* e3))]
1919
[(Begin e1 e2) (append (fv* e1) (fv* e2))]
20-
[(Let x e1 e2) (append (fv* e1) (remq* (list x) (fv* e2)))]
20+
[(Let xs es e) (append (append-map fv* es) (remq* xs (fv* e)))]
2121
[(App e1 es) (append (fv* e1) (append-map fv* es))]
2222
[(Lam f xs e) (remq* xs (fv* e))]
2323
[(LamRest f xs x e) (remq* (cons x xs) (fv* e))]

‎langs/outlaw/lambdas.rkt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@
2525
[(Prim p es) (append-map lambdas-e es)]
2626
[(If e1 e2 e3) (append (lambdas-e e1) (lambdas-e e2) (lambdas-e e3))]
2727
[(Begin e1 e2) (append (lambdas-e e1) (lambdas-e e2))]
28-
[(Let x e1 e2) (append (lambdas-e e1) (lambdas-e e2))]
28+
[(Let xs es e) (append (append-map lambdas-e es) (lambdas-e e))]
2929
[(App e1 es) (append (lambdas-e e1) (append-map lambdas-e es))]
3030
[(Lam f xs e1) (cons e (lambdas-e e1))]
3131
[(LamRest f xs x e1) (cons e (lambdas-e e1))]

‎langs/outlaw/main.c‎

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -6,18 +6,22 @@
66

77
FILE* in;
88
FILE* out;
9-
void (*error_handler)();
9+
void (*error_handler)(val_str_t* msg);
1010
val_t *heap;
1111

12-
void error_exit()
12+
void error_exit(val_str_t* msg)
1313
{
14-
printf("err\n");
14+
if (msg) {
15+
print_str(msg);
16+
} else {
17+
printf("err\n");
18+
}
1519
exit(1);
1620
}
1721

18-
void raise_error()
22+
void raise_error(val_str_t* msg)
1923
{
20-
return error_handler();
24+
return error_handler(msg);
2125
}
2226

2327
int main(int argc, char** argv)

0 commit comments

Comments
 (0)