S_table E_base_tenv(void) {
S_table init_t = S_empty();
S_enter(init_t, S_Symbol("int"), Ty_Int());
S_enter(init_t, S_Symbol("string"), Ty_String());
S_enter(init_t, S_Symbol("double"), Ty_Double());
return init_t;
}
S_table E_base_venv(void) {
S_table t = S_empty();
S_enter(
t,
S_Symbol("print"),
E_FunEntry(Ty_TyList(Ty_String(), NULL), Ty_Void())
);
S_enter(
t,
S_Symbol("flush"),
E_FunEntry(NULL, Ty_Void())
);
S_enter(
t,
S_Symbol("getchar"),
E_FunEntry(NULL, Ty_String())
);
S_enter(
t,
S_Symbol("ord"),
E_FunEntry(Ty_TyList(Ty_String(), NULL), Ty_Int())
);
S_enter(
t,
S_Symbol("chr"),
E_FunEntry(Ty_TyList(Ty_Int(), NULL), Ty_String())
);
S_enter(
t,
S_Symbol("size"),
E_FunEntry(Ty_TyList(Ty_String(), NULL), Ty_Int())
);
S_enter(
t,
S_Symbol("substring"),
E_FunEntry(Ty_TyList(Ty_String(),
Ty_TyList(Ty_Int(),
Ty_TyList(Ty_Int(), NULL))),
Ty_String())
);
S_enter(
t,
S_Symbol("concat"),
E_FunEntry(Ty_TyList(Ty_String(),
Ty_TyList(Ty_String(), NULL)),
Ty_String())
);
S_enter(
t,
S_Symbol("not"),
E_FunEntry(Ty_TyList(Ty_Int(), NULL), Ty_Int())
);
S_enter(
t,
S_Symbol("exit"),
E_FunEntry(Ty_TyList(Ty_Int(), NULL), Ty_Void())
);
return t;
}
A_exp A_StringExp(A_pos pos, S_table table, string s)
{A_exp p = checked_malloc(sizeof(*p));
p->kind=A_stringExp;
p->pos=pos;
A_ty t=S_look(table,S_Symbol(s));
if(t==NULL) p->dec_type=S_Symbol(s);
else p->dec_type=t->dec_type;
p->u.stringg=s;
return p;
}
struct expty transExp_forExp(Tr_level level, S_table venv, S_table tenv, A_exp a, Temp_label breakk) {
struct expty lo = transExp(level, venv, tenv, a->u.forr.lo, breakk);
struct expty hi = transExp(level, venv, tenv, a->u.forr.hi, breakk);
if (lo.ty->kind != Ty_int || hi.ty->kind != Ty_int)
EM_error(a->u.forr.lo->pos, "lo or hi expr is not int");
/*
* LET VAR i := lo
* VAR lmt := hi
* IN
* IF lo < hi THEN
* WHILE i <= lmt DO
* (body;
* i := i+1)
*/
A_pos pos1 = a->pos;
A_pos pos2 = a->u.forr.body->pos;
S_symbol var = a->u.forr.var;
S_symbol lmt = S_Symbol("limit");
A_exp ebody = a->u.forr.body;
A_exp transformed = A_LetExp(pos1,
A_DecList(A_VarDec(pos1, var, S_Symbol("int"), a->u.forr.lo),
A_DecList(A_VarDec(pos1, lmt, S_Symbol("int"), a->u.forr.hi), NULL)),
A_IfExp(pos1,
A_OpExp(pos1, A_ltOp, a->u.forr.lo, a->u.forr.hi),
A_WhileExp(pos1,
A_OpExp(pos1, A_leOp, A_VarExp(pos1, A_SimpleVar(pos1, var)), A_VarExp(pos1, A_SimpleVar(pos1, lmt))),
A_SeqExp(pos2, A_ExpList(ebody,
A_ExpList(A_OpExp(pos1, A_plusOp, A_VarExp(pos1, A_SimpleVar(pos1, var)), A_IntExp(pos1, 1)),
A_ExpList(A_SeqExp(pos2, NULL), // return no value
NULL))))),
NULL)
);
return transExp(level, venv, tenv, transformed, breakk);
}
/* for id := exp1 to exp2 do exp3
* 1. both exp1 and exp2 are integer type
* 2. exp3 is void type
* 3. id is a new variable implicitly declared by the for
* statement, whose scope covers only exp3
*/
struct expty transForExp(S_table venv, S_table tenv, A_exp e)
{
struct expty lo = transExp(venv, tenv, e->u.forr.lo);
struct expty hi = transExp(venv, tenv, e->u.forr.hi);
struct expty body;
if (lo.ty != Ty_Int() || hi.ty != Ty_Int()) {
EM_error(e->pos, "low or high range type is not integer");
}
S_beginScope(venv);
transDec(venv, tenv,
A_VarDec(e->pos,
e->u.forr.var,
S_Symbol("int"),
e->u.forr.lo));
body = transExp(venv, tenv, e->u.forr.body);
if (body.ty != Ty_Void()) {
EM_error(e->pos, "body of for is not void");
}
S_endScope(venv);
return ExpTy(NULL, Ty_Void());
}
static struct expty transExp(Tr_level level, S_table v, S_table t, A_exp e){
A_oper oper;
struct expty left, right, final, final2, final3, final4, final5, lo, hi;
A_expList list;
A_decList decs;
E_enventry callinfo;
Ty_ty recty, arrayty;
switch (e->kind) {
case A_varExp:
return transVar(level, v, t, e->u.var);
case A_nilExp:
return expTy(NULL, Ty_Nil());
case A_callExp:
callinfo = S_look(v, e->u.call.func); /*get params and return from tenv*/
if (callinfo && callinfo->kind == E_funEntry){
if (args_match(level, v, t, e->u.call.args, callinfo->u.fun.formals, e)) {/*check params is matched*/
if (callinfo->u.fun.result) {
return expTy(NULL, actual_ty(callinfo->u.fun.result));
} else {
return expTy(NULL, Ty_Void());
}
}
} else {
EM_error(e->pos, "undefined function %s\n", S_name(e->u.call.func));
}
return expTy(NULL, Ty_Void());
case A_recordExp:
recty = actual_ty(S_look(t, e->u.record.typ));
if (!recty) { /*cant find record-type in table tenv*/
EM_error(e->pos, "undefined type %s (debug recordExp)", S_name(e->u.record.typ));
} else {
if (recty->kind != Ty_record){
EM_error(e->pos, "%s is not a record type", S_name(e->u.record.typ));
return expTy(NULL, Ty_Record(NULL));
}
if (efields_match(level, v, t, recty, e)) {/*check record field is matched*/
return expTy(NULL, recty);
}
}
return expTy(NULL, Ty_Record(NULL));
case A_arrayExp:
arrayty = actual_ty(S_look(t, e->u.array.typ));
if (!arrayty) {
EM_error(e->pos, "undeined array type %s", S_name(e->u.array.typ));
return expTy(NULL, Ty_Array(NULL));
}
if (arrayty->kind != Ty_array) {
EM_error(e->pos, "%s is not a array type", S_name(e->u.array.typ));
return expTy(NULL, Ty_Array(NULL));
}
final2 = transExp(level, v, t, e->u.array.size);
final3 = transExp(level, v, t, e->u.array.init);
if (final2.ty->kind != Ty_int) {
EM_error(e->pos, "array size should be int %s", S_name(e->u.array.typ));
} else if (!ty_match(final3.ty, arrayty->u.array)){
EM_error(e->pos, "unmatched array type in %s", S_name(e->u.array.typ));
} else {
return expTy(NULL, arrayty);
}
return expTy(NULL, Ty_Array(NULL));
case A_seqExp:
list = e->u.seq;
if (!list) {
return expTy(NULL, Ty_Void());
}
while (list->tail) {
transExp(level, v, t, list->head);
list = list->tail;
}
return transExp(level, v, t, list->head);
case A_whileExp:
final = transExp(level, v, t, e->u.whilee.test);
if (final.ty->kind != Ty_int) {
EM_error(e->pos, "int required");
}
transExp(level, v, t, e->u.whilee.body);
return expTy(NULL, Ty_Void());
case A_assignExp:
final4 = transVar(level, v, t, e->u.assign.var);
final5 = transExp(level, v, t, e->u.assign.exp);
if (!ty_match(final4.ty, final5.ty)) {
EM_error(e->pos, "unmatched assign exp");
}
return expTy(NULL, Ty_Void());
case A_breakExp:
return expTy(NULL, Ty_Void());
case A_forExp:
{
struct expty lo = transExp(level, v, t, e->u.forr.lo);
struct expty hi = transExp(level, v, t, e->u.forr.hi);
struct expty body;
if (lo.ty != Ty_Int() || hi.ty != Ty_Int()) {
EM_error(e->pos, "low or high range type is not integer");
}
S_beginScope(v);
transDec(level, v, t, A_VarDec(e->pos, e->u.forr.var, S_Symbol("int"), e->u.forr.lo));
body = transExp(level, v, t, e->u.forr.body);
S_endScope(v);
return expTy(NULL, Ty_Void());
}
case A_letExp:
S_beginScope(v);
S_beginScope(t);
for (decs = e->u.let.decs; decs; decs = decs->tail) {
transDec(level, v, t, decs->head);
}
final = transExp(level, v, t, e->u.let.body);
S_endScope(v);
S_endScope(t);
return final;
case A_opExp:
oper = e->u.op.oper;
left = transExp(level, v, t, e->u.op.left);
right = transExp(level, v, t, e->u.op.right);
if (0 <= oper && oper < 4) {/* check +,-,*,/ */
if (left.ty->kind != Ty_int && left.ty->kind != Ty_double){
EM_error(e->u.op.left->pos, "int or double required(op)");
}
if (right.ty->kind != Ty_int && right.ty->kind != Ty_double) {
EM_error(e->u.op.right->pos, "int or double required(op)");
}
if (left.ty->kind == Ty_int && right.ty->kind == Ty_int && oper != 3) {
return expTy(NULL, Ty_Int());
} else {
/*TODO divide when return double when return int*/
/*
return expTy(NULL, Ty_Int());
*/
return expTy(NULL, Ty_Int());
}
} else if (3 < oper && oper < 10) {
if (oper == 4 || oper == 5) {/*check record type can be nil*/
if (left.ty->kind == Ty_record && right.ty->kind == Ty_nil) {
return expTy(NULL, Ty_Int());
}
if (left.ty->kind == Ty_nil && right.ty->kind == Ty_record) {
return expTy(NULL, Ty_Int());
}
}
if(left.ty->kind != Ty_int && left.ty->kind != Ty_double && left.ty->kind != Ty_string){
EM_error(e->u.op.left->pos, "int or double or record-nil required");
}
if (right.ty->kind != Ty_int && right.ty->kind != Ty_double && right.ty->kind !=Ty_string) {
EM_error(e->u.op.right->pos, "int or double or record-nil required");
}
return expTy(NULL, Ty_Int());
} else {
assert(0);
}
case A_ifExp:
final = transExp(level, v, t, e->u.iff.test);
final2 = transExp(level, v, t, e->u.iff.then);
if (e->u.iff.elsee) { /*no else-part*/
final3 = transExp(level, v, t, e->u.iff.elsee);
if (final.ty->kind != Ty_int){
EM_error(e->u.iff.test->pos, "int required");
} else if(!ty_match(final2.ty, final3.ty)) {
/* The label will be created only if it is not found. */
Temp_label Temp_namedlabel(string s)
{
return S_Symbol(s);
}
void transDec (S_table venv, S_table tenv, A_dec d)
{
switch (d->kind) {
case A_varDec: {
Ty_ty typ = NULL;
if (d->u.var.typ) {
typ = S_look(tenv, d->u.var.typ);
}
struct expty e = transExp (venv, tenv, d->u.var.init);
if (!typ || typ->kind == e.ty->kind) {
if (e.ty->kind == Ty_nil && (!typ || typ->kind != Ty_record)) {
EM_error (d->u.var.init->pos, "nil should be constrained by record");
}
S_enter (venv, d->u.var.var, E_VarEntry (e.ty));
} else {
EM_error (d->u.var.init->pos, "var type should be same as init");
}
break;
}
case A_typeDec: {
A_nametyList nList = NULL;
for (nList = d->u.type; nList; nList = nList->tail) {
bool flag;
A_nametyList scanList = NULL;
for (scanList = nList->tail; scanList; scanList = scanList->tail) {
if (strcmp(S_name(nList->head->name), S_name(scanList->head->name)) == 0) {
flag = TRUE;
break;
}
}
if (flag) {
EM_error (d->pos, "type redefined error");
}
S_enter(tenv, nList->head->name, Ty_Name (nList->head->ty->u.name, NULL));
}
for (nList = d->u.type; nList; nList = nList->tail) {
Ty_ty waitFill = S_look(tenv, nList->head->name);
if (waitFill->kind == Ty_name) {
waitFill->u.name.ty = transTy (tenv, nList->head->ty);
}
Ty_ty trueType = actual_ty(waitFill);
if (trueType) {
S_enter(tenv, nList->head->name, actual_ty(waitFill));
} else {
EM_error (d->pos, "recursive types should through record or array");
break;
}
}
break;
}
case A_functionDec: {
A_fundecList funList = NULL;
for (funList = d->u.function; funList; funList = funList->tail) {
bool flag;
A_fundecList scanList = NULL;
for (scanList = funList->tail; scanList; scanList = scanList->tail) {
if (strcmp(S_name(funList->head->name), S_name(scanList->head->name)) == 0) {
flag = TRUE;
break;
}
}
if (flag) {
EM_error (d->pos, "function redefined error");
}
A_fundec f = funList->head;
if (!f->result) {
f->result = S_Symbol("void");
}
Ty_ty resultTy = S_look (tenv, f->result);
Ty_tyList formalTys = makeFormalTyList (tenv, f->params);
S_enter (venv, f->name, E_FunEntry (formalTys, resultTy));
}
for (funList = d->u.function; funList; funList = funList->tail) {
A_fundec f = funList->head;
Ty_tyList formalTys = makeFormalTyList (tenv, f->params);
S_beginScope (venv);
{
A_fieldList l;
Ty_tyList t;
for (l = f->params, t = formalTys; l; l = l->tail, t = t->tail) {
S_enter (venv, l->head->name, E_VarEntry (t->head));
}
}
Ty_ty returnTy = S_look (tenv, f->result);
if (returnTy->kind != transExp (venv, tenv, f->body).ty->kind) {
EM_error (f->body->pos, "return type wrong");
}
S_endScope (venv);
}
break;
}
}
}
