初期状態

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 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 = undefined

decode :: Code -> Instruction
decode = undefined

execute :: Instruction -> Instruction
execute = id