コード例 #1
0
ファイル: main.c プロジェクト: mnbtkd/MameScheme
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;

}
コード例 #2
0
ファイル: read.c プロジェクト: hellcoderz/MameScheme
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_));
    }

}