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;
}
void S_free(STACK* S)
{
assert( S != NULL );
while( ! S_empty(S) )
{
S_pop(S);
}
deallocate(S);
}
void* S_pop(STACK* S)
{
void* item;
STACKNODE* tmp;
assert( S != NULL );
if( S_empty(S) )
{
printf("\nERROR: Stack empty, cannot POP.\n");
exit(-1);
}
tmp = S->top;
item = tmp->item;
S->top = tmp->next;
deallocate(tmp);
return( item );
}
void transDec(S_table venv, S_table tenv, A_dec d) {
if (!d) {
return;
}
switch (d->kind) {
case A_varDec: {
struct expty e = transExp(venv, tenv, d->u.var.init);
if (d->u.var.typ) {
Ty_ty ty = (Ty_ty)S_look(tenv, d->u.var.typ);
if (!ty) {
EM_error(d->pos, "undefined type '%s'", S_name(d->u.var.typ));
return;
}
ty = actual_ty(ty);
if (!isSameTy(ty, e.ty)) {
EM_error(d->pos, (string)"type mismatch");
return;
}
S_enter(venv, d->u.var.var, E_VarEntry(ty));
return;
}
if (e.ty->kind == Ty_nil) {
EM_error(d->pos, "initializing nil expressions not constrained by record type");
return;
}
S_enter(venv, d->u.var.var, E_VarEntry(e.ty));
return;
}
case A_typeDec: {
S_table tmp = S_empty();
A_nametyList ntl;
for (ntl = d->u.type; ntl; ntl = ntl->tail) {
if (S_look(tmp, ntl->head->name)) {
EM_error(d->pos, "type '%s' redefined", S_name(ntl->head->name));
return;
}
S_enter(tmp, ntl->head->name, "-tmp-");
S_enter(tenv, ntl->head->name, Ty_Name(ntl->head->name, NULL));
}
for (ntl = d->u.type; ntl; ntl = ntl->tail) {
Ty_ty ty = (Ty_ty)S_look(tenv, ntl->head->name);
ty->u.name.ty = transTy(tenv, ntl->head->ty);
}
for (ntl = d->u.type; ntl; ntl = ntl->tail) {
Ty_ty ty = (Ty_ty)S_look(tenv, ntl->head->name);
if (ty->u.name.ty->kind != Ty_name) {
return;
}
}
EM_error(d->pos, "infinite recursive");
return;
}
case A_functionDec: {
S_table tmp = S_empty();
A_fundecList fdl;
for (fdl = d->u.function; fdl; fdl = fdl->tail) {
if (S_look(tmp, fdl->head->name)) {
EM_error(d->pos, "function '%s' redefined", S_name(fdl->head->name));
return;
}
S_enter(tmp, fdl->head->name, "-tmp-");
}
for (fdl = d->u.function; fdl; fdl = fdl->tail) {
Ty_tyList formalTys = makeFormalTyList(tenv, fdl->head->params);
if (fdl->head->result) {
Ty_ty resultTy = S_look(tenv, fdl->head->result);
S_enter(venv, fdl->head->name, E_FunEntry(formalTys, resultTy));
}
else {
S_enter(venv, fdl->head->name, E_FunEntry(formalTys, NULL));
}
}
for (fdl = d->u.function; fdl; fdl = fdl->tail) {
Ty_tyList formalTys = makeFormalTyList(tenv, fdl->head->params);
S_beginScope(venv);
{
A_fieldList l;
Ty_tyList t;
for (l = fdl->head->params, t = formalTys; l; l = l->tail, t = t->tail) {
S_enter(venv, l->head->name, E_VarEntry(t->head));
}
}
transExp(venv, tenv, fdl->head->body);
S_endScope(venv);
}
break;
}
default: {
assert(0);
}
}
}
