HaskellでBrainf*ck

このソースコード、気がつくとかくれんぼしちゃうので
消してしまう前にここに貼っ付けとく。

・hw.txt

>+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++[<++
++>-]<.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------.[-]>
++++++++[<++++>-]<+.

・bf.hs

import Char

data Command = Inc | Dec | Nxt | Prv | Put | Get | Whl [Command] deriving (Show, Eq)

parse :: String -> [Command]
parse []       = []
parse (']':cs) = []

parse ('[':cs) = Whl (parse cs) : parse ( rmWhl cs 0 )
  where
    rmWhl :: String -> Int -> String
    rmWhl (c:cs) nst
      | c == '[' = rmWhl cs (nst+1)
      | c == ']' = if nst==0 then cs
                             else rmWhl cs (nst-1)
      | otherwise = rmWhl cs nst

parse (c:cs)
  | c == '+'  = Inc : parse cs
  | c == '-'  = Dec : parse cs
  | c == '>'  = Nxt : parse cs
  | c == '<'  = Prv : parse cs
  | c == '.'  = Put : parse cs
  | c == ','  = Get : parse cs
  | otherwise =       parse cs

type Record = ( [Int], Int )
type State  = ( [Command], Record, [Char], [Char] )

get :: Record -> Int
get (tape, pnt) = tape !! pnt

put :: Record -> Int -> Record
put (tape, pnt) num = ((take pnt tape) ++ [num] ++ (drop (pnt+1) tape), pnt)

inc, dec, nxt, prv :: Record -> Record
inc rec         = put rec ((get rec)+1)
dec rec         = put rec ((get rec)-1)
nxt (tape, pnt) = (tape, pnt+1)
prv (tape, pnt) = (tape, pnt-1)

alteration :: (Record -> Record) -> State -> State
alteration f ( (c:cs), rec, input, output ) = eval ( cs, f rec, input, output)

eval :: State -> State
eval state@(    [], _, _, _ ) = state
eval state@( Inc:_, _, _, _ ) = alteration inc state
eval state@( Dec:_, _, _, _ ) = alteration dec state
eval state@( Nxt:_, _, _, _ ) = alteration nxt state
eval state@( Prv:_, _, _, _ ) = alteration prv state
eval       ( Put:cs, rec, input, output ) = eval ( cs, rec, input, output ++ [chr (get rec)] )
eval       ( Get:cs, rec,  i:is, output ) = eval ( cs, put rec (ord i), is, output )
eval state@( Whl cmds:cs, _, _, _) = evalCs $ pntChk $ evalCmds state
  where
    evalCs   ( _, w_rec, w_input, w_output) = eval (  cs, w_rec, w_input, w_output)  
    evalCmds ( _, w_rec, w_input, w_output) = eval (cmds, w_rec, w_input, w_output)
    
    pntChk w_state@( _, w_rec, _, _ ) = if (get w_rec) == 0
                                          then w_state
                                          else pntChk $ evalCmds w_state

brainfuck :: String -> String -> String
brainfuck source input = getOutput $ eval ( (parse source), ([0,0..], 0), input, "" )
  where
    getOutput ( _, _, _, output ) = output

main = do file <- readFile "hw.txt"
          print $ brainfuck file ""

コンパイル＆実行。
$ghc bf.hs -o bf
$./bf => "Hello World!"

やったね！

iolanguageでクイックソート

前回のタイトル(http://d.hatena.ne.jp/ottu/20100527/1274990348)にて
いくつかあった問題を力技で解決。

xが見つからないやらなんやら。
これは doString が Lobby 上で実行されていたのが原因っぽい。
Object の Slot として squareBrackets を定義してやったら
既存のslotがあった場合〜の問題も併せて解決。
でも他の問題で、結局ゴミみたいなコードに変わりは無かった。

とりあえずちょこちょこ書き直した squareBrackets と、
それを使ったクイックソートの実装。
あと使ってないけど試しで書いたzip関数。
以下ソースコード

//今回のキモ
Object squareBrackets := method(
    
    args   := call message arguments
    result := List clone    

    if( (args size >1) and (args at(1) code containsSeq(" in ")) ) then(
    
        obj    := Object clone do ( setSlot("temp", List clone) )

        eachLine   := ""
        filterLine := ""
        count      := 0

        args foreach( i, arg,

            if( i==0 ) then( continue )

            if( arg code containsSeq("in") ) then(

                items := arg code split("in")
                key   := items at(0) strip
                li    := items at(1) strip

                obj setSlot( key, Object clone )

                if( obj hasSlot(li) not ) then(
                    li = call sender doString(li) asString
                )

                eachLine = eachLine .. li .. " foreach( " .. key .. ", "
                count = count+1

            ) else (
                
                boolCode := arg code
                items := boolCode split(" ")

                if( items size > 1 ) then(
                    items foreach( item,
                        val := item between("(",")")
                        if( val == nil ) then( continue )
                        if( obj hasSlot(val) not ) then(
                            boolCode = boolCode asMutable replaceSeq( val, call sender doString(val) asString )
                        )
                    )
                )
                filterLine = filterLine .. "( " .. boolCode .. " ) ifFalse( continue ); "

            )
        )
        mapLine := "temp append( " .. args at(0) code .. " )"
        result = obj doString( eachLine .. filterLine .. mapLine .. ")" repeated(count) .. "; temp" )

    ) else (
        args foreach( arg, result append( call sender doString( arg code ) ) )
    )
    return result    
)

//Listの連結を見やすく
List + := method( content,
    self appendSeq( content )
)
//クイックソート
qsort := method( appendix,
    if( appendix == [] ) then (
        return []
    ) else (
        x := appendix removeAt(0)
        return qsort([y, y in appendix, y < x]) + [x] + qsort([y, y in appendix, y >= x])
    )    
)

qsort( [6,8,3,5,4,1,9,2,7] )
==> list(1, 2, 3, 4, 5, 6, 7, 8, 9)

//zip
zip := method(

    size := Number clone
    call message arguments foreach( list,
      if (size == 0) then (
        size = call sender doString(list code) size
      ) else (
        size = call sender doString(list code) size min(size)
      )
    )

    result := List clone
    for( i, 0, size-1,
      item := List clone
      call message arguments foreach( list,
        item append( call sender doString(list code) at(i) )
      )
      result append( item )    
    )

    return result
)

zip( [1,2,3], [4,5,6], [7,8,9] )
==> list(list(1, 4, 7), list(2, 5, 8), list(3, 6, 9))

前回書くの忘れたけど、変数命名のセンスの無さは目を瞑ってやってください…。

2010/06/05 修正
squareBrackets内の無駄っぽい所を修正。
内包表記内の一時変数を l,r から y に統一。

2010/7/29 修正
obj 変数の定義場所を少しずらした。

iolanguageでリスト内包表記

[*注意*]
このコードは古くなりました。
以下のタイトルまで移動をお願い致します。
http://d.hatena.ne.jp/ottu/20100601/1275342913

ロクに構文チェックなんてしてないけど、squareBracketsを使って
とりあえず「こう書けば動く」的な内包表記を書いてみた。
単純に call message arguments をパースして foreach なソース生成して doString してるだけ。

しかしそのdoString、Lobbyでしか実行できない。

Lobby doString("~~~") //ok

test := Object clone;
test doString("~~~") //ng!

x が見つからないやらなんやら。
でもエラー後に test println してみると
しっかり x がセットされているという…。

なので仕方無しに Lobby で doString してやってるんだけど、
Lobby に内包表記内で使う要素(Slot)が既にある場合、
上書きによって既存の値が失われるのを避ける為、
一旦別の場所に退避しておいて最後に元に戻す、という回りくどい事をしてます。
原因分かる方、いらっしゃいましたらこっそり教えてください。

以下ソースコード

squareBrackets := method(

    args   := call message arguments
    result := List clone

    if( (args size > 1) and (args at(1) code containsSeq(" in ")) ) then (
    
        eachLine   := "temp := List clone; "
        filterLine := ""
        count      := 0

        hasMap  := Map clone
        if( call sender hasSlot("temp") ) then( hasMap atPut( "temp", call sender getSlot("temp") ) )

        setList := List clone
        setList append("temp")

        args foreach( i, arg,
            if(i==0) then( continue )

            if( arg code containsSeq(" in ") ) then (
                items := arg code split("in")
                key   := items at(0) strip
                li    := items at(1) strip

                if( call sender hasSlot(key) ) then( hasMap atPut( key, call sender getSlot(key) ) )
                setList append( key )
                call sender removeSlot(key)

                if( call sender hasSlot(li) ) then (
                    eachLine = eachLine .. call sender getSlot(li) asString .. " foreach( " .. key .. ", "
                ) else (
                    eachLine = eachLine .. li .. " foreach( " .. key .. ", "
                )

                count = count+1
                
            ) else (
                filterLine = filterLine .. "if( not ".. arg code .. " ) then( continue ); "
            )
        )

        mapLine := "temp append( " .. args at(0) code .. " )"
        
        repeatCloseBracket := method( count,
            result := "";
            count repeat( result = result .. ")" )  
            return result
        )

        result = call sender doString( eachLine .. filterLine .. mapLine .. repeatCloseBracket(count) .. " temp" )

        setList foreach( key, call sender removeSlot( key ) )
        hasMap  foreach( key, value, call sender setSlot( key, value) ) 

    ) else (      
      args foreach(x, result append( call sender doString(x code) ) )
    )
    return result
)


//値の上書きを避けるテスト用
//x := "test1"
//y := "test2"
//temp := List clone


a := [ x*2 , x in list(1,2,3,4,5,6,7,8,9,10), x isOdd ]
b := [ x*2, x in list(1,2,3,4,5,6,7,8,9,10), x>5 ]
c := [1,2,3,4,5]
d := [ x*3, x in c, x isOdd ]


e := [ x+y, x in [1,2,3,4,5], y in [6,7,8,9,10], x isOdd, y isEven ]
e_ := [ x+y, x in [1,2,3,4,5], x isOdd, y in [6,7,8,9,10], y isEven ]
e println
e_ println

/* 以下と同様
result := List clone
[1,2,3,4,5] foreach( x,
    [6,7,8,9,10] foreach( y,
        if( not x isOdd ) then( continue )
        if( not y isEven ) then( continue )
        result append( x+y )
    )
)
result println 
*/


f := [ [x,y], x in [ [1,2], [3,4], [5,6], [7,8], [9,10] ] , y in x, y isEven ]
f println

/* 以下と同様
result := List clone;
[ [1,2], [3,4], [5,6], [7,8], [9,10] ] foreach( x,
    x foreach( y,
        if( not y isEven ) then( continue )
        result append( [x,y] )
    )
)
result println
*/

しかしこれ、filterメソッドが全てforeach群の一番内側で実行される為
無駄にループを実行しなきゃならない。
filterメソッドに "hoge(x)" とか渡された時、"x" を上手くパースする方法がピンと来ないので
どの要素に対してのselectなのか判別出来ない…
これも誰か良いアイデアをお持ちでしたらこっそり教えてください…。

Arch + PT2 で地デジ視聴。

偶然PT2が手に入ったので、使ってみた。
見れるようになるまでの作業をかなーりざっくりと書いておく。

まずPT2をPCIに差し込む。
自分のM/BのPCIが3.3Vに対応してるかどうかは各々で確認を。

$lspci に「Multimedia controller: Xilinx Corporation Device 222a (rev 01)」
なるものが出てたらOK。

ここでいくつかAURにpackageがあるライブラリをインストールするが
PKGBUILDの使い方分からんので普通に入れる。
(prefixは全てデフォルトの/usr/localで)
AUR使い方知ってる場合は各々入れてください。
(2010/04/04 現在)

https://alioth.debian.org/projects/pcsclite から
　pcsc-lite-1.5.5.tar.bz2 と
　ccid-1.3.11.tar.bz2 を取ってくる。

pcscliteを入れる
$tar -jxvf pcsc-lite-1.5.5.tar.bz2
$cd pcsc-lite-1.5.5
$./configure
$make
$sudo make install

http://aur.archlinux.org/packages/pcsclite/pcsclite/ から
　pcscd スクリプトを取ってくる。

pcscd スクリプトを編集する。
　#!/bin/bash を１行目に追加する。
　DAEMONのパスを自分の環境(/usr/local/sbin/pcscd)に合わせて修正する。
$chmod a+x pcscd
$sudo mv pcscd /etc/rc.d

/etc/rc.conf のDAEMONにpcscdを追加する。

.xinitrc 辺りで pkg-config に PATH を追加する
export PKG_CONFIG_PATH=$PKG_CONFIG_PATH:/usr/local/lib/pkgconfig

ついでに /usr/local/bin とかにPATH通ってない人は一緒にどうですかね
export PATH=$PATH:/usr/local/bin:/usr/local/sbin

ccidを入れる
$tar -jxvf ccid-1.3.11.tar.bz2
$cd ccid-1.3.11
$./configure
$make
$sudo make install

http://ludovic.rousseau.free.fr/softwares/pcsc-tools/ から
pcsc-tools-1.4.16.tar を取ってくる

pcsc-toolsを入れる
$tar -zxvf pcsc-tools-1.4.16.tar.gz
$cd pcsc-tools-1.4.16
$make
$sudo make install

ICカードリーダーを接続して再起動。
（僕は各所で動作報告されてる SCR3310-NTTCom を使ってます）
$pcsc_scan
で
　Compiled with PC/SC lite version: 1.5.5
　Scanning present readers...
　0: SCM SCR 3310 NTTCom [Vendor Interface] 00 00
っぽいのが出力されればOK。
そしたらB-CASカードを挿入しておく。
B-CASは裏面を上にして差し込むように。

kernel-headersを入れる。
(versionは自分の環境に合わせてね)
$sudo pacman -S kernel26-headers

PT2のドライバ/録画コマンドを入れる
http://hg.honeyplanet.jp/pt1 から
　最新.bz2 と
　b25のSource入り.bz2(good citizens never use gray code...の１つ前) を取ってくる。

b25を入れる
$tar -jxvf pt1-c44e16dbb0e2.tar.bz2　←b25入り.bz2
$cd pt1-c44e16dbb0e2/arib25
$make
$sudo make install

Driverを入れる
$tar -jxvf pt1-38a793ac3d9d.tar.bz2　←最近.bz2
$cd pt1-38a793ac3d9d/driver
$make
$sudo make install

録画コマンドを入れる
$cd pt1-38a793ac3d9d/recpt1
$./autogen.sh
$./configure --enable-b25
$make
$sudo make install

/lib/modules/2.6.32-ARCH/kernel/drivers/video/pt1_drv.ko
が入ってればOK、再起動。

$lsmod | grep pt1 で
pt1_drv 19975 0

$ls -al /dev/*pt1* で
　crw-rw-rw- 1 root video 251, 0 2010-04-04 04:31 /dev/pt1video0
　crw-rw-rw- 1 root video 251, 1 2010-04-04 04:31 /dev/pt1video1
　crw-rw-rw- 1 root video 251, 2 2010-04-04 04:31 /dev/pt1video2
　crw-rw-rw- 1 root video 251, 3 2010-04-04 04:31 /dev/pt1video3
こんな感じのが出力されてればOKでしょう。

後は実際に視聴してみる。

destファイルに吐き出して、それを再生。
$recpt1 --b25 --strip 15 - dest.ts &
$mplayer dest.ts

UDPストリームを使う
$recpt1 --b25 --strip --udp --addr localhost 15 - &
$mplayer udp://localhost:1234

やったー地デジ見れたよー。

2010/04/16 追記
ICカードリーダーの事書いてなかった。

xfceの「ここで Terminal を開く」を自分好みに

「ここで Terminal を開く」でscreenを開きたかったので色々調べた。
ちょっと躓いたのでメモっておく。

まず最初に結論。
「ここで Screen を開く」アクションを追加するには
Thunarの メニュー -> 編集 -> アクションの設定　を開き
コマンド："exo-open --working-directory %f --launch TerminalEmulator screen"
というアクションを追加してやれば良い。

以下試行錯誤。

とりあえずscreenを指定したディレクトリで開く方法を・・・と思ったのだが、
chdirを使う所までは判っても、
screenrcでオプション($1に匹敵するもの)を受け取る方法が判らず断念。

ならば仕方ないって事で、cdしてからscreen実行してやるスクリプトを準備するも
これが後々必要ないモノだと気が付く。

次にThunarの設定。
メニューから 編集 -> アクションの設定 を選ぶと、
右クリック時のアクションを拡張できる事が判る。

じゃあここに上記のスクリプト動かすアクション追加すれば良いのか！と思って
素直に コマンド:".../hoge.sh %f*1" と設定したら・・・開かない。
これは単に、screenを表示する為のコンソールが開かれていないのが原因。

という事で、未知の存在 exo-open とやらを調べる。
「ここで Terminal を開く」アクションがとても参考になった。(だってそれカスタムアクションの例だもん
"--working-directory" にディレクトリを指定すれば、そこが初期ディレクトリになる。
"--launch TerminalEmulator " に起動したいshellを指定する。*2 *3

これで素のterminalを使う機会がますます減った。
良い事だ…？

*1:%fには「ここで…」の"ここ"が入る

*2:myshellを指定しない場合、環境で標準使用になってるshellが起動する。

*3:--launch には TerminalEmulator の他にも WebBrowser/MailReader などのカテゴリが指定出来るらしい

iolanguageを/usr/local以外にインストール

アドオンが動いたのを確認した程度なので、不具合が出るかもしれませんが
一応簡単なメモでも。

修正する箇所が少ないので、Makefileを直接修正します。

INSTALL_PREFIX ?= /インストール/したい/ディレクトリ
...
DLL_COMMAND := -shared -Wl,-soname="/インストール/したい/ディレクトリ/lib/libiovmall.so"

↑の２行を修正したら、make; make install.
後はio動かして、NullAddonでもUserでも簡単なアドオンが動けば大丈夫でしょう。

2010/05/18 *追記*
久しぶりにやったら↑じゃ動かなかったので書き直し。

    ...
26: #DLL_COMMAND := -shared -Wl,-soname="libiovmall.so" <- コメントアウトする
27: DLL_COMMAND := -shared -Wl,-soname="/インストール/したい/ディレクトリ/lib/libiovmall.so" <-コメントアウト外す
    ...

上記のコメントを修正したら
$ make INSTALL_PREFIX=/hoge
$ make install INSTALL_PREFIX=/hoge
でインストール。これで外部ライブラリに影響されないアドオンは動くはず。
(UserとかRangeとか)

ここで注意しておかなきゃならないのは、アンインストール時にも
$ make uninstall INSTALL_PREFIX=/hoge
と、INSTALL_PREFIXを指定してやらなければならない事。

ちなみに未だSGMLは /use/local に決め打ちでインストールされてしまうので、
make する時には実行中の権限には気をつけて。
対処方法は↓で。

2010/01/02 *追記*
あけましておめでとうございます。
今年も何卒よろしくお願い致します。

さて↑の状態で大丈夫だろうと思っていたら、SGMLアドオン辺りが使えなかったりした。
libsgmlのmakefile.inが酷い。
configure && make したものを /usr/local に決め打ちでインストールするようです。
僕は早々に心が折れたので、インストール後に手動でlibsgml関係の移動をしました。

$ mv /usr/local/include/sgml /インストール/したい/ディレクトリ/include
$ mv /usr/local/lib/libsgml.* /インストール/したい/ディレクトリ/lib

あとldからlibsgml.soを呼べるようにしないといけないので、

$ cat >> runio.sh << EOF
>#!/bin/bash
>export LD_LIBRARY_PATH="/インストール/したい/ディレクトリ/lib"
>/インストール/したい/ディレクトリ/bin/io $1
>EOF

みたいなスクリプト作って、これにioのソース渡して動かすようにしてます。

Twitterでパッチ書いてくれた方がいるのですが、
僕が公開するのも変な話ですので、気になる方は自分宛に連絡ください。

wxGTKでOpenGLを使う。

使用するwxGTKは2.8.10。

とりあえず修正しないとmakeが通らないので、
こちらを参考にさせて頂きながら、該当場所を修正。
（ちなみにOpenGLとは全く関係無い所。）

#include "wx/wxprec.h"

#if wxUSE_SOCKETS

#include <assert.h>
#include <stdlib.h>
#include <stdio.h>

#define GSocket GlibGSocket // <- insert
#include <gdk/gdk.h>
#include <glib.h>
#undef GSocket              // -< insert

#include "wx/gsocket.h"
#include "wx/unix/gsockunx.h"

修正が終わったら、

• ./configure --with-opengl
• make
• cd samples
• make

で、samples以下のサンプルが動くようになる。