Changeset 11544 for lang/c

Show
Ignore:
Timestamp:
05/14/08 00:49:49 (6 months ago)
Author:
mokehehe
Message:

任意個の引数に対応するため、関数の引数の個数をスタックに積むようにした

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

Legend:

Unmodified
Added
Removed

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

    r11387 r11544  
    280280                        SExp sets = find_sets(body, vars); 
    281281 
    282                         SExp boxes = make_boxes(sets, vars, compile(body, cons(vars, free), set_union(sets, set_intersect(s, free)), list(2, RETURN, int2s(length(vars))))); 
     282                        SExp boxes = make_boxes(sets, vars, compile(body, cons(vars, free), set_union(sets, set_intersect(s, free)), list(1, RETURN))); 
    283283                        return collect_free(free, e, list(4, CLOSE, int2s(length(free)), boxes, next)); 
    284284                } else if (eq(op, intern("if"))) { 
    … …  
    306306                        int is_tail = tailp(next); 
    307307                        SExp xx = cadr(x); 
    308                         SExp apply = list(1, APPLY); 
    309                         SExp nx = is_tail ? list(4, SHIFT, 1, cadr(next), apply) : apply; 
     308                        SExp apply = list(2, APPLY, int2s(1)); 
     309                        SExp nx = is_tail ? list(3, SHIFT, 1, apply) : apply; 
    310310                        SExp c = list(2, CONTI, list(2, ARGUMENT, compile(xx, e, s, nx))); 
    311311                        if (is_tail) 
    … …  
    319319                } else { 
    320320                        SExp args = cdr(x); 
    321                         SExp apply = list(1, APPLY); 
    322                         SExp nx = tailp(next) ? list(4, SHIFT, int2s(length(cdr(x))), cadr(next), apply) : apply; 
     321                        int argnum = length(args); 
     322                        SExp apply = list(2, APPLY, int2s(argnum)); 
     323                        SExp nx = tailp(next) ? list(3, SHIFT, int2s(argnum), apply) : apply; 
    323324                        SExp c = compile(car(x), e, s, nx); 
    324325                        return compile_pair_loop(args, c, e, s, next); 

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

    r11387 r11544  
    4747 
    4848/// �g���݊֐��̌^ 
    49 typedef SExp (*SCFunc)(int); 
     49typedef SExp (*SCFunc)(int stack); 
    5050 
    5151 

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

    r11387 r11544  
    3131 
    3232 
    33 SExp g_comp_env, g_run_env; 
    34  
    3533int load_file(const char* fn); 
    3634 
    … …  
    4038#include "inner.h" 
    4139 
     40/// ��s 
    4241SExp run(SExp c) { 
    4342        return vm(nil, c, 0, nil, 0); 
    4443} 
    4544 
     45/// �g�b�v���x���ŃR���p�C�� 
     46SExp compile_ontop(SExp code) { 
     47        SExp halt_code = cons(HALT, nil); 
     48        return compile(code, list(1, nil), nil, halt_code); 
     49} 
     50 
     51/// �]�� 
    4652SExp evaluate(SExp code) { 
    47         SExp halt_code = cons(HALT, nil); 
    48         SExp c = compile(code, g_comp_env, nil, halt_code); 
     53        SExp c = compile_ontop(code); 
     54//print(c); 
    4955        return run(c); 
    5056} 
    … …  
    7985} 
    8086 
     87static SExp builtin_consp(int s) { 
     88        SExp v = refer_stack(s, 0); 
     89        return consp(v) ? t : nil; 
     90} 
     91 
    8192static SExp builtin_eq(int s) { 
    8293        SExp a = refer_stack(s, 0); 
    … …  
    8596} 
    8697 
     98static SExp builtin_rplaca(int s) { 
     99        SExp a = refer_stack(s, 0); 
     100        SExp d = refer_stack(s, 1); 
     101        rplaca(a, d); 
     102        return nil; 
     103} 
     104 
     105static SExp builtin_rplacd(int s) { 
     106        SExp a = refer_stack(s, 0); 
     107        SExp d = refer_stack(s, 1); 
     108        rplacd(a, d); 
     109        return nil; 
     110} 
     111 
    87112static SExp builtin_plus(int s) { 
     113        sint n = s2int(refer_stack(s, -1)); 
    88114        sint x = 0; 
    89         for (int i=0; i<2; ++i) { 
     115        for (int i=0; i<n; ++i) { 
    90116                SExp a = refer_stack(s, i); 
    91117                check_number(a); 
    … …  
    96122 
    97123static SExp builtin_difference(int s) { 
     124        sint n = s2int(refer_stack(s, -1)); 
    98125        SExp a = refer_stack(s, 0); 
    99126        check_number(a); 
    100127        sint x = s2int(a); 
    101         for (int i=1; i<2; ++i) { 
     128        if (n == 1) { 
     129                x = -x; 
     130        } else { 
     131                for (int i=1; i<n; ++i) { 
     132                        SExp a = refer_stack(s, i); 
     133                        check_number(a); 
     134                        x -= s2int(a); 
     135                } 
     136        } 
     137        return int2s(x); 
     138} 
     139 
     140static SExp builtin_times(int s) { 
     141        sint n = s2int(refer_stack(s, -1)); 
     142        sint x = 1; 
     143        for (int i=0; i<n; ++i) { 
    102144                SExp a = refer_stack(s, i); 
    103145                check_number(a); 
    104                 x -= s2int(a); 
     146                x *= s2int(a); 
    105147        } 
    106148        return int2s(x); 
    107149} 
    108150 
     151static SExp builtin_quotient(int s) { 
     152        sint n = s2int(refer_stack(s, -1)); 
     153        SExp a = refer_stack(s, 0); 
     154        check_number(a); 
     155        sint x = s2int(a); 
     156        if (n == 1) { 
     157                x = 1 / x; 
     158        } else { 
     159                for (int i=1; i<n; ++i) { 
     160                        SExp a = refer_stack(s, i); 
     161                        check_number(a); 
     162                        sint d = s2int(a); 
     163                        if (d == 0) { 
     164//                              error(ERR_ZERO_DIVIDE); 
     165                                assert(!"zero divide"); 
     166                        } else { 
     167                                x /= d; 
     168                        } 
     169                } 
     170        } 
     171        return int2s(x); 
     172} 
     173 
     174static SExp num_predicate(int s, int n, bool (*p)(sint, sint)) { 
     175        SExp a = refer_stack(s, 0); 
     176        check_number(a); 
     177        sint x = s2int(a); 
     178 
     179        for (int i=1; i<n; ++i) { 
     180                SExp b = refer_stack(s, i); 
     181                check_number(b); 
     182                sint y = s2int(b); 
     183                if (!p(x, y))   return nil; 
     184                x = y; 
     185        } 
     186        return t; 
     187} 
     188 
     189static bool numeq(sint a, sint b)       { return a == b; } 
     190static SExp builtin_numeq(int s) { 
     191        sint n = s2int(refer_stack(s, -1)); 
     192        return num_predicate(s, n, numeq); 
     193} 
     194 
     195static bool numlt(sint a, sint b)       { return a < b; } 
    109196static SExp builtin_lt(int s) { 
    110         SExp a = refer_stack(s, 0); 
    111         check_number(a); 
    112         SExp d = refer_stack(s, 1); 
    113         check_number(d); 
    114  
    115         return s2int(a) < s2int(d) ? t : nil; 
     197        sint n = s2int(refer_stack(s, -1)); 
     198        return num_predicate(s, n, numlt); 
     199} 
     200 
     201static bool numgt(sint a, sint b)       { return a > b; } 
     202static SExp builtin_gt(int s) { 
     203        sint n = s2int(refer_stack(s, -1)); 
     204        return num_predicate(s, n, numgt); 
     205} 
     206 
     207static bool numle(sint a, sint b)       { return a <= b; } 
     208static SExp builtin_le(int s) { 
     209        sint n = s2int(refer_stack(s, -1)); 
     210        return num_predicate(s, n, numle); 
     211} 
     212 
     213static bool numge(sint a, sint b)       { return a >= b; } 
     214static SExp builtin_ge(int s) { 
     215        sint n = s2int(refer_stack(s, -1)); 
     216        return num_predicate(s, n, numge); 
     217} 
     218 
     219 
     220static SExp builtin_read(int s) { 
     221        return read_from_file(stdin); 
    116222} 
    117223 
    … …  
    119225        SExp a = refer_stack(s, 0); 
    120226        print(a); 
    121         return a; 
     227        return nil; 
     228} 
     229 
     230static SExp builtin_eval(int s) { 
     231        SExp code = refer_stack(s, 0); 
     232 
     233        return evaluate(code); 
     234} 
     235 
     236static SExp builtin_load(int s) { 
     237        SExp a = refer_stack(s, 0); 
     238        const char* fn = s2str(a); 
     239        if (fn != NULL) { 
     240                if (load_file(fn)) { 
     241                        return t; 
     242                } 
     243        } 
     244        return nil; 
     245} 
     246 
     247static SExp builtin_compile(int s) { 
     248        SExp code = refer_stack(s, 0); 
     249        SExp halt_code = cons(HALT, nil); 
     250        return compile_ontop(code); 
    122251} 
    123252 
    … …  
    138267                {       "car",          builtin_car,            FALSE,  1,      1,      }, 
    139268                {       "cdr",          builtin_cdr,            FALSE,  1,      1,      }, 
     269                {       "pair?",        builtin_consp,          FALSE,  1,      1,      }, 
    140270                {       "eq?",          builtin_eq,                     FALSE,  2,      2,      }, 
    141                 {       "+",            builtin_plus,           FALSE,  2,      2,      }, 
    142                 {       "-",            builtin_difference,     FALSE,  2,      2,      }, 
    143                 {       "<",            builtin_lt,                     FALSE,  2,      2,      }, 
     271                {       "set-car!",     builtin_rplaca,         FALSE,  2,      2,      }, 
     272                {       "set-cdr!",     builtin_rplacd,         FALSE,  2,      2,      }, 
     273                {       "+",            builtin_plus,           FALSE,  0,      -1,     }, 
     274                {       "-",            builtin_difference,     FALSE,  1, -1,  }, 
     275                {       "*",            builtin_times,          FALSE,  0,      -1,     }, 
     276                {       "/",            builtin_quotient,       FALSE,  1, -1,  }, 
     277                {       "=",            builtin_numeq,          FALSE,  1, -1,  }, 
     278                {       "<",            builtin_lt,                     FALSE,  1, -1,  }, 
     279                {       ">",            builtin_gt,                     FALSE,  1, -1,  }, 
     280                {       "<=",           builtin_le,                     FALSE,  1, -1,  }, 
     281                {       ">=",           builtin_ge,                     FALSE,  1, -1,  }, 
     282 
     283                {       "read",         builtin_read,           FALSE,  0,      0,      }, 
    144284                {       "print",        builtin_print,          FALSE,  1,      1,      }, 
     285                {       "eval",         builtin_eval,           FALSE,  1,      1,      }, 
     286 
     287                {       "load",         builtin_load,           FALSE,  1,      1,      }, 
     288                {       "compile",      builtin_compile,        FALSE,  1,      1,      }, 
    145289        }; 
    146290        for (int i=0; i<sizeof(tbl)/sizeof(*tbl); ++i) { 
    … …  
    151295} 
    152296 
    153 static void add_consttbl(SExp* pcenv, SExp* prenv) { 
    154         SExp cenv = *pcenv; 
    155         SExp renv = *prenv; 
    156  
    157 #if 0 
     297static void add_consttbl() { 
    158298        struct { 
    159299                const char* name; 
    … …  
    164304        for (int i=0; i<sizeof(tbl)/sizeof(*tbl); ++i) { 
    165305                SExp sym = intern(tbl[i].name); 
    166                 cenv = cons(sym, cenv); 
    167                 renv = cons(sym, renv); 
    168         } 
    169 #endif 
    170  
    171         *pcenv = cenv; 
    172         *prenv = renv; 
     306                define_global(sym, sym); 
     307        } 
    173308} 
    174309 
    175310static void init_env() { 
    176         SExp cenv = nil; 
    177         SExp renv = nil; 
    178  
    179311        add_proctbl(); 
    180         add_consttbl(&cenv, &renv); 
    181  
    182         g_comp_env = cons(cenv, nil); 
    183         g_run_env = cons(renv, nil); 
     312        add_consttbl(); 
    184313} 
    185314 
    … …  
    195324                        SExp sexp = read_from_file(fp); 
    196325                        if (nilp(sexp)) break; 
    197                         run(compile(sexp, g_comp_env, nil, halt_code)); 
     326                        run(compile(sexp, nil, nil, halt_code)); 
    198327                } 
    199328                fclose(fp); 

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

    r11387 r11544  
    3131 
    3232inline static SExp index(int s, int i) { 
    33         return g_stack[s - i - 1]; 
     33        return g_stack[s - i - 2]; 
    3434} 
    3535 
    3636inline static void index_set(int s, int i, SExp v) { 
    37         g_stack[s - i - 1] = v; 
     37        g_stack[s - i - 2] = v; 
    3838} 
    3939 
    … …  
    5050 
    5151static int shift_args(int n, int m, int s) { 
    52         for (int i=n; --i >= 0; ) { 
    53                 index_set(s, i + m, index(s, i)); 
    54         } 
    55         return s - m; 
     52        for (int i=n-1; --i > -2; ) { 
     53                index_set(s, i + m + 1, index(s, i)); 
     54        } 
     55        return s - m - 1; 
    5656} 
    5757 
    … …  
    6767        printf("#%d[", s); 
    6868        for (int i=0; i<s; ++i) { 
    69                 print_rec(refer_stack(s, i)); 
     69                print_rec(refer_stack(s, i-1)); 
    7070                printf(" "); 
    7171        } 
    … …  
    175175//============================================================================= 
    176176 
    177 static int vm_return(SExp* px, sint* pf, SExp* pc, int s, int n) { 
     177static int vm_return(SExp* px, sint* pf, SExp* pc, int s) { 
     178        int n = s2int(index(s, -1)); 
    178179        int ss = s - n; 
    179180        *px = index(ss, 0);     *pf = s2int(index(ss, 1));      *pc = index(ss, 2); 
    180         return ss - 3; 
     181        return ss - (3 + 1); 
    181182} 
    182183 
    … …  
    227228                        a = closure(body, n, s);        x = xx; s -= n; 
    228229                } else if (op == APPLY) { 
     230                        SExp argnum = cadr(x); 
     231                        int ss = push(argnum, s); 
    229232                        if (type_of(a) == tProc) { 
    230233                                Procedure* proc = (Procedure*)a.ptr; 
    … …  
    233236                                        { 
    234237                                                SCFunc cfunc = proc->u.cfunc; 
    235                                                 SExp res = (*cfunc)(s); 
    236                                                 const int n = 2;                        // �����i���j 
     238                                                SExp res = (*cfunc)(ss); 
    237239                                                a = res; 
    238                                                 s = vm_return(&x, &f, &c, s, n); 
     240                                                s = vm_return(&x, &f, &c, ss); 
    239241                                        } 
    240242                                        break; 
    241243                                case Procedure::Cell: 
    242244                                        { 
    243                                                 x = closure_body(a);    f = s;  c = a; 
     245                                                x = closure_body(a);    f = ss; c = a;  s = ss; 
    244246                                        } 
    245247                                        break; 
    … …  
    250252                        } 
    251253                } else if (op == RETURN) { 
    252                         sint n = s2int(cadr(x)); 
    253                         s = vm_return(&x, &f, &c, s, n); 
     254                        s = vm_return(&x, &f, &c, s); 
    254255                } else if (op == SHIFT) { 
    255256                        sint n = s2int(cadr(x)); 
    256                         sint m = s2int(caddr(x)); 
    257                         SExp xx = cadddr(x); 
     257                        sint m = s2int(index(s, n - 1)); 
     258                        SExp xx = caddr(x); 
    258259                        x = xx; s = shift_args(n, m, s); 
    259260                } else if (op == CONTI) {