Changeset 21628 for lang/elisp

Timestamp:

10/19/08 18:47:57 (3 months ago)

Author:

lieutar

Message:

implemented call-with-current-continuation

Location:

lang/elisp/escm/trunk

Files:

• DEVELOPERSTOOLS.el (modified) (4 diffs)
• Makefile.in (modified) (2 diffs)
• configure.in (modified) (1 diff)
• emacs-config.el (modified) (2 diffs)
• escm-arity.el (modified) (2 diffs)
• escm-base.el (modified) (4 diffs)
• escm-cbos.el (modified) (16 diffs)
• escm-compile.el (modified) (15 diffs)
• escm-debug.el (modified) (6 diffs)
• escm-devel.el (modified) (1 diff)
• escm-elizer.el (modified) (12 diffs)
• escm-env.el (modified) (18 diffs)
• escm-iblock-content.el (modified) (10 diffs)
• escm-iblock.el (modified) (1 diff)
• escm-macro.el (modified) (3 diffs)
• escm-proc.el (modified) (4 diffs)
• escm-root-env.el (added)
• escm-syntax-case.el (added)
• escm-syntax-match.el (added)
• escm-syntax.el (modified) (1 diff)
• escm-test.el (modified) (6 diffs)
• escm-util.el (modified) (9 diffs)
• escm-vm.el (modified) (16 diffs)
• escm.el (modified) (7 diffs)
• escm/prelude.escm (added)
• genprelude (deleted)
• sample (added)

lang/elisp/escm/trunk/DEVELOPERSTOOLS.el

@@ -5 +5 @@
     (setq load-path (cons dir load-path)))
 
-  (require 'escm)
+  (require 'escm-devel)
   (global-set-key [?\C-c ?e ?a] 'escm-debug::activate)
   (global-set-key [?\C-c ?e ?d] 'escm-debug::deactivate)
@@ -13 +13 @@
                     (setq escm-default-vm nil)
                     (message "default vm is resetted.")))
+
   (global-set-key [?\C-c ?e ?e] 'escm-eval-last-sexp))
-
 
 ;; dired
@@ -20 +20 @@
 
 
+
+
+
 ;; sample codes
 (when nil
 
-  (escm-vm::eval (escm-vm::new)  '(+ 0 1 (* 2 3) 4))
-  (escm-vm::eval (escm-vm::new)  '(if nil 1 2))
-  (escm-vm::eval (escm-vm::new)
-                 '((lambda ()
-                     (define (fact n) (if (= n 1) n (* n (fact (- n 1)))))
-                     (fact 1
-
-  (escm-vm::eval
-   (escm-vm::new)
-   '((lambda ()
-       (message (call/cc (lambda (cont)
-                           (cont "abc")))))))
-
-(escm-vm::eval
- (escm-vm::new)
- '((lambda ()
-     (define (fib n)
-       (define (iter a b n)
-         (if (= n 0) (+ a b) (iter b (+ a b) (- n 1))))
-       (iter 0 1 n))
-     (fib 10))))
-
-(insert (format "%S"
-                (escm-vm::byte-compile
-                 (escm-vm::new)
-                 '((define (fib n)
-                     (define (iter a b n)
-                       (if (= n 0) (+ a b) (iter b (+ a b) (- n 1))))
-                     (iter 0 1 n))
-                   (fib 10)))))
-
-(when nil
 
   (escm-vm::eval
@@ -60 +31 @@
    '((lambda ()
        (define (fib n)
-         (if (< n 2)
-             1
-           (+ (fib (- n 2))
-              (fib (- n 1)))))
+         (define (iter a b n)
+           (if (= n 0) (+ a b) (iter b (+ a b) (- n 1))))
+         (iter 0 1 n))
        (fib 10))))
 
-  (escm-vm::eval
-   (escm-vm::new)
-   '((lambda ()
-       (define (fib-iter a b n)
-         (if (= 0 n)
-             (+ a b)
-           (fib-iter b
-                     (+ a b)
-                     (- n 1))))
-       (define (fib n) (fib-iter 0 1 n))
-       (fib 12))))
-;; 
+   (escm-vm::eval
+    (escm-vm::new)
+    '((lambda ()
+        (define (fib n)
+          (if (< n 2)
+              1
+            (+ (fib (- n 2))
+               (fib (- n 1)))))
+        (fib 10))))
+   
+   (escm-vm::eval
+    (escm-vm::new)
+    '((lambda ()
+        (define (fib-iter a b n)
+          (if (= 0 n)
+              (+ a b)
+            (fib-iter b
+                      (+ a b)
+                      (- n 1))))
+        (define (fib n) (fib-iter 0 1 n))
+        (fib 12))))
 
-  (let* ((def '((define (fib-iter a b n)
-                  (if (= 0 n)
-                      (+ a b)
-                    (fib-iter b
-                              (+ a b)
-                              (- n 1))))
-                (define (fib n) (fib-iter 0 1 n))))
-         (bm   (lambda (x)
-                 (escm-util::benchmark
-                  (escm-vm::eval (escm-vm::new) x))
-                 escm-util::benchmark::result)))
-    (list (funcall bm nil)
-          (funcall bm `((lambda () ,@def )))
-          (funcall bm `((lambda () ,@def (fib 1))))
-          (funcall bm `((lambda () ,@def (fib 10))))
-          (funcall bm `((lambda () ,@def (fib 15))))))
+   
+   (let* ((def '((define (fib-iter a b n)
+                   (if (= 0 n)
+                       (+ a b)
+                     (fib-iter b
+                               (+ a b)
+                               (- n 1))))
+                 (define (fib n) (fib-iter 0 1 n))))
+          (bm   (lambda (x)
+                  (escm-util::benchmark
+                   (escm-vm::eval (escm-vm::new) x))
+                  escm-util::benchmark::result)))
+     (list (funcall bm nil)
+           (funcall bm `((lambda () ,@def )))
+           (funcall bm `((lambda () ,@def (fib 1))))
+           (funcall bm `((lambda () ,@def (fib 10))))
+           (funcall bm `((lambda () ,@def (fib 15))))))
 
-  (escm-vm::eval (escm-vm::new) '`a)
+   (escm-vm::eval (escm-vm::new) '`a)
+   (escm-vm::eval
+    (escm-vm::new) '((lambda ()
+                       (define-syntax a (lambda (_ . x) (list 'quote x)))
+                       (a b c))))
 
 
-  (escm-vm::eval
-   (escm-vm::new) '((lambda ()
-                      (define-syntax a (lambda (_ . x) (list 'quote x)))
-                      (a b c))))
+   (define (fact n)
+     (if (= n 1)        n (* n (fact (- n 1)))))
 
-
-  (define (fact n) (if (= n 1)
-                       n
-                     (* n (fact (- n 1)))))
-  (fact 20)
-  )
+   (fact 20)
+   )

lang/elisp/escm/trunk/Makefile.in

@@ -2 +2 @@
 EMACS=@EMACS@
 SITELISP=@SITELISP@
+TAR=@TAR@
 
-ELDIR=src/elisp
-ESCMDIR=src/escm
+ELS=@ELS@
 
-ELS= escm-util.minimal.el \
-     escm-test.el \
-     escm-util.el \
-     escm-cbos.el \
-\
-     escm-base.el \
-\
-     escm-env.el \
-\
-     escm-arity.el \
-     escm-proc.el \
-\
-     escm-syntax.el \
-     escm-iblock-content.el \
-     escm-iblock.el \
-     escm-icode.el \
-     escm-elizer.el \
-     escm-compile.el \
-     escm-port.el \
-\
-     escm-debug.el \
-     escm-vm.el \
-     escm.el 
-
+INSTDIR=$(SITELISP)/escm
 EMACSFLAGS= -batch -q -L .
 
@@ -35 +12 @@
 
 .el.elc:
-        $(EMACS) $(EMACSFLAGS) -f batch-byte-compile $<
+        @echo
+        @echo Compiling $< .....
+        @if test -f $@ ; then rm $@ ; fi
+        @$(EMACS) $(EMACSFLAGS) -l escm.el -f batch-byte-compile $<
 
 .escm.escmc:
         $(EMACS) $(EMACSFLAGS) -l escm.el -f escm-batch-byte-compile $<
 
-prelude.escm: genprelude escm/init.escm
-        ./genprelude escm/init.escm >$@
 
-all: elc escmc
+#all: elc escmc
+all: elc
 
-elc:  $(ELS:.el=.elc)
+elc:  escm.elc
 
-escmc: prelude.escmc
+escmc: escm/prelude.escmc
+
+distname:
+        @echo  escm-` \
+                grep escm-version escm-base.el \
+                        | sed -e 's/[( )"]\|defconst\|escm-version//g' \
+                `
+install:  all
+        mkdir -p  $(INSTDIR)
+        cp $(ELS) $(INSTDIR)
+        cp $(ELS:.el=.elc) $(INSTDIR)
+        cp -r escm test $(INSTDIR)
+        chmod 777 $(INSTDIR)/test
 
 clean:
-        find . -type f -name \*.elc |xargs rm
-        find . -type f -name \*.escmc |xargs rm
-
-install: install.el all
-        mkdir -p $(SITELISP)/escm
-        cp -r escm test $(SITELISP)/escm/escm
-        cp $(ELS) $(ELS:.el=.elc) $(SITELISP)/escm
+        find . -type f -name \*.elc   |xargs rm -f
+        find . -type f -name \*.escmc |xargs rm -f
 
 uninstall:
-        rm -rf $(SITELISP)/escm
+        rm -rf $(INSTDIR)
 
 distclean: clean
-        rm -rf config.log config.status Makefile
+        rm -rf config.log config.status Makefile MANIFEST autom4te.cache 
+        rm -rf .configure.swp
+
+dist: MANIFEST
+        cat MANIFEST |xargs $(TAR) -cvzf `$(MAKE) distname`.tar.gz 
+
+MANIFEST:
+        echo $@ > $@
+        find .  | grep -v $@ \
+                | grep -v 'config\..*' \
+                | grep -v 'autom4te\.cache' \
+                | grep -v '\.elc$$' \
+                | grep -v '\.escmc' \
+                | grep -v '\.configure.swp' \
+                | grep -v '\.tar\.[bg]z$$' \
+                >> $@
+
+@DEPENDENCIES@

lang/elisp/escm/trunk/configure.in

@@ -1 @@
-AC_INIT(escm.el)
-AC_ARG_WITH([ emacs ] ,
+AC_INIT(escm,0.001,lieutar@1dk.jp)
+AC_PREREQ(2.6)
+
+
+############################################################
+AC_SUBST(EMACSFLAGS)
+EMACSFLAGS="-batch -no-site-file -q -L ."
+
+##
+AC_SUBST(ELS)
+ELS=`echo escm*.el`
+echo el files ... $ELS
+
+##
+AC_PATH_PROGS(TAR, gtar tar)
+
+##
+AC_SUBST(EMACS)
+AC_ARG_WITH(emacs,
             AS_HELP_STRING([--with-emacs@<:@=PATH@:>@],
                            [PATH=emacs, xemacs, mule...]),
-            [ EMACS=$withval ],
-            [ AC_PATH_PROGS(EMACS, emacs xemacs mule, emacs) ])
+            [ EMACS=$withval; ],[
+            AC_PATH_PROGS(EMACS, emacs xemacs mule, emacs)
+            ])
 
+echo emacs ... $EMACS
+econf="$EMACS $EMACSFLAGS -l emacs-config.el -f"
+
+##
+AC_SUBST(SITELISP)
+AC_ARG_WITH(site-lisp,
+            AC_HELP_STRING([--with-site-lisp=@<:@PATH@:>@]),
+            [SITELISP=$with_site_lisp;],[
+            SITELISP=`$econf 'site-lisp'`;])
+echo site-lisp ... $SITELISP
+
+##
+AC_SUBST(DEPENDENCIES)
+echo Check dependencies ...
+DEPENDENCIES=`$econf dependencies escm*.el`
+
+
+##
 AC_OUTPUT(Makefile)

lang/elisp/escm/trunk/emacs-config.el

@@ +1 @@
+;;; emacs-config.el --- 
+
+;; Copyright (C) 2008  root
+
+;; Author: root <lieutar@lieutar@1dk.jp>
+;; Keywords: 
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; 
+
+
+(defun args ()
+  "Returns commandline arguments that contains function name and following arguments."
+  (cdr (member "-f" command-line-args)))
+
+(defun echo ()
+  "Outputs command line arguments."
+  (print (cdr (args))))
+
+;; 
 (defun site-lisp ()
+  "Prints a path to a site-lisp directory."
   (let ((dir (car (apply 
                    'append
@@ -9 +46 @@
                            load-path)))))
     (princ dir)))
+
+
+;;
+(defun read-dependency (file files)
+  "Read all dependency of an emacs lisp FILE in a set of FILES.
+Targets of this survey is only require form."
+  (let ((buf (find-file file))
+        (R   ()))
+    (set-buffer buf)
+    (goto-char 1)
+    (while (re-search-forward "(require\\s +'\\([^) \t]+\\)" nil t)
+      (let ((match (intern (match-string 1))))
+        (when (member (format "%s.el" match) files)
+          (setq R (cons match R)))))
+    (kill-buffer buf)
+    R))
+
+(defun dependencies ()
+  "Print dependencies of files that was given as command line arguments.
+An output of this function is formatted as Makefile targets and its dependencies."
+  (let ((files (cdr (args))))
+      (princ (concat (mapconcat (lambda (f)
+                                  (format "%sc: %s %s"
+                                          f
+                                          f
+                                          (mapconcat (lambda (f)
+                                                       (format "%s.elc" f))
+                                                     (read-dependency f
+                                                                      files)
+                                                     " ")))
+                                files
+                                "\n")
+                     "\n"))))
+

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

@@ -39 +39 @@
 
 (defsubst escm-arity::new (argspec)
-  ""
+  "Creates and returns a new escm-arity object by argspec."
   (let ((new (create-escm-arity))
         (fields   ())
@@ -60 +60 @@
 
 (defsubst escm-arity::inject-args! (self env args)
+  "Inject values of the ARGS into the given ENV by the SELF spec."
   (let ((p        (escm-arity::get-length   self))
         (at-least (escm-arity::get-at-least self)))

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

@@ +1 @@
+;;; escm-base.el --- 
+
+;; Copyright (C) 2008  root
+
+;; Author: root <root@localhost.localdomain>
+;; Keywords: 
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+
 (require 'escm-util)
 (require 'escm-cbos)
@@ -14 +43 @@
   (escm-object::to-string self))
 
-
 ;; errors for escm
 (escm-util::define-signals
@@ -20 +48 @@
    (escm-syntax-error  "")
    (escm-void-variable "")
-   (escm-unsupported   "")))
-
-
-
+   (escm-unsupported   "")
+   (escm-syntax-pattern-expression-is-illegal "")))
 
 ;; variables
+(defconst escm-version          "0.01.01")
 (defconst escm-compiler-version 0.01)
-(defconst escm-icode::indent "" "")
+(defconst escm-icode::indent    "")
 
 ;; utilities that only in this project.
@@ -44 +71 @@
 
 (provide 'escm-base)
+;;; escm-base.el ends here

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

@@ -3 +3 @@
 ;; Copyright (C) 2008  Free Software Foundation, Inc.
 
-;; Author: ;;; <onishi@THOTH>
+;; Author: ;;; <lieutar@1dk.jp>
 ;; Keywords: oop
 
@@ -35 +35 @@
    (escm-cbos::error::no-such-method "No such method")))
 
-(defconst escm-cbos::default-method nil)
-(defconst escm-cbos::class-vmt      nil)
-(defconst escm-cbos::class-fields   nil)
+(defgroup escm-cbos () ""
+  :group 'programming
+  )
+
+(defconst escm-cbos::default-method nil
+  "The symbol for the plist that is used as dictionary for methods.")
+
+(defconst escm-cbos::class-vmt      nil
+  "The symbol for the plist that is used as virtual method table.")
+
+(defconst escm-cbos::class-fields   nil
+  "The symbol for the plist that is used as dictionary of specification of fields of classes.")
 
 (defsubst escm-cbos::classp (sym)
-  "returns true if sym is escm::cbos class."
+  "Returns true if sym is escm::cbos class."
   (and (symbolp sym)
        (plist-member (symbol-plist 'escm-cbos::class-fields) sym)
        t))
 
-(defsubst escm-cbos::get-class (obj)
-  ""
-  (and (arrayp obj)
-       (< 0 (length obj))
-       (let ((cls (aref obj 0)))
+(defsubst escm-cbos::get-class (object)
+  "Returns symbol of a class name from escm-cbos OBJECT."
+  (and (arrayp object)
+       (< 0 (length object))
+       (let ((cls (aref object 0)))
          (when (escm-cbos::classp cls)
            cls))))
@@ -56 +65 @@
 
 (defsubst escm-cbos::inheritance-list (class)
-  ""
+  "Returns list that contains classes.
+ The list contains ancestor of the given CLASS and itself.
+"
   (when (escm-cbos::classp class)
     (symbol-value (get 'escm-cbos::class-vmt class))))
 
 (defsubst escm-cbos::get-fields-of (class)
-  ""
+  "Returns symbols of the fields of the CLASS."
   (get 'escm-cbos::class-fields class))
 
@@ -86 +97 @@
 
 (defun escm-cbos::register-class  (name super fields)
+  ""
   (eval (cdr (escm-cbos::make-class-info name super fields))))
 
 (defmacro escm-cbos::define-method (class name args &rest body)
-  "defines method of escm-cbos objects."   
+  "Defines method of escm-cbos objects."   
   `(progn
      (when (not (fboundp ',name))
@@ -109 +121 @@
 
 
+
 (defmacro escm-cbos::delete-method (class name)
   ""
-  (put (get 'escm-cbos::class-vmt ',class) ',name nil))
+  `(put (get 'escm-cbos::class-vmt ',class) ',name nil))
 
 (defsubst escm-cbos::find-method1 (sym name)
+  ""
   (let ((meth  nil)
         (ilist (symbol-value sym)))
@@ -123 +137 @@
 
 (defun escm-cbos::find-method (class method-name)
+  ""
   (let ((ilist (escm-cbos::inheritance-list class)))
     (escm-cbos::find-method1 'ilist method-name)))
 
 (defsubst escm-cbos::run-method (name obj args)
+  ""
   (let* ((class (escm-cbos::get-class obj))
          (ilist (symbol-value (get 'escm-cbos::class-vmt class)))
@@ -139 +155 @@
 
 
-
 (defun escm-cbos::expand-method (args body)
+  ""
   `(lambda ,(cons '*ilist* (cons '*method-name*  args))
      ,@(escm-util::walk-node
         (lambda (x)
           (if (listp x)
-              (cond ((eq 'super (car x))
+            (cond ((eq 'super (car x))
                      `(apply
                        (or (escm-cbos::find-method '*ilist* *method-name*)
@@ -165 +181 @@
 
 (defun escm-cbos::make-accessor (spec p)
+  ""
   (let* ((spec      (if (listp spec) spec (list spec)))
          (f         (car spec))
@@ -193 +210 @@
 "
   (let* ((name      (car inhspec))
-         (super     (or (cadr inhspec) 'escm-cbos::Object))
+         (super     (or (cadr inhspec)
+                        'escm-cbos::Object))
+         (document  (or (caddr inhspec)
+                        "undocumented class."))
          (classinfo (escm-cbos::make-class-info name super fields))
          (fields    (car classinfo))
@@ -199 +219 @@
          (new       (intern (format "create-%s" name)))
          (pred      (intern (format "%s-p"      name))))
+
     `(progn
        ,(cdr classinfo)
+
+       (defvar ,name ',name ,document)
+
        (defsubst ,new ()
          (let ((new (make-vector ,(+ 1 len) nil)))
@@ -220 +244 @@
      (:foreground "black" :background "white"))