おめが言語
昨日の話ですが。
なんというかこう、あんまり言及したくないような残念な感じのハッカソンに参加してきました。
作った物はコレです。*1
ΩΩωΩΩΩΩΩΩΩωωΩΩωωωωωωωωωωωΩΩΩΩΩωΩΩωωΩΩωωωωωωΩΩΩωΩΩωωωωωωωωΩωΩΩωωΩΩωωωΩωωΩΩΩΩΩΩΩΩωΩωωωΩωωΩΩΩΩΩΩΩΩωΩ
ええと、このファイルを適当なファイルに保存して実行すると、「ABC」と表示される残念な処理系を開発しました。
所謂「難解プログラミング言語」という奴ですね。
本当は「Hello,World!」とかなんか表示させたかったのですが、極めて残念な事に時間が足りなかったので「ABC」と表示させるのが精一杯という残念な結果になってしまいました。*2
説明とか
基本的にはプログラムカウンタを含む４つのレジスタと整数値のアドレスを持ったメモリ（という名のマップ）を持った残念な感じのオレオレレジスタマシンです。
- プログラムは実行前にメモリに読み込まれます。
- 命令は１つのオペレータと２つのオペランドを組にした、３つの整数値からなります。
- Ωとωを交互に記述し、同じ文字が連続して書かれた個数-1が一つの値にパースされます。
例えば「ΩΩωΩΩΩ」というコードは「1,0,2」と解釈されメモリ上にロードされ、「Aレジスタに2をセットする」という意味になるというワケです。残念ですね。
さらに残念なお知らせがあります。分岐命令を制限時間内に実装する事ができなかったため、現段階ではチューリング完全じゃ無いです。
さらに、メモリの読み書きもまだ実装できていません。プログラムカウンタを除いた３つのレジスタで頑張ってください。*3本当に、残念に思っています。
細かい説明は面倒なので完成させたら書きます。大急ぎで書いたｇｄｇｄな事この上ない、とても残念なコードを下に載せておくので、適当に読んだりいじったり遊んだりしても良いですが、そんな残念な事をしている暇があったら勉強なり仕事なりしたほうが有意義かと思います。
コード
本当は色々修正かけてからこの記事を書くのもアリかなぁと思ったのですが、フェアじゃないのは残念な気がしてきたので、６時間分の残念な成果物をそのまんま晒しておきます。
Reg.hs
module Reg(runReg, runProgram) where
import Control.Monad.State
import Data.Char
import qualified Data.Map as M
-- ================================================
---------------------------------------------------
--レジスタ
data Reg = Reg {
regA :: Int,
regB :: Int,
regC :: Int,
regPC :: Int
} deriving Show
data RegState = RegState { reg :: Reg , mem :: M.Map Int Int } deriving Show
-- ================================================
---------------------------------------------------
--レジスタに値入れたり
regSet :: Int -> Int -> Reg -> Reg
regSet 0 x (Reg a b c pc) = Reg x b c pc
regSet 1 x (Reg a b c pc) = Reg a x c pc
regSet 2 x (Reg a b c pc) = Reg a b x pc
regSet 3 x (Reg a b c pc) = Reg a b c x
--レジスタから取ったり
regGet :: Int -> Reg -> Int
regGet 0 r = regA r
regGet 1 r = regB r
regGet 2 r = regC r
regGet 3 r = regPC r
--レジスタ間の値移動
regMov :: Int -> Int -> Reg -> Reg
regMov x y r = regSet x (regGet y r) r
---------------------------------------------------
--演算
regCalc :: (Int -> Int -> Int) -> Int -> Int -> Reg -> Reg
regCalc f x y r =
let v = (regGet x r) `f` (regGet y r)
in regSet x v r
--足し算
regAdd :: Int -> Int -> Reg -> Reg
regAdd = regCalc (+)
--引き算
regSub :: Int -> Int -> Reg -> Reg
regSub = regCalc (-)
--かけ算
regMul :: Int -> Int -> Reg -> Reg
regMul = regCalc (*)
--わり算
regDiv :: Int -> Int -> Reg -> Reg
regDiv = regCalc div
--剰余
regMod :: Int -> Int -> Reg -> Reg
regMod = regCalc mod
-- ================================================
---------------------------------------------------
rReg :: State RegState Reg
rReg = do
state <- get
return $ reg state
rCalc :: (Int -> Int -> Reg -> Reg) -> Int -> Int -> String -> State RegState String
rCalc f x y s = do
state <- get
r <- rReg
put $ RegState (f x y r) (mem state)
return s
rRegRead :: Int -> State RegState Int
rRegRead i = do
state <- get
m <- return $ mem state
x <- return $ M.lookup i m
return $ nothingIsZero x
where
nothingIsZero (Just x) = x
nothingIsZero Nothing = 0
---------------------------------------------------
rSet :: Int -> Int -> String -> State RegState String
rSet x y s = do
state <- get
r <- rReg
put $ RegState (regSet x y r) (mem state)
return s
--足し算
rAdd :: Int -> Int -> String -> State RegState String
rAdd = rCalc regAdd
--引き算
rSub :: Int -> Int -> String -> State RegState String
rSub = rCalc regSub
--かけ算
rMul :: Int -> Int -> String -> State RegState String
rMul = rCalc regMul
--わり算
rDiv :: Int -> Int -> String -> State RegState String
rDiv = rCalc regDiv
--剰余
rMod :: Int -> Int -> String -> State RegState String
rMod = rCalc regMod
---------------------------------------------------
--出力
rPut :: Int -> Int -> String -> State RegState String
rPut i 0 s = do
r <- rReg
return $ chr (regGet i r) : s
rPut i 1 s = do
r <- rReg
return $ (reverse.show $ regGet i r) ++ s
---------------------------------------------------
--命令コードから関数を返す
getOrder :: Int -> (Int -> Int -> String -> State RegState String)
getOrder 1 = rSet
getOrder 2 = rAdd
getOrder 3 = rSub
getOrder 4 = rMul
getOrder 5 = rDiv
getOrder 6 = rMod
getOrder 7 = rPut
-- ================================================
---------------------------------------------------
--初期状態
initReg :: Reg
initReg = Reg 0 0 0 0
initRegState :: [(Int,Int)] -> RegState
initRegState init = RegState initReg (M.fromList init)
runReg :: State RegState a -> [(Int,Int)] -> (a, RegState)
runReg f init = runState f (initRegState init)
-- ================================================
---------------------------------------------------
runProgram :: String -> State RegState String
runProgram res = do
r <- rReg
pc <- return $ regGet 3 r
odr <- rRegRead pc
x <- rRegRead (pc + 1)
y <- rRegRead (pc + 2)
if odr == 0 then return res
else (getOrder odr) x y res >>= rSet 3 (pc + 3) >>= runProgram Main.hs
module Main where
import Data.List
import Reg
import System
odrSplit :: Eq a => [a] -> [Int]
odrSplit = map (\l -> (length l) - 1) . group
makeOrder :: String -> [(Int,Int)]
makeOrder odr = zip [0..] (odrSplit odr)
main :: IO ()
main = do
fname <- getArgs
program <- readFile (head fname)
putStrLn . reverse . fst $ run program
where run prog = runReg (runProgram "") (makeOrder prog)
