From 9610e683859c08b33a33592330390c5226ce1d65 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Fri, 12 Mar 2021 13:55:53 +0100 Subject: [PATCH] code generation more --- .gitignore | 1 + Makefile | 3 +- ast.c | 8 + ast.h | 1 + compilec.bash | 25 +++ gen.c | 153 +++++++++++++++++ gen.h | 17 ++ genc.c => gen/c.c | 158 +++++++++--------- gen/c.h | 11 ++ gen/ssm.c | 407 +++++++++++++++++++++++++++++++++++++++++++++ gen/ssm.h | 11 ++ genc.h | 10 -- input.txt | 2 + rts/rts.c => rts.c | 14 +- rts.h | 27 +++ rts.ssm | 105 ++++++++++++ rts/rts.h | 20 --- scan.l | 8 +- sem.c | 3 + sem/hm.c | 10 +- splc.c | 34 ++-- 21 files changed, 880 insertions(+), 148 deletions(-) create mode 100755 compilec.bash create mode 100644 gen.c create mode 100644 gen.h rename genc.c => gen/c.c (77%) create mode 100644 gen/c.h create mode 100644 gen/ssm.c create mode 100644 gen/ssm.h delete mode 100644 genc.h rename rts/rts.c => rts.c (82%) create mode 100644 rts.h create mode 100644 rts.ssm delete mode 100644 rts/rts.h diff --git a/.gitignore b/.gitignore index afb708d..bf48a04 100644 --- a/.gitignore +++ b/.gitignore @@ -4,6 +4,7 @@ scan.[ch] *.o y.output a.c +a.ssm a.out callgrind.out.* diff --git a/Makefile b/Makefile index b5092d1..34518dd 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,8 @@ LDFLAGS+=-Wl,--gc-sections,--print-gc-sections YFLAGS+=--locations -Wno-yacc --defines=parse.h LFLAGS+=--header-file=scan.h -OBJECTS:=array.o scan.o parse.o ast.o type.o util.o sem.o genc.o ident.o\ +OBJECTS:=array.o scan.o parse.o ast.o type.o util.o sem.o ident.o\ + $(addprefix gen,.o /c.o /ssm.o)\ $(addprefix sem,.o /scc.o $(addprefix /hm, .o /gamma.o /subst.o /scheme.o)) all: splc diff --git a/ast.c b/ast.c index 677153c..ade4615 100644 --- a/ast.c +++ b/ast.c @@ -134,6 +134,7 @@ struct expr *expr_binop(struct expr *left, enum binop op, struct expr *right, YY res->data.ebinop.l = left; res->data.ebinop.op = op; res->data.ebinop.r = right; + res->data.ebinop.type = NULL; return res; } @@ -456,6 +457,11 @@ static void expr_print2(struct expr *expr, FILE *out, struct ctx ctx) this.branch = left; expr_print2(expr->data.ebinop.l, out, this); safe_fprintf(out, " %s ", binop_str[expr->data.ebinop.op]); + if (expr->data.efuncall.type != NULL) { + safe_fprintf(out, " /* "); + type_print(expr->data.ebinop.type, out); + safe_fprintf(out, " */ "); + } this.branch = right; expr_print2(expr->data.ebinop.r, out, this); if (brace(this, ctx)) @@ -616,6 +622,8 @@ void expr_free(struct expr *expr) case ebinop: expr_free(expr->data.ebinop.l); expr_free(expr->data.ebinop.r); + if (expr->data.ebinop.type != NULL) + type_free(expr->data.ebinop.type); break; case ebool: break; diff --git a/ast.h b/ast.h index 4424dca..7e63b47 100644 --- a/ast.h +++ b/ast.h @@ -86,6 +86,7 @@ struct expr { struct expr *l; enum binop op; struct expr *r; + struct type *type; //type for overloaded equality } ebinop; char echar; struct { diff --git a/compilec.bash b/compilec.bash new file mode 100755 index 0000000..62d7557 --- /dev/null +++ b/compilec.bash @@ -0,0 +1,25 @@ +#!/bin/bash +usage() { + echo "Usage: $0 CSOURCE [-o OFILE]" >&2 + exit 1 +} +if [ $# -lt 1 ] +then + usage +fi +if [ $# -eq 3 ] +then + if [ $2 != "-o" ] + then + usage + fi + OFILE=$3 +else + OFILE=a.out +fi +CFLAGS=${CFLAGS:-} +LDLIBS=${LDLIBS:-} +LDFLAGS=${LDFLAGS:-} +CC=${CC:-gcc} +set -xe +"$CC" $CFLAGS "$1" $LDFLAGS rts.c $LDLIBS -o "$OFILE" diff --git a/gen.c b/gen.c new file mode 100644 index 0000000..0ec9190 --- /dev/null +++ b/gen.c @@ -0,0 +1,153 @@ +#include + +#include "sem.h" +#include "gen.h" +#include "gen/c.h" +#include "gen/ssm.h" + +void overloaded_type(YYLTYPE loc, struct type *type, FILE *cout) +{ + switch(type->type) { + case tarrow: + die("cannot print functions???"); + break; + case tbasic: + safe_fprintf(cout, "%s", basictype_str[type->data.tbasic]); + break; + case tlist: + safe_fprintf(cout, "l"); + overloaded_type(loc, type->data.tlist, cout); + break; + case ttuple: + safe_fprintf(cout, "t"); + overloaded_type(loc, type->data.ttuple.l, cout); + overloaded_type(loc, type->data.ttuple.r, cout); + safe_fprintf(cout, "t"); + break; + case tvar: + type_error(loc, true, "cannot print overloaded types???"); + break; + } +} + +static int type_cmpv(const void *l, const void *r) +{ + return type_cmp((struct type *)l, *(void **)r); +} + +static void call_register(struct array *st, struct type *type) +{ + *st = array_binsert(type, *st, type_cmpv); + switch(type->type) { + case tlist: + call_register(st, type->data.tlist); + break; + case ttuple: + call_register(st, type->data.ttuple.l); + call_register(st, type->data.ttuple.r); + break; + default: + break; + } +} + +static void ol_expr(struct overload *st, struct expr *expr) +{ + switch(expr->type) { + case ebinop: + if (expr->data.ebinop.op == eq || expr->data.ebinop.op == neq) + call_register(&st->eq, expr->data.ebinop.type); + ol_expr(st, expr->data.ebinop.l); + ol_expr(st, expr->data.ebinop.r); + break; + case efuncall: + if (strcmp(expr->data.efuncall.ident, "print") == 0) + call_register(&st->print, expr->data.efuncall.type); + ARRAY_ITER(struct expr *, e, i, expr->data.efuncall.args) + ol_expr(st, e); + AIEND + break; + case etuple: + ol_expr(st, expr->data.etuple.left); + ol_expr(st, expr->data.etuple.right); + break; + case eunop: + ol_expr(st, expr->data.eunop.l); + break; + default: + break; + } +} + + +static void ol_body(struct overload *st, struct array body); +static void ol_stmt(struct overload *st, struct stmt *stmt) +{ + switch(stmt->type) { + case sassign: + ol_expr(st, stmt->data.sassign.expr); + break; + case sif: + ol_expr(st, stmt->data.sif.pred); + ol_body(st, stmt->data.sif.then); + ol_body(st, stmt->data.sif.els); + break; + case sreturn: + if (stmt->data.sreturn != NULL) + ol_expr(st, stmt->data.sreturn); + break; + case sexpr: + ol_expr(st, stmt->data.sexpr); + break; + case svardecl: + ol_expr(st, stmt->data.svardecl->expr); + break; + case swhile: + ol_expr(st, stmt->data.swhile.pred); + ol_body(st, stmt->data.swhile.body); + break; + default: + die("Unsupported stmt node\n"); + } + +} + +static void ol_body(struct overload *st, struct array body) +{ + ARRAY_ITER(struct stmt *, s, i, body) + ol_stmt(st, s); + AIEND +} + +void gen(struct ast *res, enum lang lang, FILE *cout) +{ + struct overload st = { .print=array_null, .eq=array_null }; + for (int i = 0; indecls; i++) { + struct decl *decl = res->decls[i]; + switch(decl->type) { + case dcomp: + ARRAY_ITER(struct fundecl *, d, i, decl->data.dcomp) + ol_body(&st, d->body); + AIEND + break; + case dfundecl: + break; + case dvardecl: + ol_expr(&st, decl->data.dvar->expr); + break; + } + } + + switch(lang) { + case c: + genc(res, st, cout); + break; + case ssm: + genssm(res, st, cout); + break; + default: + die("unsupported language\n"); + } + array_free(st.print, NULL); + array_free(st.eq, NULL); +} diff --git a/gen.h b/gen.h new file mode 100644 index 0000000..3a55679 --- /dev/null +++ b/gen.h @@ -0,0 +1,17 @@ +#ifndef GEN_H +#define GEN_H + +#include + +#include "ast.h" + +struct overload { + struct array print; + struct array eq; +}; + +enum lang {c, ssm}; +void overloaded_type(YYLTYPE loc, struct type *type, FILE *cout); +void gen(struct ast *res, enum lang lang, FILE *cout); + +#endif diff --git a/genc.c b/gen/c.c similarity index 77% rename from genc.c rename to gen/c.c index cdcba6e..6514471 100644 --- a/genc.c +++ b/gen/c.c @@ -2,8 +2,9 @@ #include #include -#include "ast.h" -#include "sem.h" +#include "../ast.h" +#include "../sem.h" +#include "../gen.h" struct gencst { struct array printtypes; // struct type * @@ -19,52 +20,6 @@ static void binop_genc(struct gencst *st, char *fun, struct expr *l, struct expr safe_fprintf(cout, ")"); } -static int type_cmpv(const void *l, const void *r) -{ - return type_cmp((struct type *)l, *(void **)r); -} - -static void call_print_register(struct gencst *st, struct type *type) -{ - st->printtypes = array_binsert(type, st->printtypes, type_cmpv); - switch(type->type) { - case tlist: - call_print_register(st, type->data.tlist); - break; - case ttuple: - call_print_register(st, type->data.ttuple.l); - call_print_register(st, type->data.ttuple.r); - break; - default: - break; - } -} - -static void call_print_type(YYLTYPE loc, struct type *type, FILE *cout) -{ - switch(type->type) { - case tarrow: - die("cannot print functions???"); - break; - case tbasic: - safe_fprintf(cout, "%s", basictype_str[type->data.tbasic]); - break; - case tlist: - safe_fprintf(cout, "l"); - call_print_type(loc, type->data.tlist, cout); - break; - case ttuple: - safe_fprintf(cout, "t"); - call_print_type(loc, type->data.ttuple.l, cout); - call_print_type(loc, type->data.ttuple.r, cout); - safe_fprintf(cout, "t"); - break; - case tvar: - type_error(loc, true, "cannot print overloaded types???"); - break; - } -} - static void expr_genc(struct gencst *st, struct expr *expr, FILE *cout) { char buf[] = "\\x55"; @@ -72,7 +27,17 @@ static void expr_genc(struct gencst *st, struct expr *expr, FILE *cout) return; switch(expr->type) { case ebinop: - if (expr->data.ebinop.op == cons) { + if (expr->data.ebinop.op == eq || expr->data.ebinop.op == neq) { + if (expr->data.ebinop.op == neq) + safe_fprintf(cout, "!"); + safe_fprintf(cout, "eq_"); + overloaded_type(expr->loc, expr->data.ebinop.type, cout); + safe_fprintf(cout, "("); + expr_genc(st, expr->data.ebinop.l, cout); + safe_fprintf(cout, ","); + expr_genc(st, expr->data.ebinop.r, cout); + safe_fprintf(cout, ")"); + } else if (expr->data.ebinop.op == cons) { binop_genc(st, "splc_cons", expr->data.ebinop.l, expr->data.ebinop.r, cout); } else if (expr->data.ebinop.op == power) { @@ -96,8 +61,7 @@ static void expr_genc(struct gencst *st, struct expr *expr, FILE *cout) case efuncall: if (strcmp(expr->data.efuncall.ident, "print") == 0) { safe_fprintf(cout, "print_"); - call_print_register(st, expr->data.efuncall.type); - call_print_type(expr->loc, expr->data.efuncall.type, cout); + overloaded_type(expr->loc, expr->data.efuncall.type, cout); } else { safe_fprintf(cout, "%s", expr->data.efuncall.ident); } @@ -287,22 +251,64 @@ static void decl_genc(struct gencst *st, struct decl *decl, FILE *cout) } } -static void generate_print_body(struct type *type, FILE *cout) +static void generate_eq(struct type *type, FILE *cout) { + if (type->type == tbasic) + return; + + safe_fprintf(cout, "WORD eq_"); YYLTYPE loc; + overloaded_type(loc, type, cout); + safe_fprintf(cout, "("); + type_genc(type, cout); + safe_fprintf(cout, "x, "); + type_genc(type, cout); + safe_fprintf(cout, "y) {\n"); switch(type->type) { - case tbasic: - safe_fprintf(cout, "\tprint_"); - call_print_type(loc, type, cout); - safe_fprintf(cout, ");\n"); + case tlist: + safe_fprintf(cout, "\twhile(t != NULL) {\n"); + safe_fprintf(cout, "\t\tif (!eq_"); + overloaded_type(loc, type->data.tlist, cout); + safe_fprintf(cout, "(x->hd, y->hd));\n"); + safe_fprintf(cout, "\t\t\treturn false;\n"); + safe_fprintf(cout, "\t\tt = t->tl;\n"); + safe_fprintf(cout, "\t}\n"); + safe_fprintf(cout, "\treturn true;\n"); + break; + case ttuple: + safe_fprintf(cout, "\treturn eq_"); + overloaded_type(loc, type->data.ttuple.l, cout); + safe_fprintf(cout, "(x->fst, y->fst)"); + safe_fprintf(cout, " && eq_"); + overloaded_type(loc, type->data.ttuple.r, cout); + safe_fprintf(cout, "(x->snd, y->snd);"); break; + default: + die("cannot compare anything else than tuples and lists"); + } + safe_fprintf(cout, "\n}\n"); +} + +static void generate_print(struct type *type, FILE *cout) +{ + if (type->type == tbasic) + return; + + safe_fprintf(cout, "void print_"); + YYLTYPE loc; + overloaded_type(loc, type, cout); + safe_fprintf(cout, "("); + type_genc(type, cout); + safe_fprintf(cout, " t) {\n"); + switch(type->type) { case tlist: safe_fprintf(cout, "\tprintf(\"[\");\n"); safe_fprintf(cout, "\twhile(t != NULL) {\n"); safe_fprintf(cout, "\t\tprint_"); - call_print_type(loc, type->data.tlist, cout); + overloaded_type(loc, type->data.tlist, cout); safe_fprintf(cout, "(t->hd);\n"); - safe_fprintf(cout, "\t\tif (t->tl != NULL) printf(\", \");\n"); + safe_fprintf(cout, "\t\tif (t->tl != NULL)\n"); + safe_fprintf(cout, "\t\t\tprintf(\", \");\n"); safe_fprintf(cout, "\t\tt = t->tl;\n"); safe_fprintf(cout, "\t}\n"); safe_fprintf(cout, "\tprintf(\"]\");\n"); @@ -310,44 +316,38 @@ static void generate_print_body(struct type *type, FILE *cout) case ttuple: safe_fprintf(cout, "\tprintf(\"(\");\n"); safe_fprintf(cout, "\tprint_"); - call_print_type(loc, type->data.ttuple.l, cout); + overloaded_type(loc, type->data.ttuple.l, cout); safe_fprintf(cout, "(t->fst);\n"); safe_fprintf(cout, "\tprintf(\",\");\n"); safe_fprintf(cout, "\tprint_"); - call_print_type(loc, type->data.ttuple.r, cout); + overloaded_type(loc, type->data.ttuple.r, cout); safe_fprintf(cout, "(t->snd);\n"); safe_fprintf(cout, "\tprintf(\")\");\n"); break; default: + die("cannot print anything else than tuples and lists"); break; } -} - -static void generate_print(struct type *type, FILE *cout) -{ - if (type->type == tbasic) - return; - - safe_fprintf(cout, "void print_"); - YYLTYPE loc; - call_print_type(loc, type, cout); - safe_fprintf(cout, "("); - type_genc(type, cout); - safe_fprintf(cout, " t) {\n"); - generate_print_body(type, cout); safe_fprintf(cout, "}\n"); } -void genc(struct ast *ast, FILE *cout) +void genc(struct ast *ast, struct overload ol, FILE *cout) { + //Header safe_fprintf(cout, "#include \"rts.h\"\n"); + + //Overloaded functions + ARRAY_ITER(struct type *, t, i, ol.print) { + generate_print(t, cout); + } AIEND + ARRAY_ITER(struct type *, t, i, ol.eq) { + generate_eq(t, cout); + } AIEND + + //Code struct gencst st = {.printtypes = array_null}; for (int i = 0; indecls; i++) { safe_fprintf(cout, "\n"); decl_genc(&st, ast->decls[i], cout); } - ARRAY_ITER(struct type *, t, i, st.printtypes) { - generate_print(t, cout); - } AIEND - array_free(st.printtypes, NULL); } diff --git a/gen/c.h b/gen/c.h new file mode 100644 index 0000000..4c8ef90 --- /dev/null +++ b/gen/c.h @@ -0,0 +1,11 @@ +#ifndef GEN_C_H +#define GEN_C_H + +#include + +#include "../ast.h" +#include "../gen.h" + +void genc(struct ast *res, struct overload ol, FILE *cout); + +#endif diff --git a/gen/ssm.c b/gen/ssm.c new file mode 100644 index 0000000..b4f7aaa --- /dev/null +++ b/gen/ssm.c @@ -0,0 +1,407 @@ +#include + +#include "../ast.h" +#include "../sem.h" +#include "../gen.h" + +struct genssmst { + int fresh; +}; + +static const char *unop_instr[] = { [inverse] = "not", [negate] = "neg" }; +static const char *binop_instr[] = { + [binor] = "or", [binand] = "and", [eq] = "eq", [neq] = "ne", + [leq] = "le", [le] = "lt", [geq] = "ge", [ge] = "gt", [cons] = ":", + [plus] = "add", [minus] = "sub", [times] = "mul", [divide] = "div", + [modulo] = "mod", [power] = "^", +}; + +static void generate_eq(struct type *type, FILE *cout) +{ + YYLTYPE loc; + safe_fprintf(cout, "eq"); + overloaded_type(loc, type, cout); + safe_fprintf(cout, ":\n"); + safe_fprintf(cout, "link 0\n"); + switch(type->type) { + case tbasic: + safe_fprintf(cout, "bsr eq"); + overloaded_type(loc, type, cout); + safe_fprintf(cout, "\n"); + safe_fprintf(cout, "ajs -2\n"); + break; + case tlist: + die("list equality not implemented yet\n"); + break; + case ttuple: + safe_fprintf(cout, "ldl -2\nldh -1\n"); + safe_fprintf(cout, "ldl -3\nldh -1\n"); + safe_fprintf(cout, "eq\n"); + //Compare left + safe_fprintf(cout, "brf eq"); + overloaded_type(loc, type->data.ttuple.l, cout); + safe_fprintf(cout, "e\n"); + safe_fprintf(cout, "ldl -2\nldh 0\n"); + safe_fprintf(cout, "ldl -3\nldh 0\n"); + safe_fprintf(cout, "bsr eq\n"); + overloaded_type(loc, type->data.ttuple.l, cout); + safe_fprintf(cout, "\najs -2\n"); + safe_fprintf(cout, "ldr RR2\n"); + safe_fprintf(cout, "brf eq"); + overloaded_type(loc, type->data.ttuple.l, cout); + safe_fprintf(cout, "e\n"); + safe_fprintf(cout, "ldc -1\n"); + safe_fprintf(cout, "str RR\n"); + safe_fprintf(cout, "unlink\n"); + safe_fprintf(cout, "ret\n"); + //Return false + safe_fprintf(cout, "eq"); + overloaded_type(loc, type->data.ttuple.l, cout); + safe_fprintf(cout, "e:\n"); + safe_fprintf(cout, "ldc 0\n"); + safe_fprintf(cout, "str RR\n"); + break; + default: + break; + } + safe_fprintf(cout, "unlink\n"); + safe_fprintf(cout, "ret\n"); +} +static void generate_print(struct type *type, FILE *cout) +{ + YYLTYPE loc; + safe_fprintf(cout, "print"); + overloaded_type(loc, type, cout); + safe_fprintf(cout, ":\n"); + safe_fprintf(cout, "link 0\n"); + switch(type->type) { + case tbasic: + safe_fprintf(cout, "bsr print"); + overloaded_type(loc, type, cout); + safe_fprintf(cout, "\n"); + safe_fprintf(cout, "ajs -1\n"); + break; + case tlist: + //Print [ + safe_fprintf(cout, "ldc 91\ntrap 1\n"); + safe_fprintf(cout, "print"); + overloaded_type(loc, type, cout); + safe_fprintf(cout, "b:\n"); + safe_fprintf(cout, "ldl -2\n"); + //Check if null + safe_fprintf(cout, "ldc 0\n"); + safe_fprintf(cout, "eq\n"); + safe_fprintf(cout, "brt print"); + overloaded_type(loc, type, cout); + safe_fprintf(cout, "e\n"); + //Print element + safe_fprintf(cout, "ldl -2\n"); + safe_fprintf(cout, "ldh -1\n"); + safe_fprintf(cout, "bsr print"); + overloaded_type(loc, type->data.ttuple.l, cout); + safe_fprintf(cout, "\n"); + safe_fprintf(cout, "ajs -1\n"); + safe_fprintf(cout, "ldl -2\n"); + safe_fprintf(cout, "ldh 0\n"); + safe_fprintf(cout, "stl -2\n"); + //Print space + safe_fprintf(cout, "ldc 44\ntrap 1\n"); + safe_fprintf(cout, "ldc 32\ntrap 1\n"); + safe_fprintf(cout, "bra print"); + overloaded_type(loc, type, cout); + safe_fprintf(cout, "b\n"); + //End label + safe_fprintf(cout, "print"); + overloaded_type(loc, type, cout); + safe_fprintf(cout, "e:\n"); + //Print ] + safe_fprintf(cout, "ldc 93\ntrap 1\n"); + break; + case ttuple: + safe_fprintf(cout, "ldc 40\ntrap 1\n"); + safe_fprintf(cout, "ldl -2\nldh -1\n"); + safe_fprintf(cout, "bsr print"); + overloaded_type(loc, type->data.ttuple.l, cout); + safe_fprintf(cout, "\n"); + safe_fprintf(cout, "ajs -1\n"); + safe_fprintf(cout, "ldc 44\ntrap 1\n"); + safe_fprintf(cout, "ldl -2\nldh 0\n"); + safe_fprintf(cout, "bsr print"); + overloaded_type(loc, type->data.ttuple.r, cout); + safe_fprintf(cout, "\n"); + safe_fprintf(cout, "ajs -1\n"); + safe_fprintf(cout, "ldc 41\ntrap 1\n"); + break; + default: + break; + } + safe_fprintf(cout, "unlink\n"); + safe_fprintf(cout, "ret\n"); +} + +static void call_print_type(YYLTYPE loc, struct type *type, FILE *cout) +{ + switch(type->type) { + case tarrow: + die("cannot print functions???"); + break; + case tbasic: + safe_fprintf(cout, "%s", basictype_str[type->data.tbasic]); + break; + case tlist: + safe_fprintf(cout, "l"); + call_print_type(loc, type->data.tlist, cout); + break; + case ttuple: + safe_fprintf(cout, "t"); + call_print_type(loc, type->data.ttuple.l, cout); + call_print_type(loc, type->data.ttuple.r, cout); + safe_fprintf(cout, "t"); + break; + case tvar: + type_error(loc, true, "cannot print overloaded types???"); + break; + } +} + +//static void generate_print_body(struct type *type, FILE *cout) +//{ +// YYLTYPE loc; +// switch(type->type) { +// case tbasic: +// safe_fprintf(cout, "\tprint_"); +// call_print_type(loc, type, cout); +// safe_fprintf(cout, ");\n"); +// break; +// case tlist: +// safe_fprintf(cout, "\tprintf(\"[\");\n"); +// safe_fprintf(cout, "\twhile(t != NULL) {\n"); +// safe_fprintf(cout, "\t\tprint_"); +// call_print_type(loc, type->data.tlist, cout); +// safe_fprintf(cout, "(t->hd);\n"); +// safe_fprintf(cout, "\t\tif (t->tl != NULL) printf(\", \");\n"); +// safe_fprintf(cout, "\t\tt = t->tl;\n"); +// safe_fprintf(cout, "\t}\n"); +// safe_fprintf(cout, "\tprintf(\"]\");\n"); +// break; +// case ttuple: +// safe_fprintf(cout, "\tprintf(\"(\");\n"); +// safe_fprintf(cout, "\tprint_"); +// call_print_type(loc, type->data.ttuple.l, cout); +// safe_fprintf(cout, "(t->fst);\n"); +// safe_fprintf(cout, "\tprintf(\",\");\n"); +// safe_fprintf(cout, "\tprint_"); +// call_print_type(loc, type->data.ttuple.r, cout); +// safe_fprintf(cout, "(t->snd);\n"); +// safe_fprintf(cout, "\tprintf(\")\");\n"); +// break; +// default: +// break; +// } +//} + +//static void generate_print(struct type *type, FILE *cout) +//{ +// if (type->type == tbasic) +// return; +// +// safe_fprintf(cout, "void print_"); +// YYLTYPE loc; +// call_print_type(loc, type, cout); +// safe_fprintf(cout, "("); +// type_genc(type, cout); +// safe_fprintf(cout, " t) {\n"); +// generate_print_body(type, cout); +// safe_fprintf(cout, "}\n"); +//} +static void expr_genssm(struct genssmst *st, struct expr *expr, FILE *cout) +{ + switch(expr->type) { + case ebinop: + expr_genssm(st, expr->data.ebinop.l, cout); + expr_genssm(st, expr->data.ebinop.r, cout); + if (expr->data.ebinop.op == eq || expr->data.ebinop.op == neq) { + safe_fprintf(cout, "bsr eq"); + overloaded_type(expr->loc, expr->data.ebinop.type, cout); + safe_fprintf(cout, "\n"); + safe_fprintf(cout, "ajs -2\n"); + safe_fprintf(cout, "ldr RR\n"); + if (expr->data.ebinop.op == neq) + safe_fprintf(cout, "neg\n"); + + } else if (expr->data.ebinop.op == cons) { + safe_fprintf(cout, "stmh 2\n"); + } else if (expr->data.ebinop.op == power) { + safe_fprintf(cout, "bsr pow\n"); + safe_fprintf(cout, "ajs -2\n"); + safe_fprintf(cout, "ldr RR\n"); + } else { + safe_fprintf(cout, "%s\n", binop_instr[expr->data.ebinop.op]); + } + break; + case ebool: + safe_fprintf(cout, "ldc %d\n", expr->data.ebool ? "-1" : "1"); + break; + case echar: + safe_fprintf(cout, "ldc %d\n", expr->data.echar); + break; + case efuncall: + ARRAY_ITER(struct expr *, e, i, expr->data.efuncall.args) + expr_genssm(st, e, cout); + AIEND + if (strcmp(expr->data.efuncall.ident, "print") == 0) { + safe_fprintf(cout, "bsr print"); +// call_print_register(st, expr->data.efuncall.type); + call_print_type(expr->loc, expr->data.efuncall.type, cout); + safe_fprintf(cout, "\n"); + } else { + safe_fprintf(cout, "bsr %s\n", expr->data.efuncall.ident); + safe_fprintf(cout, "ajs -%u\n", + ARRAY_SIZE(expr->data.efuncall.args)); + } + break; + case eint: + safe_fprintf(cout, "ldc %d\n", expr->data.eint); + break; + //case eident: + // safe_fprintf(cout, "%s", expr->data.eident); + // break; + case enil: + safe_fprintf(cout, "ldc 0\n"); + break; + case etuple: + expr_genssm(st, expr->data.etuple.left, cout); + expr_genssm(st, expr->data.etuple.right, cout); + safe_fprintf(cout, "stmh 2\n"); + break; + //case estring: + // safe_fprintf(cout, "\""); + // for (int i = 0; idata.estring.nchars; i++) + // safe_fprintf(cout, "%s", escape_char( + // expr->data.estring.chars[i], buf, true)); + // safe_fprintf(cout, "\""); + // break; + case eunop: + expr_genssm(st, expr->data.eunop.l, cout); + safe_fprintf(cout, "%s\n", unop_instr[expr->data.eunop.op]); + break; + default: + die("Unknown expression node\n"); + } +} + +static void stmt_genssm(struct genssmst *st, struct stmt *stmt, FILE *cout); +static void body_genssm(struct genssmst *st, struct array body, FILE *cout) +{ + ARRAY_ITER(struct stmt *, s, i, body) + stmt_genssm(st, s, cout); + AIEND +} + +static void stmt_genssm(struct genssmst *st, struct stmt *stmt, FILE *cout) +{ + switch(stmt->type) { + case sassign: +// pindent(indent, cout); +// safe_fprintf(cout, "%s", stmt->data.sassign.ident); +// ARRAY_ITER(char *, f, i, stmt->data.sassign.fields) +// safe_fprintf(cout, "->%s", f); +// AIEND +// safe_fprintf(cout, " = "); +// expr_genabc(st, stmt->data.sassign.expr, cout); +// safe_fprintf(cout, ";\n"); + break; + case sif: + expr_genssm(st, stmt->data.sif.pred, cout); + safe_fprintf(cout, "brf _else%d\n", st->fresh); + body_genssm(st, stmt->data.sif.then, cout); + safe_fprintf(cout, "bra _endif%d\n", st->fresh); + safe_fprintf(cout, "_else%d:\n", st->fresh); + body_genssm(st, stmt->data.sif.els, cout); + safe_fprintf(cout, "_endif%d: \n", st->fresh++); + break; + case sreturn: + if (stmt->data.sreturn != NULL) { + expr_genssm(st, stmt->data.sreturn, cout); + safe_fprintf(cout, "str RR\n"); + } + break; + case sexpr: + expr_genssm(st, stmt->data.sexpr, cout); + safe_fprintf(cout, "ajs -1\n"); + break; + case svardecl: +// vardecl_genc(st, stmt->data.svardecl, indent, cout); + break; + case swhile: + safe_fprintf(cout, "_while%d: \n", st->fresh); + expr_genssm(st, stmt->data.sif.pred, cout); + safe_fprintf(cout, "brf _endwhile%d\n", st->fresh); + body_genssm(st, stmt->data.swhile.body, cout); + safe_fprintf(cout, "bra _while%d\n", st->fresh); + safe_fprintf(cout, "_endwhile%d: \n", st->fresh++); + break; + default: + die("Unsupported stmt node\n"); + } +} + + +static void vardecl_genssm(struct genssmst *st, struct vardecl *vardecl, FILE *cout) +{ + //TODO add to dictionary + expr_genssm(st, vardecl->expr, cout); +} + +static void fundecl_genssm(struct genssmst *st, struct fundecl *decl, FILE *cout) +{ + safe_fprintf(cout, "%s: link 0\n", decl->ident); + //TODO add args to dictionary + body_genssm(st, decl->body, cout); + safe_fprintf(cout, "unlink\n"); + safe_fprintf(cout, "ret\n"); +} + +void genssm(struct ast *ast, struct overload ol, FILE *cout) +{ + //Header + safe_fprintf(cout, "ldrr R5 R1\n"); + struct genssmst st = { .fresh=0 }; + for (int i = 0; indecls; i++) + if (ast->decls[i]->type == dvardecl) + vardecl_genssm(&st, ast->decls[i]->data.dvar, cout); + safe_fprintf(cout, "bsr main\n"); + safe_fprintf(cout, "halt\n"); + + //Generate overloaded functions + ARRAY_ITER(struct type *, t, i, ol.print) + if (t->type != tbasic) + generate_print(t, cout); + AIEND + ARRAY_ITER(struct type *, t, i, ol.eq) + if (t->type != tbasic) + generate_eq(t, cout); + AIEND + + //Generate code + for (int i = 0; indecls; i++) + if (ast->decls[i]->type == dcomp) + ARRAY_ITER(struct fundecl *, d, j, ast->decls[i]->data.dcomp) + fundecl_genssm(&st, d, cout); + AIEND + FILE *rts = fopen("rts.ssm", "r"); + if (rts == NULL) + pdie("fopen"); + #define BSIZE 1024 + char buf[BSIZE]; + size_t r; + do { + r = fread(buf, 1, BSIZE, rts); + if (r != BSIZE && ferror(rts) != 0) + pdie("fread"); + if (fwrite(buf, 1, r, cout) != r) + pdie("fwrite"); + } while(r == BSIZE); + if (fclose(rts) != 0) + pdie("fclose"); +} diff --git a/gen/ssm.h b/gen/ssm.h new file mode 100644 index 0000000..93e5247 --- /dev/null +++ b/gen/ssm.h @@ -0,0 +1,11 @@ +#ifndef GEN_SSM_H +#define GEN_SSM_H + +#include + +#include "../ast.h" +#include "../gen.h" + +void genssm(struct ast *res, struct overload ol, FILE *cout); + +#endif diff --git a/genc.h b/genc.h deleted file mode 100644 index 439b78d..0000000 --- a/genc.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef GENC_H -#define GENC_H - -#include - -#include "ast.h" - -void genc(struct ast *res, FILE *cout); - -#endif diff --git a/input.txt b/input.txt index 966a6bb..6d83348 100644 --- a/input.txt +++ b/input.txt @@ -15,5 +15,7 @@ len (x) { } main () { + var x = []; + x.hd = 42; } diff --git a/rts/rts.c b/rts.c similarity index 82% rename from rts/rts.c rename to rts.c index d7f9180..c144081 100644 --- a/rts/rts.c +++ b/rts.c @@ -1,6 +1,6 @@ -#include "rts.h" #include #include +#include "rts.h" #define REFC(ptr) (*(int *)((ptr)-1)) @@ -36,15 +36,3 @@ WORD splc_power(WORD l, WORD r) { res *= r; return res; } -void print_Int(WORD l) -{ - printf("%ld", l); -} -void print_Char(WORD l) -{ - printf("%c", l); -} -void print_Bool(WORD l) -{ - printf("%s", l ? "true" : "false"); -} diff --git a/rts.h b/rts.h new file mode 100644 index 0000000..c1efb6f --- /dev/null +++ b/rts.h @@ -0,0 +1,27 @@ +#ifndef SPLC_RTS_H +#define SPLC_RTS_H + +#include +#include +#include +#include + +#define WORD intptr_t + +struct splc_tuple { WORD fst; WORD snd; }; +struct splc_list { WORD hd; struct splc_list *tl; }; +struct splc_tuple *splc_tuple(WORD fst, WORD snd); +struct splc_list *splc_cons(WORD hd, struct splc_list *tl); +#define isEmpty(l) ((l) == NULL) +#define hd(l) (l)->hd +#define tl(l) (l)->tl +#define fst(l) (l)->fst +#define snd(l) (l)->snd +#define print_Int(l) printf("%d", l); +#define print_Char(l) printf("%c", l); +#define print_Bool(l) printf("%s", (l) ? "true" : "false"); +#define eq_Int(x, y) ((x)==(y)) +#define eq_Char(x, y) ((x)==(y)) +#define eq_Bool(x, y) ((x)==(y)) + +#endif diff --git a/rts.ssm b/rts.ssm new file mode 100644 index 0000000..6c1af57 --- /dev/null +++ b/rts.ssm @@ -0,0 +1,105 @@ +pow: +link 1; pow (x, y) { +ldc 1 +stl 1; var z = 1 +poww: +ldl -2; while (y > 0) +ldc 0 +gt +brf powe ; { +ldl -3; z = x*z +ldl 1 +mul +stl 1 +ldl -2; y = y-1 +ldc 1 +sub +stl -2 +bra poww ; } +powe: +ldl 1; return z +str RR +unlink +ret +eqInt: +link 0 +ldl -2 +ldl -3 +eq +unlink +ret +eqChar: +link 0 +ldl -2 +ldl -3 +eq +unlink +ret +eqBool: +link 0 +ldl -2 +ldl -3 +eq +unlink +ret +printInt: +link 0 +ldl -2 +trap 0 +unlink +ret +printChar: +link 0 +ldl -2 +trap 1 +unlink +ret +printBool: +link 0 +ldl -2 +brf printBoolf +ldc 84 +trap 1 +bra printBoole +printBoolf: +ldc 70 +trap 1 +printBoole: +unlink +ret +fst: +link 0 +ldl -2 +ldh -1 +str RR +unlink +ret +snd: +link 0 +ldl -2 +ldh 0 +str RR +unlink +ret +hd: +link 0 +ldl -2 +ldh -1 +str RR +unlink +ret +tl: +link 0 +ldl -2 +ldh 0 +str RR +unlink +ret +isEmpty: +link 0 +ldl -2 +ldc 0 +eq +str RR +unlink +ret diff --git a/rts/rts.h b/rts/rts.h deleted file mode 100644 index 2fc07d4..0000000 --- a/rts/rts.h +++ /dev/null @@ -1,20 +0,0 @@ -#ifndef SPLC_RTS_H -#define SPLC_RTS_H - -#include -#include -#include -#include - -#define WORD intptr_t - -struct splc_tuple { WORD fst; WORD snd; }; -struct splc_list { WORD hd; struct splc_list *tl; }; -struct splc_tuple *splc_tuple(WORD fst, WORD snd); -struct splc_list *splc_cons(WORD hd, struct splc_list *tl); - -void print_Int(WORD l); -void print_Char(WORD l); -void print_Bool(WORD l); - -#endif diff --git a/scan.l b/scan.l index 049a80a..4a24d9d 100644 --- a/scan.l +++ b/scan.l @@ -53,10 +53,10 @@ Void return TVOID; && return BINAND; == return EQ; != return NEQ; -\<= return GEQ; -\< return GE; ->= return LEQ; -> return LE; +\<= return LEQ; +\< return LE; +>= return GEQ; +> return GE; : return CONS; \+ return PLUS; - return MINUS; diff --git a/sem.c b/sem.c index 490dfa0..78cf747 100644 --- a/sem.c +++ b/sem.c @@ -67,6 +67,9 @@ static void patch_overload_expr(struct subst *subst, struct expr *expr) return; switch (expr->type) { case ebinop: + if (expr->data.ebinop.op == eq || expr->data.ebinop.op == neq) + expr->data.ebinop.type = subst_apply_t(subst, + expr->data.ebinop.type); patch_overload_expr(subst, expr->data.ebinop.l); patch_overload_expr(subst, expr->data.ebinop.r); break; diff --git a/sem/hm.c b/sem/hm.c index 6d5a4c5..f1aa557 100644 --- a/sem/hm.c +++ b/sem/hm.c @@ -103,15 +103,17 @@ struct subst *infer_expr(struct gamma *gamma, struct expr *expr, struct type *ty case binor: case binand: return infbinop(expr, &tybool, &tybool, &tybool, type); - case eq: case neq: + case eq: + f1 = gamma_fresh(gamma); + s0 = infbinop(expr, f1, f1, &tybool, type); + expr->data.ebinop.type = f1; + return s0; case leq: case le: case geq: case ge: - f1 = gamma_fresh(gamma); - s0 = infbinop(expr, f1, f1, &tybool, type); - type_free(f1); + s0 = infbinop(expr, &tyint, &tyint, &tybool, type); return s0; case cons: f1 = gamma_fresh(gamma); diff --git a/splc.c b/splc.c index 9b58990..48311c8 100644 --- a/splc.c +++ b/splc.c @@ -3,10 +3,11 @@ #include #include "ast.h" -#include "genc.h" +#include "gen.h" #include "parse.h" #include "scan.h" #include "sem.h" + extern int yylex_destroy(void); void usage(FILE *out, char *arg0) @@ -17,11 +18,11 @@ void usage(FILE *out, char *arg0) "Compile an spl file. If FILE is not specified stdin is used.\n" "\n" "Options:\n" - "\t-p\tPretty print the parsed abstract syntax tree\n" - "\t-t\tPretty print the typed abstract syntax tree\n" - "\t-g LANG\tGenerate LANG code (default: C)\n" - "\t \tSupported languages: C\n" - "\t-o FILE\tOutput code to FILE (default: a.suf)\n" + "\t-p Pretty print the parsed abstract syntax tree\n" + "\t-t Pretty print the typed abstract syntax tree\n" + "\t-g LANG Generate LANG code (default: C)\n" + "\t Supported languages: C, ABC\n" + "\t-o FILE Output code to FILE (default: a.suf)\n" "\t-h\tShow this help\n" , arg0); } @@ -31,8 +32,8 @@ int main(int argc, char *argv[]) int opt, r; bool pparse = false, ptype = false; char *cfile = NULL; - enum {langc} lang = langc; - const char *suffix[] = { [langc] = "c" }; + enum lang lang = c; + const char *suffix[] = { [c] = "c", [ssm] = "ssm" }; struct ast *result = NULL; FILE *cout; @@ -41,7 +42,10 @@ int main(int argc, char *argv[]) case 'g': if (strcmp(optarg, "c") == 0 || strcmp(optarg, "C") == 0) { - lang = langc; + lang = c; + } else if (strcmp(optarg, "ssm") == 0 + || strcmp(optarg, "SSM") == 0) { + lang = ssm; } else { usage(stderr, argv[0]); } @@ -91,15 +95,11 @@ int main(int argc, char *argv[]) sprintf(cfile = xalloc(10, char), "a.%s", suffix[lang]); cout = safe_fopen(cfile, "w+"); free(cfile); - switch(lang) { - case langc: - genc(result, cout); - break; - default: - die("unsupported language\n"); - } + + gen(result, lang, cout); + safe_fclose(cout); - safe_fprintf(stderr, "code generation* done\n"); + safe_fprintf(stderr, "code generation done\n"); ast_free(result); return r; } -- 2.20.1