macroの勉強をかねてelisp上にmy言語？っぽいものを作ってみるテスト。

全部マクロで書いちゃえば

(eval-when-compile (require 'twenty))

みたいにしてバイトコンパイルしてランタイムにはロードしないように使えば名前空間汚さないと思うので自分の作品で気兼ねなくつかえるかなと思って。(間違ってるかもしれない)

例が適当ですがarcっぽく書けます

(keep (fn (s) (=~ "r" s t)) '("perl" "ruby" "python" "lisp" "java"))
;=> ("perl" "ruby")

名前は二十歳の記念にしたいからtwentyにしようかと思ってます。
prefixが必要なときは tw- を使う予定です。

実際に使ったりしてないので現段階ではネタに過ぎません。
以下、さっき書いたコードメモ

(eval-when-compile (require 'cl))
(provide 'twenty)

(defmacro with-gensyms (symbols &rest body)
  (declare (indent 1))
  `(let ,(mapcar (lambda (sym)
                   `(,sym (gensym)))
                 symbols)
     ,@body))

(defmacro def (name args &rest body)
  `(defun* ,name ,args ,@body))

(defmacro mac (name args &rest body)
  `(defmacro* ,name ,args ,@body))

(defmacro my (var val &rest body)
  (declare (indent 2))
  `(lexical-let ((,var ,val))
     ,@body))

(defmacro with (bindings &rest body)
  `(lexical-let (,(let (ret)
                    (do ((lst (subseq bindings 0 2) (setq bindings (subseq bindings 2))))
                        ((null (car lst)) ret)
                      (push (list (car lst) (cadr lst)) ret))))
     ,@body))

(defmacro with* (bindings &rest body)
  `(lexical-let* (,(let (ret)
                     (do ((lst (subseq bindings 0 2) (setq bindings (subseq bindings 2))))
                         ((null (car lst)) ret)
                       (push (list (car lst) (cadr lst)) ret))))
     ,@body))

(defmacro with-lexical-bindings (variables &rest body)
  `(lexical-let ,(loop for variable in variables
                       collect `(,variable ,variable))
     ,@body))

(defmacro fn (args &rest body)
  `(lambda ,args
     (with-lexical-bindings ,args
       ,@body)))


(define-modify-macro toggle-aux () not)
(defmacro toggle (&rest args)
  `(progn
     ,@(loop for arg in args
             collect `(toggle-aux ,arg))))

;;; ops
(defmacro no (expr)
  `(not ,expr))

(defmacro << (lst &rest args)
  `(setq ,lst (nconc ,lst ',args)))

(defmacro is (a b)
  `(equal ,a ,b))

(defmacro === (a b)
  `(eq ,a ,b))

(put 'when-bind 'lisp-indent-hook 1)
(defmacro when-bind ((var expr) &rest body)
  `(my ,var ,expr
     (when ,var
       ,@body)))

(put 'when-bind* 'lisp-indent-hook 1)
(defmacro when-bind* (binds &rest body)
  (if (null binds)
      `(progn ,@body)
    `(lexical-let (,(car binds))
       (when ,(caar binds)
         (when-bind* ,(cdr binds) ,@body)))))

(put 'aif 'lisp-indent-hook 1)
(defmacro aif (test-form then-form &optional else-form)
  `(my it ,test-form
     (if it
         ,then-form
       ,else-form)))

(put 'awhen 'lisp-indent-hook 1)
(defmacro awhen (test-form &rest body)
  `(aif ,test-form (progn ,@body)))

(put 'awhile 'lisp-indent-hook 1)
(defmacro awhile (expr &rest body)
  `(do ((it ,expr ,expr))
       ((no it))
     ,@body))

(put 'aand 'lisp-indent-hook 1)
(defmacro aand (&rest args)
  (cond ((null args) t)
        ((null (cdr args)) (car args))
        (t `(aif
             ,(car args)
             (aand ,@(cdr args))))))

(put 'acond 'lisp-indent-hook 1)
(defmacro acond (&rest clauses)
  (unless (null clauses)
    (with-gensyms (sym)
      (my clause (car clauses)
        `(my ,sym ,(car clause)
           (if ,sym
               (my it ,sym
                 ,@(cdr clause)) ;expr
             (acond ,@(cdr clauses))))))))

(defmacro until (test &rest body)
  `(while (no ,test) ,@body))


(defmacro join (los &optional separator)
  (with-gensyms (sep)
    `(my ,sep (or ,separator "")
       (mapconcat 'identity ,los ,sep))))

(defmacro trim (str)
  `(replace-regexp-in-string
   "[ \t\n]*$" ""
   (replace-regexp-in-string "^[ \t\n]*" "" ,str)))

(defmacro cc (&rest args)
  `(concat ,@args))

(defmacro =~ (tw-regexp tw-string &rest body)
  (declare (indent 2))
  (with-gensyms (str)
    `(my ,str ,tw-string
       (when (string-match ,tw-regexp ,str)
         (symbol-macrolet ,(loop for i to 9
                                 collect `(,(intern (cc "$" (number-to-string i)))
                                           (match-string-no-properties ,i ,str)))
           ,@body)))))

(defmacro remif (tw-predicate tw-seq)
  (with-gensyms (fn)
    `(my ,fn ,tw-predicate
       (loop for a in ,tw-seq
             unless (funcall ,fn a)
             collect a))))

(defmacro keep (tw-predicate tw-seq)
  (with-gensyms (fn)
    `(my ,fn (if (functionp ,tw-predicate)
                 ,tw-predicate
               (fn (tw-x) (is tw-x ,tw-predicate)))
       (loop for tw-a in ,tw-seq
             when (funcall ,fn tw-a)
             collect tw-a))))

(defmacro !remif (tw-predicate tw-seq)
  (with-gensyms (fn)
    `(my ,fn ,tw-predicate
       (loop for a in ,tw-seq
             when (funcall ,fn a)
             collect a))))

(defmacro map-match (regexp seq)
  `(loop for str in ,seq
         when (=~ ,regexp str t)
         collect str))

(defmacro uniq (seq)
  `(my copied-seq (copy-sequence ,seq)
     (delete-dups copied-seq)))

(defmacro uniq! (seq)
  `(delete-dups ,seq))