Changeset 12268 for lang/c

Timestamp:

05/24/08 14:18:59 (6 months ago)

Author:

mokehehe

Message:

fix a bug of sending empty argument for rest parameter.

Location:

lang/c/misc/mlisp

Files:

• core/c_compiler.cpp (modified) (2 diffs)
• core/inner.h (modified) (3 diffs)
• core/v_vm.cpp (modified) (3 diffs)
• inc/sexp_dev.h (added)
• mlisp.vcproj (modified) (1 diff)
• proto/stackbased.scm (modified) (3 diffs)
• readme.txt (modified) (1 diff)

lang/c/misc/mlisp/core/c_compiler.cpp

@@ -435 +435 @@
 // �K�p����p�C��
 static SExp compile_apply(SExp x, SExp e, SExp s, SExp next) {
-        SExp expanded = macroexpand_1(x);
-        if (!eq(expanded, x)) {
-                return compile(expanded, e, s, next);
-        } else {
+//      SExp expanded = macroexpand_1(x);
+//      if (!eq(expanded, x)) {
+//              return compile(expanded, e, s, next);
+//      } else {
                 SExp args = cdr(x);
                 int argnum = length(args);
@@ -445 +445 @@
                 SExp c = compile(car(x), e, s, nx);
                 return compile_pair_loop(args, c, e, s, next);
-        }
+//      }
 }
 

lang/c/misc/mlisp/core/inner.h

@@ -6 +6 @@
 
 #include "sexp.h"
-#include "mlisp.h"
+#include "sexp_dev.h"
 
 #ifndef FALSE
@@ -28 +28 @@
         ERR_UNDEFINED_SYMBOL,
         ERR_UNEXPECTED,
-};
-
-
-/// S���̒lj���x�[�X�N���X�i�Z���Ȃǁj
-struct SExpExt {
-        SType type;                             ///< �^
 };
 
@@ -92 +86 @@
 
 
-__inline SExp gen_sexpext(struct SExpExt* p) {
-        SExp s;
-        s.ptr = (SExpExtU*)p;
-        return s;
-}
-
-
 
 

lang/c/misc/mlisp/core/v_vm.cpp

@@ -173 +173 @@
 }
 
-static void modify_args(Procedure* proc, int n, int s) {
+static void modify_args(Procedure* proc, int n) {
+        int s = g_sp - 1;
         if (proc->minnarg != proc->maxnarg) {
-                SExp rest = nil;
-                for (int i=n; --i >= proc->minnarg; ) {
-                        rest = cons(index(s, i), rest);
+                if (proc->maxnarg == -1) {              // REST �p�����[�^
+                        SExp rest = nil;
+                        for (int i=n; --i >= proc->minnarg; ) {
+                                rest = cons(index(s, i), rest);
+                        }
+                        if (n == proc->minnarg) {               // REST �p�����[�^�ɉ��������Ȃ�����ꍇ�A�X�^�b�N�t���[�����������̂Ŋg������                         const int m = n - proc->minnarg + 1;
+                                for (int i=0; i<n; ++i) {
+                                        index_set(s, i, index(s, i + m));
+                                }
+                                push(int2s(n + m));
+                                s += m;
+                        }
+                        index_set(s, proc->minnarg, rest);
+                } else {
+                        assert(!"not implemented");
                 }
-                index_set(s, proc->minnarg, rest);
         }
 }
@@ -245 +257 @@
                 if (check_arg_num(proc, n)) {
                         push(argnum);
-                        int ss = g_sp;
                         switch (proc->get_func_type()) {
                         case Procedure::Builtin:
@@ -257 +268 @@
                         case Procedure::Cell:
                                 {
-                                        modify_args(proc, n, ss - 1);
-                                        *px = closure_body(fn); *pf = ss;       *pc = fn;
+                                        modify_args(proc, n);
+                                        *px = closure_body(fn); *pf = g_sp;     *pc = fn;
                                 }
                                 r = 1;

lang/c/misc/mlisp/mlisp.vcproj

@@ -197 +197 @@
                         </File>
                         <File
+                                RelativePath=".\inc\mlisp_dev.h">
+                        </File>
+                        <File
                                 RelativePath=".\inc\sexp.h">
+                        </File>
+                        <File
+                                RelativePath=".\inc\sexp_dev.h">
                         </File>
                 </Filter>

lang/c/misc/mlisp/proto/stackbased.scm

@@ -452 +452 @@
                         (if (is-a? a <functional>)
                             (if (check-arg-num a n)
-                                (let ((ss (push n))
-                                      (body (closure-body a)))
+                                (let ((body (closure-body a)))
+                                  (push n)
                                   (if (procedure? body)
                                       (let* ((res (body))
@@ -459 +459 @@
                                         (VM res ret f c))
                                     (begin
-                                      (modify-args a n (- ss 1))
-                                      (VM a body ss a))))
+                                      (modify-args a n)
+                                      (VM a body *sp* a))))
                               (error "wrong number of argument"))
                           (error "can't apply")))
@@ -567 +567 @@
 
 ;; 可変引数の受け取り
-(define (modify-args c n s)
-  (let* ((min (closure-min-arg-num c))
-         (max (closure-max-arg-num c)))
-    (if (!= min max)
-        (let ((rest (do ((i (-1+ n) (-1+ i))
-                         (ls '() (cons (index s i) ls)))
-                        ((< i min) ls))))
-          (index-set! s min rest)))))
+(define (modify-args c n)
+  (let ((s (-1+ *sp*)))
+    (define (expand-frame n m)
+      (dotimes (i n '())
+        (index-set! s i (index s (+ i m))))
+      (push (+ n m)))
+    (let* ((min (closure-min-arg-num c))
+           (max (closure-max-arg-num c)))
+      (if (!= min max)
+          (if (= max -1)  ; REST パラメータ
+              (let ((rest (do ((i (-1+ n) (-1+ i))
+                               (ls '() (cons (index s i) ls)))
+                              ((< i min) ls))))
+                (if (= n min)  ; REST パラメータに何も与えられなかった場合、スタックフレームが足りないので拡張する
+                    (let ((m (1+ (- n min))))
+                      (expand-frame n m)
+                      (inc! s (+ n m))))
+                (index-set! s min rest))
+            (error "not implemented"))))))
 
 

lang/c/misc/mlisp/readme.txt

@@ -47 +47 @@
 
 * ToDo
--if ��else ���̕����ɑΉ�����-[v] �x�N�^��W���[���Ƃ��Ď������-[v] �X�^�b�N�x�[�X�ɒu��������-[v] �C�ӌ‚̈��󂯎�
+-[v] �C�ӌ‚̈��O�‚���Ɨ�����-�G���[���b�Z�[�W���Ƃ킩������
+-begin
+-[v] �x�N�^��W���[���Ƃ��Ď������-[v] �X�^�b�N�x�[�X�ɒu��������-[v] �C�ӌ‚̈��󂯎�
 -[v] �}�N�����
 --[v] macroexpand ��-[v] C �������[�o���̊֐���яo�������ɂ���- �unil�v�ut�v���V���{���Ȃ̂ŁA�R���p�C�������V���{���Q�ƂɂȂ�Ă��܂�