Changeset 11218 for lang/c

Show
Ignore:
Timestamp:
05/06/08 23:51:23 (7 months ago)
Author:
mokehehe
Message:

レストパラメータを受け取れるように
ファイルのロード時は式を１個ずつコンパイル、実行するように（マクロ対策）

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

Legend:

Unmodified
Added
Removed

  • lang/c/misc/mlisp/compiler/compiler.cpp

    r11144 r11218  
    181181        else if (eq(hd, intern("quote")))       return list(2, intern("quote"), car(cadr(res))); 
    182182        else    { assert(!"unexpected"); return nil; } 
     183} 
     184 
     185/// �h�b�g�y�A�̈ʒu��� 
     186static int dotted_pos(SExp ls) { 
     187        for (int pos = 0; ; ++pos, ls = cdr(ls)) { 
     188                if (nilp(ls))   return -1; 
     189                if (!consp(ls)) return pos; 
     190        } 
     191} 
     192 
     193/// REST �p�����[�^��‚��H 
     194static bool has_rest_param(SExp* prest, SExp* pmodvars, SExp vars) { 
     195        int pos = dotted_pos(vars); 
     196        if (pos >= 0) { 
     197                if (pos == 0) { 
     198                        *pmodvars = cons(vars, nil); 
     199                } else { 
     200                        SExp copied = list_copy(vars); 
     201                        SExp last = last_pair(copied); 
     202                        rplacd(last, cons(cdr(last), nil)); 
     203                        *pmodvars = copied; 
     204                } 
     205                *prest = int2s(pos); 
     206                return true; 
     207        } else { 
     208                return false; 
     209        } 
     210} 
     211 
     212/// lambda ���̃R���p�C�� 
     213static SExp compile_lambda(SExp rest, SExp vars, SExp body, SExp e, SExp next) { 
     214        return list(3, CLOSE, cons(rest, compile_block(body, extend(e, vars), list(1, RETURN))), next); 
    183215} 
    184216 
    … …  
    217249                                SExp vars = cadr(x); 
    218250                                SExp body = cddr(x); 
    219                                 return list(3, CLOSE, compile_block(body, extend(e, vars), cons(RETURN, nil)), next); 
     251                                SExp rest, modified_vars; 
     252                                if (has_rest_param(&rest, &modified_vars, vars)) { 
     253                                        return compile_lambda(rest, modified_vars, body, e, next); 
     254                                } else { 
     255                                        return compile_lambda(nil, vars, body, e, next); 
     256                                } 
    220257                        } else if (eq(op, intern("if"))) { 
    221258                                SExp test = cadr(x); 

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

    r11185 r11218  
    5353 
    5454 
     55 
     56* �o�O 
     57- �}�N�����A�錾���ɓo�^�����Ȃ��̂ŁA�������g��яo���Ă��N�������s����-- cond 
     58 
    5559* changelog 
    5660 

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

    r11144 r11218  
    44static void print_rec(SExp s); 
    55 
    6 static void print_cell(SExp p) 
    7 { 
     6static void print_cell(SExp p) { 
    87        bool b_first = true; 
    98        for (; type_of(p) == tCell; ) { 
    … …  
    2120 
    2221 
    23 static void print_rec(SExp s) 
    24 { 
     22static void print_rec(SExp s) { 
    2523        switch (type_of(s)) { 
    2624        default:        assert(FALSE);  break; 
    … …  
    7573 
    7674 
    77 void print(SExp s) 
    78 { 
     75void print(SExp s) { 
    7976        print_rec(s); 
    8077        printf("\n"); 

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

    r11144 r11218  
    7878} 
    7979 
     80SExp list_copy(SExp ls) { 
     81        SExp cp = nil; 
     82        for (; consp(ls); ls = cdr(ls)) { 
     83                cp = cons(car(ls), cp); 
     84        } 
     85        cp = nreverse(cp); 
     86        if (!nilp(ls)) { 
     87                if (!nilp(cp))  rplacd(last_pair(cp), ls); 
     88                else                    cp = ls; 
     89        } 
     90        return cp; 
     91} 
     92 
     93SExp list_tail(SExp ls, int k) { 
     94        while (k > 0) { 
     95                ls = cdr(ls); 
     96        } 
     97        return ls; 
     98} 
     99 
    80100 
    81101 

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

    r11144 r11218  
    3535SExp assoc(SExp sym, SExp alist); 
    3636 
     37/// ���X�g�̃R�s�[ 
     38SExp list_copy(SExp ls); 
     39 
     40/// ���X�g��k �Ԗڂ�cdr ��� 
     41SExp list_tail(SExp ls, int k); 
     42 
    3743 
    3844/// ���X�g�ŗv�f���ЂƂ‚����H 
    … …  
    4551 
    4652__inline int consp(SExp s)              { return type_of(s) == tCell; } 
    47  
    4853__inline int symbolp(SExp s)    { return type_of(s) == tSymb; } 
    49  
     54__inline int zerop(SExp s)              { return eq(s, int2s(0)); } 
    5055__inline SExp cadr(SExp s)              { return car(cdr(s)); } 
    5156__inline SExp cddr(SExp s)              { return cdr(cdr(s)); } 

  • lang/c/misc/mlisp/test/main.cpp

    r11144 r11218  
    3333SExp g_comp_env, g_run_env; 
    3434 
    35 int load(const char* fn); 
     35int load_file(const char* fn); 
    3636 
    3737 
    … …  
    164164} 
    165165 
     166static SExp builtin_numeq(SExp arg) { 
     167        SExp a = car(arg); 
     168        check_number(a); 
     169        sint x = s2int(a); 
     170 
     171        for (SExp p = cdr(arg); consp(p); p = cdr(p)) { 
     172                SExp b = car(p); 
     173                check_number(a); 
     174                sint y = s2int(b); 
     175                if (x != y)     return nil; 
     176        } 
     177        return t; 
     178} 
     179 
    166180static SExp builtin_lt(SExp arg) { 
    167181        SExp a = car(arg); 
    … …  
    194208} 
    195209 
     210static SExp builtin_le(SExp arg) { 
     211        SExp a = car(arg); 
     212        check_number(a); 
     213        sint x = s2int(a); 
     214 
     215        for (SExp p = cdr(arg); consp(p); p = cdr(p)) { 
     216                SExp b = car(p); 
     217                check_number(a); 
     218                sint y = s2int(b); 
     219                if (x > y)      return nil; 
     220                x = y; 
     221        } 
     222        return t; 
     223} 
     224 
     225static SExp builtin_ge(SExp arg) { 
     226        SExp a = car(arg); 
     227        check_number(a); 
     228        sint x = s2int(a); 
     229 
     230        for (SExp p = cdr(arg); consp(p); p = cdr(p)) { 
     231                SExp b = car(p); 
     232                check_number(a); 
     233                sint y = s2int(b); 
     234                if (x < y)      return nil; 
     235                x = y; 
     236        } 
     237        return t; 
     238} 
     239 
    196240static SExp builtin_read(SExp arg) { 
    197241        return read_from_file(stdin); 
    … …  
    214258        const char* fn = s2str(a); 
    215259        if (fn != NULL) { 
    216                 if (load(fn)) { 
     260                if (load_file(fn)) { 
    217261                        return t; 
    218262                } 
    … …  
    291335                {       "*",            builtin_times,          FALSE,  0,      -1,     }, 
    292336                {       "/",            builtin_quotient,       FALSE,  1, -1,  }, 
     337                {       "=",            builtin_numeq,          FALSE,  1, -1,  }, 
    293338                {       "<",            builtin_lt,                     FALSE,  1, -1,  }, 
    294339                {       ">",            builtin_gt,                     FALSE,  1, -1,  }, 
     340                {       "<=",           builtin_le,                     FALSE,  1, -1,  }, 
     341                {       ">=",           builtin_ge,                     FALSE,  1, -1,  }, 
    295342 
    296343 
    … …  
    353400 
    354401 
    355 SExp compile_file(const char* fn) { 
     402// �\�[�X�̃��[�h�i�ǂݍ��݁A�R���p�C���A��s�j 
     403int load_file(const char* fn) { 
    356404        FILE* fp = fopen(fn, "r"); 
    357         SExp code = nil; 
    358405        if (fp == NULL) { 
    359 //              runtime_error(); 
    360         } else { 
    361                 SExp acc = nil; 
     406                return FALSE; 
     407        } else { 
     408                SExp halt_code = cons(HALT, nil); 
    362409                for (;;) { 
    363                         SExp s = read_from_file(fp); 
    364                         if (nilp(s))    break; 
    365                         acc = cons(s, acc); 
     410                        SExp sexp = read_from_file(fp); 
     411                        if (nilp(sexp)) break; 
     412                        run(compile(sexp, g_comp_env, halt_code)); 
    366413                } 
    367                 SExp halt_code = cons(HALT, nil); 
    368                 code = compile_block(nreverse(acc), g_comp_env, halt_code); 
    369  
    370414                fclose(fp); 
    371         } 
    372         return code; 
    373 } 
    374  
    375  
    376 int load(const char* fn) { 
    377         SExp code = compile_file(fn); 
    378         if (!nilp(code)) { 
    379                 SExp r = run(code); 
    380415                return TRUE; 
    381         } else { 
    382                 return FALSE; 
    383416        } 
    384417} 
    … …  
    416449        init_env(); 
    417450        if (argc >= 2) { 
    418                 load(argv[1]); 
     451                load_file(argv[1]); 
    419452        } else { 
    420453                repl(); 

  • lang/c/misc/mlisp/vm/vm.cpp

    r11144 r11218  
    6666 
    6767static SExp continuation(SExp s) { 
    68         return closure(list(3, NUATE, s, cons(int2s(0), int2s(0))), nil); 
     68        return closure(cons(nil, list(3, NUATE, s, cons(int2s(0), int2s(0)))), nil); 
    6969} 
    7070 
    … …  
    7878} 
    7979 
     80static SExp modify_args(SExp pos, SExp r) { 
     81        if (!nilp(pos)) { 
     82                if (zerop(pos)) { 
     83                        r = cons(r, nil); 
     84                } else { 
     85                        SExp last = list_tail(r, s2int(pos) - 1); 
     86                        rplacd(last, cons(cdr(last), nil)); 
     87                } 
     88        } 
     89        return r; 
     90} 
    8091 
    8192SExp vm(SExp a, SExp x, SExp e, SExp r, SExp s) { 
    82         SExp ret_code = cons(RETURN, nil); 
    8393        for (;;) { 
    8494                SExp op = car(x); 
    … …  
    127137                        { 
    128138                                SExp xx = cadr(x); 
    129                                 a = continuation(s);    x = xx;; 
     139                                a = continuation(s);    x = xx; 
    130140                        } 
    131141                } else if (op == NUATE) { 
    132142                        { 
    133                                 SExp s = cadr(x); 
     143                                SExp ss = cadr(x); 
    134144                                SExp var = caddr(x); 
    135                                 a = car(lookup(var, e, false)); x = ret_code; 
     145                                a = car(lookup(var, e, false)); x = cons(RETURN, nil);  s = ss; 
    136146                        } 
    137147                } else if (op == FRAME) { 
    … …  
    156166                                                        SCFunc cfunc = proc->u.cfunc; 
    157167                                                        SExp res = (*cfunc)(r); 
    158                                                         a = res;        x = ret_code;   r = nil; 
     168                                                        a = res;        x = cons(RETURN, nil);  r = nil; 
    159169                                                } 
    160170                                                break; 
    … …  
    163173                                                        SExp body = proc->u.cell.s; 
    164174                                                        SExp ee = proc->u.cell.e; 
    165                                                         x = body;       e = extend(ee, r);      r = nil; 
     175                                                        x = cdr(body);  e = extend(ee, modify_args(car(body), r));      r = nil; 
    166176                                                } 
    167177                                                break; 
    … …  
    182192                                SExp rr = caddr(s); 
    183193                                SExp ss = cadddr(s); 
    184                                 x = xx; e = ee; r = rr; s = ss;;; 
     194                                x = xx; e = ee; r = rr; s = ss; 
    185195                        } 
    186196                } else {