int main ( int argc, char** argv )
{
SchObj robj,ret;
int opt;
char * fname = 0;
char * expr = 0;
#ifdef USE_BOEHM_GC
GC_INIT();
#endif
ensure_init_symtable();
init_reader();
init_port();
flag_use_profiler = 0;
while ( (opt = getopt(argc,argv,"pf:e:")) != -1 ) {
switch ( opt ) {
case 'p': {
flag_use_profiler = 1;
} break;
case 'f': {
fname = SCH_MALLOC(strlen(optarg) + 1);
strcpy(fname,optarg);
} break;
case 'e':{
expr = SCH_MALLOC(strlen(optarg) + 1);
strcpy(expr,optarg);
}break;
};
}
if ( expr ) {
robj = sch_read_string(expr);
ret = vm_compile(robj);
SCH_WRITE(ret);
SCH_DISPLAY(SCH_CHAR('\n'));
} else if ( fname ) {
sch_load(SCH_STRING_OBJ(SCH_STRING(fname)));
} else {
while ( 1 ) {
robj = sch_read(NULL);
ret = vm_compile(robj);
SCH_WRITE(ret);
}
}
return 0;
}
SchObj read_obj( SchPort* port ) {
unsigned int c;
do {
c = SCH_GETC(port);
} while ( ch_class(c) == CL_WHITESPACE );
if ( c == ((unsigned char)EOF) ) { /* c -> 0x 00 00 00 ff, EOF -> 0x ff */
return SCH_EOF;
}
CLEAR_BUF(token_buffer_);
if ( ch_class(c) == CL_DECIMALNUMBER || c == '-' || c == '+') {
unsigned int c0 = c;
PUSH_BUF(token_buffer_,c0);
c = SCH_GETC(port);
if ( (c0 == '-' || c0 == '+') && (ch_class(c) != CL_DECIMALNUMBER) ) {
SCH_UNGETC(c,port);
return SCH_SYMBOL(TO_S_BUF(token_buffer_));
}
while ( ch_class(c) & (CL_DECIMALNUMBER) || c == '.' || c == '/' ) {
PUSH_BUF(token_buffer_,c);
c = SCH_GETC(port);
}
SCH_UNGETC(c,port);
return read_number(TO_S_BUF(token_buffer_),10);
} else if ( ch_class(c) == CL_LIST_END ) {
return SCH_KOKKA;
} else if ( ch_class(c) == CL_LIST_BEGIN ) {
SchObj x = read_obj(port);
SchObj p_val = SCH_LIST1(x);
SchObj p_last = p_val;
if ( x == SCH_KOKKA ) {
return SCH_NIL;
}
for (;;) {
x = read_obj( port );
if ( x == SCH_KOKKA ) {
return p_val;
} else if ( x == SCH_DOT || x == SCH_SYMBOL(".") ) {
SCH_SET_CDR( p_last, read_obj(port) );
if ( read_obj( port ) != SCH_KOKKA ) {
EXCEPTION("right parenthesis ')' missing");
}
return p_val;
} else {
SchObj p_y = SCH_LIST1(x);
SCH_SET_CDR(p_last,p_y);
p_last = p_y;
}
}
} else if ( c == '"' ) {
unsigned int prev = c;
while ( (c = SCH_GETC(port)) != '"' || prev == '\\') {
if ( prev == '\\' ) {
switch(c) {
case '"':
POP_BUF(token_buffer_);
PUSH_BUF(token_buffer_,'\"');
break;
case 'n':
POP_BUF(token_buffer_);
PUSH_BUF(token_buffer_,'\n');
break;
case 't':
POP_BUF(token_buffer_);
PUSH_BUF(token_buffer_,'\t');
break;
default:
break;
}
} else {
PUSH_BUF(token_buffer_,c);
}
prev = c;
}
return SCH_STRING(TO_S_BUF(token_buffer_));
} else if ( c == '\'' ) {
return SCH_LIST2(SCH_SYMBOL("quote"),read_obj(port));
} else if ( c == '`' ) {
return SCH_LIST2( SCH_SYMBOL("quasiquote"), read_obj(port) );
} else if ( c == ',' ) {
if ( (c = SCH_GETC(port)) == '@' ) {
return SCH_LIST2( SCH_SYMBOL("unquote-splicing"), read_obj(port) );
} else {
SCH_UNGETC(c,port);
return SCH_LIST2( SCH_SYMBOL("unquote"), read_obj(port) );
}
} else if ( c == ';' ) {
while ( (c = SCH_GETC(port)) != '\n' ) {
if (c == (unsigned char)EOF) { return (SchObj)SCH_EOF; }
}
return read_obj( port );
} else if ( c == '#') {
return read_sharp_sequence(port);
} else {
do {
PUSH_BUF(token_buffer_,c);
c = SCH_GETC(port);
} while ( ch_class(c) & (CL_IDENTIFIER|CL_DECIMALNUMBER) );
SCH_UNGETC(c,port);
return SCH_SYMBOL(TO_S_BUF(token_buffer_));
}
}
