static void parseexpression(int prio)
{
int lambdacount;
parseapplication();
if(tokentype != ARROW || prio < MAXPRIO)
{
parsesection(prio);
return;
}
lambdacount = 1;
for(;;)
{
int count = 0;
while(tokentype == ARROW)
{
checkpattern(top());
count++;
gettoken();
parseapplication();
}
parsesection(MAXPRIO);
while(count-- > 0) makeinverse(LAMBDA);
if(tokentype != BAR) break;
lambdacount++;
gettoken();
parseapplication();
}
push(template_match);
while(lambdacount-- > 0) makeinverse(LAMBDAS);
}
static void parseapplication(void)
{
if(tokentype == TYPEID)
{
int count = 1;
push(gettemplate(tokenval));
gettoken();
while(tokentype == NUMBER
|| tokentype == IDENTIFIER
|| tokentype == TYPEID
|| tokentype == CHARACTER
|| tokentype == STRING
|| tokentype == LPAR
|| tokentype == LBRACK
|| tokentype == LACC)
{
parseterm();
count++;
}
makecompound(STRUCT, count);
}
else if(tokentype == OPERATOR)
parsename();
else
parseterm();
while(tokentype == NUMBER
|| tokentype == IDENTIFIER
|| tokentype == TYPEID
|| tokentype == CHARACTER
|| tokentype == STRING
|| tokentype == LPAR
|| tokentype == LBRACK
|| tokentype == LACC)
{
parseterm();
makeinverse(APPLY);
}
if(tokentype == OPERATOR && strcmp(tokenval, ":") == 0)
{
gettoken();
if(tokentype == RPAR)
{
push(gettemplate(":"));
make(APPLY);
}
else
{
parseapplication();
makeinverse(LIST);
}
}
}
/*********************************************************************
everything between a list bar and a rbrack is transformed in a
generator structure:
GENERATOR ---- GENERATOR ---- ... NULL
| |
GENERATOR --
|
in case of an ordinary expression the right part is NULL
in case of a generator the variable(list) is left and the list-expr(list) right
**********************************************************************/
static void parsegenerators(int *count)
{
Cell *temp;
for(;;)
{
int varcount = 0, exprcount = 0;
while(tokentype == SEP) gettoken();
if(tokentype == RBRACK) break;
push(temp = newcell(GENERATOR));
temp->value = getPositionCode();
(*count)++;
for(;;)
{
parseexpression(MAXPRIO);
varcount++;
if(tokentype != COMMA) break;
gettoken();
}
if(tokentype == GENER || tokentype == ASSIGNMENT)
{
bool assignment = tokentype == ASSIGNMENT;
do
{
gettoken();
parseexpression(MAXPRIO);
exprcount++;
if(assignment)
{
push(template_nil);
makeinverse(LIST);
}
}
while(tokentype == COMMA);
if(exprcount != varcount) parseerror(32);
push(template_nil);
while(exprcount-- > 0) makeinverse(LIST);
temp->right = pop();
push(template_nil);
while(varcount-- > 0) makeinverse(LIST);
checkpattern(temp->left = pop());
}
else if(varcount > 1)
parseerror(31);
else
temp->left = pop();
}
}
static void parsewhereclause(void)
{
int globaltokenoffside = tokenoffside, count = 0;
while(tokentype == IDENTIFIER
|| tokentype == OPERATOR
|| tokentype == TYPEID
|| tokentype == NUMBER
|| tokentype == CHARACTER
|| tokentype == STRING
|| tokentype == LBRACK
|| tokentype == LACC
|| tokentype == LPAR)
{
parsedefinition(False);
count++;
tokenoffside = globaltokenoffside;
if(tokentype == offside) gettoken();
}
if(count > 0)
{
push(template_nil);
while(count-->0) makeinverse(LIST);
make(LETREC);
}
}
static void buildstring(char *s)
{
int count = 0;
for(;*s != '\0'; s++)
{
makeconstant(CHAR, *s);
count++;
}
push(template_nil);
while(count-->0) makeinverse(LIST);
}
static void parselefthandside(void)
{
parseapplication();
for(;;)
if(tokentype == OPERATOR && strcmp(tokenval, "=") != 0)
{
parsename();
makeinverse(APPLY);
}
else if(tokentype == LPAR)
{
gettoken();
parseexpression(MAXPRIO);
makeinverse(APPLY);
if(tokentype != RPAR) parseerror(2);
gettoken();
}
else
break;
}
int CreateRemote(char s[])
{
if(!RemoteOk) return -1;
if(seterror() == 0)
{
Cell *pair;
int k;
buildstring(s);
push(gettemplate("object"));
make(APPLY);
eval();
pair = pop();
push(template_nil);
push(template_nil);
push(pair->left);
push(pair->right->left);
push(template_nil);
makeinverse(LIST);
makeinverse(LIST);
makeinverse(LIST);
makeinverse(LIST);
for(k=0; k < ObjectCount; k++)
if(stack[k]->tag != LIST)
{
stack[k]= pop();
return k;
}
return ObjectCount++;
}
else
{
setstackheight(ObjectCount);
interrupted = False;
return -1;
}
}
static void parsesection(int prio)
{
while(tokentype == OPERATOR)
{
Cell *temp = gettemplate(tokenval);
FuncDef *fun = getfunction(temp->value);
if(fun->prio > prio) break;
push(temp);
make(APPLY);
gettoken();
if(tokentype == RPAR) break;
parseexpression(fun->assoc==Left ? fun->prio-1 : fun->prio);
makeinverse(APPLY);
}
}
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 parseexpressionclause(void)
{
Cell *definition = makeerror();
if(strcmp(tokenval, "=") != 0) parseerror(5);
do
{
gettoken();
parseexpression(MAXPRIO);
if(tokentype == COMMA)
{
gettoken();
if(strcmp(tokenval, "if") == 0)
gettoken();
if(tokentype == OTHERWISE)
gettoken();
else
{
push(makeerror());
makeinverse(_IF);
parseexpression(MAXPRIO);
make(_IF);
}
}
definition = extenddefinition(definition, pop());
while(tokentype == SEP) gettoken();
if(tokentype == offside)
{
tokenoffside--;
gettoken();
tokenoffside++;
}
}
while(strcmp(tokenval, "=") == 0);
push(definition);
}
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);
}
static void parsetype(TypeType typetype)
{
switch(tokentype)
{
case IDENTIFIER:
if(strcmp(tokenval, "num") == 0)
{
push(newcell(INT));
gettoken();
}
else if(strcmp(tokenval, "char") == 0)
{
push(newcell(CHAR));
gettoken();
}
else if(strcmp(tokenval, "bool") == 0)
{
push(newcell(BOOLEAN));
gettoken();
}
else
{
int count = 1;
push(gettemplate(tokenval));
gettoken();
if(typetype == TYPEEXPR)
while(tokentype == IDENTIFIER
|| tokentype == OPERATOR
|| tokentype == LBRACK
|| tokentype == LPAR)
{
parsetype(TYPETERM);
count++;
}
makecompound(STRUCT, count);
}
break;
case OPERATOR:
push(maketypevariable(tokenval));
gettoken();
break;
case LPAR:
gettoken();
if(tokentype == RPAR)
push(newcell(NULLTUPLE));
else
{
parsetype(TYPEEXPR);
if(tokentype == COMMA)
{
int count = 1;
while(tokentype == COMMA)
{
gettoken();
parsetype(TYPEEXPR);
count++;
}
makecompound(PAIR, count);
}
}
if(tokentype != RPAR) parseerror(2);
gettoken();
break;
case LBRACK:
gettoken();
parsetype(TYPEEXPR);
push(template_nil);
makeinverse(LIST);
if(tokentype != RBRACK) parseerror(1);
gettoken();
break;
default:
parseerror(8);
}
if(typetype == TYPEEXPR && tokentype == ARROW)
{
gettoken();
parsetype(TYPEEXPR);
makeinverse(APPLY);
}
}
static void parseterm(void)
{
int count;
switch(tokentype)
{
case NUMBER:
if(strchr(tokenval, '.') == NULL)
makeINT(atol(tokenval));
else
makeREAL(atof(tokenval));
gettoken();
break;
case IDENTIFIER:
parsename();
break;
case TYPEID:
push(gettemplate(tokenval));
makecompound(STRUCT, 1);
gettoken();
break;
case CHARACTER:
makeconstant(CHAR, tokenval[0]);
gettoken();
break;
case STRING:
buildstring(tokenval);
gettoken();
break;
case LPAR:
gettoken();
if(tokentype == OPERATOR && strcmp(tokenval, "-") != 0)
{
parsename();
if(tokentype != RPAR)
{
parseexpression(MAXPRIO);
rotatestack();
push(gettemplate("_section"));
make(APPLY);
make(APPLY);
}
}
else if(tokentype == RPAR)
makeconstant(NULLTUPLE, 0);
else
{
parseexpression(MAXPRIO);
if(tokentype == COMMA)
{
count = 1;
while(tokentype == COMMA)
{
gettoken();
parseexpression(MAXPRIO);
count++;
}
makecompound(PAIR, count);
}
}
if(tokentype != RPAR) parseerror(2);
gettoken();
break;
case LBRACK:
parselist();
break;
case LACC:
count = 0;
do
{
gettoken();
if(tokentype != IDENTIFIER) parseerror(25);
push(gettemplate(tokenval));
gettoken();
if(strcmp(tokenval, "=") != 0) parseerror(5);
gettoken();
parseexpression(MAXPRIO);
makeinverse(ALIAS);
count++;
}
while(tokentype == COMMA);
makecompound(RECORD, count);
if(tokentype != RACC) parseerror(33);
gettoken();
break;
default:
parseerror(3);
}
}
static void parselist(void)
{
int count = 0;
gettoken();
if(tokentype != RBRACK)
{
parseexpression(MAXPRIO);
count++;
}
while(tokentype == COMMA)
{
gettoken();
parseexpression(MAXPRIO);
count++;
}
if(tokentype == RBRACK)
{
push(template_nil);
while(count-->0) makeinverse(LIST);
}
else if(tokentype == BAR && count >= 1)
{
push(template_nil);
while(count-->0) makeinverse(LIST);
count = 1;
gettoken();
parsegenerators(&count);
push(template_nil);
while(count-->0) makeinverse(GENERATOR);
}
else if(tokentype == POINTS && count == 1)
{
gettoken();
if(tokentype == RBRACK)
{
push(gettemplate("nats"));
make(APPLY);
}
else
{
push(gettemplate("nat"));
make(APPLY);
parseexpression(MAXPRIO);
makeinverse(APPLY);
}
}
else if(tokentype == POINTS && count == 2)
{
gettoken();
if(tokentype == RBRACK)
{
rotatestack();
push(gettemplate("gennats"));
make(APPLY);
make(APPLY);
}
else
{
rotatestack();
push(gettemplate("gennat"));
make(APPLY);
make(APPLY);
parseexpression(MAXPRIO);
makeinverse(APPLY);
}
}
if(tokentype != RBRACK) parseerror(1);
gettoken();
}
