新言語 neko mimi Fu**♥をHaskellで実装してみた(私じゃないです)

neko mimi mode.の歌詞でコーディングするBrainFuckの方バリエーションが
http://www.aichi-pu.ac.jp/ist/~ohkubo/sb/log/eid3.html
↑で紹介されていたので、先輩に教えたところ帰る前にHaskellで実装を済ませていたという話。

↓こいつをコンパイルして、bf.exeを作って

import Data.Char
import Data.List
import System
import System.IO

main = do
	as <- getArgs
	if length as >= 1
		then
			do
				cmd <- readFile "command.list"
				src <- readFile (as!!0)
				bfstart (lines cmd) src
		else
			putStr "usage:\n\tbf [sourcefilepath]\n\t.\\command.list ... command definition file."

-- '>' Greater Then --
gt = 0
-- '<' Less Then --
lt = 1
-- '+' PLus sign --
pl = 2
-- '-' MInus sign --
mi = 3
-- '.' PEriod --
pe = 4
-- ',' COmma --
co = 5
-- '[' Left Bracket --
lb = 6
-- ']' Right Bracket --
rb = 7


bfstart :: [String] -> String -> IO ()
bfstart= \ cmds code -> bf (normalize cmds code) 0 iniMem 0
	where
		-- initialized memory --
		iniMem = 0:iniMem

-- brainfuck core --
bf :: [Int] -> Int -> [Int] -> Int -> IO ()
bf code cp memory mp
	-- end of code --
	|length code <= cp = return ()

	-- '>' --
	|get code cp == gt = bf code (inc cp) memory (inc mp)

	-- '<' --
	|get code cp == lt = bf code (inc cp) memory (dec mp)

	-- '+' --
	|get code cp == pl = bf code (inc cp) (dataInc memory mp) mp

	-- '-' --
	|get code cp == mi = bf code (inc cp) (dataDec memory mp) mp

	-- '.' --
	|get code cp == pe =
		do
			putChar $ chr $ get memory mp
			bf code (inc cp) memory mp

	-- ',' --
	|get code cp == co =
		do
			c <- hGetChar stdin
			bf code (inc cp) (put memory mp $ ord c) mp

	-- '[' && mem == 0 --
	|get code cp == lb && get memory mp == 0 = bf code (next code $ inc cp) memory mp

	-- ']' && mem /= 0 --
	|get code cp == rb && get memory mp /= 0 = bf code (prev code $ dec cp) memory mp

	-- other characters --
	|otherwise = bf code (inc cp) memory mp

	where

		get :: [a] -> Int -> a
		get = (!!)

		put :: [a] -> Int -> a -> [a]
		put xs p y = take p xs ++ y : drop (inc p) xs

		inc :: Int -> Int
		inc = (+1)

		dec :: Int -> Int
		dec = \ n -> n - 1

		dataInc :: [Int] -> Int -> [Int]
		dataInc = \ d p -> put d p $ inc $ get d p

		dataDec :: [Int] -> Int -> [Int]
		dataDec = \ d p -> put d p $ dec $ get d p

		next :: [Int] -> Int -> Int
		next ns p
			| get ns p == rb = p
			| get ns p == lb = next ns $ inc $ next ns $ inc p
			| otherwise      = next ns $ inc p

		prev :: [Int] -> Int -> Int
		prev ns p
			| get ns p == lb = p
			| get ns p == rb = prev ns $ dec $ prev ns $ dec p
			| otherwise      = prev ns $ dec p

-- normalize --
normalize :: [String] -> String -> [Int]
normalize cmds cs
	|cs == [] = []
	|isPrefixOf (cmds !! gt) cs = gt:(normalize cmds $ drop (length $ cmds !! gt) cs)
	|isPrefixOf (cmds !! lt) cs = lt:(normalize cmds $ drop (length $ cmds !! lt) cs)
	|isPrefixOf (cmds !! pl) cs = pl:(normalize cmds $ drop (length $ cmds !! pl) cs)
	|isPrefixOf (cmds !! mi) cs = mi:(normalize cmds $ drop (length $ cmds !! mi) cs)
	|isPrefixOf (cmds !! pe) cs = pe:(normalize cmds $ drop (length $ cmds !! pe) cs)
	|isPrefixOf (cmds !! co) cs = co:(normalize cmds $ drop (length $ cmds !! co) cs)
	|isPrefixOf (cmds !! lb) cs = lb:(normalize cmds $ drop (length $ cmds !! lb) cs)
	|isPrefixOf (cmds !! rb) cs = rb:(normalize cmds $ drop (length $ cmds !! rb) cs)
	|otherwise                  = normalize cmds $ tail cs

同じディレクトリに↓のcommand.listを置く

ネコミミ！
ネコミミモード
おにいさま
私のしもべー
や・く・そ・く・よ
フルフルフルムーン
キスキス…
キス…したくなっちゃった…

neko mimi Fu**♥のソースファイル名を第一引数として、
bf.exeを実行すればおｋ。

bf hello.bf

…確認のしようもないな。

確認できました。バンザーイ。
command.listさえ差し替えれば、本家BrainFuckも含めていくらでもバリエーションを作れます。

2007/10/16追記

無駄が多かったので直したとのことなので、
掲載したソースを差し替えておきました。