lisp_atom lp_defun(slist_elem* next)
{
slist* def_list=new_slist();
slist_elem* pos=0;
lisp_atom* fun=0;
lisp_atom ret;
char* sym=0;
/* if this symbol is named then we need to skip an arg*/
if(ATOM_CAST(next)->type==LTID)
{
sym=(char*)ATOM_CAST(next)->data;
pos=next->_next;
}else pos=next;
/* get params */
if(!pos||ATOM_CAST(pos)->type!=LTLIST)
LPRETURN_NIL(ret)
slist_pushb(def_list,(void*)atom_copy(ATOM_CAST(pos)));
/* get body */
pos=pos->_next;
if(!pos||ATOM_CAST(pos)->type!=LTLIST)
LPRETURN_NIL(ret)
slist_pushb(def_list,(void*)atom_copy(ATOM_CAST(pos)));
/* install macro or fn if not a lambda*/
fun=new_atom(LENORMAL,LTLISPFN,(void*)def_list);
if(sym&&!lisp_put_symbol(sym,(void*)fun))
LPRETURN_NIL(ret)
ret.type=LTLISPFN;
ret.data=(void*)fun;
return ret;
}
slist* parse_bnf(char* input)
{
if(!input)return 0;
slist* items=new_slist();
slist* lexed_in=lex_bnf(input);
lp_token** lex_arr=(lp_token**)calloc(lexed_in->_size,sizeof(lp_token*));
int last_item=0;
int i=0;
slist_elem* sle=lexed_in->_head;
for(;i<lexed_in->_size&&sle;++i,sle=sle->_next)
{
lex_arr[i]=(lp_token*)sle->_data;
if(lex_arr[i]->lex_id==SEMI_COLON)
{
__parser(&lex_arr[last_item],(i-last_item)+1);
last_item=i+1;
if(success)
slist_append(items,(void*)item);
else return 0;
}
}
free(lex_arr);
slist_destroy(lexed_in);
return items;
}
lisp_atom lp_let(slist_elem* next)
{
slist* activation=0; /* pointer to the top of the activation stack */
slist_elem* sle=0; /* general iterator */
lisp_atom ret; /* return value */
/* put a new activation record */
activation=new_slist();
/* load all parameters */
if(ATOM_CAST(next)->type!=LTLIST)
LPRETURN_NIL(ret)
sle=((slist*)ATOM_CAST(next)->data)->_head;
while(sle&&sle->_next)
{
/* load each argument*/
if(ATOM_CAST(sle)->type!=LTID)
{
slist_destroy(activation,free);
LPRETURN_NIL(ret)
}
slist_pushb(activation,(void*)ATOM_CAST(sle)->data);
slist_pushb(activation,(void*)ATOM_CAST(sle->_next));
sle=sle->_next;
}
slist* slist_split(slist* list,
int index)
{
slist_elem* temp=0;
slist* split=0;
slist_elem* pos=0;
int i=1;
if(!list||list->_size<1||index>list->_size)
return 0;
split=new_slist();
pos=list->_head;
//iterate to one before element and remove the next element
for(;pos->_next,i<list->_size;pos=pos->_next,++i)
if(i==index-1)
{
temp=pos->_next;
pos->_next=0;
split->_head=temp;
split->_size=list->_size-index;
list->_size=index;
return split;
}
return 0;
}
slist* slist_range(slist* list,
int from,
int to)
{
slist* ret=0;
slist_elem* it=0;
if(!list)
return ret;
if(from>list->_size||
to>list->_size||to<from)
return ret;
it=slist_elem_at(list,from);
if(!it)
return ret;
to-=from;
ret=new_slist();
while(it&&to)
{
slist_append(ret,it->_data);
it=it->_next;
--to;
}
return ret;
}
type_t *
type_switch_any (void)
{
static type_t * inst = NULL;
if (!inst)
inst = new_t_switch (new_slist ());
return inst;
}
/*************************************************
* this function is used by the parser to create *
* new parse items. *
*************************************************/
bnf_parse_item* new_bnf_parse_item(char* head)
{
bnf_parse_item* bpi=(bnf_parse_item*)malloc(sizeof(bnf_parse_item));
if(head)
{
bpi->head=(char*)malloc(strlen(head)+1);
sprintf(bpi->head,"%s\0",head);
}
else bpi->head=0;
bpi->products=new_slist();
return bpi;
}
int pqload::build_sched(char *instr = NULL, SCHED_LIST *end = NULL){
char *sc_end = 0;
char *start = instr ? instr : schedule.get_string(); /* doesn't copy but doesn't use strtok */
int rv = 0, scanct = 0;
SCHED_LIST *endptr = NULL;
/* eat whitespace between schedules */
while(*start == ' '){
++start;
}
/* check schedule string end */
if(*start == '\n' || *start == 0){
return 1; /* end of schedule ~ success */
}
/* extend list */
if(sched == NULL){
sched = endptr = new_slist();
} else {
endptr = new_slist();
}
/* find bounds */
sc_end = strchr(start, ';');
if(sc_end == NULL){
gl_error("schedule token \"%s\" not semicolon terminated", start);
}
char moh_v[257], moh_w[257], hod_v[257], hod_w[257], dom_v[257], dom_w[257], moy_v[257], moy_w[257], dow_v[257], lpu[257], sc[257];
scanct = sscanf(start, "%256[-0-9*]%256[ \t]%256[-0-9*]%256[ \t]%256[-0-9*]%256[ \t]%256[-0-9*]%256[ \t]%256[-0-9*]:%256[0-9\\.]%[;]",
moh_v, moh_w, hod_v, hod_w, dom_v, dom_w, moy_v, moy_w, dow_v, lpu, sc);
/* parse the individual fields */
rv = build_sched(sc_end + 1, endptr);
if(rv > 0)
return rv + 1;
else
return rv - 1; /* error depth */
}
slist* slist_copy(slist* list)
{
int i=1;
slist* ret=0;
slist_elem* sle=0;
if(!list)return 0;
ret=new_slist();
sle=list->_head;
for(;sle&&i<list->_size;sle=sle->_next,++i)
slist_append(list,(void*)sle->_data);
return ret;
}
// Generate a slist of directory entries in specified path. Then
// print the to stdout.
void list (char *path) {
DIR *dir = opendir (path);
struct dirent *ent;
slist_ref slist = new_slist ();
if (dir != NULL) {
for (;;) {
ent = readdir (dir);
if (ent == NULL) break;
insert (slist, path, ent->d_name);
}
closedir (dir);
if (flags.recursive) push_subdir (slist, path);
if (flags.opct > 1 && !flags.recursive)
printf ("%s:\n", path);
print_directory (slist);
}else {
print_error (path, strerror (errno));
}
free_slist (slist);
}
//reduction actions switch function
int __prh(int* ri, pcstack* stack)
{
switch(-*ri)
{
case 2:
*ri=1;
//printf("item:<head><body>T(SEMI_COLON)\n");
return 3;
case 3:
*ri=2;
//printf("head:T(PRODUCT)T(COLON)\n");
temp_val=(char*)malloc(strlen(((lp_token*)peek_stackn(stack,1))->lex_val)+2);
sprintf(temp_val,"<%s\0",((lp_token*)peek_stackn(stack,1))->lex_val);
cset_add(products,(void*)temp_val);
item=new_bnf_parse_item(temp_val);
return 2;
case 4:
*ri=3;
//printf("body:<product>\n");
slist_append(item->products,(void*)product);
product=new_slist();
return 1;
case 5:
*ri=3;
//printf("body:<product>T(ACTION)\n");
temp_val=(char*)malloc(strlen(((lp_token*)peek_stackn(stack,0))->lex_val)+2);
sprintf(temp_val,"{%s\0",((lp_token*)peek_stackn(stack,0))->lex_val);
cset_add(actions,(void*)temp_val);
slist_append(product,(void*)temp_val);
slist_append(item->products,(void*)product);
product=new_slist();
return 2;
case 6:
*ri=3;
//printf("body:<body>T(PIPE)<body>\n");
return 3;
case 7:
*ri=4;
//printf("product:<part>\n");
return 1;
case 8:
*ri=4;
//printf("product:<product><part>\n");
return 2;
case 9:
*ri=5;
//printf("part:T(TOKEN)\n");
temp_val=(char*)malloc(strlen(((lp_token*)peek_stackn(stack,0))->lex_val)+2);
sprintf(temp_val,"(%s\0",((lp_token*)peek_stackn(stack,0))->lex_val);
cset_add(tokens,(void*)temp_val);
slist_append(product,(void*)temp_val);
return 1;
case 10:
*ri=5;
//printf("part:T(PRODUCT)\n");
temp_val=(char*)malloc(strlen(((lp_token*)peek_stackn(stack,0))->lex_val)+2);
sprintf(temp_val,"<%s\0",((lp_token*)peek_stackn(stack,0))->lex_val);
//cset_add(products,(void*)temp_val);
slist_append(product,(void*)temp_val);
return 1;
default:
return-1;
}
}
;\
body:<product>{printf(\"body:<product>\\n\");}\
|<product>T(ACTION){printf(\"body:<product>T(ACTION)\\n\");}\
|<body>T(PIPE)<body>{printf(\"body:<body>T(PIPE)<body>\\n\");}\
;\
product:<part>{printf(\"product:<part>\\n\");}\
|<product><part>{printf(\"product:<product><part>\\n\");}\
;\
part:T(TOKEN){printf(\"part:T(TOKEN)\\n\");}\
|T(PRODUCT){printf(\"part:T(PRODUCT)\\n\");}\
;\
*/
bool success=false;
bnf_parse_item* item=0;
static slist* product=new_slist();
static char* temp_val=0;
cset* products=new_set(comp_str);
cset* tokens=new_set(comp_str);
cset* actions=new_set(comp_str);
//beginning of stack data structure used by this parser
struct pstack_elem{void *_data;pstack_elem *_next;};
struct pcstack{size_t size;pstack_elem* first;};
pcstack* new_pcstack()
{
pcstack* pcs((pcstack*)malloc(sizeof(pcstack)));
memset((void*)pcs,0,sizeof(pcstack));
pcs->size=0;
pcs->first=0;
return pcs;
