code generation more

diff --git a/.gitignore b/.gitignore
index afb708d..bf48a04 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
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 (file)
index 0000000..0ec9190
--- /dev/null
+++ b/gen.c
@@ -0,0 +1,153 @@
+#include <string.h>
+
+#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; i<res->ndecls; 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 (file)
index 0000000..3a55679
--- /dev/null
+++ b/gen.h
@@ -0,0 +1,17 @@
+#ifndef GEN_H
+#define GEN_H
+
+#include <stdio.h>
+
+#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 (file)
--- a/genc.c
+++ b/gen/c.c
@@ -2,8 +2,9 @@
 #include <string.h>
 #include <stdlib.h>
 
-#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; i<ast->ndecls; 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 (file)
index 0000000..4c8ef90
--- /dev/null
+++ b/gen/c.h
@@ -0,0 +1,11 @@
+#ifndef GEN_C_H
+#define GEN_C_H
+
+#include <stdio.h>
+
+#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 (file)
index 0000000..b4f7aaa
--- /dev/null
+++ b/gen/ssm.c
@@ -0,0 +1,407 @@
+#include <string.h>
+
+#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; i<expr->data.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; i<ast->ndecls; 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; i<ast->ndecls; 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 (file)
index 0000000..93e5247
--- /dev/null
+++ b/gen/ssm.h
@@ -0,0 +1,11 @@
+#ifndef GEN_SSM_H
+#define GEN_SSM_H
+
+#include <stdio.h>
+
+#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 (file)
index 439b78d..0000000
--- a/genc.h
+++ /dev/null
@@ -1,10 +0,0 @@
-#ifndef GENC_H
-#define GENC_H
-
-#include <stdio.h>
-
-#include "ast.h"
-
-void genc(struct ast *res, FILE *cout);
-
-#endif

diff --git a/input.txt b/input.txt
index 966a6bb..6d83348 100644 (file)
--- 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 (file)
--- a/rts/rts.c
+++ b/rts.c
@@ -1,6 +1,6 @@
-#include "rts.h"
 #include <stdlib.h>
 #include <stdio.h>
+#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 (file)
index 0000000..c1efb6f
--- /dev/null
+++ b/rts.h
@@ -0,0 +1,27 @@
+#ifndef SPLC_RTS_H
+#define SPLC_RTS_H
+
+#include <stdint.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <stdbool.h>
+
+#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 (file)
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 (file)
index 2fc07d4..0000000
--- a/rts/rts.h
+++ /dev/null
@@ -1,20 +0,0 @@
-#ifndef SPLC_RTS_H
-#define SPLC_RTS_H
-
-#include <stdint.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <stdbool.h>
-
-#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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/splc.c
+++ b/splc.c
@@ -3,10 +3,11 @@
 #include <getopt.h>
 
 #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;
 }