Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-02-06

日本語プログラミングとLISP

| 01:18 | 日本語プログラミングとLISP - わだばLisperになる を含むブックマーク はてなブックマーク - 日本語プログラミングとLISP - わだばLisperになる

今日は、お茶を飲みながら、「初心者に優しい」ということと、LISPについて考えていました。

FORTHなどのスタック言語の文法と日本語文法とは非常に相性が良いことは良く知られていると思うのですが、LISPもリスト構造をひっくりかえしてしまえば、スタック言語の構造に非常に近い見た目になるかと思います。

そんなこんなで初心者に優しい日本語LISPのことを考えていたら、どういう訳か谷川俊太郎の詩が頭に浮んで来たので、そのインスピレーションをそのままLISPのコードに叩きつけてみました。

当初は、もう少し野心的な作りだったのですが、割とすんなり動かず、デバッグしているうちに、なんだかどんどん悲しくなってきたので、簡単なところで切り上げました。

;; 動作

;; 関数定義など
(with-俊太郎
  (("とがつてる" "月へゆくロケツトそつくり" というリスト)というのは公には おちんちん)

  (((100 通りのあてずっぽう)90 より大きいですか?)というのが おにがめかくし)

  ((((とべ とべ)
     ((おちんちん というのはどんなもの?)を 書け)
     (おにがめかくし)してるまに)
    とべ とべとべ)
   というのが 男の子のマーチ))

;; 定義した関数の実行
(男の子のマーチ)
; =>
;("月へゆくロケツトそつくり" "とがつてる") 
;("月へゆくロケツトそつくり" "とがつてる") 
;("月へゆくロケツトそつくり" "とがつてる") 
;("月へゆくロケツトそつくり" "とがつてる") 
;("月へゆくロケツトそつくり" "とがつてる") 
;("月へゆくロケツトそつくり" "とがつてる") 

;; 定義
(defpackage :俊太郎 (:use :cl))

(in-package :俊太郎)

(defun super-reverse1 (lst acc)
  (cond ((atom lst) acc)
	((atom (car lst)) 
	 (super-reverse1 (cdr lst) (cons (car lst) acc)))
	('T (super-reverse1 (cdr lst) (cons (super-reverse1 (car lst) () ) acc)))))

(defun super-reverse (lst) (super-reverse1 lst () ))

(defun super-remove (item lst)
  (remove item
	  (mapcar (lambda (x)
		    (if (consp x) (super-remove item x) x))
		  lst)))

(setf (symbol-function '通りのあてずっぽう) #'cl:random
      (symbol-function '書け) #'cl:print
      (symbol-function 'より大きいですか?) #'cl:>
      (symbol-function 'というリスト) #'cl:list
      (symbol-function 'してるまに) (macro-function 'cl:when)
      (symbol-function 'というのが) (macro-function 'cl:defun)
      (symbol-function 'というのはどんなもの?) (symbol-function 'cl:values)
      (symbol-function 'とべ) (symbol-function 'cl:go))

(defmacro というのは公には (var val) `(defparameter ,var ,val))
(defmacro とべとべ (&body body) `(prog () ,@body))

(defmacro with-俊太郎 (&body body)
  `(progn
     ,@(mapcar (lambda (x) (s->cl (super-reverse x)))
	       body)))

(defun s->cl (expr)
  (let ((expr (remove-てにをは expr)))
    (cond 
      ;; defun
      ((eq 'というのが (cadr expr))
       `(,(cadr expr) ,(car expr) nil ,@(cddr expr)))
      ;; defparameter
      ((eq 'というのは公には (cadr expr))
       `(,(cadr expr) ,(car expr) ,@(cddr expr)))
      ('T expr))))

(defun remove-てにをは (expr)
  (reduce (lambda (res x) (super-remove x res))
	  '(て に を は で)
	  :initial-value expr))
;