Changeset 9197 for lang/elisp

Timestamp:

04/09/08 18:03:21 (8 months ago)

Author:

lieutar

Message:

lang/elisp/escm/trunk: I added a Makefile.

Location:

lang/elisp/escm/trunk

Files:

• . (modified) (1 prop)
• DEVELOPERSTOOLS.el (modified) (1 diff)
• Makefile (added)
• Makefile.el (modified) (1 diff)
• escm-compile.el (modified) (1 diff)
• escm-debug.el (modified) (3 diffs)
• escm-errors.el (deleted)
• escm-port.el (moved) (moved from lang/elisp/escm/trunk/escm-stream.el) (1 diff)
• escm-proc.el (modified) (5 diffs)
• escm-vm.el (modified) (3 diffs)

lang/elisp/escm/trunk/DEVELOPERSTOOLS.el

@@ -106 +106 @@
   ((elambda (a b) (+ a b)) 1 2)
   )
+
+

lang/elisp/escm/trunk/Makefile.el

@@ -1 @@
-(let ((dir (file-name-directory (buffer-file-name)))
-      (files
-       '(
-         "escm-util.minimal.el"
-         "escm-test.el"
-         "escm-util.el"
-         "escm-cbos.el"
+(defconst escm-make::els
+  '("escm-util.minimal.el"
+    "escm-test.el"
+    "escm-util.el"
+    "escm-cbos.el"
+           
+    "escm-base.el"
+    "escm-preprocess.el"
 
-         "escm-base.el"
-         "escm-preprocess.el"
+    "escm-arity.el"
+    ;;   "escm-env.el"
+    ;;   "escm-proc.el"
+    ;;   "escm-syntax.el"
+           
+    ;;   "escm-iblock-content.el"
+    ;;   "escm-iblock.el"
+    ;;   "escm-icode.el"
+           
+    ;;   "escm-context.el"
+    ;;   "escm-compile.el"
+                 
+    ;;   "escm-debug.el"
+    ;;   "escm-vm.el"
+    ;;   "escm.el"
+    ))
 
-         "escm-arity.el"
-;;       "escm-env.el"
-;;       "escm-proc.el"
-;;       "escm-syntax.el"
+(defun escm-make::newer-than (a b)
+  (let ((atime (nth 4 (file-attributes a)))
+        (btime (nth 4 (file-attributes b))))
+    (and (< (nth 0 atime)
+            (nth 0 btime))
+         (or (> (nth 0 atime)
+                (nth 0 btime))
+             (>= (nth 1 atime)
+                 (nth 1 btime))))))
 
-;;       "escm-iblock-content.el"
-;;       "escm-iblock.el"
-;;       "escm-icode.el"
+(defun escm-make::compile (file)
+  (let ((el   (locate-library file))
+        (elc  (locate-library (concat file "c"))))
+    (when (or (not elc)
+              (escm-make::newer-than el elc))
+      (byte-compile-file el))))
 
-;;       "escm-context.el"
-;;       "escm-compile.el"
-
-;;       "escm-debug.el"
-;;       "escm-vm.el"
-;;       "escm.el"
-         )))
-  (unless (member  dir load-path )
-    (setq load-path (cons dir load-path)))
-  (mapcar 'byte-compile-file files)
-  )
-
-;;   (escm-vm::eval (escm-vm::new)  '(+ 0 1 2 3))
+(defun escm-make.elc ()
+  (mapcar (function escm-make::compile) escm-make::els))
+;;(escm-make.elc)

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

@@ -244 +244 @@
              t)
   (escm-test compile1 (escm-syntax-p (escm-env::gref env 'x)))
-  (escm-test expand   (escm-iproc::equal (escm-icode '((store 1)))
-                                         (escm-test::p "result" (escm-compile ctx '(x)))))
+  (escm-test expand   (escm-iproc::equal
+                       (escm-icode '((store 1)))
+                       (escm-test::p "result" (escm-compile ctx '(x)))))
   ))
 ;; (escm-test::run 'escm 'define-syntax)

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

@@ -33 +33 @@
 (defconst escm-debug::pos   0)
 
-(defun escm-debug (vm msg))
+(defun escm-debug (vm &optional p))
 (defun escm-debug::enter ())
 (defun escm-debug::leave ())
@@ -178 +178 @@
 
 
-(defadvice escm-debug (around escm-debug first (vm p))
+(defadvice escm-debug (around escm-debug first (vm &optional p))
   (escm-debug::step vm p))
 
@@ -191 +191 @@
       (delete-other-frames)
       (setq codewin (selected-window))
-      (switch-to-buffer codebuf)
-      (escm-debug-mode)
-      (escm-debug::init-code-buffer vm p)
+      (when p
+        (switch-to-buffer codebuf)
+        (escm-debug-mode)
+        (escm-debug::init-code-buffer vm p))
       (setq vmwin (split-window-horizontally))
       (shrink-window-horizontally (- (window-width) 20))

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

@@ -29 +29 @@
 (require 'escm-base)
 
-(escm-cbos::define-class (escm-input-stream))
-(escm-cbos::define-method escm-input-stream
-  escm-input-stream::close (self))
+(escm-cbos::define-class (escm-port))
 
-(escm-cbos::define-class (escm-file-input-stream escm-input-stream) buffer position)
-(defun escm-file-input-stream::new (file)
+;; [R5RS]
+;; (port?)
+
+;; [R5RS]
+(escm-cbos::define-method escm-port escmp-port::input-port? (self) nil)
+;; [R5RS]
+(escm-cbos::define-method escm-port escmp-port::output-port? (self) nil)
+
+
+(escm-cbos::define-class (escm-output-port escm-port))
+;; Function: close-input-port port
+;; Function: close-output-port port
+;;     [R5RS] Closes input and output port, respectively 
+
+
+(escm-cbos::define-class (escm-input-port escm-port))
+
+(escm-cbos::define-method escm-input-port
+  escm-input-port::read (self))
+
+(escm-cbos::define-method escm-input-port
+  escm-input-port::close-input-port (self))
+
+(escm-cbos::define-method escm-input-port
+  escm-input-port::read-char (self))
+
+(escm-cbos::define-method escm-input-port
+  escm-input-port::peek-char (self))
+
+(escm-cbos::define-method escm-input-port
+  escm-input-port::char-ready? (self))
+
+
+
+(escm-cbos::define-class (escm-input-file escm-input-port) buffer position)
+
+(defsubst escm-input-file::new (file)
   "creates a filehandle that bound to given path."
-  (let* ((self (create-escm-file-input-stream))
+  (let* ((self (create-escm-input-file))
          (buf  (find-file-noselect file nil nil)))
     (save-excursion
       (set-buffer buf)
       (rename-buffer (format " *escm-open %s*" file)))
-    (escm-file-input-stream::set-buffer  buf)
-    (escm-file-input-stream::set-positon 1)
+    (escm-input-file::set-buffer  buf)
+    (escm-input-file::set-positon 1)
     self))
 
-(defun escm-file-input-stream::at-eof? (self)
-  (>= (escm-file-input-stream::get-position self)
-      (escm-file-input-stream::get-buffer   self)))
+(defsubst escm-input-file::at-eof? (self)
+  (>= (escm-input-file::get-position self)
+      (escm-input-file::get-buffer   self)))
 
-(defun escm-file-input-stream::getc (self)
-  (if ((escm-file-input-stream::at-eof? self))
-    (buffer-substring-no-properties )))
+(defsubst escm-input-file::read-char (self)
+  (if (escm-input-file::at-eof? self) nil
+    (let ((buf (escm-input-file::get-buffer self))
+          (p   (escm-input-file::get-position self))
+          (r   nil))
+      (save-excursion
+        (set-buffer buf)
+        (setq r (buffer-substring-no-properties (1- p) p)))
+      (escm-input-file::set-positon self (1+ p))
+      (when r (aref r 0)))))
 
 
-(defmacro escm-util::with-fh-buffer (fh &rest body)
-  ""
-  `(let ((*buf* (current-buffer)))
-     (set-buffer (get ,fh 'buf))
-     (let ((*ret* (progn ,@body)))
-       (set-buffer *buf*)
-       *ret*)))
+(defsubst escm-input-file::peek-char (self)
+  (if (escm-input-file::at-eof? self) nil
+    (let ((buf (escm-input-file::get-buffer self))
+          (p   (escm-input-file::get-position self))
+          (r   nil))
+    (save-excursion
+      (set-buffer buf)
+      (setq r (buffer-substring-no-properties (1- p) p)))
+    (when r (aref r 0)))))
 
-(defun escm-util::getc (fh)
-  "gets a character from filehandle."
-  (escm-util::with-fh-buffer
-   fh
-   (if (= (point) (point-max)) nil
-     (forward-char 1)
-     (buffer-substring-no-properties (1- (point)) (point)))))
+(defsubst escm-input-file::close-input-port (self)
+  "closes filehandle."
+  (kill-buffer (escm-input-file::get-buffer self))
+  (escm-input-file::set-buffer self nil))
 
-(defun escm-util::gets (fh)
-  "gets a line from filehandle."
-  (escm-util::with-fh-buffer
-   fh
-   (if (= (point) (point-max)) nil
-     (let ((from (point))
-           (to   (progn (end-of-line) (point))))
-       (when (< (point) (point-max)) (forward-char 1))
-       (buffer-substring-no-properties from to)))))
+(defsubst escm-input-file::char-ready? (self)
+  (not (escm-input-file::at-eof? self)))
 
-(defun escm-util::close (fh)
-  "closes filehandle."
-  (save-excursion
-    (kill-buffer (get fh 'buf))
-    (put fh 'buf nil)))
 
-(defmacro escm-util::with-file (file var &rest body)
-  "like a IO.foreach in ruby."
-  `(let ((*ret* nil)
-         (*fh* (escm-util::open ,file))
-         ,var)
-     (while (setq ,var (escm-util::gets *fh*))
-       (setq *ret* (cons (progn ,@body) *ret*)))
-     (escm-util::close *fh*)
-     (reverse *ret*)))
+(escm-cbos::define-method escm-input-file
+  escm-input-port::close-input-port (self)
+  (escm-input-file::close-input-port self))
+
+(escm-cbos::define-method escm-input-file
+  escm-input-port::read-char (self)
+  (escm-input-file::read-char self))
+
+(escm-cbos::define-method escm-input-file
+  escm-input-port::peek-char (self)
+  (escm-input-file::peek-char self))
+
+(escm-cbos::define-method escm-input-file
+  escm-input-port::char-ready? (self)
+  (escm-input-file::char-ready? self))
+
 
 

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

@@ -73 +73 @@
   escm-wrapped-vm-method escm-wrapped-proc::make-expression (self fun)
   `(apply ,(if (symbolp fun) (symbol-function fun) fun)
-          (escm-wrapped-proc-env::get-arg
-           (cons vm (escm-vm::current-env vm)))))
-
-
-
+          (cons vm (escm-wrapped-proc-env::get-arg (escm-vm::current-env vm)))))
 
 (defsubst escm-wrapped-proc::initialize (new fun)
@@ -102 +98 @@
     new))
 
-;;(escm-wrapped-proc::new (function +))
-
-;;   (escm-vm::eval (escm-vm::new)  '(+ 1 2))
+;;
 
 (escm-cbos::define-method
@@ -115 +109 @@
 
 (defsubst escm-continuation::new (vm)
-  (create-escm-wrapped-vm-method
-   `(lambda (vm val)
-      (let ((cont ,(let ((cont (create-escm-vm)))
-                     (set-env-stack  cont (copy-list (get-env-stack  vm)))
-                     (set-proc-stack cont (copy-list (get-proc-stack vm)))
-                     (set-src-stack  cont (copy-list (get-src-stack  vm)))
-                     (set-pc-stack   cont (copy-list (get-pc-stack   vm)))
-                     (set-arg-stack  cont (copy-list (get-arg-stack  vm))))
-                     cont))
-        (set-env-stack  vm (get-env-stack  cont))
-        (set-proc-stack vm (get-proc-stack cont))
-        (set-src-stack  vm (get-src-stack  cont))
-        (set-pc-stack   vm (get-pc-stack   cont))
-        (set-arg-stack  vm (get-arg-stack  cont))
-        (set-val-stack  vm (list            val))))))
+  (escm-wrapped-vm-method::new
+   `(lambda (vm &rest *vals*)
+      (escm-vm::set-env-stack  vm ,(copy-list (cdr (escm-vm::get-env-stack  vm))))
+      (escm-vm::set-proc-stack vm ,(copy-list (cdr (escm-vm::get-proc-stack vm))))
+      (escm-vm::set-src-stack  vm ,(copy-list (cdr (escm-vm::get-src-stack  vm))))
+      (escm-vm::set-pc-stack   vm ,(copy-list (cdr (escm-vm::get-pc-stack   vm))))
+      (escm-vm::set-arg-stack  vm ,(copy-list (cdr (escm-vm::get-arg-stack  vm))))
+      (escm-vm::set-val-stack  vm *vals* )
+      (escm-debug 0)
+      )))
+
+
 
 (defun escm::values (vm &rest vals)
@@ -169 +160 @@
 (defun escm::call/cc (vm proc)
   (escm-vm::push-arg vm (list (escm-continuation::new vm)))
+  (escm-vm::set-current-val vm  proc)
   (escm-vm::call vm proc))
+
+
+
+
 
 (defun escm-proc::initialize-vm (vm)
@@ -191 +187 @@
 
      (escm-wrapped-vm-method::new
-      . ((expand-quasiquote      escm::expand-quasiquote)
-         (values                 escm::values)
-         (apply                  escm::apply)
-         (eval                   escm::eval)
-         (call/cc                escm::call/cc)
-         (call-with-continuation escm::call/cc)
+      . ((expand-quasiquote              escm::expand-quasiquote)
+         (values                         escm::values)
+         (apply                          escm::apply)
+         (eval                           escm::eval)
+         (call/cc                        escm::call/cc)
+         (call-with-current-continuation escm::call/cc)
+         (show-registers                 escm-debug::vm-to-string)
          ))))
   )
 (add-hook 'escm-vm::init-hook (function escm-proc::initialize-vm))
 
+
+
 (provide 'escm-proc)
 ;;; escm-proc.el ends here

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

@@ -91 +91 @@
            vm)))))
 
-
 (defsubst escm-vm::call (vm &optional proc)
   (escm-debug::enter)
@@ -136 +135 @@
          (list vm (escm-vm::current-env vm)))
   (escm-vm::set-current-pc vm (1+ (escm-vm::current-pc vm))))
+;;   (escm-vm::eval (escm-vm::new) '(call/cc (lambda (cc) 123)))
 
 (defsubst escm-vm::apply (vm proc args)
@@ -142 +142 @@
                        (escm-vm::push-arg       vm (reverse args))
                        (escm-vm::call           vm proc)
-                       (escm-vm::push-pc        vm 0)
+                       (escm-vm::set-current-pc vm 0)
                        (while (escm-vm::get-proc-stack vm)
                          (escm-vm::step vm))
                        (escm-vm::current-val vm))))
     (escm-vm::set-proc-stack vm procs)
+    (escm-vm::set-current-pc vm 0)
     retval))
+
+(escm-test::define-test escm escm-vm-eval
+  (let ((test (lambda (sexp)
+                (let ((vm (escm-vm::new)))
+                  (escm-vm::eval vm sexp)
+                  (eval (macroexpand
+                         `(escm-test
+                           ,(format "eval %S" sexp)
+                           (equal
+                            (escm-test::p "pc(result):"
+                                          (escm-vm::get-pc-stack vm))
+                            (escm-test::p "pc(new):"
+                                          (escm-vm::get-pc-stack
+                                           (escm-vm::new)))))))))))
+    (funcall test '())
+    (funcall test '(+ 1 1))
+    (funcall test '((lambda () )))
+    (funcall test '(define (a x) x))
+    (funcall test '(define-syntax a (lambda (sexp) )))))
+;;(escm-test::run 'escm 'escm-vm-eval)
 
 (defsubst escm-vm::compile (vm sexp)