Emacsの設定(プログラミング)

.emacsを晒す(その２)

プログラミング関係の設定。

;;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の設定あたりが消え去ったらやる気が著しく削がれるのは間違いないのでメモメモ。

Gray Streamを使う

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)

バイナリデータを読み込む(CL)

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"

3冊読了(2009/11/20)

最近読み終わった本．

• 老ヴォールの惑星

  著者

  小川一水(おがわ いっすい)

  発行元

  ハヤカワ文庫(早川書房)

  分類

  SF短編集

  感想

  SFはやはり良いものですね．4編の中では，表題の老ヴォールの惑星が好みだった．

• 五分後の世界

  著者

  村上龍(むらかみ りゅう)

  発行元

  幻冬舎文庫(株式会社幻冬舎)

  分類

  中年のおっさん，パラレルワールドで生きる

  感想

  おもしろかった．

  印象に残ったセリフ 「それらを略語で呼ぶようになって，それに慣れてしまうと，本来の意味が失われることがある (中略) O・Jが何かわかるか?」 -> 「オレンジジュースのことだ」

• 機械どもの荒野

  著者

  森岡浩之(もりおか ひろゆき)

  発行元

  ハヤカワ文庫(早川書房)

  分類

  機械vs人間なSF.

  感想

  森岡さん・・・星界の戦旗Vはまだですか・・・

GCCでマシンイプシロンを求めたいとき

C言語(GCC)でマシンイプシロンを求めたいとき、 floatとdoubleで同じ値が表示されるというわけの分からない状態になったのを目撃した。

x86系CPUの浮動小数点演算用レジスタはなぜか80bitなので、わけわからないことになるのかもしれない。

GCCのコンパイラオプション-ffloat-storeをつけてコンパイルすることでうまくいった。

マルコフ連鎖をCommonLisp+MeCabで

バイト中にエントリーシート(の自己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)))

さて、問題はサンプルをどこから持ってくるか、だ。

SBCLでCPUID

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+"

Google GoでFizzBuzz

新しい言語に触れるときは,ループや条件分岐が必要なので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型を作って呼び出すようにした。

GoogleのGoで正規表現(regexpパッケージ)

昨日インストールした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

もうすこしまともにチュートリアルを読んでから書くべきか・・・

Googleのプログラミング言語Goをインストールした

巷で噂の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")
	}

酒の瓶に書かれたPROOFってなにさ

本日の酒はアブソルートウォッカ。

グラスに酒を注いでいるとき、瓶に(40 PROOF) と書いてあったが、何のことかわからなかったので少し調べてみた。

英和辞書に、proof=酒類の標準強度という項目があったが、それだけじゃよくわからない。

Google樣に頼ると、どうも

アルコール度数 = 標準強度/2

という関係がなりたっているらしい。

国によっては度数じゃなくてproofで酒の強さを話すのがメジャーなんだろうか。

ちなみに、アブソルートウォッカの原産国はスウェーデン。作っていたのは国有企業だったが、今はフランスの企業に買収されているらしい。

mtools

フロッピーのイメージをマウントして、そこにファイルをコピーして、アンマウントする、という作業がとてもめんどくさい。

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として扱えるようだ。

C++のスタートアップ(C++でカーネルコードを書きたい)

以前適当に解決しようとした問題を調べた。といってもwiki.osdev.orgのC++の項目を読んだだけ。英語の読解力がろくに無いので間違えて理解したかもしれない。

ようは、OSというパトロンがいなくなったC++さんが路頭に迷わないための手引き。

以下自分の理解をまとめる。osdev.orgにはサンプルコードまで載っていて素敵です。

デフォルトのスタートアップコードを利用しない

デフォルトでは、G++はmainが呼び出される前に実行されるコードや、mainがreturnした後に呼ばれるコードをリンクしようとする。

なので、無効にするために-nostartfilesオプションをつける。

new/delete

必要な処理を無効にしてしまった以上は、自前で実装しなければならない。とりあえず、global/staticなオブジェクトのコンストラクタ、デストラクタを呼び出すコードを追加すればよい。

コンストラクタ、デストラクタではnew/delete(new[]/delete[]も)が必要なので、これらも実装しなければならないが、その際にメモリマネジメントの機能が必要になる。特定のアドレスにオブジェクトを作るplacement newというテクニックもあるらしい。

mainの前後

GCC(G++)はctors、dtorsというセクションにそれぞれ、 global/staticオブジェクトのコンストラクタ、デストラクタを登録する。

C++のコードにジャンプする前後にこれらのセクションの内容を処理する。セクションの境界を知るためにリンカスクリプトを書く。

__cxa_atexitは、__cxa_finalizeで呼ばれる,オブジェクトや共有リソースを破棄する時のハンドルを登録する。

C++のカーネルコードが終了したら__cxa_finalize(0)を呼ぶべき。 dctorの処理と__cxa_finalize(0)の呼び出しは両方するべきなのだろうか。まぁ、終了時の事はあまり気にしなくても動くので良いか。

__dso_handleはさようならするオブジェクトがDynamic Shared Objectかどうか判別する？

純粋仮想関数(pure virtual function)

純粋仮想関数がオーバライドされていないのに呼びだされる(?)ときのための関数を用意する。

どこかの.cpp内に、__cxa_pure_virtualという関数を作る。なお、__cxa_pure_virtualにはextern "C"でC言語のリンケージを指定する。

Local static variables

GCCはローカルなスタティック変数のコンストラクタの前後に、複数スレッドから同時に呼び出されないように保護するコードを挿入するらしい。

いままで気にした事が無いシンボル名が出てきたので、他のどこかのオプションで無効になってるのではなかろうか。標準ライブラリを無効にするところだろうか。

標準ライブラリ

無効にするために-nostdlibオプションをつける。

実行時型情報

無効にするために-fno-tffiオプションをつける。

例外

無効にするために-fno-exceptionsオプションをつける。

Shibuya.lisp TT#4

昨日(2009/11/7)はShibuya.lisp TT#4に参加していた。

TT#3に続いて2度目の参加だったけど、相変わらず発表も周囲の人もレベルが高すぎて、自分なんかが話を聞いててよいのだろうかと思うことしばしば。

ふと、自分がLisperの底辺なら、自分が頑張ることによって Lispを使う人の最低ラインが上昇するんじゃないかと思ったので、もう少しまともに学ぼうという気持ちがわいてきた。

この気持ちが持続すれば問題はないんですけどね。

ともあれ、とても楽しい半日でした。運営、発表の方々には深く感謝。

次回も参加したいので、申し込み開始時にはモニタ前で正座して待機することにしよう。

zpb-ttfを用いて文字を表示する(cl-glfw)

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+ あたりにかえて書けば良さそうだけど、ベクトルを忘れ去っている似非理系なのでまずは数学のお勉強から始めなければならないみたいだ。

続cl-yacc

どうしようか迷ったけど、いいや貼り付けてしまえ。

とりあえず、文法をうまくかけるかどうか、ということが問題。

自分の脳みそではあんまり考えられないけど、何かの文法をパクっても、どうせ途中でオレオレルールになるだろうから、試行錯誤しながら書いてみる。

(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))))))

スキルが無かろうと、ひたすら適当な文法をつづれば、一応動く。素晴らしい。

相模灘(日本酒)購入(2009/11/01)

伊勢原市の中屋という酒屋(小田急伊勢原駅から徒歩15分程度)で、前々から買おうと思っていた相模灘という日本酒を購入した。

• 相模灘 純米吟醸 雄町 (久保田酒造/神奈川)
• 相模灘 特別本醸造 (久保田酒造/神奈川)

同じ銘柄ばかり買おうとする自分に、店の方が話しかけてくださった。こんな若造にわざわざ付き合っていただいて感謝です。

神奈川には日本酒のイメージがあまり無いような気がするから, 県内でおいしい地酒が作られていてうれしい。

そんなことを思いつつ、今日は雄町の方を飲んでみる神奈川県民なのでした。

C++で書いたコードをGRUBから起動したい

GRUBから起動するコードをCで書いていたが、ろくに触ったことのないC++に書き換えてみることにした。

OSの力が借りられない(と思う)ので、コンパイルが通らなかったり、リンクできなかったりと大変だったので、とりあえずの解決へいたった道筋をメモしておく。

一応動くようになった、というレベルでしかないので、間違ったことをしているかもしれないし、勝手に思い込んでるだけという可能性も高い。

環境はVM上のUbuntu8.04。 GCC4.2.4(G++)でオブジェクトファイルにコンパイル -> ldでリンクという流れ。

• staticメンバへの参照を解決できない
  • staticメンバはクラス定義の外部に実態を作らないといけない
• eh_frameというセクションから何かの関数への参照を解決できない
  • eh_frameは例外処理関係のコードが入ってるらしい。
  • コンパイルオプションに-fno-exceptionsをつけると例外処理を無効にできる
• 関数static_initialization_and_destructionからcxa_atexitとdso_handleに対する参照が解決できない
  • static_init(ry はnew以外で静的に用意したオブジェクトの初期化と後処理のための関数?
  • cxa_atexitで終了時に動作するデストラクタを登録している?
    • ダミーのcxa_atexitをリンクさせて無理やり解決
  • dso_handleはよくわからない。Dynamic Shared Object関係?
    • libgcc.aからarコマンドでdso_handle.oを抜き出してリンク。とりあえず動く。
• new演算子への参照が(ry
  • new演算子関数というものを定義すれば良いらしい
  • new演算子関数はオブジェクトのためのメモリ確保を行う
  • オブジェクトのサイズを引数として呼ばれ、確保したメモリのアドレスを返す
  • new演算子関数が返したアドレスをthisとしてコンストラクタが呼ばれる


• アセンブラの関数への参照が(ry
  • extern "C" としなければいけないらしい

割と問題が山積みな気もするけど、一応動くとこまで持っていけるということで手打ちにする。

cl-yaccでCライクなコードを読む

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)にされてしまうという困った状態になった。

この調子だと明日もこのネタで遊んでそう。