このチャプターの目次
fetch (toy10)
fetch はメモリから次に実行すべき命令のコードを読み出します。次に実行すべき命令コードは、つねにリストの先頭にあるもとのしています。これが「逐次実行」はリストを先頭から消費していくイメージでしょうか。
fetch :: ToyState -> ToyState
fetch state = case state of
(_,top:_,_,_,_) -> case top of
(_,Code code) -> code
_ -> error "not a code"
_ -> error "empty memory"
次に実行すべき命令コードがリストの先頭にあるようにするために、メモリは循環リストにしてしまいます。これで上へのジャンプは、下へ下へ辿って実現できます。そのために、load を修正します。
load :: SourceCode -> Memory
load = cycle . map trans . lines
コード
ここまでの 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 = cycle . map trans . lines
trans :: String -> (Label, Content)
trans s = case break isSpace s' of
([], []) -> error "empty line"
(lab, content) -> (lab, read content)
where
s' = toUpper <$> s
initState :: Memory -> [Input] -> ToyState
initState mem inputs = (False, mem, 0, inputs, "")
type Memory = [(Label, Content)]
type Label = String
data Content
= Code Code
| Data Int
deriving Show
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 state = case state of
(_,top:_,_,_,_) -> case top of
(_,Code code) -> code
_ -> error "not a code"
_ -> error "empty memory"
decode :: Code -> Instruction
decode = undefined
execute :: Instruction -> Instruction
execute = id