スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

プログラミング言語作ってみました

ふと思いついてプログラミング言語作ってみました。
開発開始から5時間程度で作ってみました。
ねたのつもりで作ったので、エラー処理は考えてないです。

一応分岐とループは仕様に入っているので、
プログラミング言語の体裁はなしているはず。


データ構造はレジスタA,Bの二種
とスタックです。

プログラムが終了するときスタックの値を上から順に標準出力に出すので、
出力したいデータをスタックに詰め込んでおけばOKというなんてお得な仕様です。

命令文は以下の9種
+-$%&@?[]です。

それぞれの意味は
+ :後に続く数値をレジスタAに加える
- :後に続く数値をレジスタAから減らす
$ :レジスタAとBの値を入れ替える。
% :レジスタAの値をスタックに入れる(レジスタAの値はそのまま)
& :スタックの値を取り出しレジスタAに入れる
@ :レジスタAの値を標準出力する
? :標準入力から一文字読み込みレジスタAに入れる
[ :レジスタの値が A=>Bになっている時対応する]までジャンプする
] :レジスタの値が A=>Bになっている時対応する[までジャンプする

以下は、おなじみのHelloWorldと表示するサンプルです。

+100%+8%+6%-3%-24%+24%-3%%-7%-29%


{-# Language FlexibleContexts #-}
import Data.List
import Data.Char
import Control.Monad.State
import qualified Text.Parsec as P
import qualified Text.Parsec.Char as P
import qualified Text.ParserCombinators.Parsec.Token as P
data Memory = Memory {a::Int, b::Int,stack::[Int]}
deriving Show

initMemory = Memory{a=0,b=0,stack=[]}

data Node = Swap | Push | Pop | Add Int | Sub Int | Put | Get | Branch [Node]
deriving (Show,Eq)


swap :: Memory -> Memory
swap m@(Memory{a=a,b=b}) = m{a=b,b=a}

push :: Memory -> Memory
push m@(Memory{a=a,stack=s}) = m{stack=a:s}

pop :: Memory -> Memory
pop m@(Memory{stack=(s:ss)}) = m{a=s,stack=ss}

add :: Memory -> Int -> Memory
add m@(Memory{a=a}) n = m{a=a+n}

sub :: Memory -> Int -> Memory
sub m@(Memory{a=a}) n = m{a=a-n}

branch :: Memory -> Bool
branch m@(Memory{a=a,b=b}) = if a < b then True else False

swapM ns = do {m <-get;put (swap m); return ns}
pushM ns = do{m<-get; put (push m);return ns}

putM ns = do{m<-get;liftIO (putStr.show$ a m);put m ;return ns}
getM ns = do{m<-get; c <-liftIO(getChar);put m{a=(ord c)};return ns}

runMT :: (MonadIO m, MonadState Memory m) => [Node] -> m [Node]
runMT [] = return []
runMT (n:ns)
| n == Swap = swapM ns >>= runMT
| n == Push = pushM ns >>= runMT
| n == Put = putM ns >>= runMT
| n == Get = getM ns >>= runMT

runMT ((Add a):ns) = do{m <-get;put( add m a);return ns} >>= runMT
runMT ((Sub a):ns) = do{m <-get;put( sub m a);return ns} >>= runMT
runMT ((Branch ns):ms) =do
{
m <- get;
if branch m then
runMT' ns
else
runMT ms
}

runMT' ns =do{
runMT ns;
m <- get;
if branch m then
runMT' ns
else
return ns
}

runIO nods = do {
st <- runStateT (return nods >>= runMT) initMemory;
return $showMemory $ snd st
}


showMemory :: Memory -> String
showMemory Memory{stack=s} = map chr s

swapP :: P.Stream s m Char => P.ParsecT s u m Node
swapP = do{P.try ( P.string "$"); return Swap}

pushP :: P.Stream s m Char => P.ParsecT s u m Node
pushP = do {P.try(P.string "%");return Push}

popP :: P.Stream s m Char => P.ParsecT s u m Node
popP = do {P.try(P.string "&");return Pop}

addP :: P.Stream s m Char => P.ParsecT s u m Node
addP = do {
P.try(P.string "+");
cs <- P.many1 P.digit;
return $ Add (read cs :: Int)
}

subP :: P.Stream s m Char => P.ParsecT s u m Node
subP = do {
P.try(P.string "-");
cs <- P.many1 P.digit;
return $ Sub (read cs:: Int)
}
putP :: P.Stream s m Char => P.ParsecT s u m Node
putP = do {
P.try(P.string "@");
return $ Put
}
getP :: P.Stream s m Char => P.ParsecT s u m Node
getP = do {
P.try(P.string "?");
return $ Get
}

branchP :: P.Stream s m Char => P.ParsecT s u m Node
branchP = P.between (P.char '[') (P.char ']') nodesP >>= (\x -> return $ Branch x)


nodeP :: P.Stream s m Char => P.ParsecT s u m Node
nodeP = P.choice [swapP,pushP,popP,addP,subP,branchP,putP,getP]

nodesP :: P.Stream s m Char => P.ParsecT s u m [Node]
nodesP = P.many1 nodeP


parse ss = parse'$ parse'' ss

parse' (Right s) = s
parse' (Left x) = error "parse error"

parse'' ss = P.parse nodesP "" ss

runsIO ss = runIO $ parse ss

main ::IO()
main = getLine >>= runsIO >>= putStr
スポンサーサイト

テーマ : プログラミング
ジャンル : コンピュータ

【Haskell】マンデルブロ集合

haskellで画像ファイルを作成したいなとふと思い立ったので、マンデルブロ集合を作成するプログラムをしました。
ビットマップを扱うライブラリは公開されてると思ったので調べてcabal を使ってダウンロード&インストール
発散するかどうかのチェックは|z|>2,発散速度は|z|>2になるまでの計算の繰り返し回数です。
とりあえず作ってみたので高速化なんて全然考えてないですが、それなりに1000*1000px程度を
一分程度の速度で描けたのでまあまあかな。
作ってて気になったのがHaskellってワンライナーで書きやすいので、横に長くなっちゃうstyleで
書いてしまって、後で型エラーとかで困ることが多多ありました。

拡張をかんがえると、
1:色の指定を外部ファイルから与えること
2:発散しない場合でも何かしらの色を付ける方法を考える
3:ライブラリ化

といったところですかね。
あ、あと高速化。



{-
-マンデルブロ集合描写プログラム
- 2012/12/22 作成
- author: t.k.
- version: 0.1.0
-}
import Codec.BMP
import Numeric
import qualified Data.ByteString as B
import GHC.Word
import Data.Complex
import Control.Monad.List
import System.IO
import System.Environment



-- 計算範囲 [(x.y) | x <- [x1..x2], y <- [y1..y2]]
--とするとき
--引数 x1 -> x2 -> y1 -> y2 -> width -> outputFilePath -> IO()
--
main :: IO()
main = do arg <- getArgs
let l = read (arg !! 0)
let r = read (arg !! 1)
let b = read (arg !! 2)
let t = read (arg !! 3)
let w = read (arg !! 4)
let f = arg !! 5
drowMandibrot2 (l,t) (r,b) w f


-- [[(R,G,B)]] の配列からビットマップのByteStringに変換する
rgbToByteList:: [[(Word8,Word8,Word8)]] -> B.ByteString
rgbToByteList = B.pack . concat . map rgbToByteList'
where rgbToByteList' = concatMap (\(r,g,b) -> [ r, g,b,0])
----------------------------------------------------------------------
{-
- マンディブロ集合
-}

-- マンデルブロ集合漸化式
mandibrotFunc :: (Num a) => a -> a -> a
mandibrotFunc c z = z*z + c


-- zの計算回数
count :: Int
count = 200

-- マンデルブロ集合の発散速度[1..count]からRGBの値を得る
-- 発散速度 -> RGB
toPixcel :: Int -> (Word8,Word8,Word8)
toPixcel z
| z == 0 = (0,0,0)
| count - z > 60 = (255,241,0)
| count - z > 30 = (00,30,68)
| count - z > 25 = (99,22,60)
| count - z > 20 = (125,100,120)
| count - z > 15 = (80,90,100)
| count - z > 8 = (125,180,120)
| count - z > 3 = (120,220,225)
| otherwise = (255,255,255)
{-
| z == 0 = (0,0,0)
| z < 10 = (30,30,30)
| z < 20 = (60,60,60)
| z < 40 = (120,120,120)
| z < 80 = (150,150,150)
| z < 90 = (180,180,180)
| otherwise = (255,255,255)
-}

-- マンデルブロ集合描写関数(最初に作ったのが使いにくインターフェースだったため改良)
-- (left,top) -> (right,bottom) -> width -> FilePath -> IO()
drowMandibrot2 :: (Double ,Double) -> (Double,Double) -> Int -> FilePath -> IO()
drowMandibrot2 (left,top) (right,bottom) w file = drowMandibrot (left,bottom) (w,h) dt file
where
dt = (right - left ) / (fromIntegral w)
h = truncate $ (top - bottom) / dt

-- マンデルブロ描写関数
-- 引数 (top,left) -> (width,heigth) -> dt -> FilePath -> IO()
drowMandibrot :: (Double ,Double) -> (Int,Int) -> Double -> FilePath -> IO()
drowMandibrot point size@(w,h) dt file = writeBMP file $ packRGBA32ToBMP w h $ rgbToByteList $! mandibrot point size dt


-- 複素平面上のマンデルブロ集合の発散速度を計算しRGBのリストを返す
mandibrot :: (Double ,Double) -> (Int,Int) -> Double -> [[(Word8,Word8,Word8)]]
mandibrot (left,top) (w,h) dt = map (map (toPixcel . calc ) ) $ numberList left top w h dt
where
-- マンデルブロ集合の発散速度を計算する
-- 引数 発散速度を計算する複素平面上の点 -> 発散速度
calc c = count - (length $ takeWhile ( \x -> (magnitude x) <=2) $ take count $ iterate (mandibrotFunc c ) 0 )
-- マンデルブロ集合を計算する複素平面上の点をすべて計算する
-- 引数 left 0 -> top -> width -> height -> dt
numberList left top w h dt = map (\x -> (take w (iterate ( +(dt:+0) ) $ (left:+0) + x))) $ take h $ iterate (+ ((0:+dt))) $ (left:+top)

テーマ : プログラミング
ジャンル : コンピュータ

【つきいちHaskell】2回目 ファイル入出力(2)

ファイル入出力2


前回に引き続いてファイルIO関係を整理していきます。

ハンドラの情報を取得


ハンドラの情報を取得します。

-- 開いているかどうかのチェック
hIsOpen :: Handle -> IO Bool
-- 閉じているかどうかのチェック
hIsClosed :: Handle -> IO Bool
-- 読み込み可能かどうかのチェック
hIsReadable :: Handle -> IO Bool
-- 書き込み可能かどうかのチェック
hIsWritable :: Handle -> IO Bool
-- シーク(ランダムアクセス)可能かどうかのチェック
hIsSeekable :: Handle -> IO Bool
-- ターミナルデバイスにかどうかのチェック
hIsTerminalDevice :: Handle -> IO Bool


ターミナルディバイスってなんだろうと思いファイル、標準入力、標準出力
でチェックしたことろ、
標準入力と標準出力がTrueとなったので、標準入力と標準出力(標準エラー出力も?)みたいです。
その時のコードは以下です。

import System.IO

main :: IO ()
main = do
putStrLn"File (WriteMode)">> withFile "test.txt" WriteMode (handleProperty)
putStrLn "stdin" >> handleProperty stdin
putStrLn "stdout" >> handleProperty stdout


handleProperty :: Handle -> IO ()
handleProperty h = do
putStr "hIsOpen: " >> hIsOpen h >>= print
putStr "hIsClosed: " >> hIsClosed h >>= print
putStr "hIsReadable: " >> hIsReadable h >>= print
putStr "hIsWritable: " >> hIsWritable h >>= print
putStr "hIsSeekable: " >> hIsSeekable h >>= print
putStr "hIsTerminalDevice : " >> hIsTerminalDevice h >>= print



入出力に使う文字コードの変更


日本語のようにアルファベット以外の文字を扱う時に文字コードって結構重要で、文字化けの問題が起きたり起きなかったりするんですよね。windowsとUnix系で文字コードが違うためファイル名が文字化けしたりとか、ブラウザでダウンロードしたら中身のテキストファイルが読めなかったりとか色々起きます。
S-JISが扱えないみたいなので、windows上で扱う場合はテクニックを使う必要があるみたいです。Haskell から MultiByteToWideChar を呼び ShiftJIS←→UTF16 変換する

hSetEncoding :: Handle -> TextEncoding -> IO ()
hGetEncoding :: Handle -> IO (Maybe TextEncoding)


エンコーディング情報を取得するサンプルです。

import System.IO
main :: IO()
main = do
putStrLn "File::::" >> withFile "test.txt" WriteMode encoding
putStrLn "stdin:::" >> encoding stdin
putStrLn "stdout:::" >> encoding stdout
encoding :: Handle -> IO ()
encoding h = hGetEncoding h >>= print


私の環境(CentOS)だと以下のような出力結果になりました。

File::::
Just UTF-8
stdin:::
Just UTF-8
stdout:::
Just UTF-8

テーマ : プログラミング
ジャンル : コンピュータ

関数のMap

Haskellでリスト操作をするときによく使うmap関数は
演算する関数とデータのリストを引数にとって演算した結果のリストを返します。

[例]
map (+10) [1,2,3]
→[11,12,13]


mapと同じように関数のリストとデータを渡して演算した結果のリストを返す関数が欲しいと思って作ってみました。
(私によくあることなんですが、)

mapf :: a -> b -> [(a->b->c)] -> [c]
mapf _ _ [] = []
mapf a b c = (head c) a b : mapf a b (tail c)

テーマ : プログラミング
ジャンル : コンピュータ

階乗の桁数の計算

階乗の桁数を計算するプログラム。
ポイントフリースタイルで書いてみました。


-- 数値演算用モジュールの読み込み.(数値文字列変換用)
import Numeric

-- 計算する階乗n!のnを指定
n = 10

-- エントリーポイント
main = print $ f n

-- 階乗の計算
f = length . flip showInt "" . product . flip take ( iterate (+1) 1 )

テーマ : プログラミング
ジャンル : コンピュータ

プロフィール

かみさまみならい

Author:かみさまみならい
FC2ブログへようこそ!

最近の記事
最近のコメント
最近のトラックバック
月別アーカイブ
カテゴリー
ブロとも申請フォーム

この人とブロともになる

ブログ内検索
RSSフィード
リンク
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。