void parser_init() {
debug("Defining built-in symbols\n");
sym_map = binmap(newSYMBOL(hash("NIL")),newSTRING("NIL"));
literal_map = binmap(newSYMBOL(intern("NIL")),NIL);
literal_name_map = binmap(newPRIMFUNC(SPEC_LAMBDA,l_lambda),newSTRING(strdup("LAMBDA")));
addPrimFunc(LAMBDA,SPEC_LAMBDA,l_lambda);
addPrimFunc(PROG,SPEC_MACRO,l_prog);
addPrimFunc(COND,SPEC_MACRO,l_cond);
addPrimFunc(MACRO,SPEC_MACRODEF,l_macro);
addPrimFunc(QUOTE,SPEC_QUOTE,l_quote);
addPrimFunc(NODE,SPEC_FUNC,l_node);
addPrimFunc(LIST,SPEC_MACRO,l_list);
addPrimFunc(ADDR,SPEC_FUNC,l_addr);
addPrimFunc(DATA,SPEC_FUNC,l_data);
addPrimFunc(SETA,SPEC_FUNC,l_seta);
addPrimFunc(SETD,SPEC_FUNC,l_setd);
addPrimFunc(REF,SPEC_FUNC,l_ref);
addPrimFunc(BIND,SPEC_FUNC,l_bind);
addPrimFunc(+,SPEC_FUNC,l_add);
addPrimFunc(-,SPEC_FUNC,l_sub);
addPrimFunc(*,SPEC_FUNC,l_mul);
addPrimFunc(/,SPEC_FUNC,l_div);
addPrimFunc(PRINT,SPEC_FUNC,l_print);
addPrimFunc(ISNODE,SPEC_FUNC,l_isnode);
}
T_SYMBOL intern(char *c_str) {
if (!sym_map) parser_init();
c_str = strdup(c_str);
for (int i = 0; c_str[i]; i++) c_str[i] = toupper(c_str[i]);
debug("intern: %s %u\n",c_str,hash(c_str));
SYMBOL *sym = newSYMBOL(hash(c_str));
STRING *str = newSTRING(c_str);
NODE *entry;
while ((entry = binmap_find(sym,sym_map))) {
debugVal(entry,"matching: ");
if (cmpSTRING((STRING*)entry->addr,str)) {
decRef(entry);
sym->sym++;
} else {
break;
}
}
if (!entry) {
debug("adding symbol: %s\n",c_str);
binmap_put(sym,str,sym_map);
return sym->sym;
} else {
decRef(sym);
decRef(str);
decRef(entry);
return ((SYMBOL*)entry->data)->sym;
}
}
static void parseDBESTblock(FILE *fp, ANYTYPE *a){
register STRING *s = newSTRING();
register int ch, prev = ' ';
a->type = 's';
while( (ch = getc(fp)) != EOF){
switch(ch){
case '\n':
if(prev == '\n'){
a->u.s = s->str;
free(s); /* FREE SHELL ONLY */
return;
}
break;
case ' ':
case '\t':
break;
default:
addSTRING(s, ch);
break;
}
prev = ch;
}
freeSTRING(s);
a->u.s = NULL;
return;
}
static void parseDBESTline(FILE *fp, ANYTYPE *a){
register int ch;
register STRING *s;
a->type = 's';
while(isspace(ch = getc(fp))) /* SKIP LEADING WHITE SPACE */
if(ch == EOF){
a->u.s = NULL;
return;
}
s = newSTRING();
do {
switch(ch){
case '\t': /* REPLACE TABS WITH SPACES */
addSTRING(s, ' ');
break;
case '\n':
a->u.s = s->str;
free(s); /* FREE STRING SHELL ONLY */
return;
default:
addSTRING(s, ch);
break;
}
} while((ch = getc(fp)) != EOF);
a->u.s = NULL;
freeSTRING(s);
return;
}
static void parseDBESTpara(FILE *fp, ANYTYPE *a){
register STRING *s = newSTRING();
register int ch, prev = ' ';
a->type = 's';
while(isspace(ch = getc(fp)));
do {
switch(ch){
case '\n':
if(prev == '\n'){ /* SECTION END */
a->u.s = s->str;
free(s); /* FREE SHELL ONLY */
return;
}
break;
case ' ': /*FALLTHROUGH*/
case '\t':
if(prev == '\n'){ /* SKIP SPACE AT START OF LINE */
while(isspace(ch = getc(fp))){
if((ch == '\n') && (prev == '\n')){
a->u.s = s->str;
free(s); /* FREE SHELL ONLY */
return;
}
prev = ch;
}
addSTRING(s, ' ');
}
addSTRING(s, ch);
break;
default:
if(prev == '\n'){ /* TAG END */
ungetc(ch, fp);
a->u.s = s->str;
free(s); /* FREE SHELL ONLY */
return;
}
addSTRING(s, ch);
break;
}
prev = ch;
} while( (ch = getc(fp)) != EOF);
freeSTRING(s);
a->u.s = NULL;
return;
}
static void parseDBESTword(FILE *fp, ANYTYPE *a){
register int ch;
register STRING *s = newSTRING();
a->type = 's';
while((ch = getc(fp)) != EOF){
switch(ch){
case ' ': /* SKIP WHITE SPACE */
case '\t':
break;
case '\n':
a->u.s = s->str;
free(s); /* FREE STRING SHELL ONLY */
return;
default:
addSTRING(s, ch);
break;
}
}
return;
}
