Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
162 lines (139 sloc) 4.84 KB
#include "lie.h"
static boolean match_arg(symblst pattern, symblst actual, boolean deflt)
{ while (pattern!=NULL && actual!=NULL)
if ( type_of(actual)!=type_of(pattern)
&& type_of(pattern)!=ARGTYPE
&& type_of(actual)!=UNKNOWN
&& !coerc_tab(type_of(actual),type_of(pattern))
) return false;
else
{ actual=actual->next; if (!isarrtype(pattern)) pattern=pattern->next; }
return actual==NULL
&& (pattern==NULL || isarrtype(pattern) || deflt&&isdefault(pattern));
}
symblst srchsym(symblst table, strtype name, symblst arg)
{ symblst s;
if (table==topsym)
/* then search stack first, and user definitions afterwards */
{ for (s=table ; s!=NULL; s=s->next)
if (s->formal==name) return isargument=true, s;
table=top_definitions;
}
for (s=table ; s!=NULL; s=s->next)
if (s->a.name==name && match_arg(s->arglst, arg, false))
return isargument=false, s;
for (s=table ; s!=NULL; s=s->next)
if (s->a.name==name && match_arg(s->arglst, arg, true))
return isargument=false, s;
return isargument=false,s; /* |s==NULL|, not found anywhere */
}
void
addsym(strtype name, symblst arg, symblst expr, int class)
{ symblst s;
{ symblst ref=symbol_tab[name]; /* the permanant bindings */
if (ref!=NULL && srchsym(ref,name,arg)!=NULL) /* one of them matches */
{ err_Printf("Sorry, there is a primitive definition for ");
error_prototype(name_tab[name],arg);
error("\nwhich you cannot redefine.\n");
}
}
s=srchsym(top_definitions, name, arg);
/* if an old binding matches, overwrite it */
if (s==NULL)
{ s=creatsym(name);
s->next=top_definitions->next;
top_definitions->next=s;
}
s->class=class;
if (class==FUNCTION)
{ s->data.func=store_function_body(arg, expr);
s->arglst=s->data.func->top_arg;
s->type=UNKNOWN;
}
else if (class==VALUE) { clrshared(s->data.val); assignsym(s,expr); }
}
symbrec* creatsym(strtype a)
{ symbrec* s = (symbrec*) allocmem(sizeof(symbrec));
*s=blank_symbol; s->a.name = a;
return s;
}
void error_prototype(string name, symblst arg)
{ err_Printf("%s(",name);
if (arg!=NULL)
while (err_Printf("%3s",code_obj_type(type_of(arg))),(arg=arg->next)!=NULL)
err_Printf(", ");
err_Printf(")");
}
void assignsym(symblst s, symblst t) /* |s=t| */
{ s->class=t->class; s->type=t->type; s->data=t->data; }
void push(symblst l, symblst sym)
{ sym->next = l->next;
l->next=sym;
}
symblst push_value(symblst list)
{ symblst* p=&list, q;
for (q=list; q!=NULL; q=q->next) /* duplicate list */
{ *p=copynode(q); (*p)->arglst=q->arglst; p=&(*p)->next; }
*p=topsym->next; return topsym->next=list; /* insert list after |topsym| */
}
symblst pop_value(symblst topoldsym)
/* clear sharing in stack down to |topoldsym| */
{ symblst list;
for (list=topsym->next; list != topoldsym; list=list->next)
if (list->class==VALUE) clrshared(list->data.val);
return topoldsym;
}
void assignnames(symblst actual, symblst formal)
{ symblst* p;
for (p=&actual->arglst; *p!=NULL; p=&(*p)->next, formal=formal->next)
(*p)->formal=formal->a.label->name;
if (formal!=NULL)
{ strtype name=match("_gsetdefault",false);
symblst foundsym=srchsym(symbol_tab[name],name,NULL);
*p=addnode(0,name),
assignsym(*p,foundsym); (*p)->formal=formal->a.label->name;
(*p)->data.expr=foundsym;
}
}
void assigntype(objtype t, symblst list)
{
for ( ;list!=NULL; list=list->next)
{ list->type= list->next==NULL && t==GROUP ? GRPDFT : t;
list->class=DUMMY;
}
}
void add_dollar_names(symblst list)
{ static char *name[]=
{"$1","$2","$3","$4","$5","$6","$7","$8","$9","$10"};
int i;
for (i=0; i<10 && list!=NULL; ++i,list=list->next)
list->formal=match(name[i],false);
if (list!=NULL) error("At most 10 arguments to a block allowed.\n");
}
void error_not_foundsym(symblst s)
{ strtype id=s->a.label->name; char* name = name_tab[id];
label->line = s->a.label->line; /* adjust error indication */
{ if (strcmp(name, "_select")==0)
error("Impossible to select component from %s.\n"
, code_type(s->arglst->type));
if (strcmp(name, ".strucval")==0) error("Array has inconsistent types.\n");
}
if (name[0] == '.') ++name; /* skip |'.'| */
{ symblst p;
for (p=top_definitions; p!=NULL; p=p->next)
if (p->a.name==id) goto found;
for (p=symbol_tab[id]; p!=NULL; p=p->next)
if (p->a.name==id) goto found;
if (false) /* i.e., |if (p!=NULL)|; only do next after |goto found|: */
{ found:
if (s->arglst==NULL) err_Printf("Arguments required for %s.\n",name);
else
{ err_Printf("Argument types do not match in call. Types are: ");
error_prototype(name,s->arglst); err_Printf(".\n");
}
err_Printf("Valid argument types are for instance: ");
error_prototype(name,p->arglst); error(".\n");
}
}
error("Identifier %s is not defined. \n",name);
}
Jump to Line
Something went wrong with that request. Please try again.