Changeset 5972 for lang/c/misc

Timestamp:

02/01/08 00:46:41 (5 years ago)

Author:

mokehehe

Message:

文字列実装
シンボルのfindとmakeを統合
print修正

Location:

lang/c/misc/mlisp

Files:

• readme.txt (modified) (2 diffs)
• src/main.c (modified) (2 diffs)
• src/ml_builtin.c (modified) (2 diffs)
• src/mlisp.cpp (modified) (20 diffs)
• src/mlisp.h (modified) (3 diffs)

lang/c/misc/mlisp/readme.txt

@@ -51 +51 @@
 * todo
 
-- �����Ƃ��������� ���L�V�J���X�R�[�v�A�N���[�W��
+- ���L�V�J���X�R�[�v�A�N���[�W��
 - �K�x�R��
 - assert �Ŏ��ȂȂ��悤��
@@ -62 +62 @@
 - &optional, &rest
 
--[v] �}�N�����Łu`�v�u,�v�u,@�v���������
+-[v] �����Ƃ���������[v] �}�N�����Łu`�v�u,�v�u,@�v���������
 -- �u`�v�u,�v����ς�
 -- �u,@�v����ς�

lang/c/misc/mlisp/src/main.c

@@ -41 +41 @@
                         }
                         if (b_print_read) {
-                                ml_print(ml, ofp, r, FALSE);
+                                ml_print(ml, ofp, r);
                         }
 
@@ -47 +47 @@
                 }
                 if (e != cNL) {
-                        ml_print(ml, ofp, e, FALSE);
+                        ml_print(ml, ofp, e);
                 }
         }

lang/c/misc/mlisp/src/ml_builtin.c

@@ -52 +52 @@
                         SExp b;
                         if (SEXP_CONSP(ca)) {
-                                SExp unq = ml_make_symbol(ml, "unquote", NULL);
-                                SExp unqa = ml_make_symbol(ml, "unquote-splicing", NULL);
                                 SExp caa = ml_car(ml, ca);
-                                if (caa == unq) {
+                                if (caa == ml_find_symbol(ml, "unquote", NULL, TRUE)) {
                                         b = ml_eval(ml, ml_car(ml, ml_cdr(ml, ca)));
-                                } else if (caa == unqa) {
+                                } else if (caa == ml_find_symbol(ml, "unquote-splicing", NULL, TRUE)) {
                                         b = ml_eval(ml, ml_car(ml, ml_cdr(ml, ca)));
                                         ml_rplacd(ml, tail, b);
@@ -291 +289 @@
 {
         FILE* fp = stdout;
-        ml_print(ml, fp, a, TRUE);
-        return cNil;
+        SExp ca = ml_car(ml, a);
+        ml_print(ml, fp, ca);
+        return ca;
 }
 

lang/c/misc/mlisp/src/mlisp.cpp

@@ -122 +122 @@
         SExp read(FILE* fp);
         SExp eval(SExp a);
-        void print(FILE* fp, SExp a, bool b_cell);
+        void print(FILE* fp, SExp a);
         SExp apply(SExp ca, SExp cd, bool b_eval);
 
@@ -142 +142 @@
         void runtime_error(SExp a, const char* msg);
 
-        SExp make_symbol(const char* str, const char* end);
+        SExp find_symbol(const char* str, const char* end, bool b_make);
 
 private:
@@ -158 +158 @@
         SExp alloc_symbol();
         Symbol* get_symbol_ptr(SExp a);
-        SExp find_symbol(const char* str, const char* end);
 
         SExp eval_cell(SExp a);                                                 ///< �Z���������car �̊֐��Ɏc�������ČĂяo���j
@@ -296 +295 @@
         if (a != cNil) {
                 fprintf(fp, " :");
-                print(fp, a, false);
+                print(fp, a);
         } else {
                 fprintf(fp, "\n");
@@ -434 +433 @@
 Symbol* MLContext::get_symbol_ptr(SExp a)
 {
-        assert(SEXP_TYPE(a) == tSymb);
+        assert(SEXP_TYPE(a) == tSymb || SEXP_TYPE(a) == tStr);
         return &g_symbol_buf[SEXP_UVAL(a)];
 }
 
-SExp MLContext::find_symbol(const char* str, const char* end)
+SExp MLContext::find_symbol(const char* str, const char* end, bool b_make)
 {
         int len;
@@ -454 +453 @@
                 }
         }
-        return cFail;
-}
-
-SExp MLContext::make_symbol(const char* str, const char* end)
-{
-        SExp a;
-        a = find_symbol(str, end);
-        if (a == cFail) {
-                a = alloc_symbol();
+
+
+        if (b_make) {
+                SExp a = alloc_symbol();
                 Symbol* p = get_symbol_ptr(a);
                 p->sexp = cUndef;
@@ -474 +468 @@
                         p->str[len] = '\0';
                 }
-        }
-        return a;
+                return a;
+        }
+
+        return cFail;
 }
 
@@ -492 +488 @@
         SExp fn = MAKE_SEXP(tFunc, SEXP_UVAL(cell));
 
-        SExp symb = make_symbol(word, NULL);
+        SExp symb = find_symbol(word, NULL, true);
         setq(symb, fn);
         return symb;
@@ -535 +531 @@
         *q = '\0';
 
-        SExp a = make_symbol(str, q);
-        return cons(find_symbol("quote", NULL), cons(a, cNil));
+        SExp a = find_symbol(str, q, true);
+        return MAKE_SEXP(tStr, SEXP_UVAL(a));
 }
 
@@ -621 +617 @@
                 {
                         SExp a = read_rec(fp);
-                        return cons(make_symbol("quote", NULL), cons(a, cNil));
+                        return cons(find_symbol("quote", NULL, true), cons(a, cNil));
                 }
         case '`':
                 {
                         SExp a = read_rec(fp);
-                        return cons(make_symbol("quasiquote", NULL), cons(a, cNil));
+                        return cons(find_symbol("quasiquote", NULL, true), cons(a, cNil));
                 }
         case ',':
@@ -634 +630 @@
                         if (c != '@') {
                                 ungetc(c, fp);
-                                fn = make_symbol("unquote", NULL);
+                                fn = find_symbol("unquote", NULL, true);
                         } else {
-                                fn = make_symbol("unquote-splicing", NULL);
+                                fn = find_symbol("unquote-splicing", NULL, true);
                         }
                         SExp a = read_rec(fp);
@@ -665 +661 @@
                         SExp a = reserved(symb, q-symb);
                         if (a == cFail) {
-                                a = make_symbol(symb, q);
+                                a = find_symbol(symb, q, true);
                         }
                         return a;
@@ -699 +695 @@
         case tOther:
         case tFunc:
+        case tStr:
                 return a;
         case tSymb:
@@ -752 +749 @@
 
                         if (flags[MLF_PRINT_FUNC_ARG]) {
-                                print(stdout, param, false);
+                                print(stdout, param);
                         }
                         bind_arg(arg, param);
@@ -759 +756 @@
                                 SExp replace = eval(body);
                                 if (flags[MLF_PRINT_MACRO_REPLACE]) {
-                                        print(stdout, replace, false);
+                                        print(stdout, replace);
                                 }
                                 body = replace;
@@ -817 +814 @@
                 print_rec(stdout, symb);
                 printf(":");
-                print(stdout, val, false);
+                print(stdout, val);
         }
 }
@@ -879 +876 @@
                         Symbol* p = get_symbol_ptr(a);
                         fprintf(fp, "%s", p->str);
+                }
+                break;
+        case tStr:
+                {
+                        Symbol* p = get_symbol_ptr(a);
+                        fprintf(fp, "\"%s\"", p->str);
                 }
                 break;
@@ -911 +914 @@
 }
 
-void MLContext::print(FILE* fp, SExp a, bool b_cell)
-{
-        if (!b_cell) {
-                print_rec(fp, a);
-        } else {
-                print_cell(fp, a);
-        }
+void MLContext::print(FILE* fp, SExp a)
+{
+        print_rec(fp, a);
         printf("\n");
 }
@@ -934 +933 @@
 SExp ml_read(MLContext* ml, FILE* fp)                                                           { return ml->read(fp); }
 SExp ml_eval(MLContext* ml, SExp a)                                                                     { return ml->eval(a); }
-void ml_print(MLContext* ml, FILE* fp, SExp a, int b_cell)                      { ml->print(fp, a, b_cell != FALSE); }
+void ml_print(MLContext* ml, FILE* fp, SExp a)                                          { ml->print(fp, a); }
 SExp ml_apply(MLContext* ml, SExp ca, SExp cd)                                          { return ml->apply(ca, cd, false); }
 
@@ -950 +949 @@
 
 void ml_setq(MLContext* ml, SExp symb, SExp arg_body)                           { ml->setq(symb, arg_body); }
-SExp ml_make_symbol(MLContext* ml, const char* str, const char* end)    { return ml->make_symbol(str, end); }
+SExp ml_find_symbol(MLContext* ml, const char* str, const char* end, int b_make)        { return ml->find_symbol(str, end, b_make != FALSE); }
 
 const char* ml_get_symbol_string(MLContext* ml, SExp symb)                      { return ml->get_symbol_string(symb); }

lang/c/misc/mlisp/src/mlisp.h

@@ -45 +45 @@
 SExp ml_read(MLContext* ml, FILE* fp);
 SExp ml_eval(MLContext* ml, SExp a);
-void ml_print(MLContext* ml, FILE* fp, SExp a, int b_cell);
+void ml_print(MLContext* ml, FILE* fp, SExp a);
 SExp ml_apply(MLContext* ml, SExp ca, SExp cd);
 
@@ -65 +65 @@
 
 void ml_setq(MLContext* ml, SExp symb, SExp arg_body);          ///< setq
-SExp ml_make_symbol(MLContext* ml, const char* str, const char* end);           ///< �V���{���쐬
+SExp ml_find_symbol(MLContext* ml, const char* str, const char* end, int b_make);               ///< �V���{���쐬
 
 const char* ml_get_symbol_string(MLContext* ml, SExp symb);     ///< symbol string
@@ -83 +83 @@
 #define tOther                          (10)    ///< other (nil, t, eof)
 #define tFunc                           (14)    ///< function (lambda or macro)
+#define tStr                            (18)    ///< string
 
 /// macros