最近読み終わった本.
- 第六大陸1、2
- 著者
- 小川一水
- 発行元
- ハヤカワ文庫(早川書房)
- 分類
- SF
- 感想
- SFの主役が土建屋さんとは。
- 職業としての政治
- 著者
- マックス・ヴェーバー(Max Weber)
- 訳者
- 脇圭平(わき けいへい)
- 発行元
- 岩波文庫(岩波書店)
- 分類
- 政治と倫理についての講演(1919年)
- 感想
- 岩波文庫だけオーラが違いますね。分量は少ないけど濃そうな内容。こういったのでむつかしい内容に慣れることができれば良いな。
最近読み終わった本.
最近読み終わった本.
「取り合えずビール」と言うばかりでは良くないと思わされる一冊。
他の人がやってることを自分がやる必要はない、というスタンスがかっこいい。それで成功してきてるところがさらにすごい。
.emacsを晒す(その2)
プログラミング関係の設定。
;;Compile C-c c
(define-key mode-specific-map "c" 'compile)
(define-key mode-specific-map "n" 'next-error)
(setq compilation-window-height 12)
;;gdb Emacsからはろくに使ってないけど。
(setq gdb-many-windows t)
(setq gdb-use-sepapate-io-buffer t)
(setq gdb-find-source-frame nil)
;;indent style for c
(add-hook 'c-mode-hook
'(lambda ()
(c-set-style "linux")
(setq c-basic-offset 2)
(setq tab-width c-basic-offset)))
;;indent style for c++
(add-hook 'c++-mode-hook
'(lambda ()
(c-set-style "linux")
(setq c-basic-offset 2)
(setq tab-width c-basic-offset)))
;; C# mode ほんの少しだけLinux(mono)で触ったので。
(add-hook 'csharp-mode-hook (lambda ()
(setq c-basic-offset 4
tab-width 4
indent-tabs-mode nil)))
(autoload 'csharp-mode "csharp-mode" "C# editing mode." t)
(nconc auto-mode-alist '(("\\.cs$" . csharp-mode)))
;;haskell-mode 一応GHCはインストールされてるけど使われてない。
(load "~/emacslib/haskell-mode-2.4/haskell-site-file")
(setq auto-mode-alist
(append auto-mode-alist
'(("\\.[hg]s$" . haskell-mode)
("\\.hi$" . haskell-mode)
("\\.l[hg]s$" . literate-haskell-mode))))
(autoload 'haskell-mode "haskell-mode"
"Major mode for editing Haskell scripts." t)
(autoload 'literate-haskell-mode "haskell-mode"
"Major mode for editing literate Haskell scripts." t)
(add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode)
(add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
;;(add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent)
(add-hook 'haskell-mode-hook 'font-lock-mode)
(add-hook 'haskell-mode-hook 'imenu-add-menubar-index)
;;(add-hook 'haskell-mode-hook 'turn-on-haskell-ghc)
(setq haskell-program-name "/usr/bin/ghci")
;;;;common lisp & slime
;;;;slimeは3.0アルファ(?)と書かれたリファレンスを見て設定した
(setq inferior-lisp-program "/usr/local/bin/sbcl")
(add-to-list 'load-path "/home/kurohuku/emacslib/slime/")
(add-to-list 'load-path "/home/kurohuku/emacslib/slime/contrib/")
(setq slime-backend (expand-file-name
"~/emacslib/slime/swank-loader.lisp"))
(setq slime-truncate-lines nil)
(setq slime-enable-evaluate-in-emacs t)
(setq inferior-lisp-mode-hook (lambda () (inferior-slime-mode t)))
(require 'slime)
(slime-setup '(inferior-slime slime-repl slime-c-p-c slime-xref-browser))
;; '(
;; inferior-slime
;; slime-asdf
;; slime-autodoc
;; slime-banner
;; slime-c-p-c
;; slime-editing-commands
;; slime-fancy-inspector
;; slime-fancy
;; slime-fuzzy
;; ; slime-highlight-edits
;; slime-parse
;; slime-presentation-streams
;; slime-presentations
;; slime-references
;; slime-scratch
;; slime-tramp
;; ; slime-typeout-frame
;; slime-xref-browser
;; ))
(setq slime-net-coding-system 'utf-8-unix)
(add-hook 'lisp-mode-hook (lambda ()
(slime-mode t)
(show-paren-mode t)
(global-set-key "\C-cH" 'hyperspec-lookup)))
;;slimeで日本語を使うための設定.Lisp側の対応も必要
(setq slime-net-coding-system 'utf-8-unix)
;;;;coreファイルから起動.起動時に自前の関数を定義するutil.lispを読み込む。
(setq slime-lisp-implementations
'((sbcl
("/usr/local/bin/sbcl"
"--core" "/home/kurohuku/emacslib/sbcl.core-with-swank")
:init (lambda (port-file _)
(format "(progn
(load \"/home/kurohuku/emacslib/util.lisp\")
(setf swank::*coding-system* \"utf-8-unix\")
(swank:start-server %S))\n" port-file))
:coding-system utf-8-unix)))
;;;slimeのインデントを変更
(add-hook 'slime-mode-hook
(lambda ()
(setq lisp-indent-function 'common-lisp-indent-function)))
;; Additional definitions by Pierpaolo Bernardi.
(defun cl-indent (sym indent)
(put sym 'common-lisp-indent-function
(if (symbolp indent)
(get indent 'common-lisp-indent-function)
indent)))
(cl-indent 'if '1)
(cl-indent 'generic-flet 'flet)
(cl-indent 'generic-labels 'labels)
(cl-indent 'with-accessors 'multiple-value-bind)
(cl-indent 'with-added-methods '((1 4 ((&whole 1))) (2 &body)))
(cl-indent 'with-condition-restarts '((1 4 ((&whole 1))) (2 &body)))
(cl-indent 'with-simple-restart '((1 4 ((&whole 1))) (2 &body)))
;;;HyperSpec
(require 'hyperspec)
(setq common-lisp-hyperspec-root
(concat "file://"
(expand-file-name "~/emacslib/HyperSpec/"))
common-lisp-hyperspec-symbol-table
(expand-file-name "~/emacslib/HyperSpec/Data/MapSym.txt"))
;; HyperSpecをw3mで見る
(defadvice common-lisp-hyperspec
(around hyperspec-lookup-w3m () activate)
(let* ((window-configuration (current-window-configuration))
(browse-url-browser-function
`(lambda (url new-window)
(w3m-browse-url url nil)
(let ((hs-map (copy-keymap w3m-mode-map)))
(define-key hs-map (kbd "q")
(lambda ()
(interactive)
(kill-buffer nil)
(set-window-configuration ,window-configuration)))
(use-local-map hs-map)))))
ad-do-it))
(add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode t)))
色々な場所で調べたもののコピペばかりなはずだが、参考にしたものがどこにあるのかまでは覚えていない。
ただ、CommonLispの設定あたりが消え去ったらやる気が著しく削がれるのは間違いないのでメモメモ。
Common Lispのwith-output-to-stringやwith-input-from-stringは便利なのだが、文字列ストリームは名前の通り文字しか読み書きできない。
バイナリの読み書きもファイルを開かずに、このように書いてみたい。
(with-binary-stream (s)
(write-byte 2 s)
(write-byte 3 s)
(values (read-byte s) (read-byte s)))
少し調べてみたら、Gray Streamというものを使って実装している人がいた。単純なものなら結構簡単に書けそうだ。
良い機会なので、名前だけは聞いたことのあったGray Streamとやらを利用したコードを書いてみた。
(defpackage virtual-binary-stream
(:use :cl :sb-gray)
(:nicknames :vbstream)
(:export virtual-binary-stream
make-virtual-binary-stream
with-virtual-binary-stream))
(in-package virtual-binary-stream)
;;;Queueの実装:carがlistの先頭cons,cdrが最終Consを指す
;;;ANSI Common Lispより
(defun make-queue ()
(cons nil nil))
(defun enqueue (obj q)
(if (null (car q))
(setf (cdr q)
(setf (car q) (list obj)))
(setf (cdr (cdr q)) (list obj)
(cdr q) (cdr (cdr q))))
(car q))
(defun dequeue (q)
(pop (car q)))
(defclass virtual-binary-stream (fundamental-stream)
((queue :initform (make-queue) :accessor queue-of)))
(defmethod stream-element-type ((stream virtual-binary-stream))
'virtual-binary)
(defmethod close ((stream virtual-binary-stream) &key abort)
(declare (ignore abort))
(setf (queue-of stream) nil))
(defmethod stream-read-byte ((stream virtual-binary-stream))
(dequeue (queue-of stream)))
(defmethod stream-read-char ((stream virtual-binary-stream))
(code-char (stream-read-byte stream)))
(defmethod stream-write-byte ((stream virtual-binary-stream) integer)
(enqueue integer (queue-of stream)))
(defmethod stream-write-char ((stream virtual-binary-stream) character)
(enqueue (char-code character) (queue-of stream)))
(defun make-virtual-binary-stream (&optional (initial-element-list nil))
(let ((stream (make-instance 'virtual-binary-stream)))
(dolist (i initial-element-list)
(stream-write-byte stream i))
stream))
(defmacro with-virtual-binary-stream
((stream &optional initial-element-list) &body body)
`(let ((,stream (make-virtual-binary-stream ,initial-element-list)))
,@body))
キューはANSI Common Lispに書いてあったものを使った。リストでキューを表現する方法が格好良い。
これでwrite-byte,read-byteを使えるようになった。ついでにread-char,write-charも書いた。
>(vbstream:with-virtual-binary-stream (s)
(write-byte 2 s)
(write-char #\A s)
(list (read-byte s) (read-byte s)))
(2 65)
C++でFDCとお話しする事に疲れたから、逃避するためにLispプログラミング。
実践CommonLispに、バイナリファイルのパースという章があったかと思うが、自分の脳みそで考えるのが大事だろうということで書いてみる。
読み込みのみ。
(defmethod read-binary ((type (eql :u8)) stream)
(read-byte stream))
(defmethod read-binary ((type (eql :u16)) stream)
(let ((n 0))
;;リトルエンディアン
(setf (ldb (byte 8 0) n) (read-byte stream))
(setf (ldb (byte 8 8) n) (read-byte stream))
n))
(defmethod read-binary ((type (eql :u32)) stream)
(let ((n 0))
;;リトルエンディアン
(setf (ldb (byte 8 0) n) (read-byte stream))
(setf (ldb (byte 8 8) n) (read-byte stream))
(setf (ldb (byte 8 16) n) (read-byte stream))
(setf (ldb (byte 8 24) n) (read-byte stream))
n))
(defmacro define-binary (name &body body)
(let ((obj (gensym)))
`(progn
(defclass ,name ()
,(mapcar
#'(lambda (clause)
`(,(first clause)
:accessor ,(first clause)))
body))
(defmethod read-binary ((type (eql ',name)) stream)
(let ((,obj (make-instance ',name)))
,@(mapcar
#'(lambda (clause)
`(setf (,(first clause) ,obj)
,(if (third clause)
`(loop :repeat ,(third clause)
:collect (read-binary ,(second clause) stream))
`(read-binary ,(second clause) stream))))
body)
,obj))
)))
;;;定義
(define-binary bpb ;Bios Parameter Block
(jmp :u8 2)
(nop :u8)
(oem-id :u8 8)
(bytes-per-sector :u16) ;一般に512byteか1024byte
(sectors-per-cluster :u8) ;1クラスタが何セクタか
(reserved-sectors :u16) ;bpbからみたFAT開始位置(相対セクタ)
(total-fats :u8) ;FATはいくつかるか。普通2つ。
(max-root-entries :u16) ;ルートディレクトリエントリがいくつあるか
(total-sectors :u16) ;全セクタ数
(media-descriptor :u8)
(sectors-per-fat :u16) ;1つのFATが何セクタか
(sectors-per-track :u16) ;1トラックは何セクタか
(num-heads :u16) ;ヘッドはいくつあるか
(hidden-sector :u32)
(total-sectors-large :u32))
(define-binary fat12-boot-record
(bpb-record 'bpb)
(drive-number :u8) ;0x00=Floppy 0x80=HardDisk
(flags :u8)
(signature :u8) ;0x29
(volume-id :u32)
(volume-label :u8 11)
(system-id :u8 8)
(boot-code :u8 448)
(bootable-partition-signature :u16))
試しに読み込んでみる。
>(with-open-file (s "/home/kurohuku/floppy.img"
:direction :input :element-type '(unsigned-byte 8))
(read-binary 'fat12-boot-record s))
>(describe *)
#<FAT12-BOOT-RECORD {BBE68B1}>
[standard-object]
Slots with :INSTANCE allocation:
BPB-RECORD = #<BPB {BCA4689}>
DRIVE-NUMBER = 0
FLAGS = 0
SIGNATURE = 41
VOLUME-ID = 1252133017
VOLUME-LABEL = (32 32 32 32 32 32 32 32 32 32 32)
SYSTEM-ID = (70 65 84 49 50 32 32 32)
BOOT-CODE = (3 2 255 0 0 128 37 0 0 0 0 8 250 235 7 246 194 128 117 2 178 128 234..
BOOTABLE-PARTITION-SIGNATURE = 43605
>(map 'string #'code-char (oem-id (bpb-record **)))
"mkdosfs^@" ;^@は#\nul
>(format nil "~X" (bootable-partition-signature ***))
"AA55"
最近読み終わった本.
印象に残ったセリフ 「それらを略語で呼ぶようになって,それに慣れてしまうと,本来の意味が失われることがある (中略) O・Jが何かわかるか?」 -> 「オレンジジュースのことだ」
バイト中にエントリーシート(の自己PR)を生成するプログラムをつくろうぜ、というネタが出たのでやってみた。思えば去年も現実逃避ぎみに似たようなことをしていた気がする。
(asdf:oos 'asdf:load-op :kmrcl)
(defpackage es
(:use :cl :kmrcl)
(:export store-word store-string emit-es print-ht
write-ht-to-file read-ht-from-file))
(in-package es)
(defvar *ht* (make-hash-table :test 'equal))
(defun store-word (word prev2 prev1 &optional (ht *ht*))
(push
word
(gethash (cons prev2 prev1) ht)))
(defun get-word (prev2 prev1 &optional (ht *ht*))
(let ((word-list (gethash (cons prev2 prev1) ht)))
(nth (random (length word-list)) word-list)))
(defun store-word-list (word-list &optional (ht *ht*))
(let ((lst (append (list :start :start)
word-list
(list :end :end))))
(loop :for rest = lst then (cdr rest)
:for word = (third rest)
:for prev1 = (second rest)
:for prev2 = (first rest)
:until (and (eq prev1 :end ) (eq word :end))
:do (store-word word prev2 prev1 ht))))
(defun parse-string-to-word-list (str)
(mecab
;;改行や空白はさようならする
(remove-if
#'(lambda (ch) (or (char= ch #\space)
(char= ch #\newline)
(char= ch #\IDEOGRAPHIC_SPACE)
(char= ch #\tab)))
str)))
(defun mecab (str)
(cl-ppcre:split
"[\\n| ]"
(let ((sb-impl::*default-external-format* :eucjp))
(kmrcl:command-output "echo ~A|mecab -O wakati" str))))
(defun store-string (str &optional (ht *ht*))
(store-word-list (parse-string-to-word-list str) ht))
(defun emit-es (&optional (ht *ht*))
(loop
:for prev2 = :start then prev1
:for prev1 = :start then word
:for word = (get-word prev2 prev1 ht)
:until (eq word :end)
:do (format t "~A " word)))
(defun print-ht (&optional (ht *ht*))
(maphash #'(lambda (k v) (format t "~A:~A~%" k v)) ht))
(defun write-ht-to-file (filename &optional (ht *ht*))
(with-open-file (s filename :direction :output :if-exists :overwrite
:if-does-not-exist :create)
(maphash
#'(lambda (key val)
(write (cons key val) :stream s))
ht)))
(defun read-ht-from-file (filename &optional (ht *ht*))
(with-open-file (s filename :direction :input)
(loop :for obj = (read s nil :eof)
:until (eq obj :eof)
:do
(setf
(gethash (car obj) ht)
(cdr obj)))))
接頭語は2つで、consしてハッシュテーブルのキーにしている。なので、ハッシュテーブルの生成時にキーワードパラメータtestにequalを指定している。
ファイルへの書き出しと読み込みは、Lispなのでwrite/readを用いた。楽ちん。
形態素解析はmecabを用いているが、すごくやっつけ仕事状態になっている。 mecabはデフォルトだとeucを使うらしいので、UTF-8な私のSBCLの環境とあわないため、一時的にexternal-formatの設定を変えて対処した。
とりあえず、hunchentootを使ってwebから使えるようにしてみた。
(asdf:oos 'asdf:load-op :hunchentoot)
(defvar *server* nil)
(setf
hunchentoot:*hunchentoot-default-external-format*
:utf8)
(setf
hunchentoot:*default-content-type*
"text/html; charset=utf-8")
(setf hunchentoot:*access-log-pathname*
"/home/kurohuku/es.log")
(defun start-server (port)
(setf *server*
(hunchentoot:start
(make-instance 'hunchentoot:acceptor :port port))))
(start-server 9999)
(hunchentoot:define-easy-handler (es-main :uri "/es") ()
(setf (hunchentoot:content-type*) "text/html; charset=utf-8")
(format nil
"
<html>
<head> <title> ES main </title> </head>
<body>
<form action=\"/store\" method=\"post\">
<input type=\"submit\" value=\"send\">
<textarea name=\"str\" rows=\"4\" cols=\"40\"></textarea>
</form>
</body>
</html>"))
(hunchentoot:define-easy-handler (store-string :uri "/store") (str)
(setf (hunchentoot:content-type*) "text/plain; charset=utf-8")
(format t "str=~A~%" str)
(es:store-string str)
(format nil "store string:~%~A~%" str))
(hunchentoot:define-easy-handler (emit-es :uri "/emit") ()
(setf (hunchentoot:content-type*) "text/plain; charset=utf-8")
(with-output-to-string (*standard-output*)
(es:emit-es)))
さて、問題はサンプルをどこから持ってくるか、だ。
Shibuya.lisp TT#4で,S式でアセンブラを書いていたhigepon氏が格好良かった。アセンブラを書くまではいかなくとも、アセンブラの命令を呼ぶくらいはやってみたいと思い、 SBCLでCPUID命令を実行してみた。
最初はバイナリコード+FFI(Foreign Function Interface)でなんとかしようかとも思ったけど、バイナリコードを吐くためにアセンブラを使う方法しか思い浮かばなかったので却下した。
SBCLにはネイティブコードコンパイラがついているのだから、なんとかしてSBCLの世界だけで CPUID命令を実行するところまでいきたい。
で、SBCL internalsなる記事で調べてみたところ、VOP(Virtual Operation)というものを使えばなんとかなりそうだとわかった。 (define-instruction cpuid ...)というのがあるので、幸いにもcpuid命令のバイナリコードは定義してあるようだ。
英語を読むパワーがないので、例のごとくとりあえず動くというだけのコードになった。まあ、動くからいいや。
処理系はSBCL 1.0.30 (ubuntu-VM上).
(sb-c:defknown common-lisp-user::%cpu-id
;;arg-types
((unsigned-byte 32) (unsigned-byte 32))
;;result-type
(unsigned-byte 32)
())
(sb-c:define-vop (%cpu-id)
(:policy :fast-safe)
(:args (eax-val :scs (sb-vm::unsigned-reg sb-vm::immediate))
(arg :scs (sb-vm::any-reg sb-vm::immediate)))
(:arg-types sb-vm::positive-fixnum sb-vm::positive-fixnum)
(:translate %cpu-id)
(:temporary (:sc sb-vm::unsigned-reg :offset sb-vm::eax-offset) eax)
(:temporary (:sc sb-vm::unsigned-reg :offset sb-vm::edx-offset) edx)
(:temporary (:sc sb-vm::unsigned-reg :offset sb-vm::ecx-offset) ecx)
(:temporary (:sc sb-vm::unsigned-reg :offset sb-vm::ebx-offset) ebx)
(:results
(r1 :scs (sb-vm::unsigned-reg)))
(:result-types sb-vm::unsigned-num)
(:generator
8
(sb-vm::sc-case eax-val
(sb-vm::immediate
(sb-assem:inst mov eax (sb-vm::tn-value eax-val)))
(T (sb-c:move eax eax-val)))
(sb-assem:inst cpuid)
(sb-vm::sc-case arg
(sb-vm::immediate
(cond
((= (sb-vm::tn-value arg) sb-vm::ebx-offset) (sb-c:move r1 ebx))
((= (sb-vm::tn-value arg) sb-vm::ecx-offset) (sb-c:move r1 ecx))
((= (sb-vm::tn-value arg) sb-vm::edx-offset) (sb-c:move r1 edx))
(T (sb-c:move r1 eax))))
(T (sb-c:move r1 eax)))))
;;(sb-c::%primitive %cpu-id 0 sb-vm::ebx-offset)
(defun word->byte-list (n)
(list
(ldb (byte 8 24) n)
(ldb (byte 8 16) n)
(ldb (byte 8 8) n)
(ldb (byte 8 0) n)))
(defun get-cpu-vender ()
(let ((ebx (sb-c::%primitive %cpu-id 0 sb-vm::ebx-offset))
(ecx (sb-c::%primitive %cpu-id 0 sb-vm::ecx-offset))
(edx (sb-c::%primitive %cpu-id 0 sb-vm::edx-offset)))
(coerce
(mapcan
#'(lambda (n)
(mapcar #'code-char (reverse (word->byte-list n))))
(list ebx edx ecx))
'string)))
(defun get-cpu-processor-brand ()
(with-output-to-string (s)
(dolist (n (mapcar #'(lambda (x)
(coerce x '(unsigned-byte 32)))
(list #x80000002 #x80000003 #x80000004)))
(declare (type (unsigned-byte 32) n))
(let ((eax (sb-c::%primitive %cpu-id n sb-vm::eax-offset))
(ebx (sb-c::%primitive %cpu-id n sb-vm::ebx-offset))
(ecx (sb-c::%primitive %cpu-id n sb-vm::ecx-offset))
(edx (sb-c::%primitive %cpu-id n sb-vm::edx-offset)))
(dolist (word (list eax ebx ecx edx))
(dolist (code (reverse (word->byte-list word)))
(unless (zerop code)
(write-char (code-char code) s))))))))
%cpu-idは1つ目の引数にEAXの値、2つ目の引数に返してほしいレジスタのオフセットを指定するようにした。
レジスタの個数より多くののTN(レジスタ?)は作れないっぽい。 :temporaryで宣言したeaxなどをそのまま返り値に使いたかったけど、どうすればいいのかわからなかったので現在の形になった。
以下、実行結果
CL-USER> (get-cpu-vender)
"AuthenticAMD"
CL-USER>(get-cpu-processor-brand)
"AMD Athlon(tm) 64 X2 Dual Core Processor 3600+"
新しい言語に触れるときは,ループや条件分岐が必要なのでFizzBuzzを書いてみることにしている。
switchを使ったものと配列を使ったもの、それをメソッドとして呼び出すものの2+1パターンを書いた。
package main
import "fmt"
//switchを使ってみる
func fizzbuzz1(limit int)
{
for n:=1; n<=limit; n++{
switch{
case n%15==0:
fmt.Print("FizzBuzz");
case n%5==0:
fmt.Print("Buzz");
case n%3==0:
fmt.Print("Fizz");
default:
fmt.Print(n);
}
fmt.Printf("\n");
}
}
//配列を使ってみる
func fizzbuzz2(limit int)
{
var arr [15]string =
[15]string{"Fizzbuzz","","","Fizz","","Buzz","Fizz","","","Fizz","Buzz","","Fizz","",""};
for i := 1; i <= limit; i++{
if str := arr[i%15]; len(str) == 0{
fmt.Printf("%d\n",i);
}else{
fmt.Printf("%s\n",str);
}
}
}
//メソッドらしきもの
//Hoge型
type Hoge int
func (limit Hoge)fizzbuzz_hoge()
{
fizzbuzz1(int(limit));
}
func main()
{
fmt.Printf("**fizzbuzz1**\n");
fizzbuzz1(15);
fmt.Printf("**fizzbuzz2**\n");
fizzbuzz2(15);
fmt.Printf("**fizzbuzz_hoge**\n");
//明示的にHoge型だと指定しないとintだと思われてコンパイルエラー
var hoge Hoge = 15;
hoge.fizzbuzz_hoge();
}
switchはcaseの部分に色々書ける。if-elseif-elseをswitchとして書ける、ということなのだろう。
配列の要素数は型の前に書く。配列内の""のところにnilと書こうとしたけどコンパイラに怒られた。残念。
メソッドらしきもののところは、最初は(limit int)と書いて、3.fizzbuzz_hoge()で呼び出せるようにしたかったけど、intはnon-local typeじゃないので新しいメソッドを定義できないと言われる。仕方ないのでHoge型を作って呼び出すようにした。
昨日インストールしたGoで遊んでみる。とりあえず、みんな大好き正規表現を使ってみつつ、雰囲気を掴もうと試みる。
package main
import( "regexp"; "fmt"; "flag";"os")
// command regexp target-str
func main()
{
flag.Parse();
if flag.NArg() < 2{
fmt.Printf("Require 2 args(now %d): regexp, target\n",flag.NArg());
}else{
var regstr string = flag.Arg(0);
var target string = flag.Arg(1);
re,err := regexp.Compile(regstr);
if err != nil
{
fmt.Printf("error@regexp.Comile:");
fmt.Print(err);
os.Exit(0);
}
strs := re.MatchStrings(target);
if l:=len(strs); l!=0
{
//substring
fmt.Printf("Match:%s\n",strs[0]);
for i:=1; i<len(strs); i++{
fmt.Printf("Match[%d]:%s\n",i,strs[i]);
}
}
else
{
fmt.Printf("No Match\n");
}
}
return;
}
mainパッケージのmain関数がエントリポイントのようだ。
importやconst(定数宣言)など、はかっことこっかで囲むことで複数同時に宣言できる。セミコロンはあってもなくても良いらしい。
変数の宣言時には、変数名の後に型(クラス?)の名前を書く。省略も可能。
//宣言
var hoge string;
//宣言+初期化
var hoge string = "hoge"
var hoge = "hoge"
hoge := "hoge"
また、Goは多値を扱える。2つ目の返り値でエラーかどうかを判定する何かを返すことが多そうだ。
flagパッケージはコマンドライン引数を処理、fmtパッケージはフォーマット入出力、以下略。パッケージについてはgolang.orgのPackage documentationにまとめられている。
ドキュメントの関数の見方は、例えば、fmtパッケージ内で
func Printf(format string, v ...) (n int, errno os.Error)となっていれば、関数Printfは1つ目の引数に文字列,その後に可変長で引数を取り、整数とエラーを多値で返す,ということだろう。
以下、コンパイルして実行した結果
$./8.out "hoge" "fuga"
No Match
$./8.out "hoge" "hogefugapiyo"
Match:hoge
$./8.out "(ab|cd)efg" "abefghi"
Match:abeft
Match[1]:ab
もうすこしまともにチュートリアルを読んでから書くべきか・・・
巷で噂のThe Go Programming Languageをインストールした。
すんなり入ったわけじゃなかったのでメモしておく。
環境はVM上のUbuntu(x86).
実際に作業したときは環境変数を後で設定しているので、少し手順がおかしいかも。
/* 一般ユーザでの作業。ホームディレクトリにいる。 */
/* Goのコマンドを入れるディレクトリを作る */
$mkdir gobin
/* 環境変数設定 */
$export GOROOT='/home/kurohuku/util/go'
$export GOBIN='/home/kurohuku/gobin'
$export GOARCH='386'
$export GOOS='linux'
$export PATH='$PATH:/home/kurohuku/gobin'
/* hgコマンドとやらをインストールする */
$sudo apt-get install python-setuptools python-dev
$sudo easy_install mercurial
/* goを持ってくる */
$cd util/
$hg clone -r release https://go.googlecode.com/hg/ $GOROOT
/* アップデート? */
$cd go/
$hg pull
$hg update
/* コンパイル+インストール+テスト */
$cd src/
$./all.bash
/* テストが問題なければインストール終了 */
GOARCH=386と指定していると、コマンドは8g,8lなどと8が頭につくものになるようだ。
また、go/miscにcgo,emacs,vim,xcodeというディレクトリがある。一応Emacs使いなので、go-mode.elとgo-mode-load.elをマイelファイルディレクトリにコピー。設定ファイルまで用意してくれてるとは素晴らしいですね。
と、思ったらインデントが気にくわない。これがデフォってことはないだろうから私がなにかを間違えているのだろうか。
以下はチュートリアルに載っているサンプルコードの表示文字を少し変更しただけのコード.
package main
import "fmt"
func main()
{
fmt.Printf("Hello, 'go' World!\n")
}
適当なファイル(hello.go)に保存してコンパイル->実行する。
$8g hello.go
$ls
hello.go hello.8
$8l hello.8
$ls
hello.go hello.8 8.out
$./8.out
Hello, 'go' World!
/* ファイルサイズ */
$ls -l|awk '{print $5 " " $8}'
581735 8.out
5192 hello.8
83 hello.go
ちなみに、気にくわないインデントというのは、こんな感じ。
func main()
{
fmt.Printf("Hello, 'go' World!\n")
}
本日の酒はアブソルートウォッカ。
グラスに酒を注いでいるとき、瓶に(40 PROOF) と書いてあったが、何のことかわからなかったので少し調べてみた。
英和辞書に、proof=酒類の標準強度という項目があったが、それだけじゃよくわからない。
Google樣に頼ると、どうも
アルコール度数 = 標準強度/2という関係がなりたっているらしい。
国によっては度数じゃなくてproofで酒の強さを話すのがメジャーなんだろうか。
ちなみに、アブソルートウォッカの原産国はスウェーデン。作っていたのは国有企業だったが、今はフランスの企業に買収されているらしい。
フロッピーのイメージをマウントして、そこにファイルをコピーして、アンマウントする、という作業がとてもめんどくさい。
3つのコマンドが必要だし、フロッピーのイメージをマウントするのでルート権限まで要求されるようだし。
なにか良い解決手段はないかと思っていたところ、mtools(msdos tools?)というものがあることを教えてもらった。
どうやらubuntuならapt-getで入るようだ。
/etc/mtools.confに設定を書くことになるので、てきとーに以下の記述を加えた。
drive z: file="floppy.img" fat_bits=12 cylinders=80 heads=2 sectors=18 mformat_only
以下、mtoolsの良いところを示すコマンド例。
/* before */
$sudo mount floppy.img tmp -o loop
$sudo cp hoge.bin tmp/
$sudo umount tmp
/* after */
$mcopy hoge.bin z:hoge.bin
drive z: file="floppy.img"と設定したおかげで、z:hoge.binと書くとカレントディレクトリのファイルfloppy.imgをマウントした際の/hoge.binとして扱えるようだ。
以前適当に解決しようとした問題を調べた。といってもwiki.osdev.orgのC++の項目を読んだだけ。英語の読解力がろくに無いので間違えて理解したかもしれない。
ようは、OSというパトロンがいなくなったC++さんが路頭に迷わないための手引き。
以下自分の理解をまとめる。osdev.orgにはサンプルコードまで載っていて素敵です。
デフォルトでは、G++はmainが呼び出される前に実行されるコードや、mainがreturnした後に呼ばれるコードをリンクしようとする。
なので、無効にするために-nostartfilesオプションをつける。
必要な処理を無効にしてしまった以上は、自前で実装しなければならない。とりあえず、global/staticなオブジェクトのコンストラクタ、デストラクタを呼び出すコードを追加すればよい。
コンストラクタ、デストラクタではnew/delete(new[]/delete[]も)が必要なので、これらも実装しなければならないが、その際にメモリマネジメントの機能が必要になる。特定のアドレスにオブジェクトを作るplacement newというテクニックもあるらしい。
GCC(G++)はctors、dtorsというセクションにそれぞれ、 global/staticオブジェクトのコンストラクタ、デストラクタを登録する。
C++のコードにジャンプする前後にこれらのセクションの内容を処理する。セクションの境界を知るためにリンカスクリプトを書く。
__cxa_atexitは、__cxa_finalizeで呼ばれる,オブジェクトや共有リソースを破棄する時のハンドルを登録する。
C++のカーネルコードが終了したら__cxa_finalize(0)を呼ぶべき。 dctorの処理と__cxa_finalize(0)の呼び出しは両方するべきなのだろうか。まぁ、終了時の事はあまり気にしなくても動くので良いか。
__dso_handleはさようならするオブジェクトがDynamic Shared Objectかどうか判別する?
純粋仮想関数がオーバライドされていないのに呼びだされる(?)ときのための関数を用意する。
どこかの.cpp内に、__cxa_pure_virtualという関数を作る。なお、__cxa_pure_virtualにはextern "C"でC言語のリンケージを指定する。
GCCはローカルなスタティック変数のコンストラクタの前後に、複数スレッドから同時に呼び出されないように保護するコードを挿入するらしい。
いままで気にした事が無いシンボル名が出てきたので、他のどこかのオプションで無効になってるのではなかろうか。標準ライブラリを無効にするところだろうか。
無効にするために-nostdlibオプションをつける。
無効にするために-fno-tffiオプションをつける。
無効にするために-fno-exceptionsオプションをつける。
昨日(2009/11/7)はShibuya.lisp TT#4に参加していた。
TT#3に続いて2度目の参加だったけど、相変わらず発表も周囲の人もレベルが高すぎて、自分なんかが話を聞いててよいのだろうかと思うことしばしば。
ふと、自分がLisperの底辺なら、自分が頑張ることによって Lispを使う人の最低ラインが上昇するんじゃないかと思ったので、もう少しまともに学ぼうという気持ちがわいてきた。
この気持ちが持続すれば問題はないんですけどね。
ともあれ、とても楽しい半日でした。運営、発表の方々には深く感謝。
次回も参加したいので、申し込み開始時にはモニタ前で正座して待機することにしよう。
zpb-ttfとcl-vectorsで適当に表示することはできたが、単純に表示したいだけなら zpb-ttfのみで問題無いんじゃないかと思ったのでやってみた。
(require :asdf)
(asdf:oos 'asdf:load-op :zpb-ttf)
(require :cl-glfw)
(require :cl-glfw-opengl)
(require :cl-glfw-glu)
;;取り合えずxの最小値~最大値が0~1.0となるよう調整。
;;x,yについて実行すべき関数の多値を返す
;;返り値vertex-2fに渡したいので、関数はsingle-floatを返す。
(defun correct (bounding-box)
(let ((xbase (- 0 (zpb-ttf:xmin bounding-box)))
(ybase (- 0 (zpb-ttf:ymin bounding-box))))
(let ((xmax (+ xbase (zpb-ttf:xmax bounding-box))))
(values
(lambda (x)
(coerce (* (+ x xbase) (/ 1 xmax)) 'single-float))
(lambda (y)
(coerce (* (+ y ybase) (/ 1 xmax)) 'single-float))))))
(defun run-test (&optional (ch #\A))
(zpb-ttf:with-font-loader
(font "/usr/share/fonts/truetype/sazanami/sazanami-gothic.ttf")
(let* ((bbox (zpb-ttf:bounding-box font))
(glyph (zpb-ttf:find-glyph ch font))
(frames 0)
t0 t1)
(multiple-value-bind (x-fn y-fn)
(correct bbox)
(glfw:do-window ("test-ttf" 300 300)
((gl:with-setup-projection
(glu:perspective
45d0
(coerce 4/3 'double-float)
0.1d0
50d0))
(setf t0 (glfw:get-time)
t1 (glfw:get-time)))
;;calc FPS
(setf t1 (glfw:get-time))
(when (> (- t1 t0) 1.0)
(glfw:set-window-title
(format nil "test-ttf(~,1f FPS)" (/ frames (- t1 t0))))
(setf frames 0
t0 t1))
(incf frames)
(gl:clear gl:+color-buffer-bit+)
(gl:load-identity)
(gl:translate-f 0.0 0.0 -5.0)
(zpb-ttf:do-contours (contour glyph)
(gl:with-begin gl:+line-loop+
(gl:color-3f 1.0 0.0 0.0)
(zpb-ttf:do-contour-segments (p0 p1 p2) contour
(gl:vertex-2f
(funcall x-fn (zpb-ttf:x p0))
(funcall y-fn (zpb-ttf:y p0)))
(gl:vertex-2f
(funcall x-fn (zpb-ttf:x p2))
(funcall y-fn (zpb-ttf:y p2)))))))))))
問題として、塗りつぶすことをまったく考えてない事がある。
外積だのなんだのを使って内外判定をして、文字の色を塗るか背景色を塗るか選んでから、 gl:line-loop+をgl:+quads+ あたりにかえて書けば良さそうだけど、ベクトルを忘れ去っている似非理系なのでまずは数学のお勉強から始めなければならないみたいだ。
どうしようか迷ったけど、いいや貼り付けてしまえ。
とりあえず、文法をうまくかけるかどうか、ということが問題。
自分の脳みそではあんまり考えられないけど、何かの文法をパクっても、どうせ途中でオレオレルールになるだろうから、試行錯誤しながら書いてみる。
(defun test-parse (file)
(with-open-file (s file :direction :input)
(yacc:parse-with-lexer
(list-lexer-c
(read-c-like s))
*c-like*)))
(eval-when (compile load eval)
(defun i2p (a b c)
"Infix to Prefix"
(list b a c))
(defun k-2-3 (a b c)
(declare (ignore a c))
b))
(defun read-c-like (stream)
(let ((*readtable* (copy-readtable *readtable*)))
(loop :for ch across ";,(){}"
:do
(set-macro-character
ch
#'(lambda (stream ch)
(declare (ignore stream))
(intern (string ch) :keyword))))
(loop :for ch across "%/*"
:do
(set-macro-character
ch
#'(lambda (stream ch)
(declare (ignore stream))
(intern (string ch)))))
(set-macro-character
#\=
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\= (peek-char nil stream))
(progn (read-char stream)
:==)
:=)))
(set-macro-character
#\<
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\= (peek-char nil stream))
(progn (read-char stream)
'<=)
'<)))
(set-macro-character
#\>
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\= (peek-char nil stream))
(progn (read-char stream)
'>=)
'>)))
(set-macro-character
#\+
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\+ (peek-char nil stream))
(progn (read-char stream)
:++)
'+)))
(set-macro-character
#\-
(lambda (stream ch)
(declare (ignore ch))
(if (char= #\- (peek-char nil stream))
(progn (read-char stream)
:--)
'-)))
(loop
:while (listen stream)
:collect
;;シンボル中のアンダースコアを読み込んだ後にハイフンに直す
(let ((obj (read stream)))
(if (symbolp obj)
(let ((name (symbol-name obj)))
(intern
(map 'string
#'(lambda (ch)
(if (char= ch #\_)
#\-
ch))
name)
(symbol-package obj)))
obj)))))
(defun list-lexer-c (list)
#'(lambda ()
(let ((val (pop list)))
(if (null val)
(values nil nil)
(let ((terminal
(cond
((member val '(+ - * / %
:= :== < > <= >=
:++ :--)) val)
((eq :|(| val) :lparen)
((eq :|)| val) :rparen)
((eq :|{| val) :bstart)
((eq :|}| val) :bend)
((eq :|;| val) :eend)
((eq :|,| val) :sep)
((integerp val) :num)
((stringp val) :string)
((eq 'for val) :for)
((eq 'if val) :if)
((eq 'else val) :else)
((eq 'return val) :return)
((member val '(string int void)) :type)
((symbolp val) :name)
(t (error "Unexpected value ~A" val)))))
(values terminal val))))))
(yacc::define-parser *c-like*
(:start-symbol PROGRAM)
(:terminals
(:type :name :num :string
+ :++ - :-- * / % := :== < <= > >=
:for :if :else
:return
:struct
:bstart :bend ;block {}
:sep ; separator ,
:eend ; ;
:lparen :rparen))
(:precedence ;演算子優先順位
((:left * / %)
(:left + -)
(:left :== <= >= < >)))
(PROGRAM
(DEFS #'(lambda (defs) `(progn ,@defs))))
(DEFS
(DEF DEFS #'cons)
(DEF #'list))
(DEF
DEFVAR
DEFUN)
(DEFVAR
;;=> type name;
(:type :name :eend
#'(lambda (type name $3) `(defparameter ,name)))
;;=> type name = expression;
(:type :name := EXPRESSION :eend
#'(lambda (type name $3 expression $4)
`(defparameter ,name ,expression))))
(DEFUN
;;=> int hoge(args){bodies}
(:type :name :lparen DEFUN-ARGS :rparen :bstart BODIES :bend
#'(lambda (type name $3 args $5 $6 bodies $8)
`(defun ,name ,args
(block nil ,@bodies))))
(:type :name :lparen :rparen :bstart BODIES :bend
#'(lambda (type name $3 $4 $5 bodies $6)
`(defun ,name () (block nil ,@bodies)))))
(DEFUN-ARGS
;;=> int n , int m
(:type :name :sep DEFUN-ARGS
#'(lambda (type name $3 args)
(cons name args)))
(:type :name #'(lambda (type name) (list name))))
(FUNCALL
(:name :lparen ARGS :rparen
#'(lambda (name $2 args $4)
`(,name ,@args)))
(:name :lparen :rparen
#'(lambda (name $2 $3)
`(,name))))
(ARGS
(ARG #'list)
(ARG :sep ARGS #'(lambda (arg $2 args) (cons arg args))))
(ARG
EXPRESSION
FUNCALL
LITERALL)
(LITERALL
:name
:num
:string)
(EXPRESSIONS
(EXPRESSION #'list)
(EXPRESSION :sep EXPRESSIONS
#'(lambda (exp $2 exprs)
(cons exp exprs))))
(EXPRESSION
(expression + expression #'i2p)
(expression - expression #'i2p)
(expression * expression #'i2p)
(expression / expression #'i2p)
(expression % expression
#'(lambda (exp1 $2 exp2)
`(mod ,exp1 ,exp2)))
(expression :== expression
#'(lambda ($1 $2 $3) `(equal ,$1 ,$3)))
(expression < expression #'i2p)
(expression <= expression #'i2p)
(expression > expression #'i2p)
(expression >= expression #'i2p)
exp-term)
(exp-term
LITERALL
(:- exp-term)
SUBST
FUNCALL
(|(| expression |)| #'k-2-3))
;;代入
(SUBST
(:name := EXPRESSION
#'(lambda (name $2 expr)
`(setf ,name ,expr)))
;;後置インクリメント
(:name :++
#'(lambda (name $2)
`(prog1 ,name
(incf ,name))))
;;前置インクリメント
(:++ :name
#'(lambda ($1 name)
`(incf ,name)))
(:name :--
#'(lambda (name $2)
`(prog1 ,name
(decf ,name))))
(:-- :name
#'(lambda ($1 name)
`(decf ,name))))
;;関数やブロック内の変数宣言はletに展開する
(LET-FORM
(:type :name := EXPRESSION :eend BODIES
#'(lambda (type name $3 expr $5 bodies)
`(let ((,name ,expr)) ,@bodies)))
(:type :name :eend BODIES
#'(lambda (type name $3 bodies)
`(let (,name) ,@bodies))))
(IF-FORM
(:if :lparen expression :rparen :bstart bodies :bend
#'(lambda ($1 $2 $3 $4 $5 $6 $7)
`(when ,$3 ,@$6)))
(:if :lparen expression :rparen :bstart bodies :bend :else :bstart bodies :bend
#'(lambda ($1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11)
`(if ,$3 (progn ,@$6) (progn ,@$10))))
(:if :lparen expression :rparen :bstart bodies :bend :else body
#'(lambda ($1 $2 $3 $4 $5 $6 $7 $8 $9)
`(if ,$3 (progn ,@$6) ,$9))))
(FOR-FORM
(:for :lparen :type :name :=
EXPRESSION :eend EXPRESSION :eend EXPRESSIONS :rparen :bstart BODIES :bend
#'(lambda ($1 $2 type name $5 expr1 $7 expr2 $9 exprs
$11 $12 bodies $14)
`(loop :with ,name = ,expr1
:while ,expr2
:do ,@bodies ,@exprs)))
(:for :lparen :name :=
EXPRESSION :eend EXPRESSION :eend EXPRESSIONS :rparen
:bstart BODIES :bend
#'(lambda ($1 $2 name $4 expr1 $6 expr2 $8 exprs $10 $11 bodies $13)
`(progn
(setf ,name ,expr1)
`(loop
:while ,expr2
:do ,@bodies ,@exprs))))
(:for :lparen :eend EXPRESSION :eend EXPRESSIONS :rparen
:bstart BODIES :bend
#'(lambda ($1 $2 $3 expr2 $5 exprs $7 $8 bodies $10)
`(loop :while ,expr2
:do ,@bodies ,@exprs))))
(BODIES
(BODY BODIES #'cons)
(BODY #'list))
(BODY
RETURN-FORM
LET-FORM
(:name := EXPRESSION :eend #'(lambda (name $2 expr $4) `(setf ,name ,expr)))
FOR-FORM
IF-FORM
(EXPRESSION :eend #'(lambda (expr $2) expr)))
(RETURN-FORM
(:return :eend #'(lambda ($1 $2) `(return)))
(:return EXPRESSION :eend #'(lambda ($1 expr $3) `(return ,expr))))
)
read-c-likeで読み込んだリストを引数にしてlist-lexer-cを呼び出し、さらにその返り値をyacc:parse-with-lexerにパーサの定義とともに渡す。
とりあえず、FizzBuzzを書くいてみると、こうなる。
void fizzbuzz(int n)
{
for(int a=1;a<=n;a++)
{
if(a%15==0)
{
format(t,"FizzBuzz");
}
else if(a%5==0)
{
format(t,"Buzz");
}
else if(a%3==0)
{
format(t,"Fizz");
}
else
{
format(t,"~D",a);
}
terpri();
}
}
if~else ifとネストできるが、{}は必須。パースした結果は以下のとおり。
(PROGN
(DEFUN FIZZBUZZ (N)
(BLOCK NIL
(LOOP :WITH A = 1
:WHILE (<= A N)
:DO (IF (EQUAL (MOD A 15) 0) (PROGN (FORMAT T "FizzBuzz"))
(IF (EQUAL (MOD A 5) 0) (PROGN (FORMAT T "Buzz"))
(IF (EQUAL (MOD A 3) 0) (PROGN (FORMAT T "Fizz"))
(PROGN (FORMAT T "~D" A)))))
(TERPRI)
(PROG1 A
(INCF A))))))
スキルが無かろうと、ひたすら適当な文法をつづれば、一応動く。素晴らしい。
伊勢原市の中屋という酒屋(小田急伊勢原駅から徒歩15分程度)で、前々から買おうと思っていた相模灘という日本酒を購入した。
同じ銘柄ばかり買おうとする自分に、店の方が話しかけてくださった。こんな若造にわざわざ付き合っていただいて感謝です。
神奈川には日本酒のイメージがあまり無いような気がするから, 県内でおいしい地酒が作られていてうれしい。
そんなことを思いつつ、今日は雄町の方を飲んでみる神奈川県民なのでした。
GRUBから起動するコードをCで書いていたが、ろくに触ったことのないC++に書き換えてみることにした。
OSの力が借りられない(と思う)ので、コンパイルが通らなかったり、リンクできなかったりと大変だったので、とりあえずの解決へいたった道筋をメモしておく。
一応動くようになった、というレベルでしかないので、間違ったことをしているかもしれないし、勝手に思い込んでるだけという可能性も高い。
環境はVM上のUbuntu8.04。 GCC4.2.4(G++)でオブジェクトファイルにコンパイル -> ldでリンクという流れ。
割と問題が山積みな気もするけど、一応動くとこまで持っていけるということで手打ちにする。
Rubyライクな構文を読む、というネタを見たときからやってみたいと思ってたのでcl-yaccで遊んでみた。
とりあえず、こんなコードが
int main()
{
for(int x = 1; x < 10; x = x + 1)
{
if(x%2 == 0){
format(t,"~d:偶数~%",x);
}else{
format(t,"~d:奇数~%",x);
}
}
}
こんなコードに変換されるようになった。
(PROGN
(DEFUN MAIN ()
(LOOP :WITH X = 1
:WHILE (< X 10)
:DO (IF (EQUAL (MOD X 2) 0)
(PROGN (FORMAT T "~d:偶数~%" X))
(PROGN (FORMAT T "~d:奇数~%" X)))
(SETF X (+ X 1)))))
readで読み込んだ順のリストを作り、リストの内容が頭から取り出せるlexerを用意し、すさまじく適当な文法のparserでS式に変換している。
また、セミコロンやカンマ、括弧、演算子(+,==等)などはそのままでは CommonLisp用に読み込まれてしまったり他のシンボルの一部になってしまったりするので、リーダマクロでシンボルを返すようにした。
そうしたら今度は、hoge-fugaと書くと(- hoge fuga)にされてしまうという困った状態になった。
この調子だと明日もこのネタで遊んでそう。
Cなどのように文字列中の改行を"\n"と書けるようにしてみた。ダブルクオートにまで自前で設定できるなんてフリーダム。
;;;;文字列中の\nを改行に変える
(defun enable-string-reader ()
(set-macro-character
#\"
(lambda (stream ch)
(declare (ignore ch))
(with-output-to-string (s)
(loop
:for i = (read-char stream)
:until (char= i #\")
:do
(if (char= i #\\)
(let ((next (read-char stream)))
(case next
((#\n)
(write-char #\newline s))
(T
(write-char next s))))
(write-char i s)))))))
;;;SBCL用
(defun disable-string-reader ()
(set-macro-character #\" #'sb-impl::read-string))
いつか.emacsが消滅したときに復元する手助けになると信じて,適当に選んだ部分を晒してみる。
1つ目はタイムスタンプ。設定が変わるとめんどくさそうなので、どの環境でも同じ状態にしておきたい。
;;time-stamp
(require 'time-stamp)
(add-hook 'before-save-hook 'time-stamp)
(setq time-stamp-active t)
(setq time-stamp-start "last updated : ")
(setq time-stamp-format "%04y/%02m/%02d %02H:%02M %u@%s")
(setq time-stamp-end "\n")
(setq time-stamp-line-limit 20)
Cのインデントスタイルの設定。変わっても問題はないだろうけど、慣れているインデントスタイルにすぐ戻れるように。
;;indent style for c
(add-hook 'c-mode-hook
'(lambda ()
(c-set-style "linux")
(setq c-basic-offset 4)
(setq tab-width c-basic-offset)))
mic-paren.elの設定。一応Lisp使いの末端の端っこくらいには引っかかってほしいと思ってるので、括弧を見やすくするために入れている。
;;mic-paren
(require 'mic-paren)
(paren-activate)
(setq paren-face '(underline paren-match-face))
(setq paren-match-face '(underline paren-face))
(setq paren-sexp-mode t)
(setq parse-sexp-ignore-comments t)
anything.elをsdic用に設定してみたもの。anything自体ろくに使っていないけど、自分で書いたネタコードはこのくらいしかないので保存しておく。あとで黒歴史扱いする自分の姿が見えないでもない。
;;anything for sdic-mode
(defvar hogefuga nil)
(defvar anything-for-sdic
`((name . "sdic")
(init . (lambda () nil))
(candidates . (lambda ()
(let ((result
;;emacs lispはダイナミックスコープ
(flet ((message (n) n)
(sdic-display-buffer (x) x))
(sdic-describe-word anything-pattern))))
(push result hogefuga)
(prog1
(if result
(prog1
(with-current-buffer "*sdic*"
(split-string (buffer-string) "\n" t))
(sdic-display-buffer result))
(sdic-exit)
nil)
(set-buffer "*anything*")))))
(requires-pattern . 3)
(volatile)))
いろいろ酷いことになっているけど、ネタなので放置。
SBCLはデフォルトでマルチスレッド対応が無効になってるらしい。バイナリパッケージからインストールしたものだと*features*にsb-threadが入っていない。
INSTALLファイル(インストール手順)を確かめると、BINARY DISTRIBUTIONの項目にカスタマイズの設定を書いてビルドしろとのことらしいので、ちょうど良い機会ということにして1.0.29から1.0.30に乗り換えることにした。
INSTALLファイルに書いてあるとおり、customimze-target-features.lispファイルを作り、設定をそのままコピペする。
(lambda (features)
(flet ((enable (x)
(pushnew x features))
(disable (x)
(setf features (remove x features))))
;; Threading support, available only on x86/x86-64 Linux, x86 Solaris
;; and x86 Mac OS X (experimental).
(enable :sb-thread)))
その後は
>sh make.sh
>sh install.sh
とするだけ。すでにSBCLがインストールされてる環境なのでオプションをつけずともすんなりと進んだ。
Common LispでGLFW(OpenGLのフレームワーク)を動かすライブラリがあるので利用して遊んでみる。
とりあえず2Dの表示をやってみた。
(require :asdf)
(asdf:oos 'asdf:load-op :cl-glfw)
(asdf:oos 'asdf:load-op :cl-glfw-opengl)
(asdf:oos 'asdf:load-op :cl-glfw-glu)
(defpackage glfw-test
(:use :cl))
(in-package :glfw-test)
;;(test-modes)
;;(test-2d)
(defun test-modes (video-mode-max)
(glfw:init)
(format t "mode=(Width Height RedBits GreenBits BlueBits)~%")
(format t "Desktop-mode:~A~%" (glfw:get-desktop-mode))
(format t "Video-mode:~A~%" (glfw:get-video-modes video-mode-max))
(glfw:terminate))
;;;640x480
(defun test-2d ()
(let ((frames 0)
(quad (glu:new-quadric))
t0 t1)
(glfw:do-window ("test-2d" 640 480)
((gl:with-setup-projection
(glu:perspective 45d0
(coerce 4/3 'double-float)
0.1d0
50d0))
(setf t0 (glfw:get-time)
t1 (glfw:get-time)))
;;;calc FPS
(setf t1 (glfw:get-time))
(when (> (- t1 t0) 1.0)
(glfw:set-window-title
(format nil "test-2d(~,1f FPS)" (/ frames (- t1 t0))))
(setf frames 0
t0 t1))
(incf frames)
(gl:clear gl:+color-buffer-bit+)
(gl:load-identity)
(gl:translate-f 0.0 0.0 -5.0)
;;draw-line
(gl:with-begin gl:+line+
(gl:color-3f 1.0 0.0 0.0) ;red
(gl:vertex-2f 0.0 0.0) ;(0 0) -> (1 1)
(gl:vertex-2f 1.0 1.0)
(gl:color-3f 0.0 1.0 0.0) ;green
(gl:vertex-2f 1.0 0.0) ;(1 0) -> (0 1)
(gl:vertex-2f 0.0 1.0)
(gl:color-3f 0.0 0.0 1.0) ;blue
(gl:vertex-3f 0.0 0.0 0.0) ;(0 0 0) -> (0 1 0)
(gl:vertex-3f 0.0 1.0 0.0))
;;draw-point
(gl:with-begin gl:+point+
(gl:color-3f 1.0 0.0 0.0) ;red
(gl:vertex-2f 0.2 0.5)
(gl:color-3f 0.0 1.0 0.0) ;green
(gl:vertex-3f 0.7 0.5 0.0))
;;draw-triangle
;;(0 0)-(-1 0)-(0 -1)
(gl:with-begin gl:+triangles+
(gl:color-3f 1.0 0.0 0.0) ;red
(gl:vertex-2f 0.0 0.0)
(gl:color-3f 0.0 1.0 0.0) ;green
(gl:vertex-2f -1.0 0.0)
(gl:color-3f 0.0 0.0 1.0) ;blue
(gl:vertex-2f 0.0 -1.0) )
;;draw disk(circle)
(glu:quadric-draw-style quad glu:+fill+)
(gl:color-3f 0.0 0.0 1.0) ;blue
;;gluオブジェクトは原点に描画される
(gl:translate-f 0.5 -0.5 0.0)
;;(30角形?)
(glu:disk quad 0d0 0.5d0 30 1)
(gl:translate-f -0.5 0.5 0.0))
;;end of 'do-window'
(glu:delete-quadric quad)))
おそらくCで書いてもほとんど同じコードになるんだろうなぁ。
昨日今日で2冊本を読んだ。
SFで思い出したが、星界シリーズはいったいいつ続編がでるんだ・・・
CommonLispでN Queenを解く。きっと正しいと信じたい。
(defun check-nqueen (n lst)
(not
(or
(find n lst)
(loop
:named hoge
:for i from (1+ n)
:for j downfrom (1- n)
:for rest = lst then (cdr rest)
:for m = (car rest) then (car rest)
:finally (return-from hoge nil)
:while m
:do (when (or (= m i) (= m j))
(return-from hoge t))))))
(defun nqueen (n)
(let ((result nil))
(labels
((inner (i lst r)
(when (check-nqueen i lst)
(if (= r 1)
(push (cons i lst) result)
(loop
:with next = (cons i lst)
:for i from 1 to n
:do (inner i next (1- r)))))))
(loop
:for i from 1 to n
:do (inner i nil n)))
result))
情報処理試験(情報セキュリティスペシャリスト)を受験してきた.帰り道にふらりと降りた駅で酒屋を発見したので2本ほど購入した.
めもめも.
最近QEMUでGDBサーバーとやらを使うとおいしいということを知ったのでメモ.
/* QEMU起動時に-sオプションを付けるとGDBサーバーが起動.-pでポート指定可能.デフォルトは1234. */
>qemu -fda floppy.img -boot a -s
/* gdb起動 */
>gdb file.bin
/* GDBサーバに接続 */
>>target remote localhost:1234
QEMUのオプション
/* QEMUモニタをターミナルに */
>qemu -fda floppy.img -boot a -monitor stdio
/* QEMUをcursesで */
>qemu -fda floppy.img -boot a -curses
GDBのコマンドなど.
n(ext)とs(tep)の違いは,nextが関数呼び出しを1行として扱うのに対し,stepは関数内に入ること.
GCCでもNASMでも-gオプションを付けるとデバッガ用に出力してくれるようだ.
/* GDBで毎回コマンドを打つのがメンドクサイ.ファイルにコマンドを書いておいて読み込む.-xオプション. */
>gdb -x script.gdb file.bin
/* 構造体の内容を表示(16進) */
>>p/x *(&structure[0])
/* メモリの内容を表示 */
>>x/10 &function
/* バックトレース表示 */
>>bt
NASMを使っていたのでGCCのインラインアセンブラに触ったらエラーを連発してしまった.突っかかったところ,気を付けるところをメモしておく.
文庫を2冊読み終わった.
表題と同じタイトルの短編'最後の喫煙者'が一番好き.喫煙者を酒飲みに置き換えたら明日は我が身だな(笑)などと思いつつ,人間の思考ってわりと誘導されるよなぁ,などと考えていた.
'春の予感'.食事のメニューに載ってたら春の野菜が器にちょこんとおいてあるイメージだが,実際はどうだろう.風情がありすぎる感のある名前を付けるのは,内容を想像したり実物との差異に驚いたりといったことを楽しむためのもの・・・
だったりして.
2冊とも,著者の他の小説を読みたくなるようなもので良かった.
思えば,筒井氏の小説を読むのはこれが初めてなのであった.
本日の酒は頂いた日本酒.
若戎酒造に真秀(まほ)という酒があったが,真野鶴にも'まほ'という酒があるそうな.漢字は異なり,'万穂'.精米歩合35%と削りすぎだろってレベル.1.8Lで10500円は結構高い.飲んでみたいなぁ.
最近読み終わった書籍をログる.飲酒記録よりは自分の役に立ちそう.
出会った人々に巻き込まれかつ巻き込んで飲み歩く話(曲解).ビール,シャンパン,赤玉ポートワイン,ラムといろいろ出てくるが,なにより偽電気ブランが気になる.
この小説を読んだ誰かがネタでオレオレ電気ブランを作ったりしてるに違いない.
6人の偉人の習慣から広義でのマネジメントについて学ぶという話.
そのくらい知っている,聞いたことがある,というようなことでも大きいことを成し遂げた人の行いだと言われれば素晴らしいものに思えたりする.なにもかも鵜呑みにするのは良くないだろうが.
運や努力や才能もあるが,自分の行動規範や信念を貫けることが歴史に名前を残すような人の条件なのではないかと思う.
意志を強く持つことは誰にだってできるはずだけど,なかなかできることではない.せめて自堕落に生きることだけはないように気をつけたい.
以前のログ内容についてのメモ,ということで前回の記事で購入報告したジンについて調べてみる.有言実行はいいが三日坊主な予感がしないでもない.
ジン[gin]は大麦,ライ麦,ジャガイモなどの麦芽や穀物を原料として作られる蒸留酒で,杜松(ねず・としょう)の実[ジュニパーベリー]で香りを付けている.杜松ってどんな植物だよ,と思ってgoogle様で画像検索すると盆栽に植わってる写真が出てきた.ヒノキ科の常緑針葉樹とのことだが,私の脳味噌でこの言葉から連想できるのは,年中緑の葉っぱを付けてるということだけなのであった.
オランダの大学教授が1660年に薬用酒として作ったのが始まりらしい.薬用酒ということなので体調を崩した時にも薬と言い張って飲むことができる.
イギリスタイプとオランダタイプの2つに大別でき,イギリスタイプは穀物を発酵させた後に連続蒸留機で蒸留し,香草等を加えたのちさらに単式蒸留機で蒸留するもの,オランダタイプは穀物を発酵させた後に単式蒸留機で蒸留し,杜松の実などを加えたのちもう一度単式蒸留機で蒸留するもの,だそうだ.
一般にジンといったらイギリスタイプのジン(ドライジン/ロンドンジン)で,私もオランダタイプとやらは飲んだことはない.カクテルに使われるのも大抵ドライジンのようだ.
他に分類すると,ドライジンに糖分を加えて甘くしたオールドトムジン,オリス(アヤメ科)等7種の植物で強い香りを付けたプリマスジン,フルーツなどで香りを付けたフレーバージンなどがある.
オールドトムジンはその昔人気だった甘口ジンの販売機が雄猫(トムキャット)をモチーフにしていたのが名前の由来らしい.プリマスジンは1793年にイングランド南西部のプリマスで作られた,イギリスでもっとも歴史の長いジンだそうだ.
ボンベイサファイヤ,ギルビー,タンカレー,ビフィーター,ゴードン等の銘柄は飲んだことがあったり聞いたことがあったりするが,どれもドライジンっぽいので機会があればオランダタイプのジンを飲んでみたい.
青春18切符を使わないともったいないので山梨まで行ってきた. 10日に甲府で1泊し,11日に帰宅.
甲府では,駅前の居酒屋「七賢酒蔵」にて酒を飲む.山梨の地酒,七賢のしぼりたてなま生と満天下(三ツ星)を1合ずつ頼んだ.
良いお店だったので,甲府駅で降りる機会があったらまた行ってみようと思う.
11日は「七賢酒蔵」の店主らしき方に教えていただいた七賢の蔵元(山梨銘醸株式会社)に行くことにした. JR中央線日野春駅から徒歩で2時間くらいかかった.なんで歩いたんだろう俺.
蔵元は創業300年ほどだが,建物は築170年で,明治天皇が宿泊されたこともあるそうな.建築時に送られた欄間(天井とふすまの間の部分)の彫刻が中国の'竹林の七賢人'だったのが七賢の名前の由来だそうで,その七賢人の名前を冠した限定生酒もある.建物を見学させていただいたあと,お待ちかねのお酒(利き酒,試飲)タイムへ進む.
頂いたお酒は以下の3種.
竹林の七賢人の七種は,冬に1回つめる分だけで,5月くらいから売り切れが出てくるとのこと.売り切れていないものを買おうかとも考えたが,生酒なのでそのまま持ちかえるにはつらいということなので,満天下の五ツ星の1升瓶を買って帰ることにした.
ちなみに.「七賢酒蔵」と七賢の蔵元は会社として直接関係があるわけではないらしい.直営のレストランは蔵元のとなりにあるが,時間の都合上寄るのは諦めた.
以下今回の戦果
フロッピーディスクのイメージを作ってGRUBで起動し Multiboot Specificationとやらのパワーでプログラムを実行するためのメモ.
GNUのマニュアルや多数のブログ記事を参考にした.皆様に感謝.
$ dd if=/dev/zero of=./test bs=512 count=2880
2880+0 records in
2880+0 records out
1474560 bytes (1.5 MB) copied, 0.109047 s, 13.5 MB/s
ddコマンドで512バイトx2880(セクタ数18xヘッド数2xシリンダ数80)= 1.44MBのファイルを生成する.bs=1k count=1440の方が解りやすいかも.
$ mkfs.vfat test
mkfs.vfat 2.11 (12 Mar 2005)
適当なファイルシステムでフォーマット.mkfs.vfatはオプションを付けないとFAT16になるそうだ.
$ sudo mount test tmp -o loopカレントディレクトリにtmpというディレクトリがあることを前提とする. mountは-oに続けてオプションを指定できる.
loopオプションはループデバイス(ループバックデバイス)の機能を用いて通常のファイルをブロック型デバイスとして扱うためのオプション. -o loop=/dev/loop0等と指定するが,省略されると使われてないループデバイスを探して利用してくれるそうだ.
$ cd tmp
$ sudo mkdir boot
$ cd boot
$ sudo mkdir grub
$ sudo cp /boot/grub/stage1 /boot/grub/stage2 /boot/grub/menu.lst ./
$ menu.lstを適当に編集
マウントしたイメージに/boot/grub/というディレクトリを作り,そこに grubのstage1(1次ローダ),stage2(2次ローダ),menu.lst(grub 起動時の設定?)をコピーする.このままだとmenu.lstが現在のブート時の設定になってるので適当にいじる.いじらなくてもコマンド入力すれば動かせはする.
$ grub
/* grubのコマンド */
> device (fd0) test /* デバイスの指定 */
> root (fd0)
> setup (fd0) /* stage1を書きこむ */
> quit
grubがインストールされる.たったこれだけでいいそうな.
あとはMultiboot Specificationに対応したバイナリをディスクイメージの中に入れて(/hoge.bin等)ブートし,grubのコマンドとしてkernel /hoge.bin と打てば実行される.
今日の結論:grubすげぇ.
最近Lispに触ってないことに気づいて遊んでみた。
共有構造を利用してFizzBuzz問題を解く。リストにアクセスするだけになるので、剰余を使わないで済む。(ORは使ってるけど)
(defun fizzbuzz ()
(let ((l (quote #1=(nil nil fizz nil buzz
fizz nil nil fizz buzz
nil fizz nil nil fizzbuzz . #1#))))
(loop :for i from 1 to 100
:collect (or (nth (1- i) l) i))))
青春18切符の恩恵を受けて1泊2日で伊勢神宮に参拝してきた.無論一人で.
出発は20日朝.東海道線でひたすら西へ.片道8時間かかった.
伊勢市駅到着後に伊勢神宮の外宮周辺を巡り,頃合いを見計らって予約した宿のある二見浦駅へ.夫婦岩を(一人で)眺めた後,夕食をとって宿泊する旅館朝日館へたどり着く.
旅館の人にひとこと尋ねると驚愕の返答が.曰く,旅館周辺には居酒屋の類が存在しない.
仕方なく旅館の売店でビールを買って部屋でちびちびと(一人で)飲むことにした.
翌日は旅館で朝食を(一人で)取ってから出発し,伊勢神宮の内宮へ向かう.降車駅を間違えたため,そこからひたすら歩くことにした.
内宮周辺は結構人がいてびっくり.年配の方や小さい子供を連れた家族連れが多かったように思うが,学生やカポーの姿もそれなりに見られた.けど俺は一人.
内宮参拝後はすぐに伊勢市駅に向かい帰路に帰路に着く.帰宅したのは夜中の1時頃だった.
振り返ってみると,移動時間ばかりであまり余裕を持って観光をしていないけど,初青春18切符かつ初泊まりの一人旅かつ初伊勢神宮な旅行だったので楽しかった.次は酒造の神でもある木花咲耶姫命を祭る浅間神社に行こう.
以下参拝した神社
以下購入した酒リスト
前回のPythonは2.5だった.3に移ろう. 2.5から3に移ると,前回のコード内ではprintとhash_keyあたりが動かないと思われ.
ということで本日の酒.
最近自分で触れて遊ぶのはCommonLispが9割,Cが1割な気がするが,他の言語に触らないのもよろしくないと思うのでPythonで遊んでみた.
Hello,World -> FizzBuzz -> Brainfuck という順で,勉強がてら適当に書いてみた.
以下ソースコード
# Hello,WorldHello,Worldでは入力を使わないので,Brainfuckの入力のところは適当.文字型はなさそうで,文字列->文字コード(のリスト?)な関数があるのだろうけど,ぱっと見つからないので無視してしまいましたとさ.
print "Hello,World"
# FizzBuzz
# forはリストの要素に対して用いる.
for i in range(1, 100):
if (i % 15) == 0:
print "FizzBuzz"
elif (i % 5) == 0:
print "Buzz"
elif (i % 3) == 0:
print "Fizz"
else:
print i
# Brainfuck
# printの末尾に,を付けると改行の代わりに空白を出力するらしいが,
# これを回避するためにsys.stdout.writeを用れば良いようだ
import sys
# Wikipediaで拾ってきたBrainfuckのHello,World
program_array = "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+."
def run_bf (pg):
l = len(pg)
ptr = 0
pc = 0
mem = {}
labels = []
while pc < l:
c = pg[pc]
if c == '>':
ptr = ptr + 1
elif c == '<':
ptr = ptr - 1
elif c == '+':
if not mem.has_key(ptr):
mem[ptr] = 0
mem[ptr] = mem[ptr] + 1
elif c == '-':
if not mem.has_key(ptr):
mem[ptr] = 0
mem[ptr] = mem[ptr] - 1
elif c == '.':
if not mem.has_key(ptr):
mem[ptr] = 0
sys.stdout.write('%c' % mem[ptr])
elif c == ',':
mem[ptr] = input() # fixme
elif c == '[':
if mem[ptr] == 0:
tmp_l = []
pc = pc + 1
while (pg[pc] != ']') or tmp_l:
if pg[pc] == ']':
tmp_l.pop()
elif pg[pc] == '[':
tmp_l.append(pc)
pc = pc + 1
else:
labels.append(pc)
elif c == ']':
if mem[ptr] != 0:
pc = labels[-1]
else:
print "no reach"
pc = pc + 1
Pythonらしい書き方,というものはまだ全く分からないが,制御構造をなんとなく使える程度にはなったのかなぁ.
本日の酒
#<CHUNGA:CHUNKED-IO-STREAM {CAB3529}> fell through ETYPECASE expression.だそうだ.
Wanted one of (SB-KERNEL:ANSI-STREAM
SB-SIMPLE-STREAMS:SIMPLE-STREAM).
[Condition of type SB-KERNEL:CASE-FAILURE]
環境はSBCL1.0.23 drakma:http-requestで,送信後にストリームを読むとこでエラーが出てるっぽい.ストリームや文字コードについてのライブラリは自発的に使ったことがなかったので, drakmaでchungaとかflexi-streamsとかを使っていても何をしているのかがよくわからない. file-positionを呼んだときにETYPECASEうんぬんといわれるので,引数として渡しているストリームが悪いのかなぁとか浅知恵を巡らせてみるが,もともとhttp-requestを呼んでるだけだし,ほかの個所のhttp-requestはうまくいってる.自己解決できるスペックがほしいです.
デバッガ様のお告げ
#<CHUNGA:CHUNKED-IO-STREAM {E8A9A39}> fell through ETYPECASE expression.
Wanted one of (SB-KERNEL:ANSI-STREAM
SB-SIMPLE-STREAMS:SIMPLE-STREAM).
[Condition of type SB-KERNEL:CASE-FAILURE]" nil)
;;;引数の個数によって動作を変えるlambda
(defmacro olambda (&body body)
(let ((args (gensym "olambda-args")))
`(lambda (&rest ,args)
(case (length ,args)
,@(mapcar
#'(lambda (clause)
`(,(if (listp (car clause))
(length (car clause))
t)
(destructuring-bind ,(car clause)
,args
,@(cdr clause))))
body)))))
;;;引数すべての平均値を求める
>(defparameter avg
(olambda
(() 0) ;引数がなければ0を返す
((x) x) ;引数が1つならばそのまま返す
;;2つ以上引数があれば計算して返す
(args (/ (apply #'+ args) (length args)))))
>(funcall avg)
0
>(funcall avg 5)
5
>(funcall avg 1 2 3 4 5)
3
>(macroexpand-1
'(olambda
(() 0)
((x) x)
(args (/ (apply #'+ args) (length args)))))
(LAMBDA (&REST #:|olambda-args1425|)
(CASE (LENGTH #:|olambda-args1425|)
(0 (DESTRUCTURING-BIND () #:|olambda-args1425| 0))
(1 (DESTRUCTURING-BIND (X) #:|olambda-args1425| X))
(T
(DESTRUCTURING-BIND ARGS
#:|olambda-args1425|
(/ (APPLY #'+ ARGS) (LENGTH ARGS))))))
(defun dot-reader (stream ch1 ch2)
(declare (ignore ch1 ch2))
(cons
'progn
(merge-method-invokation-sexp
(convert-to-method-invokation
(mapcar
#'convert-to-dot-exp
(read-delimited-list #\] stream))))))
(defun convert-to-dot-exp (sexp)
(cond
((listp sexp)
(mapcar #'convert-to-dot-exp sexp))
((symbolp sexp)
(convert-symbol-to-dot-exp sexp))
(t sexp)))
(defun merge-method-invokation-sexp (sexp &optional prev)
(if (null sexp)
;;終端
(if prev (list prev) nil)
(let ((fst (car sexp)))
(if (listp fst)
(case (car fst)
(:method-invoke
(append
(if prev (list prev) nil)
(merge-method-invokation-sexp
(cdr sexp)
`(,(third fst)
,(second fst)
,@(nthcdr 3 fst)))))
(:dot
(merge-method-invokation-sexp
(cdr sexp)
`(,(second fst)
,prev
,@(nthcdr 2 fst)) ))
(t
(append
(if prev (list prev) nil)
(merge-method-invokation-sexp
(cdr sexp)
fst))))
(append
(if prev (list prev) nil)
(merge-method-invokation-sexp
(cdr sexp)
fst))))))
(defun convert-to-method-invokation (sexp)
(if (not (listp sexp)) sexp
(loop
:for rest = sexp then (if (and (listp o)
(or (eq (car o) :dot)
(eq (car o) :method-invoke)))
(cddr rest)
(cdr rest))
:for o = (car rest)
:while rest
:collect
(if (and (listp o)
(or (eq (car o) :dot)
(eq (car o) :method-invoke)))
(append o (second rest))
o))))
(defun convert-symbol-to-dot-exp (sym)
(let ((str (symbol-name sym)))
(let ((pos (position #\. str)))
(if (not pos)
sym
(if (= pos 0)
(list :dot
(convert-symbol-to-dot-exp
(intern (subseq str 1))))
(list
:method-invoke
(read-from-string (subseq str 0 pos))
(convert-symbol-to-dot-exp
(intern (subseq str (1+ pos))))))))))
(set-macro-character #\] (get-macro-character #\)))
(set-dispatch-macro-character #\# #\[ 'dot-reader)
>#[(loop :for i from 0 to 10 :collect i).elt(1)]
1
>#[(defparameter a #\0) a.char-code().+(9).code-char()]
#\9
;;リストにして返す
(chtml:parse #p"./hoge.html" (chtml:make-lhtml-builder))
;;DOMっぽいもの(CXML-STP)に利用できるオブジェクトを返す
(chtml:parse #p"./hoge.html" (stp:make-builder))
Desinatorというのは他のオブジェクトを表すオブジェクト.
funcall等の引数は関数ではなく関数を示すなにか,ということらしい.
(funcall 'car '(1 2 3))
として正しく動作するのは,シンボルCARが関数を示すDesinatorだから,ということでいいのかな.
英語をぱっと読めるようになれば,HyperSpecを巡るのも楽なんだろうなぁ.
(defun make-format-args (lst)
(let ((fmt-lst nil)
(args nil))
(dolist (obj lst)
(if (characterp obj)
(push
(cond
((char= obj #\~) "~~")
((char= obj #\\) "\\")
(T (string obj)))
fmt-lst)
(progn
(push "~A" fmt-lst)
(push (car obj) args))))
(append
(list (apply #'concatenate 'string (reverse fmt-lst)))
(reverse args))))
(defun emb-str (stream ch1 ch2)
(declare (ignore ch1 ch2))
(let ((str (read stream)))
(unless (stringp str) (error "object isn't string"))
(append '(format nil)
(make-format-args
(let ((*readtable* (copy-readtable)))
(set-macro-character #\} (get-macro-character #\)))
(with-input-from-string (in str)
(loop :while (listen in)
:for ch = (read-char in)
:collect (if (char= ch #\{)
(read-delimited-list #\} in)
ch))))))))
(set-dispatch-macro-character #\# #\! #'emb-str)
;;;test
>(defparameter hoge 3)
>#!"hoge={hoge}"
"hoge=3"
>'#!"hoge={hoge}"
(FORMAT NIL "hoge=~A" HOGE)
>#!"hoge * hoge = {(funcall #'(lambda (x) (* x x)) hoge)}"
"hoge * hoge = 9"