Changeset 12283 for lang/c

Show
Ignore:
Timestamp:
05/24/08 22:42:00 (6 months ago)
Author:
mokehehe
Message:

Modify error message.
Implement INDIRECT.

Location:
lang/c/misc/mlisp
Files:
11 modified

Legend:

Unmodified
Added
Removed

  • lang/c/misc/mlisp/core/inner.h

    r12268 r12283  
    1515 
    1616/// �G���[ 
    17 enum { 
    1817        // read ���̃G���[ 
    19         ERR_READ_ILLEGAL_CHAR = 1, 
    20         ERR_READ_STRING_NOT_TERMINATE, 
    21         ERR_READ_NO_CLOSE_PAREN, 
    22         ERR_READ_DOT_FIRST, 
    23         ERR_READ_EMPTY_AFTER_DOT, 
    24         ERR_READ_ILLEGAL_DOT_LIST, 
    25  
     18#define ERR_READ_ILLEGAL_CHAR                           "illegal char: %s" 
     19#define ERR_READ_STRING_NOT_TERMINATE           "string not terminate" 
     20#define ERR_READ_NO_CLOSE_PAREN                         "no close paren" 
     21#define ERR_READ_DOT_FIRST                                      "dot first" 
     22#define ERR_READ_EMPTY_AFTER_DOT                        "empty after dot" 
     23#define ERR_READ_ILLEGAL_DOT_LIST                       "illegal dot list" 
    2624        // �R���p�C�����̃G���[ 
    27         ERR_TYPE_REQUIRED, 
    28         ERR_UNDEFINED_SYMBOL, 
    29         ERR_UNEXPECTED, 
    30 }; 
     25#define ERR_TYPE_REQUIRED                                       "type required: %s" 
     26#define ERR_UNDEFINED_SYMBOL                            "undefined symbol" 
     27#define ERR_UNEXPECTED                                          "unexpected" 
    3128 
    3229 

  • lang/c/misc/mlisp/core/m_basic.cpp

    r12263 r12283  
    270270                return list(2, intern("quote"), list(1, car(cadr(res)))); 
    271271        else { 
    272                 error(ERR_UNEXPECTED); 
     272                error(ERR_UNEXPECTED, 0, NULL); 
    273273                return nil; 
    274274        } 

  • lang/c/misc/mlisp/core/m_vect.cpp

    r12263 r12283  
    1414        unsigned int size; 
    1515        SExp buf[1];                    // �o�b�t�@�̃T�C�Y���L�т�}; 
    16  
    17  
    18 void add_vector_module(void) { 
    19         tVect = mlisp_alloc_new_type(); 
    20 } 
    2116 
    2217 
    … …  
    7368        printf(")"); 
    7469} 
     70 
     71 
     72 
     73 
     74 
     75static SExp fn_make_vector() { 
     76        sint n = s2int(get_arg(0)); 
     77        return make_vector(n); 
     78} 
     79 
     80static SExp fn_vector_set() { 
     81        SExp v = get_arg(0); 
     82        sint i = s2int(get_arg(1)); 
     83        SExp val = get_arg(2); 
     84        vector_set(v, i, val); 
     85        return nil; 
     86} 
     87 
     88static SExp fn_vector_ref() { 
     89        SExp v = get_arg(0); 
     90        sint i = s2int(get_arg(1)); 
     91        return vector_ref(v, i); 
     92} 
     93 
     94 
     95void add_vector_module(void) { 
     96        tVect = mlisp_alloc_new_type(); 
     97 
     98        struct { 
     99                const char* name; 
     100                SCFunc func; 
     101                int minarg; 
     102                int maxarg; 
     103        } static const tbl[] = { 
     104                {       "make-vector",          fn_make_vector,         1,      1,      }, 
     105                {       "vector-set!",          fn_vector_set,          3,      3,      }, 
     106                {       "vector-ref",           fn_vector_ref,          2,      2,      }, 
     107        }; 
     108        for (int i=0; i<sizeof(tbl)/sizeof(*tbl); ++i) { 
     109                SExp sym = intern(tbl[i].name); 
     110                SExp fn = gen_cfunc(tbl[i].func, tbl[i].minarg, tbl[i].maxarg); 
     111                define_global(sym, fn); 
     112        } 
     113} 

  • lang/c/misc/mlisp/core/s_print.cpp

    r12263 r12283  
    66#include "s_util.h" 
    77 
    8 static void print_cell(SExp p) { 
     8 
     9class Printer { 
     10        void (*cb)(const char*, void*); 
     11        void* ua; 
     12 
     13        inline void out(const char* s) { 
     14                this->cb(s, ua); 
     15        } 
     16 
     17        void print_cell(SExp p); 
     18 
     19public: 
     20        Printer(void (*cb_)(const char*, void*), void* ua_) 
     21                : cb(cb_), ua(ua_) 
     22        { 
     23        } 
     24 
     25        void print_rec(SExp s); 
     26}; 
     27 
     28void Printer::print_cell(SExp p) { 
    929        bool b_first = true; 
    1030        for (; type_of(p) == tCell; ) { 
    1131                Cell* cell = (Cell*)p.ptr; 
    12                 if (!b_first)   printf(" "); 
     32                if (!b_first)   out(" "); 
    1333                print_rec(cell->car); 
    1434                p = cell->cdr; 
    … …  
    1636        } 
    1737        if (!eq(p, nil)) { 
    18                 printf(" . "); 
     38                out(" . "); 
    1939                print_rec(p); 
    2040        } 
    … …  
    2242 
    2343 
    24 void print_rec(SExp s) { 
     44void Printer::print_rec(SExp s) { 
    2545        switch (type_of(s)) { 
    2646        default:        assert(FALSE);  break; 
    2747        case tInt: 
    28                 printf("%d", s2int(s)); 
     48                { 
     49                        char buf[16]; 
     50                        sprintf(buf, "%d", s2int(s)); 
     51                        out(buf); 
     52                } 
    2953                break; 
    3054        case tCell: 
    … …  
    3256                        SExp a = car(s); 
    3357                        if (eq(a, intern("quote")) && singlep(cdr(s))) { 
    34                                 printf("'"); 
     58                                out("'"); 
    3559                                print_rec(car(cdr(s))); 
    3660                        } else { 
    37                                 printf("("); 
     61                                out("("); 
    3862                                print_cell(s); 
    39                                 printf(")"); 
     63                                out(")"); 
    4064                        } 
    4165                } 
    … …  
    4468                { 
    4569                        Symbol* p = (Symbol*)s.ptr; 
    46                         printf("%s", p->str); 
     70                        out(p->str); 
    4771                } 
    4872                break; 
    … …  
    5074                { 
    5175                        String* p = (String*)s.ptr; 
    52                         printf("\"%s\"", p->str); 
     76                        out("\""); 
     77                        out(p->str); 
     78                        out("\""); 
    5379                } 
    5480                break; 
    … …  
    6894                        case Procedure::Macro | Procedure::Cell:                type = "macro"; break; 
    6995                        } 
    70                         printf("#<%s: %s>", type, name); 
     96                        out("#<"); 
     97                        out(type); 
     98                        out(": "); 
     99                        out(name); 
     100                        out(">"); 
    71101                } 
    72102                break; 
    … …  
    78108 
    79109 
     110void print_to(SExp s, void (*cb)(const char*, void*), void* ua) { 
     111        Printer pr(cb, ua); 
     112        pr.print_rec(s); 
     113} 
     114 
     115 
     116void print_rec(SExp s) { 
     117        struct Local { 
     118                static void cb(const char* s, void* ua)         { printf("%s", s); } 
     119        }; 
     120        print_to(s, Local::cb, NULL); 
     121} 
     122 
    80123void print(SExp s) { 
    81124        print_rec(s); 

  • lang/c/misc/mlisp/core/s_read.cpp

    r11794 r12283  
    125125        for (; c = strm->getch(), c != '"'; ) { 
    126126                if (c == EOF) { 
    127                         error(ERR_READ_STRING_NOT_TERMINATE); 
     127                        error(ERR_READ_STRING_NOT_TERMINATE, 0, NULL); 
    128128                        break; 
    129129                } 
    … …  
    178178        if (s.i == cFail || s.i == cEOF) { 
    179179                // ERR: (x .) 
    180                 error(ERR_READ_EMPTY_AFTER_DOT); 
     180                error(ERR_READ_EMPTY_AFTER_DOT, 0, NULL); 
    181181        } else { 
    182182                bool err = false; 
    183183                if (eq(top, nil)) { 
    184184                        // ERR: (. x) 
    185                         error(ERR_READ_DOT_FIRST); 
     185                        error(ERR_READ_DOT_FIRST, 0, NULL); 
    186186                        err = true; 
    187187                } else { 
    … …  
    195195                if (err2 && !err) { 
    196196                        // ERR: (x . y z) 
    197                         error(ERR_READ_ILLEGAL_DOT_LIST); 
     197                        error(ERR_READ_ILLEGAL_DOT_LIST, 0, NULL); 
    198198                } 
    199199        } 
    … …  
    239239                        if (c != ')') { 
    240240                                strm->ungetch(c); 
    241                                 error(ERR_READ_NO_CLOSE_PAREN); 
     241                                error(ERR_READ_NO_CLOSE_PAREN, 0, NULL); 
    242242                        } 
    243243                        return s; 
    … …  
    317317        SExp s = read_rec(strm); 
    318318        if (s.i == cFail) { 
    319                 int c = strm->getch();          // �ǂݍ��ݎ��s�ɂȂ��������ݎ̂Ă�             error(ERR_READ_ILLEGAL_CHAR, c); 
     319                int c = strm->getch();          // �ǂݍ��ݎ��s�ɂȂ��������ݎ̂Ă�             SExp args[] = { int2s(c), }; 
     320                error(ERR_READ_ILLEGAL_CHAR, sizeof(args)/sizeof(*args), args); 
    320321                s = nil; 
    321322        } 

  • lang/c/misc/mlisp/core/sexp.cpp

    r12263 r12283  
    99#include <stdio.h> 
    1010#include <string.h> 
    11 #include <stdarg.h> 
    12  
    13 /// �G���[ 
    14 static const char* errmsg[] = { 
    15         "illegal char: %c", 
    16         "string not terminate", 
    17         "no close paren", 
    18         "dot first", 
    19         "empty after dot", 
    20         "illegal dot list", 
    21  
    22         "type required: %s", 
    23         "undefined symbol", 
    24         "unexpected", 
    25 }; 
    2611 
    2712/// �^���������tatic const char* TypeStrTbl[] = { 
    … …  
    150135} 
    151136 
    152 void error(int errid, ...) { 
    153         va_list ap; 
    154         va_start(ap, errid); 
    155         char buf[256]; 
    156         vsprintf(buf, errmsg[errid-1], ap); 
    157         va_end(ap); 
    158  
     137void error(const char* errmsg, int narg, SExp* args) { 
    159138        if (vtbl->error != NULL) { 
    160                 (*vtbl->error)(buf); 
     139                (*vtbl->error)(errmsg, narg, args); 
    161140        } else { 
    162                 exit(errid); 
     141                exit(-1); 
    163142        } 
    164143} 
    … …  
    169148int type_check(SExp s, int type) { 
    170149        if (type_of(s) != type) { 
    171                 error(ERR_TYPE_REQUIRED, TypeStrTbl[type]); 
     150                SExp args[] = { gen_str(TypeStrTbl[type]), }; 
     151                error(ERR_TYPE_REQUIRED, sizeof(args)/sizeof(*args), args); 
    172152                return FALSE; 
    173153        } else { 

  • lang/c/misc/mlisp/core/v_vm.cpp

    r12268 r12283  
    1414#include <assert.h> 
    1515 
    16 static void runtime_error(const char* msg) { 
    17         printf("%s\n", msg); 
    18         error(ERR_UNEXPECTED); 
     16#define ERR_UNBOUND_VARIABLE            "unbound variable: %s" 
     17#define ERR_SYMBOL_NOT_DEFINED          "symbol not defined: %s" 
     18 
     19static void runtime_error(const char* msg, int narg, SExp* args) { 
     20        error(msg, narg, args); 
    1921} 
    2022 
    … …  
    4850static void push(SExp x) { 
    4951        if (g_sp >= STACK_SIZE) { 
    50                 runtime_error("stack overflow"); 
     52                runtime_error("stack overflow", 0, NULL); 
    5153                return; 
    5254        } 
    … …  
    5658static SExp pop() { 
    5759        if (g_sp <= 0) { 
    58                 runtime_error("stack underflow"); 
     60                runtime_error("stack underflow", 0, NULL); 
    5961                return nil; 
    6062        } 
    … …  
    6567        g_sp -= n; 
    6668        if (g_sp < 0) { 
    67                 runtime_error("stack underflow"); 
     69                runtime_error("stack underflow", 0, NULL); 
    6870        } 
    6971} 
    … …  
    124126                return it->second; 
    125127        } else { 
    126                 runtime_error("unbound variable:");     // sym 
     128                SExp args[] = { sym }; 
     129                runtime_error(ERR_UNBOUND_VARIABLE, sizeof(args)/sizeof(*args), args);  // sym 
    127130                return nil; 
    128131        } 
    … …  
    183186                        if (n == proc->minnarg) {               // REST �p�����[�^�ɉ��������Ȃ�����ꍇ�A�X�^�b�N�t���[�����������̂Ŋg������                         const int m = n - proc->minnarg + 1; 
    184187                                for (int i=0; i<n; ++i) { 
    185                                         index_set(s, i, index(s, i + m)); 
     188                                        index_set(s, i - m, index(s, i)); 
    186189                                } 
    187190                                push(int2s(n + m)); 
    … …  
    275278                        } 
    276279                } else { 
    277                         runtime_error("wrong number of argument"); 
     280                        SExp args[] = { int2s(proc->minnarg), argnum }; 
     281                        runtime_error("wrong number of argument: %d to %d", sizeof(args)/sizeof(*args), args); 
    278282                        r = -1; 
    279283                } 
    280284        } else { 
    281                 runtime_error("can't apply"); 
     285                SExp args[] = { fn }; 
     286                runtime_error("can't apply: %s", sizeof(args)/sizeof(*args), args); 
    282287                r = -1; 
    283288        } 
    … …  
    372377                        unlink(n); 
    373378                        a = aa; x = xx; 
    374                 } else if (op == BOX) { 
    375                         sint n = s2int(cadr(x)); 
    376                         SExp xx = caddr(x); 
    377                         index_set(g_sp, n + 1, box(index(g_sp, n + 1))); 
    378                         x = xx; 
    379379                } else if (op == ASSIGN_LOCAL) { 
    380380                        sint n = s2int(cadr(x)); 
    … …  
    423423                        SExp var = cadr(x); 
    424424                        SExp xx = caddr(x); 
    425                         define_global(var, a); 
    426                         a = var;        x = xx; 
     425                        if (exist_global(var)) { 
     426                                define_global(var, a); 
     427                        } else { 
     428                                SExp args[] = { var }; 
     429                                runtime_error(ERR_SYMBOL_NOT_DEFINED, sizeof(args)/sizeof(*args), args); 
     430                        } 
     431                        x = xx; 
     432                } else if (op == BOX) { 
     433                        sint n = s2int(cadr(x)); 
     434                        SExp xx = caddr(x); 
     435                        index_set(g_sp, n + 1, box(index(g_sp, n + 1))); 
     436                        x = xx; 
     437                } else if (op == INDIRECT) { 
     438                        SExp xx = cadr(x); 
     439                        a = unbox(a);   x = xx; 
    427440                } else { 
    428                         runtime_error("illegal opecode"); 
     441                        SExp args[] = { op }; 
     442                        runtime_error("illegal opecode: %s", sizeof(args)/sizeof(*args), args); 
    429443                        return nil; 
    430444                } 

  • lang/c/misc/mlisp/inc/sexp.h

    r12263 r12283  
    5959 
    6060        /// �G���[���ɌĂяo���֐� 
    61         void (*error)(const char* errmsg); 
     61        void (*error)(const char* errmsg, int narg, SExp* args); 
    6262} SVTable; 
    6363 
    … …  
    9797SExp read_from_string(const char* str); 
    9898void print(SExp s); 
     99void print_to(SExp s, void (*cb)(const char*, void*), void* ua); 
    99100 
    100 void error(int errid, ...); 
     101void error(const char* errmsg, int narg, SExp* arg); 
    101102void reset_error(void); 
    102103 

  • lang/c/misc/mlisp/proto/stackbased.scm

    r12268 r12283  
    104104  (cond 
    105105   ((pair? x) 
    106     (case x 
     106    (case (car x) 
    107107      ((quote) x) 
    108108      ((lambda) (let* ((vars (cadr x)) 
    … …  
    461461                                      (modify-args a n) 
    462462                                      (VM a body *sp* a)))) 
    463                               (error "wrong number of argument")) 
     463                              (error "stackbased: wrong number of argument")) 
    464464                          (error "can't apply"))) 
    465465                 (RETURN () 
    … …  
    477477                 (ASSIGN-GLOBAL (var x) 
    478478                                (if (exist-global? var) 
    479                                     (VM (define-global var a) x f c) 
     479                                    (begin 
     480                                      (define-global var a) 
     481                                      (VM a x f c)) 
    480482                                  (error "assign to undefined symbol:" var))) 
    481483                 (else 
    … …  
    571573    (define (expand-frame n m) 
    572574      (dotimes (i n '()) 
    573         (index-set! s i (index s (+ i m)))) 
     575        (index-set! s (- i m) (index s i))) 
    574576      (push (+ n m))) 
    575577    (let* ((min (closure-min-arg-num c)) 
    … …  
    583585                    (let ((m (1+ (- n min)))) 
    584586                      (expand-frame n m) 
    585                       (inc! s (+ n m)))) 
     587                      (inc! s m))) 
    586588                (index-set! s min rest)) 
    587589            (error "not implemented")))))) 
    … …  
    856858 
    857859(define (repl) 
     860  (init-stack) 
    858861  (let ((s (read))) 
    859862    (unless (eq? s 'quit) 
    … …  
    878881 
    879882 
     883 
    880884(load "test_macro.scm") 
    881885 
    882886 
    883  
    884  
    885 (macroexpand-1 '(let ((x 1) (y 2)) (+ x y))) 
    886  
    887  
    888  
    889 (defmacro test (a . b) (list 'list a b)) 
    890  
    891  
    892 (test 1 2) 
    893  
    894  
    895  
    896 (evaluate '((lambda (a b . c) (list a b c)) 1 2 3 4)) 
    897  
    898  
    899  
    900  
    901 (compile-top '((lambda (a . b) (list 'list a b)) '1 '2)) 
    902  
    903  
    904 (let ((x 1) (y 2)) (cons x y)) 
    905  
    906  
    907 (call/cc (lambda (cc) (cc 1234))) 
    908  
    909  
    910 1234 
    911  
    912 (load "test_nondet.scm") 
    913  
     887(macroexpand-1 
     888 '(letrec ((loop (lambda (n acc) 
     889                   (if (> n 0) 
     890                       (loop (- n 1) (+ acc n)) 
     891                     acc)))) 
     892   (loop 10 0))) 
     893 
     894 
     895letrec 
     896 
     897 
     898 
     899 
     900 
     901(letrec ((loop (lambda (n acc) 
     902                 (if (> n 0) 
     903                     (loop (- n 1) (+ acc n)) 
     904                   acc)))) 
     905        (loop 10 0)) 
    914906 
    915907 

  • lang/c/misc/mlisp/readme.txt

    r12268 r12283  
    4747 
    4848* ToDo 
    49 -[v] �C�ӌ‚̈��O�‚���Ɨ�����-�G���[���b�Z�[�W���Ƃ킩������ 
     49-[v] �G���[���b�Z�[�W���Ƃ킩������ 
    5050-begin 
    5151-[v] �x�N�^��W���[���Ƃ��Ď������-[v] �X�^�b�N�x�[�X�ɒu��������-[v] �C�ӌ‚̈��󂯎� 
    5252-[v] �}�N����� 
    5353--[v] macroexpand ��-[v] C �������[�o���̊֐���яo�������ɂ���- �unil�v�ut�v���V���{���Ȃ̂ŁA�R���p�C�������V���{���Q�ƂɂȂ�Ă��܂� 
    54 - ��s���ɕϐ�������������Ƃ��̎����� 
     54-[v] ��s���ɕϐ�������������Ƃ��̎����� 
    5555- �������� 
    5656-[v] �}�N�����g�����Ƃ��́A���R�ϐ���t!�̎g�p�̃`�F�b�N 
    … …  
    6161-- define �̈��V���{�����H 
    6262-- �֐��Ăяo���`�F�b�N 
    63 --- �֐����ǂ����H