static void makerecordfield(Cell *recordtype, Cell *field, Cell *fieldtype)
{
char *fieldname = getfunction(field->value)->name;
Cell *var = newcell(VARIABLE);
var->value = 1;
var->left = field;
push(fieldtype);
push(recordtype);
make(APPLY);
if(!inserttypeexpr(fieldname, pop())) parseerror(12);
push(var);
push(var);
push(field);
make(ALIAS);
makecompound(RECORD, 1);
push(field);
make(APPLY);
make(LIST);
if(!insert(fieldname, 1, FUNC, pop(), NULL)) parseerror(18);
}
static void parsetypesynonym(void)
{
Cell *head = pop();
setchecktypevariables(COLLECT);
push(template_match);
for(; head->tag==APPLY; head=head->left)
{
if(head->right->tag != UNDEFINED && head->right->tag != FUNC) parseerror(9);
push(maketypevariable(getfunction(head->right->value)->name));
make(STRUCT);
}
if(head->tag != UNDEFINED && head->tag != FUNC) parseerror(10);
makeconstant(FUNC, head->value);
make(STRUCT);
setchecktypevariables(CHECK);
gettoken();
parsetype(TYPEEXPR);
makeinverse(TYPESYNONYM);
if(!inserttypeexpr(getfunction(head->value)->name, pop())) parseerror(12);
setchecktypevariables(NOCHECK);
}
static void parseabstype(void)
{
Cell *head, *abstype;
int globaltokenoffside;
gettoken();
parselefthandside();
abstype = pop();
while(abstype->tag == APPLY) abstype = abstype->left;
if(abstype->tag != UNDEFINED && abstype->tag != FUNC) parseerror(13);
if(!insertabstype(getfunction(abstype->value)->name, abstype)) parseerror(12);
if(tokentype != WITH) parseerror(14);
globaltokenoffside = tokenoffside;
tokenoffside = tokenindent + 1;
gettoken();
while(tokentype == IDENTIFIER || tokentype == OPERATOR || tokentype == LPAR)
{
int temptokenoffside = tokenoffside;
parselefthandside();
tokenoffside = tokenindent + 1;
if(tokentype != COLONS) parseerror(15);
head = pop();
if(head->tag != UNDEFINED && head->tag != FUNC) parseerror(13);
gettoken();
parsetype(TYPEEXPR);
if(!inserttypeexpr(getfunction(head->value)->name, pop()))
parseerror(12);
if(!insertabstype(getfunction(head->value)->name, abstype))
parseerror(12);
while(tokentype == SEP) gettoken();
tokenoffside = temptokenoffside;
if(tokentype == offside) gettoken();
}
tokenoffside = globaltokenoffside;
if(tokentype == offside) gettoken();
}
/********************************************************************
initialisation of hashtable with system functions
*********************************************************************/
static void initsyslib(void)
{
Cell *obj = gettemplate("objecttype");
inserttypestring("object", "[char] -> objecttype");
insertabstype("object", obj);
parsetypeexpr("(*, [char] -> [[char]] -> * -> (*, [[char]]))");
makeconstant(FUNC, obj->value);
makecompound(STRUCT, 1);
make(TYPESYNONYM);
inserttypeexpr("objecttype", pop());
insertabstype("objecttype", obj);
insert("_section", 3, FUNC , NULL, apply_SECTION);
insert("if" , 3, FUNC , NULL, applyIF);
insert("^" , 2, FUNC , NULL, applyPOWER);
insert("neg" , 1, FUNC , NULL, applyNEG);
insert("*" , 2, FUNC , NULL, applyTIMES);
insert("/" , 2, FUNC , NULL, applyDIV);
insert("//" , 2, FUNC , NULL, applyDIVIDE);
insert("%" , 2, FUNC , NULL, applyMOD);
insert("+" , 2, FUNC , NULL, applyPLUS);
insert("-" , 2, FUNC , NULL, applyMINUS);
insert("=" , 2, FUNC , NULL, applyEQ);
insert("~=" , 2, FUNC , NULL, applyNE);
insert("<" , 2, FUNC , NULL, applyLT);
insert("<=" , 2, FUNC , NULL, applyLE);
insert(">" , 2, FUNC , NULL, applyGT);
insert(">=" , 2, FUNC , NULL, applyGE);
insert("&" , 2, FUNC , NULL, applyUPDATE);
insert("True" , 0, BOOLEAN , NULL, NULL);
insert("False" , 0, BOOLEAN , NULL, NULL);
insert("pi" , 0, REAL , NULL, NULL);
insert("Nil" , 0, NIL , NULL, NULL);
insert("" , 1, FUNC , NULL, NULL);
insert("strict" , 2, FUNC , NULL, applySTRICT);
inserttypestring("_section" , "(* -> ** -> ***) -> ** -> * -> ***");
inserttypestring("if" , "bool -> * -> * -> *");
inserttypestring("^" , "num -> num -> num");
inserttypestring("neg" , "num -> num");
inserttypestring("*" , "num -> num -> num");
inserttypestring("/" , "num -> num -> num");
inserttypestring("//" , "num -> num -> num");
inserttypestring("%" , "num -> num -> num");
inserttypestring("+" , "num -> num -> num");
inserttypestring("-" , "num -> num -> num");
inserttypestring("=" , "* -> * -> bool");
inserttypestring("~=" , "* -> * -> bool");
inserttypestring("<" , "* -> * -> bool");
inserttypestring("<=" , "* -> * -> bool");
inserttypestring(">" , "* -> * -> bool");
inserttypestring(">=" , "* -> * -> bool");
inserttypestring("&" , "* -> * -> *");
inserttypestring("True" , "bool");
inserttypestring("False" , "bool");
inserttypestring("pi" , "num");
inserttypestring("Nil" , "[*]");
inserttypestring("strict" , "(* -> **) -> * -> **");
insertsys("strict");
insertsys("^");
insertsys("neg");
insertsys("*");
insertsys("/");
insertsys("//");
insertsys("%");
insertsys("+");
insertsys("-");
insertsys("=");
insertsys("~=");
insertsys("<");
insertsys("<=");
insertsys(">");
insertsys(">=");
insertoperator("." , 1, Right);
insertoperator(":" , 1, Right);
insertoperator("&" , 1, Left);
insertoperator("!" , 2, Left);
insertoperator("^" , 2, Right);
insertoperator("*" , 3, Left);
insertoperator("/" , 3, Left);
insertoperator("//" , 3, Left);
insertoperator("%" , 3, Left);
insertoperator("++" , 4, Right);
insertoperator("--" , 4, Left);
insertoperator("+" , 4, Left);
insertoperator("-" , 4, Left);
insertoperator("=" , 5, Right);
insertoperator("~=" , 5, Left);
insertoperator("<" , 5, Left);
insertoperator("<=" , 5, Left);
insertoperator(">" , 5, Left);
insertoperator(">=" , 5, Left);
insertoperator("/\\" , 6, Right);
insertoperator("\\/" , 7, Right);
template_divide = gettemplate("//");
template_div = gettemplate("/");
template_mod = gettemplate("%");
template_power = gettemplate("^");
template_update = gettemplate("&");
}
static void parsedefinition(bool globallevel)
{
Cell *head;
int globaltokenoffside = tokenindent, posCode;
bool generic = False;
if(tokentype == ABSTYPE && globallevel)
{
parseabstype();
while(tokentype == SEP) gettoken();
return;
}
else if(tokentype == GENERIC && globallevel)
{
generic = True;
gettoken();
}
parselefthandside();
posCode = getPositionCode();
tokenoffside = tokenindent + 1;
if(tokentype == COLONS && globallevel)
{
head = pop();
if(head->tag != UNDEFINED && head->tag != FUNC) parseerror(13);
gettoken();
parsetype(TYPEEXPR);
if(!inserttypeexpr(getfunction(head->value)->name, pop())) parseerror(12);
getfunction(head->value)->generic = generic;
while(tokentype == SEP) gettoken();
}
else if(tokentype == DEF && globallevel)
{
parsestructdef();
while(tokentype == SEP) gettoken();
}
else if(tokentype == SYN && globallevel)
{
parsetypesynonym();
while(tokentype == SEP) gettoken();
}
else
{
head = top();
if(head->tag == APPLY || globallevel)
{
for(; head->tag==APPLY; head=head->left) checkpattern(head->right);
if(head->tag != UNDEFINED && head->tag != FUNC) parseerror(17);
if(globallevel) storefunctionname(getfunction(head->value)->name);
}
else
checkpattern(head);
parseexpressionclause();
if(tokentype == WHERE)
{
gettoken();
parsewhereclause();
}
else if(tokentype == offside)
{
tokenoffside = globaltokenoffside;
gettoken();
if(tokentype == WHERE)
{
tokenoffside = tokenindent + 1;
gettoken();
parsewhereclause();
}
}
makeinverse(LIST);
top()->value = posCode;
if(globallevel)
{
Cell *def = pop();
int argcount = 0;
char *funname;
head = def;
for(head=head->left; head->tag==APPLY; head=head->left) argcount++;
funname = getfunction(head->value)->name;
initrename(funname);
def = renamerec(FUN, def);
if(!insert(funname, argcount, FUNC, def, NULL)) parseerror(18);
}
}
}
static void parsestructdef(void)
{
char structname[stringsize];
char *headname;
int count;
Cell *head = pop();
setchecktypevariables(COLLECT);
push(template_match);
for(; head->tag==APPLY; head=head->left)
{
if(head->right->tag != UNDEFINED && head->right->tag != FUNC) parseerror(9);
push(maketypevariable(getfunction(head->right->value)->name));
make(STRUCT);
}
if(head->tag != UNDEFINED && head->tag != FUNC) parseerror(10);
headname = getfunction(head->value)->name;
makeconstant(FUNC, head->value);
make(STRUCT);
setchecktypevariables(CHECK);
gettoken();
head = top();
if(tokentype == LACC)
{
count = 0;
do
{
gettoken();
if(tokentype != IDENTIFIER) parseerror(25);
push(gettemplate(tokenval));
gettoken();
if(tokentype != COLONS) parseerror(15);
gettoken();
parsetype(TYPEEXPR);
makerecordfield(head, getN(2), getN(1));
makeinverse(TYPEDEF);
count++;
}
while(tokentype == COMMA);
makecompound(RECORD, count);
makeinverse(TYPEDEF);
if(tokentype != RACC) parseerror(33);
gettoken();
}
else
{
for(;;)
{
if(tokentype != TYPEID) parseerror(11);
strcpy(structname, tokenval);
count = 0;
gettoken();
while(tokentype == IDENTIFIER
|| tokentype == OPERATOR
|| tokentype == LBRACK
|| tokentype == LPAR)
{
parsetype(TYPETERM);
count++;
}
push(head);
while(count-- > 0) makeinverse(APPLY);
if(!inserttypeexpr(structname, pop())) parseerror(12);
if(tokentype != BAR) break;
gettoken();
}
}
if(!inserttypeexpr(headname, pop())) parseerror(12);
setchecktypevariables(NOCHECK);
}
