Changeset 6617

Timestamp:

02/13/08 01:31:53 (10 months ago)

Author:

lieutar

Message:

/share/lang/elisp/escm/trunk: add some changes

Location:

lang/elisp/escm/trunk

Files:

• escm-assemble.el (added)
• escm-compile.el (added)
• escm-env.el (modified) (3 diffs)
• escm-proc.el (modified) (1 diff)
• escm-syntax.el (added)
• escm-test.el (modified) (1 diff)
• escm-util.el (modified) (1 diff)
• escm-vm-init.el (deleted)
• escm-vm.el (modified) (4 diffs)
• escm-wrapped-proc.el (added)
• escm.el (modified) (1 diff)

lang/elisp/escm/trunk/escm-env.el

@@ -43 +43 @@
   (let ((pos (escm-env::pos self sym)))
     (if pos `(aref ,env ,pos)
-      (escm-env::make-referer (escm-env::parent self)
-                              `(escm-env::parent ,env)
+      (escm-env::make-referer (escm-env::get-parent self)
+                              `(escm-env::get-parent ,env)
                               sym))))
 
@@ -50 +50 @@
   (let ((pos (escm-env::pos self sym)))
     (if pos `(aset ,env ,pos ,val)
-      (escm-env::make-setter (escm-env::parent self)
-                             `(escm-env::parent ,env)
+      (escm-env::make-setter (escm-env::get-parent self)
+                             `(escm-env::get-parent ,env)
                              sym
                              val))))
-
 
 (escm-test::deftest escm env
@@ -66 +65 @@
    (escm-test "gset! 2" (escm-env::gset! g 'a 3) t)
    (escm-test "gref  2" (and (eq 1 (escm-env::gref e 'a))
-                             (eq 3 (escm-env::gref g 'a))))))
+                             (eq 3 (escm-env::gref g 'a))))
+   (escm-util::a (escm-env::make-referer f 'env 'a))
+   (escm-util::a (escm-env::make-setter f 'env 'a '((aaa))))))
 
-;;(escm-test::run 'escm 'env)
+;;(escm-test::run 'escm 'env )
 (provide 'escm-env)

lang/elisp/escm/trunk/escm-proc.el

@@ -11 +11 @@
     new))
 
-(defsubst escm-proc::wrap (fun)
-  (let ((new (create-escm-proc)))
-    (escm-proc::set-body
-     (vector
-      (byte-compile (lambda (vm)
-                      (escm-vm::set-current-value
-                       vm
-                       (apply fun (escm-vm::get-current-args vm)))))
-      (function escm-vm::ret)
-      ))))
-
-(defmacro escm-defun ())
+(defmacro escm-defun ()
+  (let (())
+    ))

lang/elisp/escm/trunk/escm-test.el

@@ -5 +5 @@
                   (let ((err (eval (progn ,@x)))) (if (eq err t) nil err))
                 (error *error*))))
-     (when err (setq failed (cons (cons name err) failed)))))
+     (when err (setq failed (cons (cons ,name err) failed)))))
 
 (defun escm-test::run-test (reporter project name all)

lang/elisp/escm/trunk/escm-util.el

@@ -50 +50 @@
 
 (defun escm-util::a (&rest args)
+  ""
   (read-char (format "%S" args))
   nil)
 
+(defsubst escm-util::get-arity (fun)
+  "returns argument list."
+  (if (functionp fun)
+      (cond ((subrp fun) (subr-arity fun))
+            ((listp fun) (cadr       fun))
+            (t           (aref       fun 0)))
+    (throw 'error (format "wrong type argument: functionp %S" fun))))
+
 (provide 'escm-util)

lang/elisp/escm/trunk/escm-vm.el

@@ -2 +2 @@
 (require 'escm-cbos)
 (require 'escm-proc)
+(require 'escm-wrapped-proc)
+
+(defconst 'escm-vm::init-hook ())
+(defun escm-vm-init (vm) (run-hook-with-args 'escm-vm::init-hook vm))
 
 (escm-util::expand
@@ -42 +46 @@
            vm)))))
 
-(defsubst escm-vm::call (vm proc)
-  (let ((args   (escm-vm::get-current-args vm))
+(defsubst escm-vm::call (vm)
+  (let ((proc   (escm-vm::get-current-val))
+        (args   (escm-vm::get-current-args vm))
         (env    (escm-cbos::clone  (escm-proc::get-env   proc)))
         (arity  (escm-proc::get-arity proc))
@@ -53 +58 @@
     (escm-vm::push-args vm ())))
 
-(defsubst escm-vm::t-call (vm proc)
-  (let ((args   (escm-vm::get-current-args vm))
+(defsubst escm-vm::t-call (vm)
+  (let ((proc   (escm-vm::get-current-val))
+        (args   (escm-vm::get-current-args vm))
         (env    (escm-cbos::clone  (escm-proc::get-env   proc)))
         (arity  (escm-proc::get-arity proc))
@@ -64 +70 @@
     (escm-vm::set-current-args  vm  ())))
 
-(defsubst escm-vm::ret (vm val)
+(defsubst escm-vm::ret (vm)
+  (escm-vm::set-val  (mapcar (lambda (v)
+                               (if (escm-cbos::is-a v 'escm-proc)
+                                   (let ((proc (escm-cbos::clone v))
+                                         (renv (escm-cbos::clone (escm-proc::get-env v)))
+                                         (cenv (escm-vm::get-current-env vm)))
+                                     (escm-env::set-parent renv cenv)
+                                     (escm-proc::set-env   proc renv)
+                                     proc)
+                                 v))
+                             (escm-vm::get-val)))
   (escm-vm::pop-proc vm)
   (escm-vm::pop-env  vm)

lang/elisp/escm/trunk/escm.el

@@ -1 @@
-
-(require 'escm-util)
-(require 'escm-cbos)
-
-(require 'escm-env)
 (require 'escm-vm)
-(require 'escm-proc)
-
 
 (defvar escm-default-vm nil)