Changeset 11058 for lang/c

Timestamp:

05/04/08 08:57:54 (7 months ago)

Author:

mokehehe

Message:

コンパイルできるようにした

Location:

lang/c/misc/mlisp

Files:

• mlisp.vcproj (modified) (1 diff)
• readme.txt (modified) (1 diff)
• sexp/sexp.cpp (modified) (1 diff)
• sexp/sexp.h (modified) (4 diffs)
• sexp/sutil.h (modified) (1 diff)
• test/compiler.cpp (modified) (5 diffs)
• test/main.cpp (modified) (12 diffs)
• test/vm.cpp (modified) (3 diffs)

lang/c/misc/mlisp/mlisp.vcproj

@@ -81 +81 @@
                                 Name="VCLinkerTool"
                                 AdditionalDependencies="boehmgc.lib libcpmt.lib"
-                                OutputFile="$(OutDir)/mlisp.exe"
+                                OutputFile="mlisp.exe"
                                 LinkIncremental="1"
                                 GenerateDebugInformation="TRUE"

lang/c/misc/mlisp/readme.txt

@@ -8 +8 @@
 -BoehmGC ��p
 -�q�[�v�x�[�X�̎��
--repl ����quit�v�Ƒł����ނƔ�����
+-repl ����quit�v�Ƒł����ނƔ�����-�unil�v�ut�v���V���{���Ȃ̂ŁA�R���p�C�������V���{���Q�ƂɂȂ�Ă��܂�
+-�V���{���̑啶���Ə�������ʂ���

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

@@ -90 +90 @@
 }
 
+const char* s2str(SExp s) {
+        type_check(s, tStr);
+        String* str = (String*)s.ptr;
+        return str->str;
+}
+
 
 //=============================================================================

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

@@ -90 +90 @@
 void rplacd(SExp s, SExp d);    // cdr ���u������
 
+/// ������Ή��������{�����
 SExp intern(const char* str);
 
@@ -113 +114 @@
 SExp int2s(sint x);
 
+/// S���𕶎���ϊ�
+const char* s2str(SExp s);
+
 
 
@@ -124 +128 @@
 //=============================================================================
 // �C�����C��
-
-__inline int consp(SExp s)              { return type_of(s) == tCell; }
-
-__inline int symbolp(SExp s)    { return type_of(s) == tSymb; }
-
 
 __inline SExp int2s(sint x) {
@@ -145 +144 @@
 
 
-
-__inline SExp cadr(SExp s)              { return car(cdr(s)); }
-__inline SExp cddr(SExp s)              { return cdr(cdr(s)); }
-__inline SExp caddr(SExp s)             { return car(cdr(cdr(s))); }
-__inline SExp cdddr(SExp s)             { return cdr(cdr(cdr(s))); }
-__inline SExp cadddr(SExp s)    { return car(cdr(cdr(cdr(s)))); }
-__inline SExp cddddr(SExp s)    { return cdr(cdr(cdr(cdr(s)))); }
-
-
-
 #ifdef __cplusplus
 inline bool SExp::operator==(const SExp s) const { return eq(*this, s) != 0; }

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

@@ -36 +36 @@
 
 
+
+__inline int consp(SExp s)              { return type_of(s) == tCell; }
+
+__inline int symbolp(SExp s)    { return type_of(s) == tSymb; }
+
+__inline SExp cadr(SExp s)              { return car(cdr(s)); }
+__inline SExp cddr(SExp s)              { return cdr(cdr(s)); }
+__inline SExp caddr(SExp s)             { return car(cddr(s)); }
+__inline SExp cdddr(SExp s)             { return cdr(cddr(s)); }
+__inline SExp cadddr(SExp s)    { return car(cdddr(s)); }
+__inline SExp cddddr(SExp s)    { return cdr(cdddr(s)); }
+
+
 #ifdef __cplusplus
 } // extern "C"

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

@@ -43 +43 @@
 }
 
+// ���[�J���‹��ɕϐ���^
+SExp compile_define_global(SExp env, SExp var) {
+        return cons(int2s(length(env) - 1), compile_define_var(last_pair(env), var));
+}
+
 
 
 
 static SExp compile_lookup(SExp var, SExp e) {
+#if 0
         int rib = 0;
 nxtrib:;
-                if (nilp(e)) {
-                        return nil;
-                }
+                if (nilp(e))    return nil;
                 SExp vars = car(e);
                 int elt = 0;
@@ -58 +62 @@
                         if (eq(car(vars), var)) return cons(int2s(rib), int2s(elt));
                         else                                    { vars = cdr(vars); ++elt; goto nxtelt; }
+#else
+        int rib = 0;
+        for (;; e = cdr(e), ++rib) {
+                if (nilp(e))    return nil;
+                SExp vars = car(e);
+                int elt = 0;
+                for (;; vars = cdr(vars), ++elt) {
+                        if (nilp(vars))                 break;
+                        if (eq(car(vars), var)) return cons(int2s(rib), int2s(elt));
+                }
+        }
+#endif
 }
 
@@ -128 +144 @@
         if (symbolp(x)) {
                 SExp access = compile_lookup(x, e);
+                if (nilp(access)) {
+                        access = compile_define_global(e, x);
+                }
                 return list(3, REFER, access, next);
         } else if (consp(x)) {
@@ -155 +174 @@
                         SExp var = cadr(x);
                         SExp body = cddr(x);
-                        compile_define(var, body, e, next);
+                        return compile_define(var, body, e, next);
                 } else if (eq(op, intern("call/cc"))) {
                         SExp xx = cadr(x);
@@ -164 +183 @@
                                 return list(3, FRAME, c, next);
                 } else {
-                        compile_pair_loop(cdr(x), compile(car(x), e, cons(APPLY, nil)), e, next);
+                        return compile_pair_loop(cdr(x), compile(car(x), e, cons(APPLY, nil)), e, next);
                 }
         } else {
-                list(3, CONSTANT, x, next);
+                return list(3, CONSTANT, x, next);
         }
 }

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

@@ -33 +33 @@
 SExp comp_env, run_env;
 
+int load(const char* fn);
 
 
@@ -38 +39 @@
 #include "op.h"
 #include "inner.h"
+
+SExp run(SExp c) {
+        return vm(nil, c, run_env, nil, nil);
+}
 
 SExp evaluate(SExp code) {
         SExp halt_code = cons(HALT, nil);
         SExp c = compile(code, comp_env, halt_code);
-        SExp r = vm(nil, c,  run_env, nil, nil);
-        return r;
-}
-
-
-static bool check_number(SExp a)
-{
+        return run(c);
+}
+
+
+static bool check_number(SExp a) {
         switch (type_of(a)) {
         default:
@@ -85 +88 @@
 }
 
-static SExp builtin_plus(SExp arg)
-{
+static SExp builtin_plus(SExp arg) {
         sint x = 0;
         for (SExp p = arg; consp(p); p = cdr(p)) {
@@ -96 +98 @@
 }
 
-static SExp builtin_difference(SExp arg)
-{
+static SExp builtin_difference(SExp arg) {
         SExp a = car(arg);
         check_number(a);
@@ -115 +116 @@
 }
 
-static SExp builtin_lt(SExp arg)
-{
+static SExp builtin_times(SExp arg) {
+        sint x = 1;
+        for (SExp p = arg; consp(p); p = cdr(p)) {
+                SExp a = car(p);
+                check_number(a);
+                x *= s2int(a);
+        }
+        return int2s(x);
+}
+
+static SExp builtin_quotient(SExp arg) {
+        SExp a = car(arg);
+        check_number(a);
+        sint x = s2int(a);
+
+        SExp p = cdr(arg);
+        if (!consp(p)) {
+                x = -x;
+        } else {
+                for (; consp(p); p = cdr(p)) {
+                        SExp a = car(p);
+                        check_number(a);
+                        sint d = s2int(a);
+                        if (d == 0) {
+//                              error(ERR_ZERO_DIVIDE);
+                                assert(!"zero divide");
+                        } else {
+                                x /= d;
+                        }
+                }
+        }
+        return int2s(x);
+}
+
+static SExp builtin_lt(SExp arg) {
         SExp a = car(arg);
         check_number(a);
@@ -131 +165 @@
 }
 
-static SExp builtin_read(SExp arg)
-{
+static SExp builtin_gt(SExp arg) {
+        SExp a = car(arg);
+        check_number(a);
+        sint x = s2int(a);
+
+        for (SExp p = cdr(arg); consp(p); p = cdr(p)) {
+                SExp b = car(p);
+                check_number(a);
+                sint y = s2int(b);
+                if (x <= y)     return nil;
+                x = y;
+        }
+        return t;
+}
+
+static SExp builtin_read(SExp arg) {
         return read_from_file(stdin);
 }
 
-static SExp builtin_print(SExp arg)
-{
+static SExp builtin_print(SExp arg) {
         SExp a = car(arg);
         print(a);
@@ -143 +190 @@
 }
 
-static SExp builtin_eval(SExp arg)
-{
+static SExp builtin_eval(SExp arg) {
         SExp code = car(arg);
 
         return evaluate(code);
+}
+
+static SExp builtin_load(SExp arg) {
+        SExp a = car(arg);
+        const char* fn = s2str(a);
+        if (fn != NULL) {
+                if (load(fn)) {
+                        return t;
+                }
+        }
+        return nil;
+}
+
+static SExp builtin_compile(SExp arg) {
+        SExp code = car(arg);
+        SExp halt_code = cons(HALT, nil);
+        return compile(code, comp_env, halt_code);
 }
 
@@ -168 +231 @@
                 {       "+",            builtin_plus,           FALSE,  0,      -1,     },
                 {       "-",            builtin_difference,     FALSE,  1, -1,  },
+                {       "*",            builtin_times,          FALSE,  0,      -1,     },
+                {       "/",            builtin_quotient,       FALSE,  1, -1,  },
                 {       "<",            builtin_lt,                     FALSE,  1, -1,  },
+                {       ">",            builtin_gt,                     FALSE,  1, -1,  },
 
 
@@ -174 +240 @@
                 {       "print",        builtin_print,          FALSE,  1,      1,      },
                 {       "eval",         builtin_eval,           FALSE,  1,      1,      },
+
+                {       "load",         builtin_load,           FALSE,  1,      1,      },
+                {       "compile",      builtin_compile,        FALSE,  1,      1,      },
         };
         for (int i=0; i<sizeof(tbl)/sizeof(*tbl); ++i) {
@@ -218 +287 @@
 
 
-void loop() {
+SExp compile_file(const char* fn) {
+        FILE* fp = fopen(fn, "r");
+        SExp code = nil;
+        if (fp != NULL) {
+                SExp acc = nil;
+                for (;;) {
+                        SExp s = read_from_file(fp);
+                        if (nilp(s))    break;
+                        acc = cons(s, acc);
+                }
+                SExp halt_code = cons(HALT, nil);
+                code = compile_block(nreverse(acc), comp_env, halt_code);
+
+                fclose(fp);
+        }
+        return code;
+}
+
+
+int load(const char* fn) {
+        SExp code = compile_file(fn);
+        if (!nilp(code)) {
+                SExp r = run(code);
+                return TRUE;
+        } else {
+                return FALSE;
+        }
+}
+
+
+void repl() {
         SExp halt_code = cons(HALT, nil);
 
@@ -238 +337 @@
 
 
-SExp load_file(const char* fn) {
-        FILE* fp = fopen(fn, "r");
-        SExp code = nil;
-        if (fp != NULL) {
-                SExp acc = nil;
-                for (;;) {
-                        SExp s = read_from_file(fp);
-                        if (nilp(s))    break;
-                        acc = cons(s, acc);
-                }
-                code = nreverse(acc);
-
-                fclose(fp);
-        }
-        return code;
-}
-
-
-SExp load(const char* fn) {
-        SExp sexps = load_file(fn);
-
-        SExp halt_code = cons(HALT, nil);
-        SExp c = compile_block(sexps, comp_env, halt_code);
-        SExp r = vm(nil, c,  run_env, nil, nil);
-
-        return r;
-}
-
-
 int main(int argc, char* argv[])
 {
@@ -279 +349 @@
                 load(argv[1]);
         } else {
-                loop();
+                repl();
         }
         mlisp_delete();

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

@@ -9 +9 @@
 #include "inner.h"
 #include <assert.h>
+
+static void runtime_error(const char* msg) {
+        assert(!msg);
+}
+
 
 
@@ -27 +32 @@
         for (int elt = s2int(cdr(access)); ; --elt) {
                 if (nilp(r)) {
-                        extend_run_env(car(e), elt + 1);
+                        SExp le = car(e);
+                        if (!nilp(le)) {
+                                extend_run_env(car(e), elt + 1);
+                        } else {
+                                rplaca(e, replicate(elt + 1, nil));
+                        }
+
                         r = car(e);     elt = s2int(cdr(access));
                 }
@@ -165 +176 @@
                         }
                 } else {
-                        assert(!"illegal opecode");
+                        runtime_error("illegal opecode");
+                        return nil;
                 }
         }