Интерпретатор для начинающих на Haskell

Я новичок в haskell и мог бы воспользоваться некоторыми отзывами о моем коде и решениях, которые мне нужно было принять. В моем предыдущем проекте я создал парсер JSON, но в значительной степени полагался на рекомендации университетского курса.

Этот проект представляет собой интерпретатор мозгов, для которого я не использовал ничего, кроме статьи в вики о мозговом учении (т. Е. Без чужого дизайна или кода, кроме whileM). В некотором смысле это открыло мне глаза, потому что я, наконец, использовал и разработал монадические операции сам. Но я уверен, что есть еще много глаз, на которые я слеп, поэтому, пожалуйста, укажите, где я ошибаюсь или пропускаю более элегантные решения.

В этой реализации отсутствует какой-либо ввод-вывод, потому что я хотел создать простую базовую реализацию вычислений с отслеживанием состояния. Цель состоит в том, чтобы впоследствии использовать StateT вместо State и объединить его с IO, чтобы я правильно научился использовать преобразователи монад.

В частности, я не уверен в следующих моментах:

1. Модель данных

Я сделал ленту типа с указателем, который можно перемещать и читать / писать. Я использую этот тип как для ленты данных, так и для самой программы brainfuck, ленты с инструкциями. Функциональные возможности двух лент совпадают, но не полностью. Например, операция «увеличить байт в указателе» нужна только для ленты данных, а «искать следующую совпадающую скобку» — только для ленты с инструкциями (строки 1–100).

Возникает вопрос: можно ли создать один тип, для которого я реализую ВСЕ функции, или мне лучше разделить его на два типа и продублировать код для общих инструкций (большинство из них являются общими)? Есть ли идиоматический способ «унаследовать» типы от других типов?

2. Превращение его в государственную монаду

В строках 149–188 я реализую восемь мозговых операций как операции преобразования состояния. Хотя они делают совершенно разные вещи, я считать Мне нужно, чтобы они были одного типа из-за функции chooseAction (строка 232): между различными шагами программы brainfuck следующая инструкция должна считываться с ленты инструкций и превращаться в фактический исполняемый преобразователь состояния. Поскольку эта функция chooseAction должна возвращать значения одного и того же типа, все мои монадические операции должны иметь один и тот же тип … Верно? Как этого лучше всего достичь?

В моем случае я решил создать тип Effect, который в настоящее время имеет два конструктора, но который я могу легко расширить, создав преобразователи состояний с новыми эффектами. Большинство преобразователей состояний (>, <, +, - и т.д.) не имеют возвращаемого значения, поэтому они возвращают None :: Effect. Но преобразователь состояния sOutp, который соответствует '.', Выводит байт. Именно здесь в конечном итоге появится IO, но на данный момент я просто хочу, чтобы этот байт был захвачен типом Effect и возвращался монадической функции, собирающей эффект, whileM :: Monad => m Bool -> ma — > м [a].

Помимо использования здесь монады ввода-вывода и превращения State в StateT, есть ли лучший способ сделать то, что я хочу здесь? И поэтому все мои 8 монадических операций с мозгами должны быть одного и того же типа, даже если они делают такие разные вещи?

3)

Строки 150–188 кажутся немного многословными, потому что мне кажется, что я повторяю одно и то же снова и снова. Мне здесь не хватает элегантного способа или это просто утомительная часть реализации?

Спасибо за любой вклад!

Номера строк см. В этом файле: https://github.com/el-micha/bf/blob/master/bf.hs

Тот же код воспроизводится ниже. Чтобы запустить, попробуйте:

runTM testtm а также runTM testtm2

import Control.Monad
import Data.Char (ord, chr)
import Data.Word (Word8)

-- Implementation without IO. Basecase for future IO extension with MonadTransformers. 

-- ============================================================================
-- Data types for data and instruction tapes and their operations
-- ============================================================================

-- keep track of tape length with tuple (pointer position, tape length so far)
type Bound = (Int, Int)
leftB :: Bound -> Bound
leftB (x, y) = (x-1, y)
rightB :: Bound -> Bound
rightB (x, y) = (x+1, max y (x+1))

-- a type for both the data tape and the instruction tape. 
-- pointer is head of first list. left of pointer is field1[1], right of pointer is field2[0]
-- [1 2 3 4 5 6]
--      ^
-- corresponds to Tape [3, 2, 1] [4, 5, 6] (2, 5)
type Byte = Word8
data Tape = Tape [Byte] [Byte] Bound

zeroes = [0 | _ <- [1..]]

emptyTape :: Tape
emptyTape = Tape [0] zeroes ((0, 0) :: Bound)

initTape :: [Byte] -> Tape
initTape (x:xs) = Tape [x] (xs++zeroes) ((0, length xs) :: Bound)

-- shift pointer by one
left :: Tape -> Tape
left (Tape [] _ _) = error "Cannot shift tape to left: Is at origin. Bad initialization."
left (Tape [x] _ _) = error "Cannot shift tape to left: Is at leftmost cell."
left (Tape (x:xs) ys b) = Tape xs (x:ys) (leftB b)

right :: Tape -> Tape
right (Tape xs (y:ys) b) = Tape (y:xs) ys (rightB b)

ptrPos (Tape xs ys b) = fst b
tapeLength (Tape xs ys b) = snd b

-- read from pointer position
readTape :: Tape -> Byte
readTape (Tape (ptr:xs) ys b) = ptr

-- is byte at ptr 0?
isZero :: Tape -> Bool
isZero = (==0) . readTape

isChar :: Char -> Tape -> Bool
isChar c = (==c) . chr . fromEnum . readTape

-- write to pointer position
writeTape :: Byte -> Tape -> Tape
writeTape n (Tape (ptr:xs) ys b) = Tape (n:xs) ys b

--increment, decrement the byte at ptr
increment :: Tape -> Tape
increment (Tape (ptr:xs) y b) = Tape ((ptr+1):xs) y b

decrement :: Tape -> Tape
decrement (Tape (ptr:xs) y b) = Tape ((ptr-1):xs) y b

inc = increment
dec = decrement

instance Show Tape where
  show (Tape (ptr:xs) ys b) = show (reverse xs) ++ " " ++ show ptr ++ " " ++ show (take (snd b - fst b) ys)

-- for the instruction tape
show' (Tape (x:xx) yy b) = reverse xs ++ " " ++ [ptr] ++ " " ++ take (snd b - fst b) ys
  where ptr = f x
        xs  = map f xx
        ys  = map f yy
        f   = chr . fromEnum

-- ============================================================================
-- Instruction Tape: reuse tape but add some functions

-- find matching ], assuming program is syntactically correct, i.e., there IS a matching ] AND the tape points to a [ 
-- same with [ and left, so parametrized. result points to the bracket, so this needs a right/left shift afterwards, like every other instr.
seekAny dir charMatch charOther t = go 0 (dir t)
  where go n t
          | n == 0 && isChar charMatch t = t
          | isChar charMatch t           = go (n - 1) (dir t)
          | isChar charOther t           = go (n + 1) (dir t)
          | otherwise                    = go n (dir t)

seekRight :: Tape -> Tape
seekRight = seekAny right ']' '['

seekLeft :: Tape -> Tape
seekLeft  = seekAny left  '[' ']'

-- init for instruction tape
initStringTape :: [Char] -> Tape
initStringTape = initTape . map (toEnum . ord)

-- the whole brainfuck program / machine is a turingmachine, where both tapes are in a state which can change with every instr.
data TM = TM {dataTape :: Tape, insTape :: Tape}

instance Show TM where
  show (TM d i) = "n" ++ show d ++ "n" ++ show' i

testtm = TM (initTape [2,7]) (initStringTape "[->+<]")
testtm2 = TM emptyTape (initStringTape "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.")

-- ============================================================================
-- Put the data into a stateful context using State (-transformers) 
-- ============================================================================

-- TM state transformers
newtype State s a = State {runState :: s -> (a, s)}

-- State data constructor proxy
state :: (s -> (a, s)) -> State s a
state = State

-- canonical stuff
instance Functor (State s) where
  fmap = liftM

instance Applicative (State s) where
  pure = return
  (<*>) = ap

instance Monad (State s) where
  return x = state (s -> (x, s)) 
  p >>= k = state $  s0 ->
    let (x, s1) = runState p s0
    in runState (k x) s1  

-- ============================================================================
-- The brainfuck operations are stateful
-- ============================================================================

-- let the monadic functions return effects. can be extended as necessary
data Effect = None | Result Byte

isNone None = True
isNone _    = False

-- these seem a bit verbose.. is this necessary? is there a better way?

-- shift data tape
fRight :: TM -> (Effect, TM)
fRight (TM d i) = (None , TM (right d) i)
sRight = state fRight

fLeft :: TM -> (Effect, TM)
fLeft (TM d i) = (None, TM (left d) i)
sLeft = state fLeft

-- increment byte at ptr on data tape
fInc :: TM -> (Effect, TM)
fInc (TM d i) = (None, TM (inc d) i)
sInc = state fInc

fDec :: TM -> (Effect, TM)
fDec (TM d i) = (None, TM (dec d) i)
sDec = state fDec

-- read or write byte from/to data tape
fOutp :: TM -> (Effect, TM)
fOutp tm = (Result (readTape $ dataTape tm), tm)
sOutp = state fOutp

fInp :: Byte -> TM -> (Effect, TM)
fInp byte (TM d i) = (None, TM (writeTape byte d) i)
sInp byte = state (fInp byte)

-- seek the next [ or the previous ]
fFwd :: TM -> (Effect, TM)
fFwd (TM d i)
  | isZero d  = (None, TM d (seekRight i))
  | otherwise = (None, (TM d i))
sFwd = state fFwd

fBwd :: TM -> (Effect, TM)
fBwd (TM d i)
  | not $ isZero d = (None, TM d (seekLeft i))
  | otherwise = (None, (TM d i))
sBwd = state fBwd

-- ============================================================================

--read instruction from instr tape
fReadInstr :: TM -> (Byte, TM)
fReadInstr tm = (readTape $ insTape tm, tm)
sReadInstr = state fReadInstr

--next instruction: shift instr tape 
fNext :: TM -> ((), TM)
fNext (TM d i) = ((), TM d (right i))
sNext = state fNext

-- check if instruction tape is at the end
fCheck :: TM -> (Bool, TM)
fCheck (TM d i) = ((check i), TM d i)
  where check tape = (readTape tape) == 0
sCheck = state fCheck

sCheckNot = do 
  res <- sCheck
  return (not res)

-- ============================================================================
-- Putting it together: Run brainfuck turing machine step by step, 
-- collecting potential results (Effect)
-- ============================================================================

-- from Control.Monad.Loops
whileM :: Monad m => m Bool -> m a -> m [a]
whileM = whileM'

whileM' :: (Monad m, MonadPlus f) => m Bool -> m a -> m (f a)
whileM' p f = go
  where go = do
          x <- p
          if x
          then do
            x  <- f
            xs <- go
            return (return x `mplus` xs)
          else return mzero

-- from instruction character, resolve which action to take next.
chooseAction :: Enum a => a -> State TM Effect
chooseAction instr = 
  case chr . fromEnum $ instr of 
    '>' -> sRight
    '<' -> sLeft
    '+' -> sInc
    '-' -> sDec
    '.' -> sOutp --sOutp
    ',' -> return None --sInp -- to be combined with IO...
    '[' -> sFwd
    ']' -> sBwd
    _   -> return None

-- run the current step of the brainfuck program
stepTM :: State TM Effect
stepTM = do
  instr <- sReadInstr
  let next = chooseAction instr -- get statetransformer encoded by this char
  res <- next -- run that statetransformer
  sNext -- shift instruction tape pointer to right
  return res

-- combine a list of possibly empty effects into a string
combineEffects :: [Effect] -> [Char]
combineEffects ms = go "" ms 
  where
    go str [] = str
    go str ((None):xs) = go str xs
    go str ((Result byte):xs) = go (str ++ [(chr . fromEnum $ byte)]) xs

-- run a tm and print its result and states
runTM tm = (combineEffects (fst tup), (snd tup)) 
  where
    tup = runState (whileM sCheckNot stepTM) tm