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; }
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; }
/* translate expression */ struct expty transExp(S_table venv, S_table tenv, A_exp e) { switch (e->kind) { case A_varExp: return transVar(venv, tenv, e->u.var); case A_nilExp: return ExpTy(NULL, Ty_Nil()); case A_intExp: return ExpTy(NULL, Ty_Int()); case A_stringExp: return ExpTy(NULL, Ty_String()); case A_callExp: return transCallExp(venv, tenv, e); case A_opExp: return transOpExp(venv, tenv, e); case A_recordExp: return transRecordExp(venv, tenv, e); case A_seqExp: return transSeqExp(venv, tenv, e->u.seq); case A_assignExp: return transAssignExp(venv, tenv, e); case A_ifExp: return transIfExp(venv, tenv, e); case A_whileExp: return transWhileExp(venv, tenv, e); case A_forExp: return transForExp(venv, tenv, e); case A_breakExp: return transBreakExp(venv, tenv, e); case A_letExp: return transLetExp(venv, tenv, e); case A_arrayExp: return transArrayExp(venv, tenv, e); } assert(0); }
struct expty transExp(Tr_level level, S_table venv, S_table tenv, A_exp a, Temp_label breakk) { switch (a->kind) { case A_varExp: return transVar(level, venv, tenv, a->u.var, breakk); case A_nilExp: return expTy(Tr_nilExp(), Ty_Nil()); case A_intExp: return expTy(Tr_intExp(a->u.intt), Ty_Int()); case A_stringExp: return expTy(Tr_stringExp(a->u.stringg), Ty_String()); case A_breakExp: return expTy(Tr_breakExp(breakk), Ty_Void()); case A_callExp: return transExp_callExp( level, venv, tenv, a, breakk); case A_opExp: return transExp_opExp( level, venv, tenv, a, breakk); case A_recordExp: return transExp_recordExp(level, venv, tenv, a, breakk); case A_seqExp: return transExp_seqExp( level, venv, tenv, a, breakk); case A_assignExp: return transExp_assignExp(level, venv, tenv, a, breakk); case A_ifExp: return transExp_ifExp( level, venv, tenv, a, breakk); case A_whileExp: return transExp_whileExp( level, venv, tenv, a, breakk); case A_forExp: return transExp_forExp( level, venv, tenv, a, breakk); case A_letExp: return transExp_letExp( level, venv, tenv, a, breakk); case A_arrayExp: return transExp_arrayExp( level, venv, tenv, a, breakk); } assert(0); /* should have returned from some clause of the switch */ }
struct expty transExp(S_table venv, S_table tenv, A_exp a) { /* S_beginScope(venv); */ /* S_beginScope(tenv); */ switch(a->kind) { case A_varExp: return transVar( venv , tenv , a->u.var ); break; case A_nilExp: return _expTy( NULL, Ty_Nil() ); break; case A_intExp: return _expTy( NULL, Ty_Int() ); break; case A_stringExp: return _expTy( NULL, Ty_String() ); break; case A_callExp: return transExpCall( venv, tenv, a ); break; case A_opExp: case A_recordExp: case A_seqExp: case A_assignExp: case A_ifExp: case A_whileExp: case A_forExp: case A_breakExp: case A_letExp: case A_arrayExp: //break; default: assert(0); } /* S_endScope(tenv); */ /* S_endScope(venv); */ }
struct expty transExp(S_table venv, S_table tenv, A_exp e) { if (e == NULL) { return expTy(NULL, Ty_Void()); } switch (e->kind) { case A_varExp: { return transVar(venv, tenv, e->u.var); } case A_nilExp: { return expTy(NULL, Ty_Nil()); } case A_intExp: { return expTy(NULL, Ty_Int()); } case A_stringExp: { return expTy(NULL, Ty_String()); } case A_callExp: { E_enventry fun = S_look(venv, e->u.call.func); if (fun == NULL || fun->kind == E_varEntry) { //EM_error(e->pos, "undefined function %s", S_name(e->u.call.func)); return expTy(NULL, Ty_Int()); } else { if (fun->u.fun.formals == NULL && e->u.call.args == NULL) { return expTy(NULL, actual_ty(fun->u.fun.result)); } else if (fun->u.fun.formals == NULL && e->u.call.args != NULL) { EM_error(e->pos, "incorrect function prototype %s", S_name(e->u.call.func) ); return expTy(NULL, actual_ty(fun->u.fun.result)); } else if (fun->u.fun.formals != NULL && e->u.call.args == NULL) { EM_error(e->pos, "incorrect function prototype %s", S_name(e->u.call.func) ); return expTy(NULL, actual_ty(fun->u.fun.result)); } else { return expTy(NULL, actual_ty(fun->u.fun.result)); } } } case A_opExp: { A_oper oper = e->u.op.oper; struct expty left = transExp(venv, tenv, e->u.op.left); struct expty right = transExp(venv, tenv, e->u.op.right); if (oper == A_plusOp || oper == A_minusOp || oper == A_timesOp || oper == A_divideOp) { if (left.ty->kind != Ty_int) EM_error(e->u.op.left->pos, "integer required"); if (right.ty->kind != Ty_int) EM_error(e->u.op.right->pos, "integer required"); return expTy(NULL, Ty_Int()); } else if (oper == A_eqOp || oper == A_neqOp) { if (left.ty->kind == Ty_int && right.ty->kind == Ty_int) { return expTy(NULL, Ty_Int()); } else if (left.ty->kind == Ty_string && right.ty->kind == Ty_string) { return expTy(NULL, Ty_Int()); } else if (left.ty->kind == Ty_record && right.ty->kind == Ty_record) { if (left.ty == right.ty) { return expTy(NULL, Ty_Int()); } else { EM_error(e->pos, "same record type required"); return expTy(NULL, Ty_Int()); } } else if (left.ty->kind == Ty_array && right.ty->kind == Ty_array) { if (left.ty == right.ty) { return expTy(NULL, Ty_Int()); } else { EM_error(e->pos, "same array type required"); return expTy(NULL, Ty_Int()); } } else if (left.ty->kind == Ty_record && right.ty->kind == Ty_nil) { return expTy(NULL, Ty_Int()); } else if (left.ty->kind == Ty_nil && right.ty->kind == Ty_record) { return expTy(NULL, Ty_Int()); } else { EM_error(e->pos, "type not match"); return expTy(NULL, Ty_Int()); } } else if (oper == A_ltOp || oper == A_leOp || oper == A_gtOp || oper == A_geOp) { if (left.ty->kind == Ty_int && right.ty->kind == Ty_int) { return expTy(NULL, Ty_Int()); } else { EM_error(e->pos, "type not match"); return expTy(NULL, Ty_Int()); } } } case A_recordExp: { Ty_ty ty = S_look(tenv, e->u.record.typ); if (ty != NULL) { ty = actual_ty(ty); } if (ty == NULL || ty->kind != Ty_record) { EM_error(e->pos, "undefined record type %s", S_name(e->u.record.typ)); return expTy(NULL, Ty_Nil()); } else { Ty_fieldList fieldList = ty->u.record; A_efieldList efieldList = e->u.record.fields; while (fieldList != NULL && efieldList != NULL) { if (fieldList->head->name != efieldList->head->name) { EM_error(e->pos, "record field not match"); return expTy(NULL, Ty_Nil()); } struct expty res = transExp(venv, tenv, efieldList->head->exp); Ty_ty fieldty = actual_ty(fieldList->head->ty); if (fieldty->kind == Ty_record && res.ty->kind == Ty_nil) { } else if (fieldty->kind == Ty_record && res.ty->kind == Ty_record) { if (fieldty == res.ty) { } else { EM_error(e->pos, "record field not match"); return expTy(NULL, Ty_Nil()); } } else if (fieldty->kind == Ty_array && res.ty->kind == Ty_array) { if (fieldty == res.ty) { } else { EM_error(e->pos, "record field not match"); return expTy(NULL, Ty_Nil()); } } else { if (fieldty->kind != res.ty->kind) { EM_error(e->pos, "record field not match"); return expTy(NULL, Ty_Nil()); } } fieldList = fieldList->tail; efieldList = efieldList->tail; } if (fieldList != NULL && efieldList != NULL) { EM_error(e->pos, "record field not match"); return expTy(NULL, Ty_Nil()); } } return expTy(NULL, ty); } case A_seqExp: { if (e->u.seq == NULL) { return expTy(NULL, Ty_Void()); } else { return expTy(NULL, transExp(venv, tenv, e->u.seq->head).ty); } } case A_assignExp: { struct expty left = transVar(venv, tenv, e->u.assign.var); struct expty right = transExp(venv, tenv, e->u.assign.exp); if (left.ty->kind == Ty_nil) { if (right.ty->kind == Ty_nil) { return expTy(NULL, Ty_Void()); } else if (right.ty->kind == Ty_record && left.ty == right.ty) { return expTy(NULL, Ty_Void()); } else { EM_error(e->pos, "type not match"); return expTy(NULL, Ty_Void()); } } else if (left.ty->kind == Ty_array) { if (right.ty->kind == Ty_array && left.ty == right.ty) { return expTy(NULL, Ty_Void()); } else { EM_error(e->pos, "type not match"); return expTy(NULL, Ty_Void()); } } else if (left.ty->kind == right.ty->kind) { return expTy(NULL, Ty_Void()); } else { EM_error(e->pos, "type not match"); return expTy(NULL, Ty_Void()); } } case A_ifExp: { struct expty test = transExp(venv, tenv, e->u.iff.test); if (test.ty->kind != Ty_int) { EM_error(e->pos, "if-else clause integer test required"); return expTy(NULL, Ty_Void()); } else { struct expty then = transExp(venv, tenv, e->u.iff.then); if (e->u.iff.elsee == NULL) { if (then.ty->kind != Ty_void) { EM_error(e->pos, "if-then clause void then required"); return expTy(NULL, Ty_Void()); } else { return expTy(NULL, Ty_Void()); } } else { struct expty elsee = transExp(venv, tenv, e->u.iff.elsee); if (then.ty->kind == Ty_record) { if (elsee.ty->kind == Ty_record && then.ty == elsee.ty) { return expTy(NULL, then.ty); } else if (elsee.ty->kind == Ty_nil) { return expTy(NULL, then.ty); } } else if (then.ty->kind == Ty_nil && elsee.ty->kind == Ty_record) { return expTy(NULL, elsee.ty); } else if (then.ty->kind == Ty_array && elsee.ty->kind == Ty_array) { if (then.ty == elsee.ty) { return expTy(NULL, then.ty); } else { EM_error(e->pos, "then and else type not match"); return expTy(NULL, Ty_Void()); } } else if (then.ty->kind == elsee.ty->kind) { return expTy(NULL, then.ty); } else { EM_error(e->pos, "then and else type not match"); return expTy(NULL, Ty_Void()); } } } } case A_whileExp: { struct expty test = transExp(venv, tenv, e->u.whilee.test); struct expty body = transExp(venv, tenv, e->u.whilee.body); if (test.ty->kind != Ty_int) { EM_error(e->pos, "test clause integer required"); return expTy(NULL, Ty_Void()); } else { if (body.ty->kind != Ty_void) { //EM_error(e->pos, "while clause must produce no value"); return expTy(NULL, Ty_Void()); } else { return expTy(NULL, Ty_Void()); } } } case A_forExp: { struct expty lo = transExp(venv, tenv, e->u.forr.lo); struct expty hi = transExp(venv, tenv, e->u.forr.hi); if (lo.ty->kind != Ty_int || hi.ty->kind != Ty_int) { EM_error(e->pos, "for clause lo and hi integer required"); return expTy(NULL, Ty_Void()); } else { struct expty body = transExp(venv, tenv, e->u.forr.body); if (body.ty->kind != Ty_void) { EM_error(e->pos, "for clause body no-value required"); return expTy(NULL, Ty_Void()); } else { return expTy(NULL, Ty_Void()); } } } case A_breakExp: { return expTy(NULL, Ty_Void()); } case A_letExp: { //S_beginScope(venv); //S_beginScope(tenv); struct expty exp = transExp(venv, tenv, e->u.let.body); //S_endScope(tenv); //S_endScope(venv); return expTy(NULL, exp.ty); } case A_arrayExp: { struct expty size = transExp(venv, tenv, e->u.array.size); struct expty init = transExp(venv, tenv, e->u.array.init); Ty_ty ty = actual_ty(S_look(tenv, e->u.array.typ)); if (ty == NULL || ty->kind != Ty_array) { //EM_error(e->pos, "undefined array type %s", S_name(e->u.array.typ)); return expTy(NULL, Ty_Void()); } Ty_ty ty2 = actual_ty(ty->u.array); if (size.ty->kind != Ty_int) { EM_error(e->pos, "size int value required"); return expTy(NULL, actual_ty(ty)); } else if (ty2->kind == Ty_record) { if ((init.ty->kind == Ty_nil) || (init.ty->kind == Ty_record && ty2 == init.ty)) { return expTy(NULL, ty); } else { EM_error(e->pos, "array init fail:type not match"); return expTy(NULL, ty); } } else if(ty2->kind == Ty_array) { if (init.ty->kind == Ty_array && ty2 == init.ty) { return expTy(NULL, ty); } else { EM_error(e->pos, "array init fail:type not match"); return expTy(NULL, ty); } } else if (ty2->kind == init.ty->kind) { return expTy(NULL, ty); } else { EM_error(e->pos, "array init fail:type not match"); return expTy(NULL, ty); } } default: { assert(0); } } }
static struct expty transExp(Tr_level level, Tr_exp breakk, S_table v, S_table t, A_exp e){ if (!e) { return expTy(Tr_noExp(), Ty_Void()); } switch (e->kind) { case A_varExp: return transVar(level, breakk, v, t, e->u.var); case A_nilExp: return expTy(Tr_nilExp(), Ty_Nil()); case A_callExp: { E_enventry callinfo = S_look(v, e->u.call.func); /*get params and return from tenv*/ A_expList args = NULL; Tr_expList argList = NULL; Ty_tyList formals; Tr_exp trans = Tr_noExp(); if (callinfo && callinfo->kind == E_funEntry){ formals = callinfo->u.fun.formals; /* if (args_match(level, breakk, v, t, e->u.call.args, callinfo->u.fun.formals, e)) {//check params is matched if (callinfo->u.fun.result) { return expTy(trans, actual_ty(callinfo->u.fun.result)); } }*/ for (args = e->u.call.args; args && formals; args = args->tail, formals = formals->tail) { /*memory args-info by order*/ struct expty arg = transExp(level, breakk, v, t, args->head); if (!ty_match(arg.ty, formals->head)) EM_error(args->head->pos, "unmatched type in function %s", S_name(e->u.call.func)); Tr_expList_prepend(arg.exp, &argList); } if (!args && formals) EM_error(e->pos, "short few paras"); if (args && !formals) EM_error(e->pos, "too many paras"); trans = Tr_callExp(callinfo->u.fun.label, callinfo->u.fun.level, level, &argList); return expTy(trans, actual_ty(callinfo->u.fun.result)); } else { EM_error(e->pos, "undefined function %s\n", S_name(e->u.call.func)); return expTy(trans, Ty_Int()); } } case A_recordExp: {/*record create*/ Ty_ty 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(Tr_noExp(), Ty_Record(NULL)); } /* if (efields_match(level, breakk, v, t, recty, e)) {//check record field is matched Tr_expList l = NULL; int n = 0; A_efieldList el; for (el = e->u.record.fields; el; el = el->tail, n++) { struct expty val = transExp(level, breakk, v, t, el->head->exp); Tr_expList_prepend(val.exp, &l); } return expTy(Tr_recordExp(n, l), recty); }*/ Ty_fieldList fieldTys = recty->u.record; A_efieldList recList; Tr_expList list = NULL; int n = 0; for (recList = e->u.record.fields; recList; recList = recList->tail, fieldTys = fieldTys->tail, n++) { struct expty et = transExp(level, breakk, v, t, recList->head->exp); if (recList->head->name != fieldTys->head->name) EM_error(e->pos, "%s not a valid field name", recList->head->name); if (!ty_match(fieldTys->head->ty, et.ty)) EM_error(recList->head->exp->pos, "type error: given %s but expected %s"); Tr_expList_prepend(et.exp, &list); } return expTy(Tr_recordExp(n, list), recty); } return expTy(Tr_noExp(), Ty_Record(NULL)); } case A_arrayExp: {/*array create*/ Ty_ty 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(Tr_noExp(), Ty_Int()); } if (arrayty->kind != Ty_array) { EM_error(e->pos, "%s is not a array type", S_name(e->u.array.typ)); return expTy(Tr_noExp(), Ty_Int()); } struct expty final2 = transExp(level, breakk, v, t, e->u.array.size); struct expty final3 = transExp(level, breakk, 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(Tr_arrayExp(final2.exp, final3.exp), arrayty); } return expTy(Tr_noExp(), Ty_Int()); } case A_seqExp: { Tr_expList l = NULL; A_expList list = e->u.seq; struct expty seqone; if (!list) { return expTy(Tr_noExp(), Ty_Void()); } for (; list; list = list->tail) { seqone = transExp(level, breakk, v, t, list->head); Tr_expList_prepend(seqone.exp, &l); } return expTy(Tr_seqExp(l), seqone.ty); } case A_whileExp: { struct expty final = transExp(level, breakk, v, t, e->u.whilee.test); if (final.ty->kind != Ty_int) { EM_error(e->pos, "int required"); } Tr_exp done = Tr_doneExp(); struct expty body = transExp(level, done, v, t, e->u.whilee.body); return expTy(Tr_whileExp(final.exp, body.exp, done), Ty_Void()); } case A_assignExp: { struct expty final4 = transVar(level, breakk, v, t, e->u.assign.var); struct expty final5 = transExp(level, breakk, v, t, e->u.assign.exp); if (!ty_match(final4.ty, final5.ty)) { EM_error(e->pos, "unmatched assign exp"); } return expTy(Tr_assignExp(final4.exp, final5.exp), Ty_Void()); } case A_breakExp: if (!breakk) return expTy(Tr_noExp(), Ty_Void()); return expTy(Tr_breakExp(breakk), Ty_Void()); case A_forExp: { EM_error(e->pos, "\nsome one said for is better than while\nmake them unhappy \nahahaha"); return expTy(Tr_noExp(), Ty_Int()); } case A_letExp: { A_decList decs; Tr_expList l = NULL; S_beginScope(v); S_beginScope(t); for (decs = e->u.let.decs; decs; decs = decs->tail) { Tr_expList_prepend(transDec(level, breakk, v, t, decs->head), &l); } struct expty final = transExp(level, breakk, v, t, e->u.let.body); Tr_expList_prepend(final.exp, &l); S_endScope(v); S_endScope(t); return expTy(Tr_seqExp(l), final.ty); } case A_opExp: { A_oper oper = e->u.op.oper; struct expty left = transExp(level, breakk, v, t, e->u.op.left); struct expty right = transExp(level, breakk, 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)"); } else if (right.ty->kind != Ty_int && right.ty->kind != Ty_double) { EM_error(e->u.op.right->pos, "int or double required(op)"); } else if (left.ty->kind == Ty_int && right.ty->kind == Ty_int) { return expTy(Tr_arithExp(oper, left.exp, right.exp), Ty_Int()); } else { return expTy(Tr_arithExp(oper, left.exp, right.exp), Ty_Double()); } return expTy(Tr_noExp(), Ty_Int()); } else if (3 < oper && oper < 10) { Tr_exp translation = Tr_noExp(); if (oper == 4 || oper == 5) {/*check record type can be nil(=, <>)*/ switch(left.ty->kind) { case Ty_int: case Ty_double:/*see is double query like int TODO*/ if (right.ty->kind == Ty_int || right.ty->kind == Ty_double) translation = Tr_eqExp(oper, left.exp, right.exp); else {EM_error(e->u.op.right->pos, "unexpected type in comparsion");} break; case Ty_string: if (ty_match(right.ty, left.ty)) translation = Tr_eqStringExp(oper, left.exp, right.exp); else {EM_error(e->u.op.right->pos, "unexpected type in comparsion");} break; case Ty_array: if (ty_match(right.ty, left.ty)) translation = Tr_eqRef(oper, left.exp, right.exp); else {EM_error(e->u.op.right->pos, "unexpected type in comparsion");} break; case Ty_record: if (ty_match(right.ty, left.ty) || right.ty->kind == Ty_nil) translation = Tr_eqRef(oper, left.exp, right.exp); else {EM_error(e->u.op.right->pos, "unexpected type in comparsion");} break; default: EM_error(e->u.op.right->pos, "unexpected expression in comparsion"); } return expTy(translation, Ty_Int()); } else { switch(left.ty->kind) { case Ty_double: case Ty_int: if (right.ty->kind == Ty_double || right.ty->kind == Ty_int) translation = Tr_relExp(oper, left.exp, right.exp); else {EM_error(e->u.op.right->pos, "unexpected type in comparsion");} break; case Ty_string: if (right.ty->kind == Ty_string) translation = Tr_eqStringExp(oper, left.exp, right.exp); else {EM_error(e->u.op.right->pos, "unexpected type in comparsion");} break; default: EM_error(e->u.op.right->pos, "unexpected type in comparsion"); } return expTy(translation, Ty_Int()); } } else { assert(0); } } case A_ifExp: { struct expty final = transExp(level, breakk, v, t, e->u.iff.test); struct expty final2 = transExp(level, breakk, v, t, e->u.iff.then); struct expty final3 = {NULL, NULL}; if (e->u.iff.elsee) { /*no else-part*/ final3 = transExp(level, breakk, v, t, e->u.iff.elsee); if (final.ty->kind != Ty_int){ EM_error(e->u.iff.test->pos, "int required"); } if(!ty_match(final2.ty, final3.ty)) { EM_error(e->pos, "if-else sentence must return same type"); } } return expTy(Tr_ifExp(final.exp, final2.exp, final3.exp), final2.ty); } case A_stringExp: return expTy(Tr_stringExp(e->u.stringg), Ty_String()); case A_intExp: return expTy(Tr_intExp(e->u.intt), Ty_Int()); case A_doubleExp: return expTy(Tr_doubleExp(e->u.doublee), Ty_Double()); default: assert(0); }
struct expty transExp (S_table venv, S_table tenv, A_exp a) { switch (a->kind) { case A_opExp: { A_oper oper = a->u.op.oper; struct expty left = transExp (venv, tenv, a->u.op.left); struct expty right = transExp (venv, tenv, a->u.op.right); if (oper == A_plusOp || oper == A_minusOp || oper == A_timesOp || oper == A_divideOp) { if (left.ty->kind != Ty_int) { EM_error (a->u.op.left->pos, "integer required"); } if (right.ty->kind != Ty_int) { EM_error (a->u.op.right->pos, "integer required"); } } else { if (left.ty->kind != right.ty->kind) { EM_error (a->u.op.right->pos, "left type should be same as right"); } } return expTy (NULL, Ty_Int()); } case A_varExp: { return transVar (venv, tenv, a->u.var); } case A_nilExp: { return expTy (NULL, Ty_Nil()); } case A_intExp: { return expTy (NULL, Ty_Int()); } case A_stringExp: { return expTy (NULL, Ty_String()); } case A_callExp: { E_enventry x = S_look (venv, a->u.call.func); if (x && x->kind == E_funEntry) { Ty_tyList tList; A_expList eList; for (tList = x->u.fun.formals, eList = a->u.call.args; tList && eList; tList = tList->tail, eList = eList->tail) { Ty_ty expTyName = transExp (venv, tenv, eList->head).ty; if (tList->head->kind != expTyName->kind) { if (tList->head->kind == Ty_record && expTyName->kind == Ty_nil) { continue; } EM_error (eList->head->pos, "field type is wrong"); return expTy (NULL, Ty_Int()); } } if (tList || eList) { EM_error (a->u.call.args->head->pos, "field type number is wrong"); return expTy (NULL, Ty_Int()); } return expTy (NULL, x->u.fun.result); } EM_error (a->pos, "undefined function name %s", S_name (a->u.call.func)); return expTy (NULL, Ty_Int()); } case A_recordExp: { Ty_ty record = S_look (tenv, a->u.record.typ); if (!record) { EM_error (a->pos, "undefined record type %s", S_name (a->u.record.typ)); return expTy (NULL, record); } if (record->kind != Ty_record) { EM_error (a->pos, "type should be an record"); return expTy (NULL, Ty_Int()); } else { A_efieldList efieldList = NULL; Ty_fieldList fieldList = record->u.record; for (efieldList = a->u.record.fields; efieldList && fieldList; efieldList = efieldList->tail, fieldList = fieldList->tail) { Ty_ty field = actual_ty(fieldList->head->ty); Ty_ty expTyName = transExp (venv, tenv, efieldList->head->exp).ty; if (field->kind != expTyName->kind) { if (field->kind == Ty_record && expTyName->kind == Ty_nil) { continue; } EM_error (a->pos, "field type wrong"); } } if (efieldList || fieldList) { EM_error (a->pos, "field number wrong"); } return expTy (NULL, record); } } case A_arrayExp: { Ty_ty array = S_look (tenv, a->u.array.typ); if (!array) { EM_error (a->pos, "undefined array type %s", S_name (a->u.array.typ)); return expTy (NULL, array); } if (array->kind != Ty_array) { EM_error (a->pos, "type should be an array"); return expTy (NULL, Ty_Int()); } else { if (transExp (venv, tenv, a->u.array.size).ty->kind != Ty_int) { EM_error (a->pos, "array size should be int"); } if (transExp (venv, tenv, a->u.array.init).ty->kind != array->u.array->kind) { EM_error (a->pos, "array type should be same as init"); } return expTy (NULL, array); } } case A_seqExp: { A_expList d; for (d = a->u.seq; d && d->tail; d = d->tail) { transExp (venv, tenv, d->head); } if (d) { return transExp (venv, tenv, d->head); } else { return expTy (NULL, Ty_Void()); } } case A_assignExp: { transVar (venv, tenv, a->u.assign.var); transExp (venv, tenv, a->u.assign.exp); return expTy (NULL, Ty_Void()); } case A_ifExp: { transExp (venv, tenv, a->u.iff.test); if (a->u.iff.elsee) { struct expty then = transExp (venv, tenv, a->u.iff.then); struct expty elsee = transExp (venv, tenv, a->u.iff.elsee); if (then.ty->kind != elsee.ty->kind) { EM_error (a->u.iff.elsee->pos, "then should be same as else"); } return then; } else { struct expty then = transExp (venv, tenv, a->u.iff.then); if (then.ty->kind != Ty_void) { EM_error (a->u.iff.then->pos, "then should be void"); } return expTy (NULL, Ty_Void()); } } case A_whileExp: { transExp (venv, tenv, a->u.whilee.test); struct expty body = transExp (venv, tenv, a->u.whilee.body); if (body.ty->kind != Ty_void) { EM_error (a->u.whilee.body->pos, "body of while error, it should return void"); } return expTy (NULL, Ty_Void()); } case A_forExp: { S_enter (venv, a->u.forr.var, E_VarEntry (Ty_Int())); struct expty lo = transExp (venv, tenv, a->u.forr.lo); struct expty hi = transExp (venv, tenv, a->u.forr.hi); if (lo.ty->kind != Ty_int) { EM_error (a->u.forr.lo->pos, "lo exp of for should be int"); } if (hi.ty->kind != Ty_int) { EM_error(a->u.forr.hi->pos, "hi exp of for should be int"); } S_beginScope (venv); //if (a->u.forr.body->kind == A_seqExp) { // A_expList test = a->u.forr.body->u.seq; // while (test) { // if (test->head->kind == A_assignExp) { // } // } //} struct expty body = transExp (venv, tenv, a->u.forr.body); if (body.ty->kind != Ty_void) { EM_error (a->u.forr.body->pos, "body of for error, it should return void"); } S_endScope(venv); return expTy (NULL, Ty_Void()); } case A_breakExp: { return expTy (NULL, Ty_Void()); } case A_letExp: { struct expty exp; A_decList d; S_beginScope (venv); S_beginScope (tenv); for (d = a->u.let.decs; d; d = d->tail) { transDec (venv, tenv, d->head); } exp = transExp (venv, tenv, a->u.let.body); S_endScope (tenv); S_endScope (venv); return exp; } } assert (0); }
struct expty transExp(S_table venv, S_table tenv, A_exp e) { if (e == NULL) { return expTy(NULL, Ty_Void()); } switch (e->kind) { case A_varExp: { return transVar(venv, tenv, e->u.var); } case A_nilExp: { return expTy(NULL, Ty_Nil()); } case A_intExp: { return expTy(NULL, Ty_Int()); } case A_stringExp: { return expTy(NULL, Ty_String()); } case A_callExp: { E_enventry fun = (E_enventry)S_look(venv, e->u.call.func); if (!fun || fun->kind == E_varEntry) { EM_error(e->pos, (string)"undefined function '%s'", S_name(e->u.call.func)); return expTy(NULL, Ty_Int()); } if ((!fun->u.fun.formals && e->u.call.args) || (fun->u.fun.formals && !e->u.call.args)) { EM_error(e->pos, (string)"incorrect function prototype '%s'", S_name(e->u.call.func)); return expTy(NULL, Ty_Int()); } Ty_tyList ttl; A_expList el; for (ttl = fun->u.fun.formals, el = e->u.call.args; ttl || el; ttl = ttl->tail, el = el->tail) { if (ttl && !el) { EM_error(e->pos, (string)"formals are more than actuals"); return expTy(NULL, Ty_Int()); } if (!ttl && el) { EM_error(e->pos, (string)"formals are less than actuals"); return expTy(NULL, Ty_Int()); } struct expty arg = transExp(venv, tenv, el->head); if (actual_ty(ttl->head)->kind != actual_ty(arg.ty)->kind) { EM_error(e->pos, (string)"formals and actuals have different types"); return expTy(NULL, Ty_Int()); } } if (!fun->u.fun.result) { return expTy(NULL, Ty_Void()); } return expTy(NULL, actual_ty(fun->u.fun.result)); } case A_opExp: { A_oper oper = e->u.op.oper; struct expty left = transExp(venv, tenv, e->u.op.left); struct expty right = transExp(venv, tenv, e->u.op.right); if (oper == A_plusOp || oper == A_minusOp || oper == A_timesOp || oper == A_divideOp) { if (left.ty->kind != Ty_int || right.ty->kind != Ty_int) { EM_error(e->u.op.left->pos, (string)"integer required"); return expTy(NULL, Ty_Int()); } return expTy(NULL, Ty_Int()); } if (oper == A_eqOp || oper == A_neqOp) { if (isSameTy(left.ty, right.ty)) { return expTy(NULL, Ty_Int()); } EM_error(e->pos, (string)"same type required"); return expTy(NULL, Ty_Int()); } if (oper == A_ltOp || oper == A_leOp || oper == A_gtOp || oper == A_geOp) { if (left.ty->kind == Ty_int && right.ty->kind == Ty_int) { return expTy(NULL, Ty_Int()); } if (left.ty->kind == Ty_string && right.ty->kind == Ty_string) { return expTy(NULL, Ty_Int()); } EM_error(e->pos, "comparison of incompatible type"); return expTy(NULL, Ty_Int()); } assert(0); } case A_recordExp: { Ty_ty ty = (Ty_ty)S_look(tenv, e->u.record.typ); if (!ty) { EM_error(e->pos, "undefined record type '%s'", S_name(e->u.record.typ)); return expTy(NULL, Ty_Nil()); } ty = actual_ty(ty); if (ty->kind != Ty_record) { EM_error(e->pos, "'%s' is not a record", S_name(e->u.record.typ)); } else { Ty_fieldList tfl; A_efieldList efl; for (tfl = ty->u.record, efl = e->u.record.fields; tfl || efl; tfl = tfl->tail, efl = efl->tail) { if (tfl && !efl) { EM_error(e->pos, "record field is less than need"); return expTy(NULL, Ty_Nil()); } if (!tfl && efl) { EM_error(e->pos, "record field is more than need"); return expTy(NULL, Ty_Nil()); } if (tfl->head->name != efl->head->name) { EM_error(e->pos, "record field mismatch"); return expTy(NULL, Ty_Nil()); } struct expty res = transExp(venv, tenv, efl->head->exp); Ty_ty fieldty = actual_ty(tfl->head->ty); if (!isSameTy(fieldty, res.ty)) { EM_error(e->pos, (string)"record field mismatch"); return expTy(NULL, Ty_Nil()); } } } return expTy(NULL, ty); } case A_seqExp: { A_expList el = e->u.seq; if (el) { while (el->tail) { transExp(venv, tenv, el->head); el = el->tail; } return expTy(NULL, transExp(venv, tenv, el->head).ty); } return expTy(NULL, Ty_Void()); } case A_assignExp: { struct expty left = transVar(venv, tenv, e->u.assign.var); struct expty right = transExp(venv, tenv, e->u.assign.exp); if (isSameTy(left.ty, right.ty)) { return expTy(NULL, Ty_Void()); } EM_error(e->pos, "type mismatch"); return expTy(NULL, Ty_Void()); } case A_ifExp: { struct expty test = transExp(venv, tenv, e->u.iff.test); if (test.ty->kind != Ty_int) { EM_error(e->pos, "if-else clause integer test required"); return expTy(NULL, Ty_Void()); } struct expty then = transExp(venv, tenv, e->u.iff.then); if (e->u.iff.elsee == NULL) { if (then.ty->kind != Ty_void) { EM_error(e->pos, "if-then returns non unit"); return expTy(NULL, Ty_Void()); } return expTy(NULL, Ty_Void()); } struct expty elsee = transExp(venv, tenv, e->u.iff.elsee); if (isSameTy(then.ty, elsee.ty)) { return expTy(NULL, then.ty); } EM_error(e->pos, "types of then - else differ"); return expTy(NULL, Ty_Void()); } case A_whileExp: { struct expty test = transExp(venv, tenv, e->u.whilee.test); struct expty body = transExp(venv, tenv, e->u.whilee.body); if (test.ty->kind != Ty_int) { EM_error(e->pos, "test clause integer required"); return expTy(NULL, Ty_Void()); } if (body.ty->kind != Ty_void) { EM_error(e->pos, "body of while not void"); return expTy(NULL, Ty_Void()); } return expTy(NULL, Ty_Void()); } case A_forExp: { struct expty lo = transExp(venv, tenv, e->u.forr.lo); struct expty hi = transExp(venv, tenv, e->u.forr.hi); if (lo.ty->kind != Ty_int || hi.ty->kind != Ty_int) { EM_error(e->pos, "for clause lo and hi integer required"); return expTy(NULL, Ty_Void()); } S_beginScope(venv); if (!S_look(venv, e->u.forr.var)) { S_enter(venv, e->u.forr.var, E_VarEntry(Ty_Int())); } struct expty body = transExp(venv, tenv, e->u.forr.body); S_endScope(venv); if (body.ty->kind != Ty_void) { EM_error(e->pos, "for clause body no-value required"); return expTy(NULL, Ty_Void()); } return expTy(NULL, Ty_Void()); } case A_breakExp: { return expTy(NULL, Ty_Void()); } case A_letExp: { A_decList d; S_beginScope(venv); S_beginScope(tenv); for (d = e->u.let.decs; d; d = d->tail) { transDec(venv, tenv, d->head); } struct expty exp = transExp(venv, tenv, e->u.let.body); S_endScope(venv); S_endScope(tenv); return exp; } case A_arrayExp: { struct expty size = transExp(venv, tenv, e->u.array.size); struct expty init = transExp(venv, tenv, e->u.array.init); Ty_ty ty = (Ty_ty)S_look(tenv, e->u.array.typ); if (!ty) { EM_error(e->pos, "undefined array type '%s'", S_name(e->u.array.typ)); return expTy(NULL, Ty_Void()); } ty = actual_ty(ty); if (ty->kind != Ty_array) { EM_error(e->pos, "'%s' is not a array", S_name(e->u.array.typ)); return expTy(NULL, Ty_Void()); } if (size.ty->kind != Ty_int) { EM_error(e->pos, "size int value required"); return expTy(NULL, actual_ty(ty)); } Ty_ty ty2 = actual_ty(ty->u.array); if (!isSameTy(ty2, init.ty)) { EM_error(e->pos, "initializing exp and array type differ"); return expTy(NULL, Ty_Void()); } return expTy(NULL, ty); } default: { assert(0); } } }