Changeset 22086 for lang/c

Show
Ignore:
Timestamp:
10/25/08 09:47:45 (6 years ago)
Author:
mokehehe
Message:

標準入出力を生成

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

Legend:

Unmodified
Added
Removed
  • lang/c/misc/mlisp/SExp.vcproj

    r22075 r22086  
    178178                                RelativePath=".\src\test\main.cpp"> 
    179179                        </File> 
     180                        <File 
     181                                RelativePath=".\src\test\mlisp.cpp"> 
     182                        </File> 
     183                        <File 
     184                                RelativePath=".\src\test\mlisp.h"> 
     185                        </File> 
    180186                </Filter> 
    181187        </Files> 
  • lang/c/misc/mlisp/src/sexp/s_read.c

    r22075 r22086  
    351351//============================================================================= 
    352352 
    353 SExp read(SExp s) { 
    354         if (type_of(s) == tStream) { 
    355                 return read_exec(&s.ptr->strm); 
     353SExp read(SExp strm) { 
     354        if (type_of(strm) == tStream) { 
     355                return read_exec(&strm.ptr->strm); 
    356356        } else { 
    357357                error("not stream"); 
  • lang/c/misc/mlisp/src/sexp/sexp.h

    r22075 r22086  
    4242extern SExp t; 
    4343 
    44 SExp read(SExp s); 
     44SExp read(SExp strm); 
    4545SExp eval(SExp s); 
    4646 
  • lang/c/misc/mlisp/src/sexp/smem.c

    r22075 r22086  
    5252 
    5353        { 
    54                 SExp strm_stdout = make_file_stream(stdout, "<stdout>"); 
    5554                p = s_balloc.used; 
    5655                printf("used:\n"); 
     
    6867                        if (type != NULL) { 
    6968                                printf("%p: %7d: %-10s", p, p->s.size * sizeof(union balloc_header), type); 
    70                                 prin1(ptr2s(pe), strm_stdout); 
     69                                prin1(ptr2s(pe), nil); 
    7170                                printf("\n"); 
    7271                        } else { 
  • lang/c/misc/mlisp/src/sexp/sutil.c

    r22075 r22086  
    55#include "sutil.h" 
    66#include "ssym.h" 
     7 
     8 
     9SExp list1(SExp c1) { 
     10        return cons(c1, nil); 
     11} 
     12 
     13SExp list2(SExp c1, SExp c2) { 
     14        return cons(c1, cons(c2, nil)); 
     15} 
    716 
    817 
     
    2837        } 
    2938        return nil; 
     39} 
     40 
     41 
     42SExp nreverse(SExp s) { 
     43        SExp prev = nil; 
     44        for (; consp(s); ) { 
     45                SExp n = cdr(s); 
     46                rplacd(s, prev); 
     47                prev = s; 
     48                s = n; 
     49        } 
     50        return prev; 
     51} 
     52 
     53SExp mapcar(SExp (*fn)(SExp, void*), SExp ls, void* param) { 
     54        SExp acc = nil; 
     55        for (; !nilp(ls); ls = cdr(ls)) { 
     56                acc = cons(fn(car(ls), param), acc); 
     57        } 
     58        return nreverse(acc); 
    3059} 
    3160 
  • lang/c/misc/mlisp/src/sexp/sutil.h

    r22075 r22086  
    1212#endif 
    1313 
     14 
     15SExp list1(SExp c1); 
     16SExp list2(SExp c1, SExp c2); 
     17 
    1418SExp last(SExp s); 
    1519 
    1620SExp assoc(SExp key, SExp ls); 
     21 
     22SExp nreverse(SExp s); 
     23 
     24SExp mapcar(SExp (*fn)(SExp, void*), SExp ls, void* param); 
    1725 
    1826int evlis(SExp* buf, SExp ls, int b_eval); 
  • lang/c/misc/mlisp/src/test/main.cpp

    r22074 r22086  
     1#include "mlisp.h" 
    12#include "sexp.h" 
    23#include "ssym.h" 
    34#include "sstream.h" 
    45#include "smem.h" 
    5 #include <stdio.h> 
    6  
    7 //============================================================================= 
    8 // subr 
    9  
    10 SExp subr_cons(int narg, SExp args[]) { 
    11         return cons(args[0], args[1]); 
    12 } 
    13  
    14 SExp subr_car(int narg, SExp args[]) { 
    15         return car(args[0]); 
    16 } 
    17  
    18 SExp subr_cdr(int narg, SExp args[]) { 
    19         return cdr(args[0]); 
    20 } 
    21  
    22 SExp subr_list(int narg, SExp args[]) { 
    23         SExp r = nil; 
    24         int i; 
    25         for (i=narg; --i>=0; ) { 
    26                 r = cons(args[i], r); 
    27         } 
    28         return r; 
    29 } 
    30  
    31 #if 0 
    32 SExp subr_prin1(int narg, SExp args[]) { 
    33         prin1(args[0]); 
    34         return args[0]; 
    35 } 
    36 #endif 
    37  
    38 SExp subr_eq(int narg, SExp args[]) { 
    39         return eq(args[0], args[1]) ? t : nil; 
    40 } 
    41  
    42 SExp subr_plus(int narg, SExp args[]) { 
    43         SFixnum a = s2fixnum(args[0]); 
    44         SFixnum b = s2fixnum(args[1]); 
    45         return fixnum2s(a + b); 
    46 } 
    47  
    48 SExp subr_difference(int narg, SExp args[]) { 
    49         SFixnum a = s2fixnum(args[0]); 
    50         SFixnum b = s2fixnum(args[1]); 
    51         return fixnum2s(a - b); 
    52 } 
    53  
    54 SExp subr_times(int narg, SExp args[]) { 
    55         SFixnum a = s2fixnum(args[0]); 
    56         SFixnum b = s2fixnum(args[1]); 
    57         return fixnum2s(a * b); 
    58 } 
    59  
    60 SExp subr_quotient(int narg, SExp args[]) { 
    61         SFixnum a = s2fixnum(args[0]); 
    62         SFixnum b = s2fixnum(args[1]); 
    63         return fixnum2s(a / b); 
    64 } 
     6#include <assert.h> 
    657 
    668 
    67 void define_subr(void) { 
    68         struct { 
    69                 const char* name; 
    70                 SubrType cfunc; 
    71         } subr_tbl[] = { 
    72                 {       "cons",         subr_cons,              }, 
    73                 {       "car",          subr_car,               }, 
    74                 {       "cdr",          subr_cdr,               }, 
    75                 {       "list",         subr_list,      }, 
    76                 {       "eq",           subr_eq,                }, 
    77                 {       "+",            subr_plus,              }, 
    78                 {       "-",            subr_difference,        }, 
    79                 {       "*",            subr_times,             }, 
    80                 {       "/",            subr_quotient,  }, 
    81 //              {       "prin1",        subr_prin1,             }, 
    82         }; 
    83         int i; 
    84         for (i=0; i<sizeof(subr_tbl)/sizeof(*subr_tbl); ++i) { 
    85                 setq(intern(subr_tbl[i].name), gen_subr(subr_tbl[i].cfunc, subr_tbl[i].name)); 
    86         } 
    87 } 
    88  
    89  
    90 //============================================================================= 
    91 // special form 
    92  
    93 SExp sf_quote(SExp args) { 
    94         return car(args); 
    95 } 
    96  
    97 SExp sf_setq(SExp args) { 
    98         SExp p = args; 
    99         SExp v = nil; 
    100         while (!nilp(p)) { 
    101                 SExp q = car(p);        p = cdr(p); 
    102                 v = car(p);     p = cdr(p); 
    103                 if (type_of(q) != tSym) { 
    104                         error("not symbol: %a", q); 
    105                 } else { 
    106                         setq(q, eval(v)); 
    107                 } 
    108         } 
    109         return v; 
    110 } 
    111  
    112 SExp sf_if(SExp args) { 
    113         SExp a = car(args); 
    114         SExp e = eval(a); 
    115         if (!nilp(e)) { 
    116                 SExp th = cadr(args); 
    117                 SExp e = eval(th); 
    118                 return e; 
    119         } else { 
    120                 SExp dd = cddr(args); 
    121                 if (nilp(dd)) { 
    122                         return nil; 
    123                 } else { 
    124                         SExp el = car(dd); 
    125                         SExp e = eval(el); 
    126                         return e; 
    127                 } 
    128         } 
    129 } 
    130  
    131 SExp sf_lambda(SExp args) { 
    132         SExp arglist = car(args); 
    133         SExp body = cdr(args); 
    134         return gen_lambda(arglist, body); 
    135 } 
    136  
    137 SExp sf_macro(SExp args) { 
    138         SExp arglist = car(args); 
    139         SExp body = cdr(args); 
    140         return gen_macro(arglist, body); 
    141 } 
    142  
    143  
    144 void define_specialform(void) { 
    145         struct { 
    146                 const char* name; 
    147                 SpecialFormType cfunc; 
    148         } tbl[] = { 
    149                 {       "quote",        sf_quote,               }, 
    150                 {       "setq",         sf_setq,                }, 
    151                 {       "if",           sf_if,                  }, 
    152                 {       "lambda",       sf_lambda,              }, 
    153                 {       "macro",        sf_macro,               }, 
    154         }; 
    155         int i; 
    156         for (i=0; i<sizeof(tbl)/sizeof(*tbl); ++i) { 
    157                 setq(intern(tbl[i].name), gen_specialform(tbl[i].cfunc, tbl[i].name)); 
    158         } 
    159 } 
    160  
    161 //============================================================================= 
    162 // constant 
    163  
    164 void define_const(void) { 
    165         setq(intern("nil"), nil); 
    166         setq(intern("t"), t); 
    167 } 
    168  
    169  
    170  
    171  
    172  
    173 //============================================================================= 
    174  
    1759void repl() { 
    176         SExp strm_stdin = make_file_stream(stdin, "<stdin>"); 
    177         SExp strm_stdout = make_file_stream(stdout, "<stdout>"); 
    17810        SExp quit = intern(":quit"); 
    17911 
     
    18214                SExp s, e; 
    18315                printf("> "); 
    184                 s = read(strm_stdin); 
     16                s = read(sstdin); 
    18517                if (eq(s, quit))        break; 
    18618 
    18719                e = eval(s); 
    188                 prin1(e, strm_stdout); 
    189                 write(strm_stdout, "\n"); 
     20                prin1(e, sstdout); 
     21                write(sstdout, "\n"); 
    19022        } 
    19123} 
     
    21042 
    21143 
    212  
    21344const int HEAP_SIZE = 16 * 1024; 
    21445unsigned long s_buf[HEAP_SIZE / sizeof(unsigned long)]; 
     
    22758        smem_init(s_buf, sizeof(s_buf)); 
    22859        sexp_new(); 
    229  
    230         define_specialform(); 
    231         define_subr(); 
    232         define_const(); 
     60        init_mlisp(); 
    23361 
    23462        if (argc < 2) {