Changeset 12594 for lang/elisp

Show
Ignore:
Timestamp:
05/28/08 16:31:52 (6 months ago)
Author:
lieutar
Message:

I oganized some files

Location:
lang/elisp/escm/trunk
Files:
9 added
13 modified
1 moved

Legend:

Unmodified
Added
Removed

  • lang/elisp/escm/trunk/DEVELOPERSTOOLS.el

    r10671 r12594  
    1313                    (setq escm-default-vm nil) 
    1414                    (message "default vm is resetted."))) 
    15   (global-set-key [?\C-c ?e ?e] 'escm-eval-last-sexp) 
    16   nil) 
     15  (global-set-key [?\C-c ?e ?e] 'escm-eval-last-sexp)) 
    1716 
    1817 
    … …  
    2322;; sample codes 
    2423(when nil 
     24 
    2525  (escm-vm::eval (escm-vm::new)  '(+ 0 1 (* 2 3) 4)) 
    26  
    2726  (escm-vm::eval (escm-vm::new)  '(if nil 1 2)) 
    28  
    2927  (escm-vm::eval (escm-vm::new) 
    3028                 '((lambda () 
    3129                     (define (fact n) (if (= n 1) n (* n (fact (- n 1))))) 
    32                      (fact 10)))) 
    33  
    34   (progn  
    35  
    36     (defun fib (n) 
    37       (if (< n 2) 
    38           1 
    39         (+ (fib (- n 2)) 
    40            (fib (- n 1))))) 
    41  
    42     (escm-eval '(fib 10)) 
    43  
    44     ) 
     30                     (fact 1 
    4531 
    4632  (escm-vm::eval 
    … …  
    6046 
    6147(insert (format "%S" 
    62                 (escm-vm::byte-compile-sexp-list 
     48                (escm-vm::byte-compile 
    6349                 (escm-vm::new) 
    6450                 '((define (fib n) 
    … …  
    6652                       (if (= n 0) (+ a b) (iter b (+ a b) (- n 1)))) 
    6753                     (iter 0 1 n)) 
    68                    (fib 10))) 
    69 )) 
     54                   (fib 10))))) 
    7055 
    7156(when nil 
    … …  
    8570   '((lambda () 
    8671       (define (fib-iter a b n) 
    87          (if (zero? n) 
     72         (if (= 0 n) 
    8873             (+ a b) 
    8974           (fib-iter b 
    … …  
    9580 
    9681  (let* ((def '((define (fib-iter a b n) 
    97                   (if (zero? n) 
     82                  (if (= 0 n) 
    9883                      (+ a b) 
    9984                    (fib-iter b 
    … …  
    11398  (escm-vm::eval (escm-vm::new) '`a) 
    11499 
     100 
    115101  (escm-vm::eval 
    116102   (escm-vm::new) '((lambda () 
    … …  
    118104                      (a b c)))) 
    119105 
     106 
    120107  (define (fact n) (if (= n 1) 
    121108                       n 
    122109                     (* n (fact (- n 1))))) 
    123   (escm-eval '(fact 20)) 
    124   (fact 1) 
    125  
    126   ((elambda (a b) (+ a b)) 1 2) ) 
    127 ) 
     110  (fact 20) 
     111  ) 

  • lang/elisp/escm/trunk/Makefile.in

    r10671 r12594  
    4040        $(EMACS) $(EMACSFLAGS) -l escm.el -f escm-batch-byte-compile $< 
    4141 
     42prelude.escm: genprelude escm/init.escm 
     43        ./genprelude escm/init.escm >$@ 
    4244 
     45all: elc escmc 
    4346 
    44 elc: 
    45         cd src/elisp; \ 
    46         make -f ../../Makefile.in elcs EMACS=$(EMACS) 
     47elc:  $(ELS:.el=.elc) 
    4748 
    48 elcs:  $(ELS:.el=.elc) 
    49  
     49escmc: prelude.escmc 
    5050 
    5151clean: 
    5252        find . -type f -name \*.elc |xargs rm 
     53        find . -type f -name \*.escmc |xargs rm 
    5354 
    54 install: install.el elc 
    55         cp  
     55install: install.el all 
     56        mkdir -p $(SITELISP)/escm 
     57        cp -r escm test $(SITELISP)/escm/escm 
     58        cp $(ELS) $(ELS:.el=.elc) $(SITELISP)/escm 
     59 
     60uninstall: 
     61        rm -rf $(SITELISP)/escm 
    5662 
    5763distclean: clean 

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

    r10671 r12594  
    3737     ((test) "test") 
    3838     ((escm) "escm") 
     39     ((tmp)  (or (getenv "TMP") 
     40                 (getenv "TEMP") 
     41                 "/tmp")) 
    3942     (t (signal 'error (list "unknown project-directory type" purpose)))) 
    40    (expand-file-name 
    41     "../" 
    42     (file-name-directory (locate-library "escm"))))) 
     43   (file-name-directory (locate-library "escm")))) 
    4344 
    4445(provide 'escm-base) 

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

    r10671 r12594  
    7575             (put 'escm-cbos::class-fields ',name ',fields) 
    7676             (put 'escm-cbos::class-vmt 
    77                   ',name (let ((*tbl* (make-symbol (format "*spec:%s*" ',name)))) 
     77                  ',name (let ((*tbl* (make-symbol 
     78                                       (format "*spec:%s*" ',name)))) 
    7879                           (set *tbl* 
    7980                                (cons ',name 

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

    r10671 r12594  
    2828 
    2929(require 'escm-base   ) 
    30 (require 'escm-syntax ) 
     30(require 'escm-macro ) 
    3131(require 'escm-icode  ) 
    32  
    3332(require 'escm-env    ) 
    3433(require 'escm-arity  ) 
    … …  
    5958                (escm-context::build-vm-manupilator context)))) 
    6059 
    61  
     60(defun escm-get-all-identifiers (sexp) 
     61  (let ((stack  (list sexp)) 
     62        (result (make-symbol "result"))) 
     63    (while stack 
     64      (let ((sexp (car stack))) 
     65        (setq stack (cdr stack)) 
     66        (cond ((null    sexp)) 
     67              ((symbolp sexp) 
     68               (put result sexp t)) 
     69              ((or (listp   sexp) 
     70                   (vectorp sexp)) 
     71               (mapcar (lambda (s) (setq stack (cons s stack))) 
     72                       sexp))))) 
     73    (mapcar 'car (escm-util::plist-to-alist (symbol-plist result))))) 
    6274 
    6375(defsubst escm-compile::sympp (sym) 
    … …  
    6678    ((",")  'unquote) 
    6779    ((",@") 'unquote-splicing) 
    68     (t sym))) 
     80    (t      sym))) 
    6981 
    7082(defun escm-compile (context sexp) 
    … …  
    7587    (let* ((head  (car sexp)) 
    7688           (env   (escm-context::get-env context)) 
    77            (headv (when (symbolp head) 
    78                     (condition-case *err* 
    79                         (escm-env::gref env (escm-compile::sympp head)) 
    80                       (escm-void-variable))))) 
    81       (cond 
    82        ((escm-syntax-p headv) 
    83         (escm-syntax::apply headv context sexp)) 
    84        (t (escm-compile-apply context sexp))))) 
     89           (headv (condition-case *err* 
     90                      (cond ((symbolp head) 
     91                             (escm-env::gref env (escm-compile::sympp head))) 
     92                            ((escm-identifier-p head) 
     93                             (escm-identifier::value head))) 
     94                    (escm-void-variable)))) 
     95 
     96      (cond ((escm-macro-p headv) 
     97             (escm-macro::apply headv context sexp)) 
     98            (t (escm-compile-apply context sexp))))) 
    8599 
    86100   ;; refering symbol-value 
    87    ((and sexp 
    88          (symbolp sexp)) 
     101   ((and sexp (symbolp sexp)) 
    89102    (escm-icode (list (list (if (escm-context::get-func? context) 'fref 'ref) 
    90                             sexp 
    91                             (escm-context::get-env context))))) 
     103                            sexp (escm-context::get-env context))))) 
     104 
     105   ((escm-identifier-p sexp) 
     106    (escm-icode (list (list (if (escm-context::get-func? context) 'fref 'ref) 
     107                            (escm-identifier::get-symbol sexp) 
     108                            (escm-identifier::get-env    sexp))))) 
    92109 
    93110   ;; sexp 
    … …  
    125142                            (escm-context::set-func? context t)  head)) 
    126143    (escm-iproc::merge ret 
    127                        (escm-icode (list (list (if (escm-context::get-tail? context) 
    128                                                    'tcall 
    129                                                  'call))))))) 
     144                       (escm-icode 
     145                        (list 
     146                         (list (if (escm-context::get-tail? context) 
     147                                   'tcall 
     148                                 'call))))))) 
    130149;;; test code 
    131150(escm-test::define-test escm escm-compile-apply 
    … …  
    176195  "" 
    177196  (escm-iproc::merge negativex 
    178                      (escm-icode (list (list 'jmp (escm-iproc::length positivex))))) 
     197                     (escm-icode (list (list 'jmp 
     198                                             (escm-iproc::length 
     199                                              positivex))))) 
    179200  (escm-iproc::merge condx 
    180                      (escm-icode (list (list 'jt  (escm-iproc::length negativex))))) 
     201                     (escm-icode (list (list 'jt 
     202                                             (escm-iproc::length 
     203                                              negativex))))) 
    181204  (escm-iproc::merge condx negativex) 
    182205  (escm-iproc::merge condx positivex)) 
    … …  
    184207(defsubst escm-compile-if (context sexp) 
    185208  "" 
    186  (let ((condx     (escm-compile (escm-context::set-tail? context nil) (cadr   sexp))) 
     209 (let ((condx     (escm-compile (escm-context::set-tail? 
     210                                 context nil) (cadr   sexp))) 
    187211       (positivex (escm-compile context (caddr  sexp))) 
    188212       (negativex (escm-compile context (cadddr sexp)))) 
    … …  
    242266         (val   (caddr sexp)) 
    243267         (iproc (escm-compile (escm-context::set-tail? context nil) val))) 
    244     (escm-iproc::merge iproc 
    245                        (escm-icode (list (list 'set! sym (escm-context::get-env context))))))) 
    246  
    247  
    248 (defun escm-compile-let (context sexp) 
    249   (let* ((bindings (cadr sexp)) 
    250          (body     (cddr sexp)) 
    251          (name     (unless (listp bindings) 
    252                      (let ((name bindings)) 
    253                        (setq bindings (car body)) 
    254                        (setq body     (cdr body)) 
    255                        name))) 
    256          (syms    ()) 
    257          (vals    ())) 
    258     (mapcar 
    259      (lambda (b) 
    260        (setq syms (cons (car  b) syms)) 
    261        (setq vals (cons (escm-compile 
    262                          (escm-context::set-tail? context nil) 
    263                          (cadr b)) vals)) bindings) 
    264      bindings) 
    265     (when name (setq syms (cons name syms))) 
    266     (let ((proc (escm-compile context (list 'lambda syms body))) 
    267           (ret  (escm-iproc::new ()))) 
    268       
    269       (mapcar 
    270        (lambda (v) (escm-iproc::merge ret v)) 
    271        (if name (cons (escm-iproc (list (list 'store-to-arg proc))) vals) 
    272          vals)) 
    273       ret))) 
    274 ;; 
     268    (escm-iproc::merge 
     269     iproc 
     270     (escm-icode (list (list 'set! sym (escm-context::get-env context))))))) 
    275271 
    276272;; 
    277273(defun escm-compile-define-syntax (context sexp) 
    278   (let ((name (cadr  sexp)) 
    279         (proc (escm-vm::eval 
    280                (escm-context::get-vm context) 
    281                (caddr sexp)))) 
     274  (let* ((vm (escm-context::get-vm context)) 
     275         (name (cadr  sexp)) 
     276         (proc (progn 
     277                 (escm-env::gset! (escm-context::get-env context) 
     278                                  '*syntax-context* 
     279                                  context) 
     280                 (escm-vm::eval 
     281                  vm 
     282                  (caddr sexp))))) 
    282283    (escm-env::define (escm-context::get-env context) 
    283284                      name 
    284                       (escm-syntax::new proc)) 
     285                      (escm-smacro::new proc)) 
    285286    (escm-icode (list (list 'store (list 'quote name)))))) 
    286287 
    287288(escm-test::define-test escm define-syntax 
     289 
    288290  (let* ((vm  (escm-vm::new)) 
    289291         (env (escm-vm::current-env vm)) 
    290292         (ctx (escm-context::new env vm))) 
    291   (escm-test compile0 (escm-compile-define-syntax 
    292                        ctx 
    293                        '(define-syntax x (lambda (_ . body) 
    294                                            1))) 
    295              t) 
    296   (escm-test compile1 (escm-syntax-p (escm-env::gref env 'x))) 
    297   (escm-test expand   (escm-iproc::equal 
    298                        (escm-icode '((store 1))) 
    299                        (escm-test::p "result" (escm-compile ctx '(x))))) 
    300   )) 
     293 
     294    (escm-test compile0 (escm-compile-define-syntax 
     295                         ctx 
     296                         '(define-syntax x (lambda (_ . body) 
     297                                             1))) t) 
     298 
     299    (escm-test compile1 (escm-macro-p (escm-env::gref env 'x))) 
     300 
     301    (escm-test expand   (escm-iproc::equal 
     302                         (escm-icode '((store 1))) 
     303                         (escm-test::p 
     304                          "result" 
     305                          (escm-compile ctx '(x))))))) 
     306 
    301307;; (escm-test::run 'escm 'define-syntax) 
    302  
    303308 
    304309 
    … …  
    315320               ctx 
    316321               (car b) 
    317                (escm-syntax::new (escm-compile context (cdr b))))) 
     322               (escm-macro::new (escm-compile context (cdr b))))) 
    318323            bind) 
    319324    (mapcar (lambda (x) (escm-iproc::merge ret (escm-compile ctx x)) 
    … …  
    366371     "compiled" 
    367372     (escm-iproc::to-string 
    368       (escm-icode (list (list 'store-proc (escm-compile-lambda1 context sexp)))))) 
     373      (escm-icode (list (list 'store-proc 
     374                              (escm-compile-lambda1 context sexp)))))) 
    369375    (funcall test (escm-compile-lambda1 context sexp)) 
    370376    (funcall test (escm-vm::eval vm sexp)))) 
    … …  
    433439  (escm-icode (list (list 'store (list 'quote (cadr sexp)))))) 
    434440 
     441;; ToDo: Make library form. 
     442;;: - compile-time - 
     443;;: 
     444;;:  1. load library file. 
     445;;:  2. import symbols from loaded library. 
     446;;:  3. process body of the library. 
     447;;:  4. fix library.  
     448;;;     - load 
     449;;;     -  
     450;;;     -  
     451;;;  5. define itself. 
     452;;: 
     453;;: - run time (precompiled) - 
     454;;: 
     455;;:  1. read itself from file. 
     456;;;  2. load library files. 
     457;;;  3. set procedures and macros to slots. 
     458;;: 
     459(defun escm-compile-library (context sexp) 
     460  (let ((name   (cdr    sexp)) 
     461        (import (caddr  sexp)) 
     462        (export (cadddr sexp)) 
     463        (body   (cddddr sexp))) 
     464  (escm-icode (list 
     465               () 
     466               ())))) 
     467 
     468 
    435469;; 
    436470(defsubst escm-compile::init-vm (vm) 
    437  
    438471  (mapcar 
    439472   (lambda (spec) 
    … …  
    442475   '((quote         escm-compile-quote) 
    443476     (if            escm-compile-if) 
    444      (let           escm-compile-let) 
    445477     (set!          escm-compile-set!) 
    446478     (let-syntax    escm-compile-let-syntax) 
    … …  
    449481     (lambda        escm-compile-lambda) 
    450482     (elambda       escm-compile-elambda) 
    451      (elmeth        escm-compile-elmeth))) 
    452  
    453    (escm-vm::eval 
    454     vm 
    455     '(define-syntax quasiquote 
    456          (lambda (_ . body) 
    457            (expand-quasiquote (list 'quote body)))))) 
    458  
     483     (elmeth        escm-compile-elmeth)))) 
    459484(add-hook 'escm-vm::init-hook (function escm-compile::init-vm)) 
    460485 

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

    r10671 r12594  
    3333                               | <<abstract>> | 
    3434                               +------+-------+ 
    35                                      /_\ 
     35                                     /_\\ 
    3636                                      | 
    3737                  +-------------------+---------------------+---------+ 
    … …  
    4040         | escm-fixed-env |<-+ escm-dynamic-env |  | escm-elisp-env | | 
    4141         +--------+-------+  +--------+---------+  +----------+-----+ | 
    42                  /_\                 /_\                      |       | 
     42                 /_\\                 /_\\                      |       | 
    4343                  |                   |                       |       | 
    4444          +-------+               +---+-----------------+     |       | 
    … …  
    5959  escm-library          ... Library that specified by R6RS. 
    6060  escm-dynamic-library  ... Compiling time library that specified by R6RS. 
     61 
    6162") 
    6263 
    … …  
    403404  (format "#<%s>" (escm-cbos::get-class self))) 
    404405 
     406 
     407 
     408 
     409;; 
     410(escm-cbos::define-class (escm-library escm-fixed-env) 
     411                         name 
     412                         version 
     413                         level 
     414                         export) 
     415(defsubst escm-dynamic-env::import-from-library (self) 
     416  (if ())) 
     417 
     418 
    405419(provide 'escm-env) 
    406420;;; escm-env.el ends here 

  • lang/elisp/escm/trunk/escm-macro.el

    r10671 r12594  
    1 ;;; escm-syntax.el ---  
     1;;; escm-macro.el ---  
    22 
    33;; Copyright (C) 2008  Free Software Foundation, Inc. 
    44 
    5 ;; Author: (require 'escm-base) <onishi@THOTH> 
     5;; Author: (require 'escm-base) <lieutar@1dk.jp> 
    66;; Keywords:  
    77 
    … …  
    3030(require 'escm-proc) 
    3131 
    32 (escm-cbos::define-class (escm-syntax escm-object) proc) 
    33 (escm-cbos::define-class (escm-builtin-syntax escm-syntax)) 
     32(escm-cbos::define-class 
     33 (escm-macro escm-object) proc) 
    3434 
    35 (defsubst escm-syntax::apply1 (self context sexp) 
    36   (let ((vm (escm-context::get-vm context))) 
     35(escm-cbos::define-class 
     36 (escm-builtin-macro escm-macro)) 
     37 
     38 
     39;; define-macro includes the context to a syntax-procedure. 
     40;; applying syntax receives the context at the applicated co. 
     41 
     42(defsubst escm-macro::apply1 (self context sexp) 
     43  (escm-env::gset (escm-context::get-env context) 
     44                  '*current-context* 
     45                  context) 
     46  (let ((vm  (escm-context::get-vm context))) 
    3747    (escm-compile 
    3848     context 
    39      (escm-vm::apply vm 
    40                      (escm-proc::activate (escm-syntax::get-proc self) vm) 
    41                      (list sexp))))) 
     49     (escm-vm::apply 
     50      vm 
     51      (escm-proc::activate (escm-macro::get-proc self) vm) 
     52      (list sexp))))) 
    4253 
    43 (escm-cbos::define-method escm-syntax escm-syntax::apply (self context sexp) 
    44  (escm-syntax::apply1 self context sexp)) 
     54(escm-cbos::define-method escm-macro escm-macro::apply (self context sexp) 
     55 (escm-macro::apply1 self context sexp)) 
    4556 
    4657(escm-cbos::define-method 
    47  escm-builtin-syntax escm-syntax::apply  (self context sexp) 
    48  (apply (escm-syntax::get-proc self) 
     58 escm-builtin-macro escm-macro::apply  (self context sexp) 
     59 (apply (escm-macro::get-proc self) 
    4960        (list context sexp))) 
    5061 
    51 (defsubst escm-syntax::new (proc) 
    52   (let ((self (create-escm-syntax))) 
    53     (escm-syntax::set-proc 
     62(defsubst escm-macro::new (proc) 
     63  (let ((self (create-escm-macro))) 
     64    (escm-macro::set-proc 
    5465     self 
    5566     proc) 
    5667    self)) 
    5768 
    58 (defsubst escm-builtin-syntax::new (proc) 
    59   (let ((self (create-escm-builtin-syntax))) 
    60     (escm-syntax::set-proc self proc) 
     69(defsubst escm-builtin-macro::new (proc) 
     70  (let ((self (create-escm-builtin-macro))) 
     71    (escm-macro::set-proc self proc) 
    6172    self)) 
    6273 
    63 (defun escm-define-builtin-syntax (vm name fun) 
    64   (escm-vm::define vm 
    65                    name 
    66                    (escm-builtin-syntax::new fun))) 
     74(defun escm-define-builtin-macro (vm name fun) 
     75  (escm-vm::define vm name (escm-builtin-macro::new fun))) 
    6776 
    68 (put 'escm-define-builtin-syntax 'lisp-indent-function 'defun) 
     77(put 'escm-define-builtin-macro 'lisp-indent-function 'defun) 
    6978 
    7079 
    7180;; 
     81(provide 'escm-macro) 
    7282 
    73  
    74 (provide 'escm-syntax) 
    75  
    76 ;;; escm-syntax.el ends here 
     83;;; escm-macro.el ends here 

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

    r10671 r12594  
    6262 
    6363 
    64  
    6564;;; 
    6665(escm-cbos::define-class (escm-wrapped-proc escm-proc)) 
    … …  
    117116  self)