Skip to content

Commit

Permalink
revert to the (old) trampoline way, abandon tail_call_reg (#22)
Browse files Browse the repository at this point in the history
This is a long detour, I decide to go back to the simpler VM + top-of-stack-caching codegen way
  • Loading branch information
tiancaiamao authored Jan 23, 2024
1 parent 15dca24 commit 98a550f
Show file tree
Hide file tree
Showing 14 changed files with 919 additions and 928 deletions.
2 changes: 1 addition & 1 deletion compile.bc

Large diffs are not rendered by default.

1 change: 1 addition & 0 deletions compile.bc1

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion init.bc

Large diffs are not rendered by default.

1 change: 1 addition & 0 deletions init.bc1

Large diffs are not rendered by default.

84 changes: 6 additions & 78 deletions lib/compile.cora
Original file line number Diff line number Diff line change
Expand Up @@ -39,9 +39,9 @@
[['set . 2] ['car . 1] ['cdr . 1] ['cons . 2] ['cons? . 1] ['+ . 2] ['- . 2] ['* . 2] ['/ . 2]
['= . 2] ['> . 2] ['< . 2] ['gensym . 1] ['symbol? . 1] ['not . 1] ['integer? . 1] ['string? . 1]])

(func temp-list
(func .temp-list
0 res => res
n res => (temp-list (- n 1) (cons (gensym 'tmp) res)))
n res => (.temp-list (- n 1) (cons (gensym 'tmp) res)))

;; TODO: optimize the func macro to make the generate code small enough!
;; (func .closure-convert
Expand Down Expand Up @@ -69,7 +69,7 @@
;; (< (length args) (cdr find)))
;; ;; rewrite partial apply of primitives
;; ;; (+ x) => (lambda (tmp) (+ x tmp))
;; (let tmp (temp-list (- (cdr find) (length args)) ())
;; (let tmp (.temp-list (- (cdr find) (length args)) ())
;; (.closure-convert ['lambda tmp (append [f . args] tmp)] locals env frees nlets))
;; (.closure-convert-list [f . args] locals env frees nlets ()))) where (symbol? f)
;; [f . args] locals env frees nlets => (.closure-convert-list [f . args] locals env frees nlets ()))
Expand Down Expand Up @@ -106,7 +106,7 @@
(< (length args) (cdr find)))
;; rewrite partial apply of primitives
;; (+ x) => (lambda (tmp) (+ x tmp))
(let tmp (temp-list (- (cdr find) (length args)) ())
(let tmp (.temp-list (- (cdr find) (length args)) ())
(.closure-convert ['lambda tmp (append [f . args] tmp)] locals env frees nlets))
(.closure-convert-list [f . args] locals env frees nlets ())))))
(true (let f (car exp)
Expand Down Expand Up @@ -157,7 +157,7 @@
((= 'do (car exp)) (let x (cadr exp)
y (caddr exp)
(.compile x locals frees
(.compile y locals frees next))))
(cons ['pop] (.compile y locals frees next)))))
((= 'let (car exp)) (let var (cadr exp)
val (caddr exp)
exp (cadddr exp)
Expand All @@ -180,7 +180,7 @@
(func .compile-list
[] locals frees next => next
[hd . tl] locals frees next => (.compile hd locals frees
(cons ['push] (.compile-list tl locals frees next))))
(.compile-list tl locals frees next)))

(defun .cc (exp)
(match (.closure-convert exp () () () 0)
Expand All @@ -190,75 +190,3 @@
res
(cons ['reserve-locals nlets] res)))))

(defun .bytecode-to-exec (bc)
(let p (.c-make-program)
(begin
(.to-exec-many bc p)
p)))

(func for-each
fn [] => []
fn [x . y] => (begin
(fn x)
(for-each fn y)))

(defun .to-exec-many (bc p)
(for-each (lambda (x) (.to-exec x p)) bc))

;; (defun .c-prog-append-prim (p x)
;; (cond
;; ((= x '=) (.c-prog-append-op p .c-opPrimEQ))
;; ((= x 'set) (.c-prog-append-op p .c-opPrimSet))
;; ((= x '+) (.c-prog-append-op p .c-opPrimAdd))
;; ((= x '-) (.c-prog-append-op p .c-opPrimSub))
;; ((= x '*) (.c-prog-append-op p .c-opPrimMul))
;; ((= x '<) (.c-prog-append-op p .c-opPrimLT))
;; ((= x '>) (.c-prog-append-op p .c-opPrimGT))
;; ((= x 'car) (.c-prog-append-op p .c-opPrimCar))
;; ((= x 'cdr) (.c-prog-append-op p .c-opPrimCdr))
;; ((= x 'cons) (.c-prog-append-op p .c-opPrimCons))
;; ((= x 'not) (.c-prog-append-op p .c-opPrimNot))
;; ((= x 'cons?) (.c-prog-append-op p .c-opPrimIsCons))
;; ((= x 'gensym) (.c-prog-append-op p .c-opPrimGenSym))
;; ((= x 'integer?) (.c-prog-append-op p .c-opPrimIsInteger))
;; ((= x 'symbol?) (.c-prog-append-op p .c-opPrimIsSymbol))
;; ((= x 'string?) (.c-prog-append-op p .c-opPrimIsString))))

(func .to-exec
['const x] p => (begin (.c-prog-append-op p .c-opConst)
(.c-prog-append-obj p x))
['local-ref idx] p => (begin
(.c-prog-append-op p .c-opLocalRef)
(.c-prog-append-int32 p idx))
['closure-ref idx] p => (begin
(.c-prog-append-op p .c-opClosureRef)
(.c-prog-append-int32 p idx))
['global-ref obj] p => (begin
(.c-prog-append-op p .c-opGlobalRef)
(.c-prog-append-obj p obj))
['if succ fail] p => (begin (.c-prog-append-op p .c-opIf)
(let pos (.c-prog-prepare-size p)
(begin
(.to-exec-many succ p)
(.c-prog-write-back-size p pos)
(.to-exec-many fail p))))
['make-closure required nfrees code] p => (begin (.c-prog-append-op p .c-opMakeClosure)
(.c-prog-append-int32 p required)
(.c-prog-append-int32 p nfrees)
(let pos (.c-prog-prepare-size p)
(begin(.to-exec-many code p)
(.c-prog-write-back-size p pos))))
['tailcall n] p => (begin (.c-prog-append-op p .c-opTailCall)
(.c-prog-append-int32 p n))
['call n] p => (begin (.c-prog-append-op p .c-opCall)
(.c-prog-append-int32 p n))
['push] p => (.c-prog-append-op p .c-opPush)
['exit] p => (.c-prog-append-op p .c-opExit)
['reserve-locals n] p => (begin (.c-prog-append-op p .c-opReserveLocals)
(.c-prog-append-int32 p n))
['local-set idx] p => (begin (.c-prog-append-op p .c-opLocalSet)
(.c-prog-append-int32 p idx))
['primitive x] p => (.c-prog-append-prim p x))

(defun .eval (exp)
(.c-prog-run (.bytecode-to-exec (.cc exp))))
64 changes: 32 additions & 32 deletions main.c
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
#include "builtin.h"

static void
repl(struct VM *vm, int pos, FILE* stream) {
repl(struct VM *vm, FILE* stream) {
struct SexpReader r = {.pkgMapping = Nil};
int errCode = 0;

Expand All @@ -17,21 +17,22 @@ repl(struct VM *vm, int pos, FILE* stream) {
printf("%d #> ", i);
}

Obj exp = sexpRead(vm, pos, &r, stream, &errCode);
Obj exp = sexpRead(vm, 0, &r, stream, &errCode);
if (errCode != 0) {
break;
}

/* printf("before macro expand =="); */
/* printf("before macro expand ==%d", vmPos(vm)); */
/* sexpWrite(stdout, exp); */
/* printf("\n"); */

exp = macroExpand(vm, pos, exp);
exp = macroExpand(vm, exp);

/* printf("after macro expand =="); */
/* printf("after macro expand ==%d", vmPos(vm)); */
/* sexpWrite(stdout, exp); */
/* printf("\n"); */

Obj res = eval(vm, pos, exp);
Obj res = eval(vm, exp);

if (stream == stdin) {
sexpWrite(stdout, res);
Expand All @@ -40,36 +41,35 @@ repl(struct VM *vm, int pos, FILE* stream) {
}
}

static void
replBytecode(struct VM *vm, FILE* stream) {
struct SexpReader r = {.pkgMapping = Nil};
int errCode;

for (int i=0; ; i++) {
printf("%d #> ", i);

int err = 0;
Obj exp = sexpRead(vm, 0, &r, stdin, &errCode);
if (err != 0) {
break;
}

Obj res = run(vm, exp);

sexpWrite(stdout, res);
printf("\n");
}
}

int main(int argc, char *argv[]) {
struct VM* vm = newVM();
int pos = 0;

// CORA PATH
strBuf tmp = getCoraPath();
strBuf tmp1 = strDup(toStr(tmp));
loadByteCode(vm, pos, toStr(strCat(tmp, cstr("cora/init.bc"))));
loadByteCode(vm, pos, toStr(strCat(tmp1, cstr("cora/compile.bc"))));
repl(vm, pos, stdin);
}
loadByteCode(vm, toStr(strCat(tmp, cstr("cora/init.bc"))));
loadByteCode(vm, toStr(strCat(tmp1, cstr("cora/compile.bc"))));
repl(vm, stdin);

/* static void */
/* replBytecode(struct VM *vm, FILE* stream) { */
/* for (int i=0; ; i++) { */
/* printf("%d #> ", i); */

/* int err = 0; */
/* struct SexpReader r = {.pkgMapping = Nil}; */
/* int errCode; */
/* Obj exp = sexpRead(&r, stdin, &errCode); */
/* if (err != 0) { */
/* break; */
/* } */

/* char *exec = bytecodeToExec(exp); */
/* Obj res = run(&vm, exec); */

/* sexpWrite(stdout, res); */
/* printf("\n"); */
/* } */
/* } */
/* replBytecode(vm, stdin); */
}
41 changes: 5 additions & 36 deletions src/bootstrap_test.c
Original file line number Diff line number Diff line change
Expand Up @@ -7,48 +7,17 @@

extern Obj reverse(struct VM *vm, int pos, Obj o);

void readFileAsSexp(void *pc, Obj val, struct VM *vm, int pos) {
Obj path = vmGet(vm, 1);
Obj pkg = vmGet(vm, 2);
struct SexpReader r = {.pkgMapping = Nil, .selfPath = toCStr(stringStr(pkg))};
strBuf pathStr = stringStr(path);
FILE* f = fopen(toCStr(pathStr), "r");
int errCode = 0;
Obj ret = Nil;
while(errCode == 0) {
Obj v = sexpRead(NULL, 0, &r, f, &errCode);
ret = cons(NULL, 0, v, ret);
}
fclose(f);
ret = reverse(NULL, 0, ret);
vmReturn(vm, ret);
}

void writeSexpToFile(void *pc, Obj val, struct VM *vm, int pos) {
Obj path = vmGet(vm, 1);
Obj exp = vmGet(vm, 2);
strBuf pathStr = stringStr(path);
FILE* f = fopen(toCStr(pathStr), "w");
/* printObj(stdout, exp); */
printObj(f, exp);
fclose(f);
vmReturn(vm, Nil);
}

int main(int argc, char *argv[]) {
struct VM *vm = newVM();
int pos = 0;
loadByteCode(vm, pos, cstr("../init.bc"));
loadByteCode(vm, pos, cstr("../compile.bc"));

symbolSet(makeSymbol("read-file-as-sexp"), makePrimitive(NULL, 0, readFileAsSexp, 2));
symbolSet(makeSymbol("write-sexp-to-file"), makePrimitive(NULL, 0, writeSexpToFile, 2));
loadByteCode(vm, cstr("../init.bc"));
loadByteCode(vm, cstr("../compile.bc"));

// (load "lib/bootstrap.cora" "") to generate the new init.bc and compile.bc
char *s = "../lib/bootstrap.cora";
eval(vm, pos, cons(NULL, 0, intern("load"), cons(NULL, 0, makeString(NULL, 0, s, strlen(s)), cons(NULL, 0, makeString(NULL, 0, "", 0), Nil))));
eval(vm, cons(NULL, 0, intern("load"), cons(NULL, 0, makeString(NULL, 0, s, strlen(s)), cons(NULL, 0, makeString(NULL, 0, "", 0), Nil))));

// Check the new generated bytecode can be load successfully
loadByteCode(vm, pos, cstr("./init.bc"));
loadByteCode(vm, pos, cstr("./compile.bc"));
loadByteCode(vm, cstr("./init.bc"));
loadByteCode(vm, cstr("./compile.bc"));
}
Loading

0 comments on commit 98a550f

Please sign in to comment.