このチャプターの目次
load の実装 (toy07)
ソースコード SourceCode は行ごとに、ラベル Label 付き内容 Content に変換します。
コンテンツは、行の2つめ以降のカラムから始まるとしてありますので、ラベルは必ず行の最初のカラムから始まる名前となります。
load :: SourceCode -> Memory
load = map trans . lines
trans :: String -> (Label, Content)
trans s = case break isSpace s of
([], []) -> error "empty line"
(lab, content) -> (lab, read content))
isSpace のために Data.Char モジュールのインポート宣言を追加する必要があります。
import Data.Char
Content の読み込みについては、read が使えるように、Content が Read 型クラスのインスタンスであることを宣言しておきましょう。
instance Read Content where
readsPrec _ content = case words content of
[cnt] -> case readSigned readDec cnt of
[(num,"")] -> [(Data num, "")]
_ -> [(Code (read cnt, None), ""]
[op, arg]
-> [(Code (read op, read arg), ""]
数値の読み込み用の readSigned および readDec のために Numeric モジュールをインポートします。
import Numeric
同様に Operand も Read 型クラスのインスタンスであることを宣言します。
instance Read Operand where
readsPrec _ s = case words s of
[oprd] -> case readSigned readDec oprd of
[(num,"")] -> [(Num Int, "")]
_ -> [(Lab oprd, "")]
_ -> []
コード
ここまでの Toy モジュール
src/Toy.hs
module Toy where
import Data.Char
import Numeric
type SourceCode = String
type Interactive = [Input] -> [Output]
type Input = String
type Output = String
drive :: Interactive -> (String -> String)
drive f = unlines . f . lines
toy :: SourceCode -> Interactive
toy prog = map output . eval . initState (load prog)
output :: ToyState -> Output
output = undefined
load :: SourceCode -> Memory
load = map trans . lines
trans :: String -> (Label, Content)
trans s = case break isSpace s of
([], []) -> error "empty line"
(lab, content) -> (lab, read content)
initState :: Memory -> [Input] -> ToyState
initState = undefined
type Memory = [(Label, Content)]
type Label = String
data Content
= Code Code
| Data Int
instance Read Content where
readsPrec _ content = case words content of
[cnt] -> case readSigned readDec cnt of
[(num,"")] -> [(Data num, "")]
_ -> [(Code (read cnt, None), "")]
[op, arg]
-> [(Code (read op, read arg), "")]
type Code = (Operator, Operand)
data Operator
= STOP
| GET
| PRINT
| LOAD
| STORE
| ADD
| SUB
| GOTO
| IFZERO
| IFPOS
deriving (Show, Read)
data Operand
= None
| Num Int
| Lab Label
deriving Show
instance Read Operand where
readsPrec _ s = case words s of
[oprd] -> case readSigned readDec oprd of
[(num,"")] -> [(Num num, "")]
_ -> [(Lab oprd, "")]
_ -> []
type ToyState = (Final, Memory, Acc, [Input], Output)
type Final = Bool
type Acc = Int
eval :: ToyState -> [ToyState]
eval state = state : rests
where
rests | isFinal state = []
| otherwise = eval (step state)
isFinal :: ToyState -> Bool
isFinal (flg,_,_,_,_) = flg
type Instruction = ToyState -> ToyState
step :: ToyState -> ToyState
step state = execute (decode (fetch state)) state
fetch :: ToyState -> Code
fetch = undefined
decode :: Code -> Instruction
decode = undefined
execute :: Instruction -> Instruction
execute = id