このチャプターの目次
trans 修正 (toy08)
trans を確認するためには、Content を Show 型クラスのインスタンスにします。
data Content
= Code Code
| Data Int
deriving (Show)
これで、trans を試してみると、
>>> trans "top get"
("top",Code*** Exception: Prelude.read: no parse
のように、read でのエラーになってしまいます。
これは、"get" を GET として読めないからです。Toy のアセンブリ言語では、大文字小文字を区別しないので、trans の最初の処理で、ソースコードをすべて大文字に変換してしまうようにしましょう。
trans s = s = case break isSpace s' of
([], []) -> error "empty line"
(lab, content) -> (lab, read content)
where
s' = toUpper <$> s
確認すると、
>>> trans "top get"
("TOP",Code (GET,None))
>>> trans " print"
("",Code (PRINT,None))
>>> trans " ifzero bot"
("",Code (IFZERO,Lab "BOT"))
これで OK。
コード
ここまでの 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)
where
s' = toUpper <$> s
initState :: Memory -> [Input] -> ToyState
initState = undefined
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 = undefined
decode :: Code -> Instruction
decode = undefined
execute :: Instruction -> Instruction
execute = id