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 |

2010-09-19

簡単なSWANKの拡張で適当補完

| 02:11 | 簡単なSWANKの拡張で適当補完 - わだばLisperになる を含むブックマーク はてなブックマーク - 簡単なSWANKの拡張で適当補完 - わだばLisperになる

slime-complete-formというコマンドがあるのですが、これは文脈に応じて実行すると、

;; ■ = カーソル
(EVAL-WHEN ■)
;->
(EVAL-WHEN (:compile-toplevel :load-toplevel :execute) body...)

と補完してくれるというものです。

そんなに活躍するところもないのですが、ぴったりはまる場所では便利です。(eval-whenとか、(declare (optimize))とか)

そんな slime-complete-form の実装を眺めてみたのですが、なにかを補完したい場合には流用できそうだったので、試しにお決まりのパターンを補完するようなものをでっち上げてみました(コードは文末)

かなり適当なコードですが、

(MAPCAR ■)
;->
(MAPCAR (LAMBDA ()))
(DEFPACKAGE ■)
;->
(DEFPACKAGE :FOO
  (:USE :CL))
(REDUCE #'+ FOO■)
;->
(REDUCE #'+ FOO :INITIAL-VALUE)
(SET-DISPATCH-MACRO-CHARACTER ■)
;->
(SET-DISPATCH-MACRO-CHARACTER #\# #\? (LAMBDA (STREAM SUBCHAR ARG) (DECLARE (IGNORE SUBCHAR ARG)) ))

位のことはできます。

補完した後にカーソルも適切な場所に移動したりできたら、それなりに便利にはなりそうではあります。

ちなみに、SWANKを眺めていたら、パターンマッチのユーティリティが取り込まれていたので使ってみました。

Stephen Adams氏作で、

http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/match/miranda/select.cl

のものと同一だと思われます。

以前、Chaton COMMON LISP JP部屋でshiroさんにCLを書く時に使っているライブラリを伺ったときに、パターンマッチがないとやってられないので、これを改造して利用していると伺った覚えがあります。

SWANKに付いてくるので、自分がCLを使っている時は常時読み込まれていますし、しばらく積極的に使ってみようかなと思っています。

コード

emacs側
(progn
  (defun slime-my-complete-form ()
    (interactive)
    ;; Find the (possibly incomplete) form around point.
    (let ((buffer-form (slime-parse-form-upto-point)))
      (let ((result (slime-eval `(swank:my-complete-form ',buffer-form))))
        (if (eq result :not-available)
            (error "Could not generate completion for the form `%s'" buffer-form)
          (progn
            (just-one-space (if (looking-back "\\s(" (1- (point)))
                                0
                              1))
            (save-excursion
              (insert result)
              (let ((slime-close-parens-limit 1))
                (slime-close-all-parens-in-sexp)))
            (save-excursion
              (backward-up-list 1)
              (indent-sexp)))))))

  (define-key slime-mode-map [(control ?c) (control shift ?s)]
     'slime-my-complete-form))
SWANK側
(IN-PACKAGE :SWANK)

(DEFSLIMEFUN MY-COMPLETE-FORM (RAW-FORM)
  (FLET ((STRING-UPCASE-SAFE (X)
           (IF (STRINGP X) (STRING-UPCASE X) X)))
    (MATCH (MAPCAR #'STRING-UPCASE-SAFE RAW-FORM)
      (("MAPCAR" . REST) "(LAMBDA ())")
      (("SET-MACRO-CHARACTER" . REST) 
       "#\\ (LAMBDA (STREAM CHAR) (DECLARE (IGNORE CHAR)))")
      
      (("SET-DISPATCH-MACRO-CHARACTER" . REST)
       "#\\ #\\ (LAMBDA (STREAM SUBCHAR ARG) (DECLARE (IGNORE SUBCHAR ARG)) )")

      (("EVAL-WHEN" (":COMPILE-TOPLEVEL" ":LOAD-TOPLEVEL" ":EXECUTE") . REST) 
       ":?")
      
      (("EVAL-WHEN" . REST) 
       "(:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)")

      (("LOOP" . REST) 
       ":FOR X :FROM 0 :TO 100 :COLLECT X")

      (("LET" ("" %CURSOR-MARKER%) . REST) 
       "(X X)")
      
      (("LET" . REST) 
       "()")

      (("DEFPACKAGE" . REST)
       ":FOO (:USE :CL)")

      (("REDUCE" #:_ #:_ %cursor-marker%)
       ":INITIAL-VALUE")

      (("REDUCE" #:_ #:_ "" %cursor-marker% . REST)
       ":INITIAL-VALUE")

      (OTHER :NOT-AVAILABLE))))