`(Hello ,world)

ツッコミ、添削大歓迎です。いろいろ教えてください。

2012-07-14

3impのヒープベース処理系に多値を追加する

3impの処理系には多値がない。いままでどうやればいいのか思いつかなかったのだけど、なんとなくできたので。

compileのペアの評価に、多値を返すスペシャルフォーム values を追加する:

(define compile
  ...
  (record-case x
   ...
   (values args
           (recur loop ((args args)
                        (c (if (tail? next)
                               ;; Tail case: directly go to next command.      
                               (list 'values next)
                             ;; Non-tail case: implicit return.                
                             (list 'values '(return)))))
                  (if (null? args)
                      (if (tail? next)
                          c
                        (list 'frame next c))
                    (loop (cdr args)
                          (compile (car args)
                                   e
                                   (list 'argument c))))))
   ...

valuesがきたら、関数呼び出しと同じく引数をargumentで積んでいって、最後に (values next) というバイトコードを追加する。あとは末尾だったらframeを作らないとかは関数呼び出しと同じ。例:

> (compile '(values 1 2 3) '())
(constant 3 (argument (constant 2 (argument (constant 1 (argument (values (return))))))))

VMでは、オペコードがvaluesだったら、引数としてつまれている最初の値(空の場合はundefined)を a に代入する。それによって一番目の値をそのまま演算に使える。

(define VM
  ...
    (record-case x                                                            
     (values (x)
             (let1 a (if (null? r)
                         (undefined)
                       (car r))
                   (VM a x e r s r)))
  ...

多値を受け取る receive スペシャルフォームもコンパイラに追加する。receiveは (receive (x y z) (values 1 2 3) body) という形式:

(define compile
  ...
  (record-case x
   ...
   (receive (vars vals body)
            (compile vals e
                     (list 'receive
                           (compile body (extend e vars) next))))
   ...

まず vals をコンパイルして、あとはlambdaと同じく環境をvarsで拡張してボディを評価。

VMに、それまでのステートに加えて、多値用の変数 rest-values を追加する

(define VM
  (lambda (a x e r s rest-values)

バイトコードの receive がきたら、関数呼び出しの apply と同じような感じで、rest-values を使って環境を拡張する:

(define VM
  ...
    (record-case x                                                            
     (receive (x)
              (VM a x (extend e rest-values) '() s rest-values))
  ...

あとはvaluesで返した値の数がreceiveで受け取る数より少なかったり、restパラメータの処理とかは適宜。

ヒープベースには簡単に追加できるけど、スタックベースにも同様に追加できるでしょう。

Javaで作ってるやつのパッチはこちら

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20120714

2010-12-07

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20101207

2010-09-14

xyzzyでArcのifのインデント

ArcのifはLisp/Schemeのcondの括弧が少ない版といった感じで

(if pred1
    exp1
  pred2
    exp2
  ...
    ...
  else-value)

という風に複数の条件を続けて書ける。このオートインデントをxyzzyで実現しようと思うと元々のlispmodeのインデント計算のままではうまくいかない。lispmodeのインデント計算はifなどのシンボルによって、引数の何個目までは*lisp-body-indent*の2倍、それ以降は*lisp-body-indent*、となってしまっていて融通が利かない。

そこで、シンボルに関数を設定できるようにする。lispmode.lのcalc-lisp-indent関数内でシンボルのlisp-indent-hookに設定された値の型が関数だったら、その関数を呼び出してインデントを決定するようにする:

(defun calc-lisp-indent (opoint)
  ...
                     (cond ((numberp method)
                            ...)

                           ;追加
                           ((functionp method)
                            (let ((count -1))
                              (while (< (point) opoint)  ; 何個目の引数かを数える
                                (skip-white-forward)
                                (setq count (+ count 1))
                                (or (forward-sexp 1 t)
                                    (return)))
                              (+ column -1
                                 (funcall method count))))

                           (method
                            ...

こうして、ifのlisp-indent-hookに関数を設定する:

(setf (get 'if 'lisp-indent-hook)
      #'(lambda (count)
          (if (zerop (mod count 2))
              *lisp-body-indent*
            (* *lisp-body-indent* 2))))

でOK。

注意点は、M-x byte-compile-file で lispmode.l をバイトコンパイルするだけじゃなく、いったんxyzzy.wxpを削除しないと反映されなくてハマった。

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100914

2010-08-23

アクトインディ技術部隊報告書

アクトインディ技師部隊報告書

濃いな〜センスがぶっとんでて面白すぎる。「隙があればlispを詰め込んで行きたい」誰得感がすごい。一番のお気に入りは真の豊かさとは何か「メッセージは依然適当にスルーされています」chibaさんのこういう軽快な文章が大好きです。

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100823

2010-08-12

BiwaSchemeにオートインデントを組み込む

仮に、オートインデントをBiwaSchemeのREPLに組み込んでみる:

no title

BiwaSchemeはprototype.jsを使ってて、オートインデントはjQueryを組み込んじゃったので、共存させるには prototype.jsと同時に使うには - jQuery 日本語リファレンス。できればjQueryを使わないようにしたい。

組み込みはまあ簡単に、jQuerylisp-mode.jsを組み込んで、set_lisp_mode() でテキストエリアのjQueryオブジェクトを渡せばキーイベントをのっとってくれる:

<script type="text/javascript" src="http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"></script>
<script type="text/javascript" src="lisp-mode.js"></script>
<script type="text/javascript"><!--
jQuery.noConflict();
jQuery(document).ready(function($){
	var target = $("#bs-input");
	set_lisp_mode($, target);
});
--></script>

あとはスクロールしない点とOperaだけ解決できれば、まあ使えそうな。

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100812

2010-08-11

Opera...

テキストエリアでオートインデントさせるのに、JavaScriptであれこれ書いてる。動作確認は、IEははなから切り捨ててChromeFireFoxで主に試してる。一応動いて、Operaでも試してみるかとやってみると、挙動が全然違う。

RETを押したときにonkeydownでfalseを返してもRETが挿入される
改行
  • テキストエリア内に "\n" を突っ込むとChromeFireFoxでは10の1文字なのに、Opera だと[13, 10] の2文字になる?カーソル位置を計算できない…
選択範囲のセット
  • カーソル位置を移動させるのにテキストエリアの選択範囲のセットを使うが、なぜかひとつ前の位置になってしまう。+1してやらないといけない。

いろいろ、クロスブラウザめんどい…

閉じ括弧で対応範囲をハイライト

Lispの場合オートインデントが必要というよりは、閉じ括弧を入力したときに対応する開き括弧の位置を示してくれないとまともに使えないと個人的には思う。xyzzyなどでは対応する開き括弧の位置に一定時間ポイントが移って、また戻るようになっている。同じような機能をテキストエリアに組み込んでみる。

テスト (jsソース

up_list_backward()だかgoto_matched_open()で開き括弧の位置を取れるようにしたので、その範囲をtextarea.setSelectRange()で選択してやる。setTimeout()で一定時間が経過したり、その間になにかキーが押されたら、その選択ははずす。

keydownなどのイベントで、jQueryを使ったほうがクロスブラウザで楽かな、と思って使ってみた。

  • たくさん入力してスクロールするときになってもしてくれない。textarea.setSelectRange()でカーソル位置を設定しても自動的にはスクロールされない。どうやってやったらいいんだろう?
  • 続きを読む

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100811

2010-08-10

テキストエリアでオートインデントさせてみる

テキストエディタでどうやってオートインデントしてるか知りたくてxyzzyのソースを見てみたところ、地道にやるしかないということだったので、力任せにJavaScriptで組んでみた:

テスト

ChromeFireFoxで確認。Operaだとカーソル位置がおかしくなるっぽい。一応なんとなく動いてるけど、こうなるとタブ押したときもなって欲しいし、閉じ括弧を入力したときに対応する開き括弧を示して欲しい。タブはFireFoxではフックできるぽい。閉じ括弧はChromeでは取れるぽい。

  • リスト、シンボル、数値などのみ。文字列やコメントにはまだ非対応。

続きを読む

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100810

2010-08-03

オートインデント2

前回xyzzyでオートインデントをどうやってるかを追おうと見てみたけど、主要な関数だと思われる up-list がビルトインでXyzzyLispで行われてなかったので、C++のソースを見てみる。

Lisp側のup-listと関連付けられているビルトインのC関数

どうやって関連付けられているのかわからなかった…

  DEFCMD3 (up-list, 0, 2, 0, "p"),
  • たぶんFup_list()
Fup_list()

syntax.cc:1884

lisp
Fup_list (lisp arg, lisp noerror)
{
  return up_down_list (arg, noerror, 0);
}
  • 単に up_down_list() 関数の呼び出し
up_down_list()

syntax.cc:1863

static lisp
up_down_list (lisp arg, lisp noerror, int downp)
{
  int n = (!arg || arg == Qnil) ? 1 : fixnum_value (arg);
  if (!n)
    return Qnil;

  Window *wp = selected_window ();
  wp->w_disp_flags |= Window::WDF_GOAL_COLUMN;
  Buffer *bp = wp->w_bufp;
  Point &point = wp->w_point;
  point_t opoint = point.p_point;
  int status = bp->up_down_list (point, n, downp);
  if (!status)
    return Qt;
  bp->goto_char (point, opoint);
  if (!noerror || noerror == Qnil)
    sexp_error (status);
  return Qnil;
}
  • 現在のバッファ、ポイントに対して Buffer::up_down_list() メソッドの呼び出し
Buffer::up_down_list()

syntax.cc:1791

int
Buffer::up_down_list (Point &point, int n, int downp) const
{
  const syntax_table *tab = xsyntax_table (lsyntax_table);
  int i = 0;
  int (Buffer::*skip_white)(Point &, int) const;
  int (Buffer::*skip_sexp)(Point &) const;
  int dir;

  if (n > 0)
    {
      dir = 1;
      skip_white = &Buffer::skip_white_forward;
      skip_sexp = &Buffer::skip_sexp_forward;
    }
  else
    {
      dir = -1;
      n = -n;
      skip_white = &Buffer::skip_white_backward;
      skip_sexp = &Buffer::skip_sexp_backward;
    }

  while (1)
    {
      if (dir < 0
          && ((!eobp (point) && bolp (point)
               && (syntax (tab, point) == SCopen
                   || syntax (tab, point) == SCtag_start))
              || !forward_char (point, -1)))
        return Send_sexp;

      int status;
      point_t before;
      do
        {
          before = point.p_point;
          status = (this->*skip_white)(point, 0);
        }
      while (status == Sin_comment && point.p_point != before);
      if (status && (dir > 0 || status != Sbob))
        return status;

      if (dir > 0 && !eobp (point)
          && (syntax (tab, point) == SCopen
              || syntax (tab, point) == SCtag_start))
        {
          if (downp)
            {
              forward_char (point, 1);
              if (++i == n)
                return 0;
            }
          else if (bolp (point))
            return Sunmatched_paren;
        }

      status = (this->*skip_sexp)(point);
      if (!downp && status == Send_sexp)
        {
          if (dir > 0)
            forward_char (point, 1);
          if (++i == n)
            return 0;
        }
      else if (status)
        return status;
      if (dir < 0 && bobp (point))
        return Sbob;
    }
}
  • 結果は引数の point に返る
  • 方向によって、skip_sexp でS式を飛ばす
  • ネストしたS式は skip_sexp 側で処理するだろうから、このメソッドでは指定個の開き括弧または閉じ括弧を数えるだけ
  • skip_sexp の戻り値は、リストの終端だったら Send_sexp が返る?
Buffer::skip_sexp_forward(), Buffer::skip_sexp_backward()

syntax.cc:1490

int
Buffer::skip_sexp_forward (Point &point) const
{
  const syntax_table *tab = xsyntax_table (lsyntax_table);
  int status;

  if (eobp (point))
    return Seob;

  while (1)
    {
      Char c = point.ch ();
      if (!SBCP (c))
        return skip_symbol_forward (point);

      switch (xchar_syntax (tab, c))
        {
        case SCclose:
        case SCtag_end:
          if (escaped_char_p (point))
            goto symbol;
          return Send_sexp;

        case SCopen:
        case SCtag_start:
        case SCmath:
          if (escaped_char_p (point))
            goto symbol;
          status = goto_matched_close (point, c);
          if (!status)
            forward_char (point, 1);
          return status;

        case SCstring:
          if (escaped_char_p (point))
            goto symbol;
          status = skip_string_forward (point, c);
          if (!status)
            forward_char (point, 1);
          return status;

        case SCword:
        case SCsymbol:
        case SCsymbol_prefix:
        case SCkanji:
        case SCkana:
        symbol:
          return skip_symbol_forward (point);

        case SCescape:
        case SCquote:
          break;

        default:
          return 0;
        }

      if (!forward_char (point, 1) || eobp (point))
        return Seob;
    }
}

int
Buffer::skip_sexp_backward (Point &point) const
{
  const syntax_table *tab = xsyntax_table (lsyntax_table);

  if (eobp (point) && !forward_char (point, -1))
    return Sbob;

  while (1)
    {
      Char c = point.ch ();
      if (!SBCP (c))
        return skip_symbol_backward (point);

      switch (xchar_syntax (tab, c))
        {
        case SCopen:
        case SCtag_start:
          if (escaped_char_p (point))
            goto symbol;
          return Send_sexp;

        case SCclose:
        case SCmath:
        case SCtag_end:
          if (escaped_char_p (point))
            goto symbol;
          return goto_matched_open (point, c);

        case SCstring:
          if (escaped_char_p (point))
            goto symbol;
          return skip_string_backward (point, c);

        case SCword:
        case SCsymbol:
        case SCsymbol_prefix:
        case SCkanji:
        case SCkana:
        symbol:
          return skip_symbol_backward (point);

        case SCescape:
        case SCquote:
          break;

        default:
          return 0;
        }

      if (!forward_char (point, -1))
        return Sbob;
    }
}
  • 文字によってスキップ
  • リストを前方に飛ばすところだけ見ようか。goto_matched_close()
Buffer::goto_matched_close()

syntax.cc:1155

int
Buffer::goto_matched_close (Point &point, Char openc) const
{
  const syntax_table *tab = xsyntax_table (lsyntax_table);
  int depth = 1, status;
  Char prev_ch = 0;
  while (1)
    {
      if (tab->comment_column >= 0 && !eobp (point))
        prev_ch = point.ch ();
      if (!forward_char (point, 1) || eobp (point))
        return Sunmatched_paren;
      if (tab->comment_column >= 0 && prev_ch == '\n'
          && column_comment_p (tab, point))
        {
          status = skip_single_char_comment_forward (point);
          if (status)
            return status;
          continue;
        }
      Char c = point.ch ();
      if (!SBCP (c))
        continue;

      if (xcomment_end_first_char_p (tab, c)
          && forward_comment_end_p (point))
        return Sin_comment;
      if (xcomment_start_first_char_p (tab, c)
          && forward_comment_start_p (point))
        {
          status = skip_multi_chars_comment_forward (point);
          if (status)
            return status;
          continue;
        }
      if (xcplusplus_comment_char_p (tab, c)
          && !xparse_sexp_ignore_comment_p (tab, c)
          && forward_cplusplus_comment_p (point))
        {
          status = skip_cplusplus_comment_forward (point);
          if (status)
            return status;
          continue;
        }

      switch (xchar_syntax (tab, c))
        {
        case SCclose:
        case SCtag_end:
          if (escaped_char_p (point))
            break;
          if (c == xchar_match (tab, openc))
            {
              if (!--depth)
                return 0;
            }
          else
            return Sunbalanced_paren;
          break;

        case SCopen:
        case SCtag_start:
          if (escaped_char_p (point))
            break;
          if (c == openc)
            depth++;
          else
            {
              status = goto_matched_close (point, c);
              if (status)
                return status;
            }
          break;

        case SCmath:
          if (escaped_char_p (point))
            break;
          if (c == openc)
            return 0;
          status = goto_matched_close (point, c);
          if (status)
            return status;
          break;

        case SCstring:
          if (escaped_char_p (point))
            break;
          status = skip_string_forward (point, c);
          if (status)
            return status;
          break;

        case SCcomment_start:
          if (escaped_char_p (point))
            break;
          if (xparse_sexp_ignore_comment_p (tab, c))
            break;
          status = skip_single_char_comment_forward (point);
          if (status)
            return status;
          break;

        default:
          break;
        }
    }
}
syntax()

syntax.cc:745

static inline syntax_code
syntax (const syntax_table *tab, const Point &point)
{
  return syntax (tab, point.ch ());
}
  • ポイントのキャラを取り出して、別名の syntax() 呼び出し

syntax.cc:737

static inline syntax_code
syntax (const syntax_table *tab, Char c)
{
  if (SBCP (c))
    return syntax_code (xchar_syntax (tab, c));
  return SCkanji;
}
  • 文字の種類を返す
  • syntax_code は単なる enum。この形式のキャストは関数呼び出しと紛らわしいね…
SBCP()
inline int SBCP (Char c) {return c < 256;}
  • 多バイト文字じゃないか?
syntax_code

syntax.h:43

enum syntax_code
{
  SCwhite,
  SCpunct,
  SCopen,
  SCclose,
  SCmath,
  SCstring,
  SCcomment_start,
  SCcomment_end,
  SCcplusplus_comment_end,
  SCescape,
  SCquote,
  SCsymbol,
  SCword,
  SCkana,
  SCkanji,
  SCjunk,
  SCtag_start,
  SCtag_end,
  SCsymbol_prefix,
  SCmax
};
xchar_syntax()
# define xchar_syntax(t, c) ((t)->type[(c)])
  • 単なるテーブルからの取り出し
Buffer::forward_char()

move.cc:37

int
Buffer::forward_char (Point &point, long nchars) const
{
  long d = min (max (point.p_point + nchars, b_contents.p1),
                b_contents.p2) - point.p_point;
  int f = d == nchars;
  const Chunk *cp = point.p_chunk;

  if (d > 0)
    {
      while (1)
        {
          int size = cp->c_used - point.p_offset;
          if (d <= size)
            {
              point.p_point += d;
              if (d == size && cp->c_next)
                {
                  cp = cp->c_next;
                  point.p_offset = 0;
                }
              else
                point.p_offset += d;
              point.p_chunk = (Chunk *)cp;
              break;
            }
          d -= size;
          point.p_point += size;
          point.p_offset = 0;
          cp = cp->c_next;
          assert (cp);
        }
    }
  else if (d < 0)
    {
      while (1)
        {
          if (point.p_offset + d >= 0)
            {
              point.p_offset += d;
              point.p_point += d;
              point.p_chunk = (Chunk *)cp;
              break;
            }
          d += point.p_offset + 1;
          point.p_point -= point.p_offset + 1;
          cp = cp->c_prev;
          assert (cp);
          point.p_offset = cp->c_used - 1;
        }
    }
  return f;
}
Buffer::goto_char()

move.cc:91

void
Buffer::goto_char (Point &point, point_t goal) const
{
  goal = min (max (goal, b_contents.p1), b_contents.p2);
  if (goal < point.p_point / 2)
    {
      point.p_point = 0;
      point.p_chunk = b_chunkb;
      point.p_offset = 0;
    }
  else if (goal > (point.p_point + b_nchars) / 2)
    {
      point.p_point = b_nchars;
      point.p_chunk = b_chunke;
      point.p_offset = b_chunke->c_used;
    }
  forward_char (point, goal - point.p_point);
}
結局
  • 地道にやるより他ない
  • xyzzyのCソースは、クラス別じゃなくて機能別に分かれてて面白いなと思った
トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100803

2010-07-28

オートインデントはどうやってるのか

テキストエディタでLispの自動インデントをどうやっているのか知りたい。あわよくばJavaScriptに持っていってブラウザのフォームに組み込んで、BiwaSchemeで使えるようにしたい。

xyzzyのソースを追ってみる。

リターンキーにバインドされた関数を調べる

M-x describe-bindings

...

TAB lisp-indent-line

RET lisp-newline-and-indent

lisp-newline-and-indent

lispmode.l:262

(defun lisp-newline-and-indent (&optional (arg 1))
  (interactive "*p")
  (delete-trailing-spaces)
  (insert #\LFD arg)
  (lisp-indent-line))
  • lisp-indent-lineがインデントする関数
lisp-indent-line

lispmode.l:229

(defun lisp-indent-line ()
  (interactive "*")
  (if (or (not (interactive-p))
          *lisp-tab-always-indent*
          (save-excursion
            (skip-chars-backward " \t")
            (bolp)))
        (smart-indentation (save-excursion
                             (goto-bol)
                             (if (protect-match-data
                                   (looking-at "[ \t]*;;;"))
                                 0
                               (max 0 (calc-lisp-indent (point))))))
    (insert "\t"))
  t)
  • TABのバインディングもこの関数
  • タブを押したときに、行の頭のほうだったらsmart-indentaion、そうじゃなかったらタブ挿入
  • インデントの位置は(calc-lisp-indent (point))で計算
  • goto-bol 行頭に移動します
    • bol = begining of line?
  • save-excursion 処理の前後でカレントバッファとポイントを保存します。
calc-lisp-indent

lispmode.l:159

(defun calc-lisp-indent (opoint)
  (protect-match-data
    (let ((begin-paren (and lisp-indent-close-paren
                            (looking-at "[ \t]*)"))))
      (goto-bol)
      (when (and (looking-at "\\s(")
                 (forward-char -1))
        (skip-white-backward)
        (forward-char 1))
      (or (up-list -1 t)
          (return-from calc-lisp-indent 0))
      (cond (begin-paren
             (+ (current-column) lisp-paren-imaginary-offset))
            ((or (looking-back "#")
                 (and (not (looking-back "#'"))
                      (looking-back "'")))
             (+ (current-column) 1))
            (t
             (let ((package (or (and (stringp *buffer-package*)
                                     (find-package *buffer-package*))
                                *package*)))
               (when (save-excursion
                       (when (and (up-list -1 t)
                                  (looking-for "((")
                                  (up-list -1 t))
                         (forward-char 1)
                         (multiple-value-bind (symbol found)
                             (calc-lisp-indent-current-symbol package)
                           (and found (get symbol 'lisp-indent-flet)))))
                 (return-from calc-lisp-indent (+ (current-column) *lisp-body-indention*)))
               (let ((column (progn
                               (forward-char 1)
                               (current-column))))
                 (multiple-value-bind (symbol found pkg-marker-p)
                     (calc-lisp-indent-current-symbol package)
                   (when pkg-marker-p
                     (return-from calc-lisp-indent column))
                   (let ((method (when found
                                   (or (let ((method (get symbol 'lisp-indent-handler)))
                                         (and method
                                              (save-excursion
                                                (and (up-list -1 t)
                                                     (forward-list -1 t)
                                                     (up-list -1 t)
                                                     (progn
                                                       (forward-char 1)
                                                       (multiple-value-bind (symbol found)
                                                           (calc-lisp-indent-current-symbol package)
                                                         (eq symbol 'handler-case)))))
                                              method))
                                       (get symbol 'lisp-indent-hook)))))
                     (cond ((numberp method)
                            (let ((count -1))
                              (while (< (point) opoint)
                                (skip-white-forward)
                                (setq count (+ count 1))
                                (or (forward-sexp 1 t)
                                    (return)))
                              (+ column -1 (if (< count method)
                                               (* *lisp-body-indent* 2)
                                             *lisp-body-indent*))))
                           (method
                            (+ column -1 *lisp-body-indention*))
                           (t (skip-chars-forward " \t")
                              (if (or (eolp) (looking-for ";"))
                                  (if *lisp-indent-offset*
                                      (+ column *lisp-indent-offset*)
                                    column)
                                (current-column)))))))))))))
  • うへ~!読めない!計算してるのはここなんだろうけど
  • looking-at: 現在のカーソル位置で前方向に正規表現でマッチしたらt、しなかったらnilを返します。
  • looking-for: 現在のカーソル位置から前方向にマッチしたらt、しなかったらnilを返します。
    • こっちは正規表現じゃなくて、現在の場所のテキストがマッチするかどうか
  • up-list: カーソルを ARG 個外側の括弧の後ろに移します。
    • こいつはbuiltin関数...
  • lisp-indent-hook シンボルにプロパティを設定することで lisp-indent-line でのインデント量を制御します。
    • 説明に書いてあることが、calc-lisp-indent関数の後半でやってること
    • シンボルに'lisp-indent-hookがsetされてると、それでhookされる
  • forward-sexp lisp-modeでS式を1つ進めます。[ESC C-f]
  • forward-list 前方のリストの終端へ移動します。[ESC C-n]
  • (defvar *lisp-body-indention* 2) ; lispmode.l:25
  • 最初の(up-list -1 t)でインデントしたい位置の1つ上に上がって、begin-parenじゃなくてコメント行じゃなかったら calc-lisp-indent-current-symbol で、そのポイントのシンボルを得る
    • シンボルに数値が設定されていたら(if=2, when=1, など)その数だけ(* *lisp-body-indent* 2)インデント
(if (predicate)  ; <- (get 'if 'lisp-indent-hook) = 2 なので
    ここ         ; 2個目の引数までは (* *lisp-body-indent* 2)
  ここ           ; それ以降は *lisp-body-indent*
    • 最初の引数が同じ行に書いてあったら、その位置
(hoge fuga  ; <- 最初の引数 fuga があるので
      ここ) ; <- そこと同じ位置
    • そうでなければ開始括弧の位置+*lisp-indent-offset*
(hoge  ; <- 最初の引数がないので
 ここ) ; <- 括弧の次の位置
calc-lisp-indent-current-symbol
(defun calc-lisp-indent-current-symbol (package)
  (skip-syntax-spec-forward " ")
  (if (looking-for ":")
      (values nil nil t)
    (multiple-value-bind (symbol found maybe-symbol)
        (lookup-symbol (point)
                       (progn
                         (skip-syntax-spec-forward "w_")
                         (point))
                       package)
      (values symbol (and found maybe-symbol)))))
  • キーワード(":" で始まってる)だったら (nil nil t)
  • skip-syntax-spec-forward: シンタックステーブルのカテゴリ基づいて文字を前方方向にスキップします。
    • "w_" ワードの区切りに移動・英字
  • lookup-symbol: ビルトイン関数
    • 1番目の引数のポイントから2番目の引数のポイントまでの文字を3番目のパッケージから探して、(シンボルか?、数値じゃないか?)の多値を返す?
store-match-data
(defmacro protect-match-data (&body body)
  `(let* ((#1=#:match-data (match-data (car *match-data-pool*)))
          (*match-data-pool* (cdr *match-data-pool*)))
     (unwind-protect
         (progn ,@body)
       (store-match-data #1#))))
  • match-data: scan-buffer で検索時点の状態を保持します。複数の検索をした後で、元の検索の結果で match-string / match-beginning / match-end / replace-match を行うことが可能です。
  • store-match-data: match-data で退避しておいた検索時点の状態を戻します。
結局
  • よくわからなかった。まあでもLispはS式なんで、ソースのオートインデントは他の言語のを行うより楽かもしれない。
  • Lispのソース読むの辛い
トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100728

2010-05-01

.NET FrameworkのClispサンプル

WindowsC#を少し使い出して、なかなか便利だなぁと思い始めていたところ。.NETって動作結構速くてどうなってるのかなぁと調べてると、MSIL(Microsoft Intermediate Language)というらしい。

.NET SDKには、マネージド・コードを出力するLispコンパイラが、しかもソースコード付きで収録されている。

うおおぉぉ!てなわけで.NET Framework SDKを入れてみる。

  • CLISPサンプルは1.1じゃないとついてない
  • C:\Program Files\Microsoft.NET\SDK\v1.1\Tool Developers Guide\Samples\clisp
  • ilasm.exe とかがみつからない
  • フィボナッチサンプル:
(defun Fib (N)
  (if (<= N 0)
      0
    (if (= N 1)
        1
      (+ (Fib (- N 1))
         (Fib (- N 2))))))

(defun Fibo (N)
  (do ((count 0
              (+ count 1))
       (Fibo (car (Fib 0))
             (cons Fibo (car (Fib count)))))
      ((> count N)
       Fibo)))

(Fibo 25)
  • わけわからん
    • (car (Fib 0)) とかしてる
    • (Fib 0) と (car (Fib 0)) のどちらも 0
  • フィボナッチサンプルのコンパイルされたコードを逆アセンブルした結果:
//  Microsoft (R) .NET Framework IL Disassembler.  Version 3.5.30729.1
//  Copyright (c) Microsoft Corporation. All rights reserved.



// Metadata version: v1.1.4322
.assembly extern mscorlib
{
  .publickeytoken = (B7 7A 5C 56 19 34 E0 89 )                         // .z\V.4..
  .ver 1:0:5000:0
}
.assembly extern Clisp
{
  .ver 0:0:0:0
}
.assembly fibo.exe
{
  .hash algorithm 0x00008004
  .ver 0:0:0:0
}
.module fibo.exe
// MVID: {B046BA20-D9BF-4DA6-90EF-EE12244D77E6}
.imagebase 0x00400000
.file alignment 0x00000200
.stackreserve 0x00100000
.subsystem 0x0003       // WINDOWS_CUI
.corflags 0x00000001    //  ILONLY
// Image base: 0x03210000


// =============== CLASS MEMBERS DECLARATION ===================

.class private auto ansi fibo
       extends [mscorlib]System.Object
{
  .method public static void  Main() cil managed
  {
    .entrypoint
    // コード サイズ       43 (0x2b)
    .maxstack  1
    IL_0000:  ldstr      "Fib"
    IL_0005:  call       void [mscorlib]System.Console::WriteLine(string)
    IL_000a:  ldstr      "Fibo"
    IL_000f:  call       void [mscorlib]System.Console::WriteLine(string)
    IL_0014:  ldc.i4.s   25
    IL_0016:  call       class [Clisp]CList fibo::Fibo(int32)
    IL_001b:  call       void [Clisp]LispRuntime::Print(class [Clisp]CList)
    IL_0020:  ldstr      ""
    IL_0025:  call       void [mscorlib]System.Console::WriteLine(string)
    IL_002a:  ret
  } // end of method fibo::Main

  .method public static int32  Fib(int32 A_0) cil managed
  {
    // コード サイズ       68 (0x44)
    .maxstack  9
    IL_0000:  ldarg.0
    IL_0001:  ldc.i4.0
    IL_0002:  ble        IL_000d

    IL_0007:  ldc.i4.0
    IL_0008:  br         IL_000e

    IL_000d:  ldc.i4.1
    IL_000e:  brfalse    IL_0019

    IL_0013:  ldc.i4.0
    IL_0014:  br         IL_0043

    IL_0019:  ldarg.0
    IL_001a:  ldc.i4.1
    IL_001b:  beq        IL_0026

    IL_0020:  ldc.i4.0
    IL_0021:  br         IL_0027

    IL_0026:  ldc.i4.1
    IL_0027:  brfalse    IL_0032

    IL_002c:  ldc.i4.1
    IL_002d:  br         IL_0043

    IL_0032:  ldarg.0
    IL_0033:  ldc.i4.1
    IL_0034:  sub
    IL_0035:  call       int32 fibo::Fib(int32)
    IL_003a:  ldarg.0
    IL_003b:  ldc.i4.2
    IL_003c:  sub
    IL_003d:  call       int32 fibo::Fib(int32)
    IL_0042:  add
    IL_0043:  ret
  } // end of method fibo::Fib

  .method public static class [Clisp]CList 
          Fibo(int32 A_0) cil managed
  {
    // コード サイズ       82 (0x52)
    .maxstack  4
    .locals init (int32 V_0,
             class [Clisp]CList V_1)
    IL_0000:  ldc.i4.0
    IL_0001:  stloc.0
    IL_0002:  ldc.i4.0
    IL_0003:  call       int32 fibo::Fib(int32)
    IL_0008:  call       class [Clisp]CList [Clisp]LispRuntime::ToList(int32)
    IL_000d:  call       class [Clisp]CList [Clisp]LispRuntime::Car(class [Clisp]CList)
    IL_0012:  stloc.1
    IL_0013:  br         IL_0033

    IL_0018:  ldloc.0
    IL_0019:  ldc.i4.1
    IL_001a:  add
    IL_001b:  stloc.0
    IL_001c:  ldloc.1
    IL_001d:  ldloc.0
    IL_001e:  call       int32 fibo::Fib(int32)
    IL_0023:  call       class [Clisp]CList [Clisp]LispRuntime::ToList(int32)
    IL_0028:  call       class [Clisp]CList [Clisp]LispRuntime::Car(class [Clisp]CList)
    IL_002d:  call       class [Clisp]CList [Clisp]LispRuntime::Cons(class [Clisp]CList,
                                                                     class [Clisp]CList)
    IL_0032:  stloc.1
    IL_0033:  ldloc.0
    IL_0034:  ldarg.0
    IL_0035:  bgt        IL_0040

    IL_003a:  ldc.i4.0
    IL_003b:  br         IL_0041

    IL_0040:  ldc.i4.1
    IL_0041:  brfalse    IL_004c

    IL_0046:  ldloc.1
    IL_0047:  br         IL_0051

    IL_004c:  br         IL_0018

    IL_0051:  ret
  } // end of method fibo::Fibo

  .method public specialname rtspecialname 
          instance void  .ctor() cil managed
  {
    // コード サイズ       7 (0x7)
    .maxstack  2
    IL_0000:  ldarg.0
    IL_0001:  call       instance void [mscorlib]System.Object::.ctor()
    IL_0006:  ret
  } // end of method fibo::.ctor

} // end of class fibo


// =============================================================

// *********** 逆アセンブルが完了しました ***********************
  • C#のソースを見る
    • ILGeneratorというのでコード生成をしている
    • Emit 実行時にコード生成してさらに実行できる!

これを使って Compilers: Backend to Frontend and Back to Front Againとか、セルフホスティングとか作ったら面白いんじゃないかと思うのでいまさらながらやってみたい。

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100501

2010-02-27

Optimistic Stack Allocation For Java-Like Languages

切り出してみる。 - hogeなlogで教えてもらったやつ。ググッたらacmじゃなくてCiteSeerXからpdfが落とせたので読んでみたい。

最近またLuaSquirrelみたいに簡単に組み込んで使えるLispスクリプト言語が欲しいなぁと思い出した。エラー表示をちゃんとしてBoehmじゃないやつ。自分だとどうしても完成しないんだよな…。

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100227

2010-02-19

竹内郁雄教授の最終講義のお知らせ

日時: 2010年3月3日(水)  (16:30 - 18:00)

会場: 東京大学本郷キャンパス (工学部2号館1階213講義室)

(東京都文京区本郷7-3-1)

講義題目 研究・開発は楽しく

竹内郁雄教授の最終講義のお知らせ - Cafe Babe

行きたいな…

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20100219

2009-11-15

State-Based Scripting in Uncharted 2: Among Thieves

via yakiimo02の日記: State-Based Scripting in Uncharted 2: Among Thieves

うぉぉぉ!Uncharted 2のゲームで使われてるスクリプトの話。

  • PLT Schemeがベース
    • defun とか出てくるけど?
  • シンボルじゃなく、文字列を使ってるぽい
  • FiniteStateMachine (Hierarchicalじゃない?)
    • stateごとにon イベント
    • go でステート切り替え
  • trackがスレッドで、イベント内で使える
  • VM
  • waitは継続

Naughty dogはJak & DaxterでのLisp風言語(Game Object Assembly Lisp)でLispに懲りて、Lispは捨てたのかと思ってたぜ。

中身は案外普通。

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20091115

2009-11-09

Shibuya.lisp テクニカルトーク#4に参加しました

Shibuya.lisp テクニカルトーク #4 に参加しました。

Lispは歴史が長いだけあって年配の方々の話、近山隆先生によるCommonLisp以前の話や、竹内郁雄先生によるLisp誕生までのマッカーシーの紆余曲折の話とかが聞けて、とても楽しかった。万能カレンダーの話とかUSO-800とか楽しそうに話すんでとてもよかった。

Lispノイマン型(プログラムとデータを区別しない)ってのは考えたことなかったなぁ。でノイマンはヒルベルトに師事してて、ゲーデルの不完全性定理に衝撃を受けたのが影響してるはず、てのがなるほど!と思った。また「LISP はラムダ算法の計算モデルを紙の上で表現するための記法として考案された」うんぬんは聞いたことがあったんだけど、ゲーデルと関係あるとは知らなかったなぁ。

LTで発表させていただきました。去年はあわあわして5分内に終わらなかったので、今回はそういうことがないようにと思って高橋メソッドにしてみた。上がって周りが見えなくなるところは変わらず、ただまあ高橋メソッドでガンガン進めていったら一応時間内に、1分も時間が余った。でもアドリブきかないんで、そのまま終了。

内容に関しては、ABAさんshinhさんに頼りっきり、お二人に感謝します。会場に来ていたshinhさんとお話が出来て幸せ。

もうちょっとハキハキと、抑揚をつけて話せるようになりたいなぁ。司会をされてるharupiyoさんやhigeponさんはさすが場慣れしてる、と思ってきいてみると、higeponさんでも緊張するし、練習よりペースが早くなってしまったと言っていた。全然そうは見えないな!

最後に、毎回会場を貸してくださっているECナビさんありがとうございます。ふつう会社は営利目的だけど、こういう形でも人々を支えてくれるのは素晴らしいですね。kinukawaさんは毎回宴会の幹事という大変な役を自らやっていてすごいと思う。koguroさんはすでに動画をニコニコ動画YouTubeに上げてくださっている。仕事速っ!

トラックバック - http://cadr.g.hatena.ne.jp/mokehehe/20091109