;; org-modeのバッファ中に call_XXX(...) という文字列があると
;; インラインのコードブロック実行命令として扱われるので、
;; 正規表現を置き換えることで call_XXXにマッチしないようにする。
;; http://orgmode.org/manual/Evaluating-code-blocks.html#Evaluating-code-blocks
(setq org-babel-inline-lob-one-liner-regexp "^^"
org-babel-lob-one-liner-regexp
(concat "\\(" org-babel-block-lob-one-liner-regexp "\\)"))
正しい無効化の方法がわからなかったので、むりやり修正しました。
(in-package :jvm)
(defun make-empty-class-file (class-name &optional (super-name "java.lang.Object"))
(make-class-file (make-jvm-class-name class-name)
(make-jvm-class-name super-name)
'(:public)))
(defun create-class-bytes (class-file)
(let ((stream (sys::%make-byte-array-output-stream)))
(write-class-file class-file stream)
(finish-output stream)
(sys::%get-output-stream-bytes stream)))
(defun write-class-bytes (fname bytes)
(with-open-file (f fname :direction :output :element-type '(unsigned-byte 8))
(let ((n (java:jarray-length bytes)))
(dotimes (i n)
(write-byte (mod (java:jarray-ref bytes i) 256) f)))))
(defun create-helloworld-class (class-name fname)
(let ((class-file (make-empty-class-file class-name)))
(let* ((string-array-class (class-array (make-jvm-class-name "java.lang.String")))
(method (make-jvm-method "main" :void `(,string-array-class) :flags '(:public :static))))
(class-add-method class-file method)
(with-code-to-method (class-file method)
(emit-getstatic "java.lang.System" "out" (make-jvm-class-name "java.io.PrintStream"))
(emit 'ldc (pool-string "Hello,World"))
(emit-invokevirtual "java.io.PrintStream"
"println"
`(,(make-jvm-class-name "java.lang.String"))
:void)
(emit 'return))
(finalize-class-file class-file)
(write-class-bytes fname (create-class-bytes class-file)))))
(create-helloworld-class "AbclHelloWorld" "AbclHelloWorld.class")
> java AbclHelloWorld Hello,World
多次元配列の各要素に対して関数を適用した結果を返すmap系関数を作成する場合、 make-arrayに:displaced-toキーワードを指定して作成したベクターに対してmap-intoを使うと簡潔に書けそうです。
(defun map-array! (fn array)
(let ((v (make-array (array-total-size array) :displaced-to array)))
(map-into v fn v))
array)
(asdf:load-system :alexandria)
(map-array! #'1+ (alexandria:copy-array #2A((1 2) (3 4))))
;; => #2A((2 3) (4 5))
以下、初めて知った多次元配列関連の関数
ABCLはJVM上で動作するCommon Lisp処理系なので、Javaのライブラリが利用できます。
(require :abcl-contrib)
(require :abcl-asdf)
(asdf:defsystem apache-poi
:components ((:mvn "org.apache.poi/poi/3.8")
(:mvn "org.apache.poi/poi-ooxml/3.8")))
(asdf:load-system 'apache-poi)
(defpackage :test-poi
(:use :cl :jss))
(in-package :test-poi)
(defun create-9x9 (path)
(let* ((wb (new 'xssfworkbook))
(sh (#"createSheet" wb)))
(dotimes (i 9)
(#"createRow" sh i))
(dotimes (i 9)
(dotimes (j 9)
(#"setCellValue" (#"createCell" (#"getRow" sh j) i)
(format nil "~A" (* (1+ i) (1+ j))))))
(#"write" wb (new 'fileoutputstream path))))
(create-9x9 "test.xlsx")
(defpackage asm (:use :cl :ccl) (:import-from :ccl defx86lapfunction)) (in-package :asm)まずは2つの整数を加算する関数を書いてみます。
;; add2という関数を定義します。 ;; 引数はaとbで、それぞれレジスタarg_yとarg_zを使って渡します。 ;; arg_yとarg_zはそれぞれRDIとRSIの別名です。 (defx86lapfunction add2 ((a arg_y) (b arg_z)) ;; 引数が2つかどうかチェックします。(lapmacro) (check-nargs 2) ;; RBPをスタックに積みます(スタックフレーム作成その1) (pushq (% rbp)) ;; RSPをRBPに設定(代入)します(スタックフレーム作成その2) (movq (% rsp) (% rbp)) ;; 引数同士を加算してbに保存します。 (addq (% a) (% b)) ;; スタックフレームを復元します(BPをSPにコピー,スタックからpopした値をBPにコピー) (leave) ;; b(arg_z)に保存した値を戻り値として関数を終了します。 (single-value-return)) ;; 実行します。 (add2 1 2) ;; => 3
(defx86lapfunction one? ((n arg_z)) (check-nargs 1) (pushq (% rbp)) (movq (% rsp) (% rbp)) (movq (% n) (% rax)) ;; 戻り値のデフォルト値として1(1である)を設定します。 (movq ($ '1) (% arg_z)) ;; RAXと測値1を比較します。 (cmpq ($ '1) (% rax)) ;; RAX==1の時, ENDラベルまでジャンプします。 (je END) ;; (RAX!=1の時) 戻り値に0(1でない)を設定します。 (movq ($ '0) (% arg_z)) ;; ENDラベル END (leave) (single-value-return)) ;; 実行 (one? 0) ;; => 0 (one? 1) ;; => 1 (one? 2) ;; => 0
(defx86lapfunction cpuid ((operation arg_z)) ;; 引数の数をチェック (check-nargs 1) ;; スタックフレーム作成 (pushq (% rbp)) (movq (% rsp) (% rbp)) ;; CPUIDで上書きされてしまうRBXを保存 (pushq (% rbx)) ;; CPUIDで取得する情報の種類をRAX(EAX)に保存 (unbox-fixnum operation rax) ;; CPUID命令実行 (cpuid) ;; 呼び出し結果をlispのfixnumに変換 (box-fixnum rbx rbx) ;; 多値で返すためにスタックに積む(2つ目) (pushq (% rbx)) ;; 退避していたRBXの値を復元 (movq (@ 8 (% rsp)) (% rbx)) (box-fixnum rax rax) ;; 多値で返すためにスタックに積む(1つ目) (movq (% rax) (@ 8 (% rsp))) (box-fixnum rcx rcx) ;; 多値で返すためにスタックに積む(3つ目) (pushq (% rcx)) (box-fixnum rdx rdx) ;; 多値で返すためにスタックに積む(4つ目) (pushq (% rdx)) ;; 戻り値の数を設定 (set-nargs 4) ;; 関数を終了して多値を返す (jmp-subprim .SPnvalret))
(defun u32->str (n)
(map 'string
(lambda (byte) (code-char (ldb byte n)))
(list (byte 8 0)
(byte 8 8)
(byte 8 16)
(byte 8 24))))
;; 実行
(multiple-value-bind (_ ebx ecx edx) (cpuid 0)
(format nil "~A~A~A"
(u32->str ebx)
(u32->str edx)
(u32->str ecx)))
;; => "GenuineIntel"
※ Lisp Advent Calendar 2日目でタグの話題がありましたが、CCLはポインタにタグが付いてるタイプのLispです。
なので、Lisp側から整数の1を渡したつもりでも機械語としてはタグの分(ここでは3bit)ずれた値になってしまいます。
box/unboxはこのずれを補正するための処理で、実際には掛け算やシフトが行われています。
Common Lispには、戻り値を作り出すために元々の構造を破壊する関数があります。
sort、stable-sort を除く破壊的な関数には対応する非破壊的な関数があるので、基本的には非破壊版を利用しておいたほうが良さそうです。
なお、破壊的関数の先頭に付く n は non-consing の略だそうです。
詳しくは 実践Common Lispの12章 あたりを見ると良いでしょう。
| 非破壊的 | 破壊的 | 概要 |
| sort | ソート | |
| stable-sort | 安定ソート | |
| reverse | nreverse | リストの反転 |
| append | nconc | リストの結合 |
| revappend | nreconc | リストの結合 |
| butlast | nbutlast | リストの末尾以外取得 |
| remove | delete | シーケンスの要素削除 |
| remove-if | delete-if | 条件に一致する要素削除 |
| remove-if-not | delete-if-not | 条件に一致しない要素削除 |
| remove-duplicates | delete-duplicates | 重複を削除 |
| union | nunion | 和集合 |
| intersection | nintersection | 積集合 |
| set-difference | nset-difference | 差集合 |
| set-exclusive-or | nset-exclusive-or | 対称差 |
| string-capitalize | nstring-capitalize | 単語の先頭を大文字、それ以外を小文字に変換 |
| string-downcase | nstring-downcase | 文字列を小文字に変換 |
| string-upcase | nstring-upcase | 文字列を大文字に変換 |
| subst | nsubst | 木構造(リスト)の要素を変更 |
| subst-if | nsubst-if | 木構造(リスト)の要素を変更 |
| subst-if-not | nsubst-if-not | 木構造(リスト)の要素を変更 |
| sublis | nsublis | 木構造(リスト)の要素を変更 |
| substitute | nsubstitute | シーケンスの要素を変更 |
| substitute-if | nsubstitute-if | シーケンスの要素を変更 |
| substitute-if-not | nsubstitute-if-not | シーケンスの要素を変更 |