スポンサーサイト

上記の広告は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
スポンサーサイト

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

プロフィール

かみさまみならい

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

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

この人とブロともになる

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